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)
Related
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)
Given an unsorted list, say (list a b c ...) where all values are integers. Is there a way to use simple recusion to build a binary search tree.
I'm using the Beginner Student version of Racket.
I know how to solve the problem if the list is sorted, and I know how to solve the problem with an accumulator. I also know I could just sort the list and then use simple recusion. But, without any of these methods, how would I do this?
Example:
Given the list (list 1 2 3 5 0 9 3 5 2) the function should produce a binary tree something like
As requested, this is my code for doing the above with an accumulator. I don't have code to perform what I've asked, because I don't know how to make code to do what I've asked.
(define-struct node (key left right))
;; A Node is a (make-node Nat BT BT)
;; A binary tree (BT) is one of:
;; * empty
;; * Node
;; (build-bst-from-list list) takes in an unstorted list and builds
;; a binary search tree using an acculator
;; build-bst-from-list: (listof Num) -> BT
(define (build-bst-from-list list)
(build-bst-from-list/acc (rest list) (make-node (first list) empty empty)))
;; (build-bst-from-list/acc list tree) takes in an unstored list and a binary
;; tree and inserts all the values from the list into the tree such that
;; the tree continues to be a binary search tree
;; build-bst-from-list/acc (listof Num) BT -> BT
(define (build-bst-from-list/acc list tree)
(cond [(empty? list) tree]
[else (build-bst-from-list/acc (rest list)
(bst-add tree (first list)))]))
;; (bst-add tree value) takes in a binary search tree and a value and
;; add's the value such that the tree remainder a binary search
;; tree
;; bst-add: BT Num -> BT
(define (bst-add tree value)
(cond [(empty? tree) (make-node value empty empty)]
[(> (node-key tree) value) (make-node (node-key tree)
(bst-add (node-left tree) value)
(node-right tree))]
[(= (node-key tree) value) tree]
[else (make-node (node-key tree)
(node-left tree)
(bst-add (node-right tree) value))]))
Supposing that an empty tree is represented as null and a non-empty tree is represented as (letf root right), you can define a function to insert an item into a binary tree as follows:
(define (insert item tree)
(cond
[(empty? tree) (list null item null)]
[(< item (second tree)) (list (insert item (first tree)) (second tree) (third tree))]
[(> item (second tree)) (list (first tree) (second tree) (insert item (third tree)))]
[else tree]))
Then, you can use foldl to create a binary search tree as follows:
(define (create-bst items)
(foldl insert null items))
Here are some examples:
> (create-bst '(4 6 2 7 1 5 3))
'(((() 1 ()) 2 (() 3 ())) 4 ((() 5 ()) 6 (() 7 ())))
> (create-bst '(1 2 3 5 0 9 3 5 2))
'((() 0 ()) 1 (() 2 (() 3 (() 5 (() 9 ())))))
So, it turns out all I needed to do for this was, well, simple recursion. Simply do the same as I was doing for the accumulator, but instead of inserting into the accumulator, I will insert into the recursive call which creates the rest of the list.
Something like this
(define (bst-from-list list)
(cond [(empty? list) empty]
[else (bst-add (bst-from-list (rest list))
(first list))]))
(define (bst-add tree value)
(cond [(empty? tree) (make-node value empty empty)]
[(> (node-key tree) value) (make-node (node-key tree)
(bst-add (node-left tree) value)
(node-right tree))]
[(= (node-key tree) value) tree]
[else (make-node (node-key tree)
(node-left tree)
(bst-add (node-right tree) value))]))
my task is to count all element within a list, which have duplicates, eg
( 2 2 (3 3) 4 (3)) will result in 2 (because only 2 and 3 have duplicates)
Searchdeep - just returns a nill if WHAT isn't find in list WHERE
Count2 - go through the single elements and sub-lists
If it finds atom he will use SEARCHDEEP to figure out does it have duplicates, then list OUT will be checked (to make sure if this atom was not already counted (e.g. like ( 3 3 3), which should return 1, not 2)
, increase counter and add atom to the OUT list.
However, i don't understand why, but it constantly returns only 1. I think it is some kind of logical mistake or wrong use of function.
My code is:
(SETQ OUT NIL)
(SETQ X (LIST 2 -3 (LIST 4 3 0 2) (LIST 4 -4) (LIST 2 (LIST 2 0 2))-5))
(SETQ count 0)
(DEFUN SEARCHDEEP (WHAT WHERE) (COND
((NULL WHERE) NIL)
(T (OR
(COND
((ATOM (CAR WHERE)) (EQUAL WHAT (CAR WHERE)))
(T (SEARCHDEEP WHAT (CAR WHERE)))
)
(SEARCHDEEP WHAT (CDR WHERE))
)
)
)
)
(DEFUN Count2 ( input)
(print input)
(COND
((NULL input) NIL)
(T
(or
(COND
((ATOM (CAR input))
(COND
(
(and ;if
(SEARCHDEEP (CAR INPUT) (CDR INPUT))
(NOT (SEARCHDEEP (CAR INPUT) OUT))
)
(and ;do
(Setq Count (+ count 1))
(SETQ OUT (append OUT (LIST (CAR INPUT))))
(Count2 (CDR input))
)
)
(t (Count2 (CDR input)))
)
)
(T (Count2 (CAR input)))
)
(Count2 (CDR input))
)
)
)
)
(Count2 x)
(print count)
First, your code has some big style issues. Don't write in uppercase (some, like myself, like to write symbols in uppercase in comments and in text outside of code, but the code itself should be written in lowercase), and don't put parentheses on their own lines. So the SEARCHDEEP function should look more like
(defun search-deep (what where)
(cond ((null where) nil)
(t (or (cond ((atom (car where)) (equal what (car where)))
(t (searchdeep what (car where))))
(searchdeep what (cdr where))))))
You also should not use SETQ to define variables. Use DEFPARAMETER or DEFVAR instead, although in this case you should not use global variables in the first place. You should name global variables with asterisks around the name (*X* instead of x, but use a more descriptive name).
For the problem itself, I would start by writing a function to traverse a tree.
(defun traverse-tree (function tree)
"Traverse TREE, calling FUNCTION on every atom."
(typecase tree
(atom (funcall function tree))
(list (dolist (item tree)
(traverse-tree function item))))
(values))
Notice that TYPECASE is more readable than COND in this case. You should also use the mapping or looping constructs provided by the language instead of writing recursive loops yourself. The (values) at the end says that the function will not return anything.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(traverse-tree (lambda (item)
(format t "~a " item))
tree))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
; No values
If you were traversing trees a lot, you could hide that function behind a DO-TREE macro
(defmacro do-tree ((var tree &optional result) &body body)
`(progn (traverse-tree (lambda (,var)
,#body)
,tree)
,result))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(do-tree (item tree)
(format t "~a " item)))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
;=> NIL
Using this, we can write a function that counts every element in the tree, returning an alist. I'll use a hash table to keep track of the counts. If you're only interested in counting numbers that will stay in a small range, you might want to use a vector instead.
(defun tree-count-elements (tree &key (test 'eql))
"Count each item in TREE. Returns an alist in
form ((item1 . count1) ... (itemn . countn))"
(let ((table (make-hash-table :test test)))
(do-tree (item tree)
(incf (gethash item table 0)))
(loop for value being the hash-value in table using (hash-key key)
collect (cons key value))))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(tree-count-elements tree))
;=> ((2 . 5) (-3 . 1) (4 . 2) (3 . 1) (0 . 2) (-4 . 1) (-5 . 1))
The function takes a keyword argument for the TEST to use with the hash table. For numbers or characters, EQL works.
Now you can use the standard COUNT-IF-function to count the elements that occur more than once.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(count-if (lambda (item)
(> item 1))
(tree-count-elements tree)
:key #'cdr))
;=> 3
I apologize for the unclear topic title.
I have this function in Scheme which is a custom implementation of the map function. It works fine, but I got lost trying to understand it.
(define (my-map proc . ls)
(letrec ((iter (lambda (proc ls0)
(if (null? ls0)
'()
(cons (proc (car ls0))
(iter proc (cdr ls0))))))
(map-rec (lambda (proc ls0)
(if (memq '() ls0)
'()
(cons (apply proc (iter car ls0))
(map-rec proc (iter cdr ls0)))))))
(map-rec proc ls)))
The problem lays in cons (proc (car ls0)). If I'm correct, when passing (1 2 3) (4 5 6) to the ls parameter the actual value of it will be ((1 2 3) (4 5 6)). Therefore iter car ls0 in map-rec will pass (1 2 3) to iter. Hence proc (car ls0) in iter will have the form: (car (car (1 2 3))), but this is impossible, right?
I know my thinking is flawed somewhere, but I can't figure out where.
Here's one way to understand the procedure:
The iter helper is the same as map, but operating on a single list.
The map-rec helper generalizes iter, working for a list of lists, stopping when at least one of the lists is empty
This part: (apply proc (iter car ls0)) applies the procedure on the first element of each list; the call to iter creates a list of the car part of the lists
And this part: (map-rec proc (iter cdr ls0)) simultaneously advances the recursion over all the lists; the call to iter creates a list of the cdr part of the lists
Perhaps renaming the procedures will make things clear. Here's a completely equivalent implementation, making explicit the fact that map-one operates on a single list and map-many operates on a list of lists:
(define (map-one proc lst) ; previously known as `iter`
(if (null? lst)
'()
(cons (proc (car lst))
(map-one proc (cdr lst)))))
(define (map-many proc lst) ; previously known as `map-rec`
(if (memq '() lst)
'()
(cons (apply proc (map-one car lst))
(map-many proc (map-one cdr lst)))))
(define (my-map proc . lst) ; variadic version of `map-many`
(map-many proc lst))
It works just like the original my-map:
(my-map + '(1 2 3) '(4 5 6) '(7 8 9))
=> '(12 15 18)
And you can check that map-one is really a map that works on a single list:
(map-one (lambda (x) (* x x))
'(1 2 3 4 5))
=> '(1 4 9 16 25)
See the effect of (map-one car lst) on a list of lists:
(map-one car '((1 4 5) (2 6 7) (3 8 9)))
=> '(1 2 3)
Likewise, see how (map-one cdr lst) works:
(map-one cdr '((1 4 5) (2 6 7) (3 8 9)))
=> '((4 5) (6 7) (8 9))
I was doing a problem from the HTDP book where you have to create a function that finds all the permutations for the list. The book gives the main function, and the question asks for you to create the helper function that would insert an element everywhere in the list. The helper function, called insert_everywhere, is only given 2 parameters.
No matter how hard I try, I can't seem to create this function using only two parameters.
This is my code:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
My desired output for (insert_everywhere 'a (list 1 2 3)) is (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a), but instead my list keeps terminating.
I've been able to create this function using a 3rd parameter "position" where I do recursion on that parameter, but that botches my main function. Is there anyway to create this helper function with only two parameters? Thanks!
Have you tried:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
The insert function allows you to insert values anywhere within a list:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
The range function allows you to create Haskell-style list ranges:
(range 0 3) => (0 1 2 3)
The insert-everywhere function makes use of insert and range. It's pretty easy to understand how it works. If your implementation of scheme doesn't have the fold-right function (e.g. mzscheme) then you can define it as follows:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
As the name implies the fold-right function folds a list from the right.
You can do this by simply having 2 lists (head and tail) and sliding elements from one to the other:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
In Racket, you could also express it in a quite concise way as follows:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
This has a lot in common with my answer to Insert-everywhere procedure. There's a procedure that seems a bit odd until you need it, and then it's incredibly useful, called revappend. (append '(a b ...) '(x y ...)) returns a list (a b ... x y ...), with the elements of (a b ...). Since it's so easy to collect lists in reverse order while traversing a list recursively, it's useful sometimes to have revappend, which reverses the first argument, so that (revappend '(a b ... m n) '(x y ...)) returns (n m ... b a x y ...). revappend is easy to implement efficiently:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
Now, a direct version of this insert-everywhere is straightforward. This version isn't tail recursive, but it's pretty simple, and doesn't do any unnecessary list copying. The idea is that we walk down the lst to end up with the following rhead and tail:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
If you put the recursive call in the place of the ..., then you get the result that you want:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
Now, this isn't tail recursive. If you want a tail recursive (and thus iterative) version, you'll have to construct your result in a slightly backwards way, and then reverse everything at the end. You can do this, but it does mean one extra copy of the list (unless you destructively reverse it).
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
How about creating a helper function to the helper function?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
We need our sublists kept separate, so that each one can be prefixed separately. If we'd append all prematurely, we'd lose the boundaries. So we append only once, in the very end:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
Testing:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
By the way this internal function is tail recursive modulo cons, more or less, as also seen in the illustration. This suggests it should be possible to convert it into an iterative form. Joshua Taylor shows another way, using revappend. Reversing the list upfront simplifies the flow in his solution (which now corresponds to building directly the result row in the illustration, from right to left, instead of "by columns" in my version):
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))