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)
Related
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.
I'm new to Scheme (via Racket) and (to a lesser extent) functional programming, and could use some advise on the pros and cons of accumulation via variables vs recursion. For the purposes of this example, I'm trying to calculate a moving average. So, for a list '(1 2 3 4 5), the 3 period moving average would be '(1 2 2 3 4). The idea is that any numbers before the period are not yet part of the calculation, and once we reach the period length in the set, we start averaging the subset of the list according the chosen period.
So, my first attempt looked something like this:
(define (avg lst)
(cond
[(null? lst) '()]
[(/ (apply + lst) (length lst))]))
(define (make-averager period)
(let ([prev '()])
(lambda (i)
(set! prev (cons i prev))
(cond
[(< (length prev) period) i]
[else (avg (take prev period))]))))
(map (make-averager 3) '(1 2 3 4 5))
> '(1 2 2 3 4)
This works. And I like the use of map. It seems composible and open to refactoring. I could see in the future having cousins like:
(map (make-bollinger 5) '(1 2 3 4 5))
(map (make-std-deviation 2) '(1 2 3 4 5))
etc.
But, it's not in the spirit of Scheme (right?) because I'm accumulating with side effects. So I rewrote it to look like this:
(define (moving-average l period)
(let loop ([l l] [acc '()])
(if (null? l)
l
(let* ([acc (cons (car l) acc)]
[next
(cond
[(< (length acc) period) (car acc)]
[else (avg (take acc period))])])
(cons next (loop (cdr l) acc))))))
(moving-average '(1 2 3 4 5) 3)
> '(1 2 2 3 4)
Now, this version is more difficult to grok at first glance. So I have a couple questions:
Is there a more elegant way to express the recursive version using some of the built in iteration constructs of racket (like for/fold)? Is it even tail recursive as written?
Is there any way to write the first version without the use of an accumulator variable?
Is this type of problem part of a larger pattern for which there are accepted best practices, especially in Scheme?
It's a little strange to me that you're starting before the first of the list but stopping sharply at the end of it. That is, you're taking the first element by itself and the first two elements by themselves, but you don't do the same for the last element or the last two elements.
That's somewhat orthogonal to the solution for the problem. I don't think the accumulator is making your life any easier here, and I would write the solution without it:
#lang racket
(require rackunit)
;; given a list of numbers and a period,
;; return a list of the averages of all
;; consecutive sequences of 'period'
;; numbers taken from the list.
(define ((moving-average period) l)
(cond [(< (length l) period) empty]
[else (cons (mean (take l period))
((moving-average period) (rest l)))]))
;; compute the mean of a list of numbers
(define (mean l)
(/ (apply + l) (length l)))
(check-equal? (mean '(4 4 1)) 3)
(check-equal? ((moving-average 3) '(1 3 2 7 6)) '(2 4 5))
Well, as a general rule, you want to separate the manner in which you recurse and/or iterate from the content of the iteration steps. You mention fold in your question, and this points in the right step: you want some form of higher-order function that will handle the list traversal mechanics, and call a function you supply with the values in the window.
I cooked this up in three minutes; it's probably wrong in many ways, but it should give you an idea:
;;;
;;; Traverse a list from left to right and call fn with the "windows"
;;; of the list. fn will be called like this:
;;;
;;; (fn prev cur next accum)
;;;
;;; where cur is the "current" element, prev and next are the
;;; predecessor and successor of cur, and accum either init or the
;;; accumulated result from the preceeding call to fn (like
;;; fold-left).
;;;
;;; The left-edge and right-edge arguments specify the values to use
;;; as the predecessor of the first element of the list and the
;;; successor of the last.
;;;
;;; If the list is empty, returns init.
;;;
(define (windowed-traversal fn left-end right-end init list)
(if (null? list)
init
(windowed-traversal fn
(car list)
right-end
(fn left-end
(car list)
(if (null? (cdr list))
right-end
(second list))
init)
(cdr list))))
(define (moving-average list)
(reverse!
(windowed-traversal (lambda (prev cur next list-accum)
(cons (avg (filter true? (list prev cur next)))
list-accum))
#f
#f
'()
list)))
Alternately, you could define a function that converts a list into n-element windows and then map average over the windows.
(define (partition lst default size)
(define (iter lst len result)
(if (< len 3)
(reverse result)
(iter (rest lst)
(- len 1)
(cons (take lst 3) result))))
(iter (cons default (cons default lst))
(+ (length lst) 2)
empty))
(define (avg lst)
(cond
[(null? lst) 0]
[(/ (apply + lst) (length lst))]))
(map avg (partition (list 1 2 3 4 5) 0 3))
Also notice that the partition function is tail-recursive, so it doesn't eat up stack space -- this is the point of result and the reverse call. I explicitly keep track of the length of the list to avoid either repeatedly calling length (which would lead to O(N^2) runtime) or hacking together a at-least-size-3 function. If you don't care about tail recursion, the following variant of partition should work:
(define (partition lst default size)
(define (iter lst len)
(if (< len 3)
empty
(cons (take lst 3)
(iter (rest lst)
(- len 1)))))
(iter (cons default (cons default lst))
(+ (length lst) 2)))
Final comment - using '() as the default value for an empty list could be dangerous if you don't explicitly check for it. If your numbers are greater than 0, 0 (or -1) would probably work better as a default value - they won't kill whatever code is using the value, but are easy to check for and can't appear as a legitimate average
With the following code, I get #<CompilerException java.lang.UnsupportedOperationException: Can only recur from tail position (NO_SOURCE_FILE:4)> despite the fact that all recurs are in tail positions. If I remove the recur from the one-argument version, it stops complaining. Why is this happening?
(defn remove-duplicates "Removes duplicate elements of lst.
For example, given (1 2 3 1 4 1 2), remove-duplicates returns a sequence
containing the elements (1 2 3 4), in some order."
[lst] (recur (rest lst) (set (first lst)))
[lst uniques] (cond (zero? (count lst)) uniques
:else (cond
(some (partial = (first lst)) uniques)
(recur (rest lst) uniques)
:else
(recur (rest lst) (first lst)))))
You haven't split up the multi-arity bodies right. Should read (defn foo ([x] (...)) ([x y] (...))). This causes the compiler to think you're doing totally different stuff, which probably accounts for your issue.
First of all: you know that all you want is (def remove-duplicates set) or -- if you want a vector -- (def remove-duplicates-vec (comp vec set)), right?
Five things here:
As amalloy noticed, you should've added parens
As kotarak noticed, you can't recur between arities
You can't call (set (first lst)) because set wants coll. If you want, do something like (set (vector (first [1 2 3 2 3]))) but this is neither pretty nor idiomatic
Doing (cond pred1 code1 :else (cond pred2a code2a :else code2b)) could be made simplier: (cond pred1 code1 pred2a code2a :else code2b) -- what you did is treated cond macro as if it were if (which is a built-in as far as I know)
Your last tail-call is also wrong. Assume we've started with [1 2 3 2 1]
When you call it first you have following arguments: ([2 3 2 1] #{1}) (I've skipped the boring part)
Then you have last predicate true, so you go with ([3 2 1] 2) and this is obviously wrong because you wanted ([3 2 1] #{1 2}). You probably want to call (recur (rest lst) (conj uniques (first lst)))
Summing up:
(defn remove-duplicates
([lst] (remove-duplicates (rest lst) #{(first coll)}))
([lst uniques]
(cond
(zero? (count lst)) uniques
(some (partial = (first lst)) uniques)
(recur (rest lst) uniques)
:else
(recur (rest lst) (conj uniques (first lst))))))
Before I start: YES, this is homework from college. Before I get told that I'm lazy and evil: this part of the homework was to convert two functions we already had, this one is the 6th.
(define (flatten-list a-list)
(cond ((null? a-list) '())
((list? (car a-list))
(append (flatten-list (car a-list)) (flatten-list (cdr a-list))))
(else (cons (car a-list) (flatten-list (cdr a-list))))))
The function, as you can guess, flattens a list even if it's nested. My specific problem with the transformation comes in the (list? (car a-list)) condition, in which I'm doing two recursive calls. I already did fibonacci, which I can do by just having two "acummulators" on the tail recursion. However, my mind is not trained in this yet to know how it should go.
I would appreciate if I was given hints and not the result. Thanks!
Here's my solution:
(define (flatten-iter a-list)
(define (flat-do acc lst-interm lst)
(cond
((null? lst)
(reverse acc))
((and (list? lst-interm) (not (null? lst-interm)))
(flat-do acc (car lst-interm) (append (cdr lst-interm) lst)))
((not (list? lst-interm))
(flat-do (cons lst-interm acc) empty lst))
((list? (car lst))
(flat-do acc (car lst) (cdr lst)))
(else
(flat-do (cons (car lst) acc) empty (cdr lst)))))
(flat-do empty empty a-list))
(flatten-iter (list 1 (list 2 (list 3 4 (list 5 empty 6))) 7 8))
=> (1 2 3 4 5 6 7 8)
Tail-recrusive functions require that they never return, and thus you can't use stack for storing your program's state. Instead, you use function arguments to pass the state between function calls. Therefore, we need to determine how to maintain the state. Because the result of our function is list?, it's meaningful to grow an empty list; we're using acc for this purpose. You can see how it works in else branch above. But we should be able to process nested lists. And while we're going deeper, we should keep the rest elements of the nested list for further processing. Sample list: (list 1 (list 2 3) 4 5)
Until (list 2 3) we have already added 1 to accumulator. Since we can't use stack, we need some other place to store the rest elements of the list. And this place is the lst argument, which contains elements of the original list to be flattened. We can just append the lst to the rest elements (cdr (list 2 3)) which are (list 3), and proceed with the list's head we stumbled upon while flattening, i. e. (car (list 2 3)) which is just 2. Now, (and (list? lst-interm) (not (null? lst-interm))) succeeds because flat-do is called this way:
(flat-do (list 1) (list 2 3) (list 4 5))
and the condition triggers this code:
(flat-do (list 1) (car (list 2 3)) (append (cdr (list 2 3)) (list 4 5)))
flat-do again is called this way: (flat-do (list 1) 2 (list 3 4 5))
The condition (not (list? 2)) now succeeds and the code (flat-do (cons 2 1) empty (list 3 4 5)) is evaluated.
The rest processing is done with else branch until lst is null? and reverse is performed on acc. Function then returns the reversed accumulator.
How can I pass a list as a parameter to a function adding elements to it recursively,and have it unmodified when it comes out of recursion?
I want to use the list at each level of recursion with the list having the values added by deeper recursion levels.
To be more specific I want to do a DFS search on a graph and I want to store in the list the nodes I visited.
One method of doing this is just to return the list so you have access to it at higher levels of recursion.
Another method is to have your list be stored in a variable outside of the recursion. In other words not stored on the stack. Since it is not a good idea to use a global variable for this we need to have some local recursion.
The following code is a foolish way to reverse a list but it does illustrate the technique I am talking about.
(define (letrecreverse lst)
(letrec ((retlist '())
(reverse (lambda (lst)
(if (null? lst)
'()
(begin
(set! retlist (cons (car lst) retlist))
(reverse (cdr lst)))))))
(reverse lst)
retlist))
(letrecreverse '(1 2 3 4))
;outputs '(4 3 2 1)
Can you adopt this technique for your purposes?
If you build a new list by consing a value onto an old list, that old list is unmodified.
(define old '(1 2 3))
(define new (cons 55 old))
new
>(55 1 2 3)
old
>(1 2 3)
The 'tail' of the first cons in "new" is the list "old". But old hasn't changed.
(cdr new)
> (1 2 3)
If I understood your question correctly, this could be one solution:
;; Just a helper to print the current list.
(define (show list)
(display "list = ")
(display list)
(newline)
(flush-output))
;; Maximum depth of recursion
(define max-recur 5)
;; Original list is backed-up here.
(define orig-list null)
(define (recur list depth)
(if (null? orig-list)
(set! orig-list list))
(cond ((< depth max-recur)
(show list)
(recur (cons (random max-recur) list) (add1 depth)))
(else orig-list)))
Sample run:
> (recur '(1) 0)
list = (1)
list = (1 1)
list = (2 1 1)
list = (3 2 1 1)
list = (4 3 2 1 1)
(1) ;; In the end you get the original list back.