Scheme find far left node of a tree recursively - recursion

I am writing a function that finds the farthest left node in any tree. The function does not traverse the tree or give the farthest left node but just gives the left most child of the first node.
(define (far-left tree)
(cond (null? (cadr tree))
(car tree)
(far-left (cdr tree))))
sample input, which gives many nodes rather than the desired one:
(display (far-left '(1 (3 4 (6 7 (12 13))) 8 9 (10 11))))

What you call "the left most child of the first node" is (cadr tree).
There is one (cadr tree) in your function, and that suggests that the first condition is always true.
And that is what's happening.
cond's form is
(cond clause-1 clause-2 ...)
Each clause in turn has the form (condition value).
That is,
(cond (condition-1 value-1)
(condition-2 value-2)
(condition-3 value-3)
...)
If you match this to your function, you will see that
null? is condition-1 and (cadr tree) is value-1,
car is condition-2 and tree is value-2, and
far-left is condition-3 and (cdr tree) is value-3.
Since null? is not #f, the first clause is always selected.
The correct form is
(define (far-left tree)
(cond
((null? (cadr tree)) (car tree))
(else (far-left (cdr tree)))
This code still does not work, though.
Fixing the bugs left as an exercise.

Data Definition: Tree
A Tree is either a Leaf or a Node where:
A Leaf is a Number.
A Node is a non-empty list of sub-Trees .
Function: far-left
Condition 1: A Leaf as an input is invalid because we're supposed to find the "farthest left node in any tree.
Condition 2: If a Node has Leaf as its left-most (or first) element, then it is the left-most node. If the left-most element is a Tree that is not a Leaf we recur on it.
#lang typed/racket
(define-type Leaf Number)
(define-type Node (Pairof Tree (Listof Tree)))
(define-type Tree (U Leaf Node))
(: far-left (-> Tree Node))
(define (far-left tree)
(cond [(number? tree) (error "Farthest left node of a leaf does not exist!")]
[(cons? tree) (if (number? (first tree)) tree (far-left (first tree)))]))
Tests:
(far-left '(1 (3 4 (6 7 (12 13))) 8 9 (10 11)))
; => '(1 (3 4 (6 7 (12 13))) 8 9 (10 11))
(far-left '((3 4 (6 7 (12 13))) 1 8 9 (10 11)))
; => '(3 4 (6 7 (12 13)))
(far-left '(((6 7 (12 13)) 3 4) 1 8 9 (10 11)))
; => '(6 7 (12 13))
(far-left '((((12 13) 6 7) 3 4) 1 8 9 (10 11)))
; => '(12 13)

Related

A way of abstracting a breadth-first list traversal

I wrote a simple/naive graph traversal in breadth-first, and then was playing with it to apply a simple tree, instead of a structured graph that easily bends itself to this function. I'm afraid I'm having difficulty coming up with a get-children lambda that'll yield the result I want, and it seems to be a nice brain-teaser to have a go at. Here it is:
The breadth-first function is:
(defun run-breadth-first (node fn get-children)
"Run fn breadth-first starting from node, traversing the whole tree."
(let ((queue (list node)))
(loop for i = (first queue)
for inners = (if i (funcall get-children i) nil)
until (null i)
when inners do (setf queue (append queue inners))
do
(funcall fn i)
(pop queue))))
Btw, if anyone is wondering why I'm doing this, because I found it a nice abstraction to apply, and have a find call of one line to do a search as such:
(run-breadth-first sg-node #'find-sg-at-aux #'inner-nodes)
Now the difficulty I'm having is, I'd like to see this run with a regular list, instead of a custom graph structure with get-children functions returning a list of children. Here is an attempt with a simple 5-am test syntax:
(test run-breadth-first.test.list
(let (output)
(run-breadth-first '(1 2 (3 (4.1 4.2)) 5 (6 (6.1)) 7)
(lambda (node) (push (first node) output))
(lambda (node) (if (atom (first node))
(list (rest node))
(list (append (rest node) (first node)))))))
(is (equal output (reverse '(1 2 5 7 3 6 4.1 4.2 6.1)))))
But when you run the statement inside, which is here for easy copying and separation:
(let (output)
(run-breadth-first '(1 2 (3 (4.1 4.2)) 5 (6 (6.1)) 7)
(lambda (node) (push (first node) output))
(lambda (node) (if (atom (first node))
(list (rest node))
(list (append (rest node) (first node))))))
output)
it returns:
(6.1 4.2 4.1 #1=(6.1) 6 #2=(4.1 4.2) 3 7 (6 #1#) 5 (3 #2#) 2 1)
The order of elements are correct, except the inner-lists. I'm yet to find a way to give me the result:
(6.1 4.2 4.1 6 3 7 5 2 1)
Could anyone see a solution?
Apparently, using just lambda functions was taking the valuable tool 'trace' away, and writing the function explicitly helped me shape it further.
Here is one function that'll give the correct result:
(defun get-list-children (node)
(if (atom (first node))
(if (atom (second node))
(list (rest node))
(list (append (rest (rest node)) (second node))))
(list (append (rest node) (first node)))))
then call it:
(let (output)
(run-breadth-first '(1 2 (3 (4.1 4.2)) 5 (6 (6.1)) 7)
(lambda (node) (push (first node) output))
#'get-list-children)
output)

Lisp program to check whether a binary tree is a Binary Search Tree

Write a Lisp program to check whether a binary tree is a Binary Search Tree.
The left sub-tree of a node has a key less than or equal to its parent node's key. The right sub-tree of a node has a key greater than to its parent node's key.
A list can be used to represent the structure of a binary tree as follows:
'(8 (3 (1 () ()) (6 (4 () ())( 7 () ()))) (10 (()) (14 (13) ()))) where this would return true.
I am trying to write a binary recursive approach but I'm a beginner and I have no idea where to go from here.
(defun isBST (L)
(cond
((null (first L)) t)
((and (not (null (caadr L)) ) (< (first L) (caadr L)) ) nil)
((and (not (null (caaddr L))) (> (car L) (caaddr L))) nil)
((and (not (isBST (cadr L))) (not (isBST (caddr L)))) ))
)
You can express your definitions in code to make your life easier.
A node is represented as a list of three things: a key, a left subtree, and a right subtree.
(defun node-key (node)
(first node))
(defun node-left-subtree (node)
(second node))
(defun node-right-subtree (node)
(third node))
For a tree to be a binary search tree, four conditions must be met, unless both subtrees are empty:
the left subtree must be a binary search tree
the right subtree must be a binary search tree
the largest key of the left subtree (if present) must be smaller than the root key
the smallest key of the right subtree (if present) must be bigger than the root key
Note: the naming convention in Lisp is to write everything in lower case, with word parts separated by dashes. A predicate, i. e. a function that is used to obtain a truth value, ends with p. The predicate for a binary search tree might be named bst-p or binary-search-tree-p. The function to obtain the largest key of a bst might be called bst-largest-key.
In order to get the largest (smallest) key of a BST, you only need to recurse on the right (left) subtree.
Here's a scheme procedure that might help you.
(define (is-bst l)
(define (loop node proc)
(if (null? node)
#t
(and (proc (car node))
(loop (cadr node)
(curry > (car node)))
(loop (caddr node)
(curry < (car node))))))
(loop l (const #t)))
It can be frustrating to fix a program when your input data is the source of the bugs. I had to fix your (()) and (13). Use multiple lines and the auto-indenter to easily find mistakes.
(is-bst '(8 (3 (1 () ())
(6 (4 () ())
(7 () ())))
(10 ()
(14 (13 () ())
()))))
;; #t
Invalidate one of the nodes to ensure is-bst detects a non-bst.
(is-bst '(8 (3 (1 () ())
(6 (4 () ())
(7 () ())))
(10 ()
(2 (13 () ()) ;; 14 changed to 2; invalid tree
()))))
;; #f
To make a slight improvement, notice we called (car node) three times in the procedure above. This should be avoided with the use of let.
(define (is-bst l)
(define (loop node proc)
(if (null? node)
#t
(let ((value (car node)))
(and (proc value)
(loop (cadr node)
(curry > value))
(loop (caddr node)
(curry < value))))))
(loop l (const #t)))
Another interesting way is using streams, which can be easily implemented using basic procedures. We could write a generic traverse procedure to traverse our trees.
(define (traverse bst)
(if (null? bst)
empty-stream
(stream-append (traverse (cadr bst))
(stream (car bst))
(traverse (caddr bst)))))
(define tree
'(8 (3 (1 () ())
(6 (4 () ())
(7 () ())))
(10 ()
(14 (13 () ())
()))))
(stream->list (traverse tree))
;; '(1 3 4 6 7 8 10 13 14)
Now we write is-bst to simply check that the values come out in ascending order.
(define (is-bst l)
(define (loop x s)
(if (stream-empty? s)
#t
(let ((y (stream-first s)))
(and (< x y)
(loop y (stream-rest s))))))
(loop -inf.0
(traverse l)))
(is-bst tree)
; #t
(is-bst '(1 (2 () ())
(3 () ())))
; #f
Because a stream is used, the values come out lazily. If an early #f is found, iteration of the stream is stopped and the computation is finished.

Find main diagonal in matrix - Scheme

I need to extract the main diagonal from a square matrix
(1 2 3)
(4 5 6) -> (1 5 9)
(7 8 9)
I have the following code and I need to replace the ... with the appropriate functions.
(define (diag m)
(if (null? m) '()
(cons (... m)
(diag (map ... (... m))))))
Input: (diag '((1 2 3) (4 5 6) (7 8 9)))
Output: (1 5 9)
Any ideas? Thank you!
First of all I created a function that returns n-th element of list (I am not sure if you can use built-in function for it, that's why I created my own bicycle):
(define (nthItem l item currentItem)
(if (null? l) '()
(if (= currentItem item) (car l)
(nthItem (cdr l) item (+ currentItem 1)))))
Then I created a function that you need. I added a parameter "i" that contains current position on a diagonal:
(define (diagPrivate m i)
(if (null? m) '()
(cons (nthItem (car m) i 0)
(diagPrivate (cdr m) (+ i 1)))))
For better appearance I created a wrapper for this function (that looks like your initial function):
(define (diag m)
(diagPrivate m 0))
So you are asking, given you have the list '((1 2 3) (4 5 6) (7 8 9)) how do I get the value 1 from it?
Then you are asking given the same list, how do I get ((4 5 6) (7 8 9)) from it.
Then given that result how do I make a new list using map that only takes the rest of each element list so that the result is ((5 6) (8 9))
The question code looks like came from SO as an answer with VERY easy challenge on how to complete it. Am I right?
The answer is of course just list accessors every beginner schemer should know: cdr x 2 and caar, not necessarily in that order.
Using Racket which is a Scheme dialect:
(define diag '((1 2 3) (4 5 6) (7 8 9)))
(define (getDiagonal l)
(let loop ((l l)
(ol '())
(n 0))
(cond
[(empty? l) (reverse ol)]
[(loop (rest l)
(cons (list-ref (first l) n) ol)
(add1 n))])))
(getDiagonal diag)
Output:
'(1 5 9)
There is for/list loop in Racket which also can be used here:
(for/list ((i (length diag)))
(list-ref (list-ref diag i) i))

How to write adjoin-set recursively in Lisp/scheme

I'd like to write the following ex:
(adjoin-set 2 (adjoin-set 8 (adjoin-set 4 (adjoin-set 3 (adjoin-set 7 (adjoin-set 5 '()))))))
recursively.
My other code is as follows (from Structure and Interpretation of Computer Programs, 2nd ed.)
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right)
(list entry left right))
(define (adjoin-set x set)
(cond ((null? set) (make-tree x '() '()))
((= x (entry set)) set)
((< x (entry set))
(make-tree (entry set)
(adjoin-set x (left-branch set))
(right-branch set)))
((> x (entry set))
(make-tree (entry set)
(left-branch set)
(adjoin-set x (right-branch set))))))
So far I've tried the following:
(define (bst list)
(if (null? list) '())
(bst (adjoin-set (cdr list) '())))
This doesn't work. How could I make this work?
I'd like to follow a similar approach as when making the calls manually, i.e., (adjoin-set (car list) (next adjoint-set)).
First, rather than working a binary search tree for representing sets, I'll just use lists with no duplicate elements. The point is that we'll write a method to adjoin a single element, and then figure out how to call it with repeatedly with multiple values and get the final result. You'll still be able to apply this approach to your tree-based implementation.
Representing sets with lists containing no duplicates
If we represent sets by lists with no duplicates, then a single adjoin just takes an element and a list and returns the list if the element is already in the list, or a new list created from the new element and the old list, if the list doesn't contain it. So, adjoin isn't too hard:
(define (member? element list)
(cond
((null? list) #f)
((eqv? (car list) element) #t)
(else (member? element (cdr list)))))
(define (adjoin element set)
(if (member? element set)
set
(cons element set)))
This is counterpart of what you've already got with adjoin-set from SICP.
Performing more than one operation
Now, if you want to be able to adjoin a bunch of elements onto some initial value, you're performing a reduction, or fold. There are lots of variant implementations of reduce or fold (and foldr, foldl, etc.), but a quick and simple left-associative version is:
(define (reduce function list initial-value)
(if (null? list)
initial-value
(reduce function
(cdr list)
(function (car list) initial-value))))
Now, you can reduce your adjoin function over a list of elements of and get the final result:
(define (adjoin* elements set)
(reduce adjoin elements set))
Here are two examples that adjoin a bunch of elements to some preexisting sets. In the first case, the set is the empty set. In the second case, it's the set (1 2 3 4). Of course, to make this work with your code, those initial sets will need to be tree-based sets.
(display (adjoin* '(5 7 3 4 8 2) '()))
;;=> (2 8 4 3 7 5)
(display (adjoin* '(5 7 3 4 8 2) '(1 2 3 4)))
;;=> (8 7 5 1 2 3 4)

Constructing tree from symbolic input

I am trying to construct a tree in scheme language , from string input. Following is what i have tried -
(define travsal (lambda (tree)
(cond
((null? tree) '())
(#t (append (travsal (car tree)) (cons (cadr tree)
(travsal (caddr tree))))))))
(define tree1 '(((() 4 ()) 2 (() 5 ())) 1 ((() 6 ()) 3 (() 7 ()))))
(display tree1)
(newline)
(travsal tree1)
As you can see its just iterating the input provided and not doing what actual binary tree should do.
I am struck at the logic as of how to save the tree using nodes and child from symbolic input like - "(((() 4 ()) 2 (() 5 ())) 1 ((() 6 ()) 3 (() 7 ()))))" and then print it out like above function is printing.
Please help out , i was asked this question in an interview and still can't solve it.
What do you mean with "not doing what actual binary tree should do"? . The traversal code is fine, it's doing an in-order traversal of the tree. Fixing some formatting issues:
(define travsal
(lambda (tree)
(cond ((null? tree) '())
(else (append (travsal (car tree))
(cons (cadr tree)
(travsal (caddr tree))))))))
Now, bear in mind that the tree you provided is binary but not sorted:
(define tree1 '(((() 4 ()) 2 (() 5 ())) 1 ((() 6 ()) 3 (() 7 ()))))
If we draw it, it'll look like this:
1
/ \
2 3
/ \ / \
4 5 6 7
Which, after an in-order traversal will correctly yield this result when using the travsal procedure:
(travsal tree1)
=> '(4 2 5 1 6 3 7)

Resources