I use 2 methods to build a tree based on cons cells.
(defun make-tree (nodes)
(cons nodes NIL))
(defun add-child (tree child)
(setf (cdr tree) (append (cdr tree) child)))
Then I created 4 parameters:
(defparameter *root* (make-tree "root"))
(defparameter *a* (make-tree "a"))
(defparameter *b* (make-tree "b"))
(defparameter *c* (make-tree "c"))
And I construct the following tree:
(add-child *root* *a*)
(add-child *root* *b*)
(add-child *a* *c*)
The *root* is displayed in the console:
CL-USER> *root*
("root" "a" "b")
My question is: Is it possible to retrieve c from *root*? Something like: (cdr (car (cdr *root*))) returns an error.
You need to use NCONC rather than APPEND in ADD-CHILD, so you don't make copies of the subtrees.
(defun add-child (tree child)
(setf (cdr tree) (append (cdr tree) child)))
With this change, after I do all the other steps, I get:
> *root*
("root" "a" "b" "c")
> (car (cdr (cdr (cdr *root*))))
"c"
> (cadddr *root*)
"c"
Related
(defun leftorright (element tree)
(cond ((null (car tree))
(setf tree
(cons element (cons (cons NIL NIL) (cons NIL NIL)))))
((>= element (car tree))
(if (null (caddr tree))
(setf (cddr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cddr tree))))
((< element (car tree))
(if (null (caaddr tree))
(setf (cadr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cadr tree))))))
(setf tree (cons NIL NIL))
(print tree)
(leftorright 8 tree)
(leftorright 3 tree)
(leftorright 6 tree)
(leftorright 4 tree)
(leftorright 7 tree)
(print tree)
(defun leftorright (element tree)
(cond ((null (car tree))
(setf tree
(cons element (cons (cons NIL NIL) (cons NIL NIL)))))
((>= element (car tree))
(if (null (caddr tree))
(setf (cddr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cddr tree))))
((< element (car tree))
(if (null (caaddr tree))
(setf (cadr tree)
(cons element (cons (cons NIL NIL) (cons NIL NIL))))
(leftorright element (cadr tree))))))
So looking at
(setf tree (cons NIL NIL))
(print tree)
You think of the tree structure as something with 2 slots - a left and a right one. leftorright is actually an inser function which takes an element and fits the element into either left or right slot of a tree.
(null (car tree)) considers the case that the tree is empty.
In that case you want to set tree
(cons element (cons (cons NIL NIL) (cons NIL NIL))).
Let's take 'element as value for element just to see the returned structure:
(ELEMENT (NIL) NIL)
Here is already some problem. Why not (element nil nil)? OR: (element (nil) (nil))?
In the next cond clauses, you distinguish between the cases that element is >= (car tree) (the current value?) and < than (car tree).
Then, in the next step you distinguish the case that the first subtree (caddr tree) is null - thus empty. In that case you again build (element (nil) nil). But you assign it to some subparts of tree.
(caddr tree) or (cadr tree). If they are not empty you delegate to leftorright to handle those subtreeparts.
So as many commentators point our, your (setf tree ...) expressions are problematic - because they are mutating tree -
obviously you come from some non-lisp language (which we lispers call blubb language) and try to think in the blubb way - meaning imperatively.
The lisp-way for such tree functions is always to recursively construct a tree and return the entire tree.
Recursion means to break down the cases into the very primitive and simple cases - and just to think-through one step.
So what is the most primitive case of tree? - If we assume that it is actually a list - probably of the length 3 (current-value left right).
The most primitive tree is the empty tree. (null tree).
So we start with
(defun insert (element tree)
(cond ((null tree) (cons element (cons nil (cons nil nil))))
...))
However, cons cons cons is not as nice as once a list. So let's do:
(defun insert (element tree)
(cond ((null tree) (list element nil nil))
...))
And we use list for constructing a tree.
If the tree is not empty, it contains 3 slots - the first for the element (current-value) and the seconds and third slots are for sub-trees (either an empty-tree - '() - or another 3-slot-list - a real tree.
For the next element which gets inserted to any non-empty tree - the criterion is the current value. Any element >= than the current value gets inserted as a tree into the right slot. Otherwise/else/< into the left slot.
(defun insert (element tree)
(cond ((null tree)
(list element
nil
nil))
((>= element (car tree))
(list (car tree) (cadr tree) (insert element (caddr tree))))
(t
(list (car tree) (insert element (cadr tree)) (caddr tree)))))
and that is actually what you wanted.
Let's use it:
(defparameter *tree* nil) ;; generate an empty tree
Now let's insert - but now we assign the result anew to *tree* using setf.
(setf *tree* (insert 8 *tree*))
(setf *tree* (insert 3 *tree*))
(setf *tree* (insert 6 *tree*))
(setf *tree* (insert 4 *tree*))
(setf *tree* (insert 7 *tree*))
;; let's see how now *tree* looks like:
*tree*
;; => (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)
Let's improve the function
We are lazy, we don't want to write so often setf and we want to give in order the numbers to be inserted.
First, we change the order of the arguments:
(defun insert (tree element)
(cond ((null tree)
(list element
nil
nil))
((>= element (car tree))
(list (car tree) (cadr tree) (insert (caddr tree) element)))
(t
(list (car tree) (insert (cadr tree) element) (caddr tree)))))
And then, we make this function variadic - means it can take as many arguments as we want (namely the sequence of the elements):
(defun insert* (tree &rest elements)
(let ((tree tree))
(loop for e in elements
do (setf tree (insert tree e))
finally (return tree))))
Now we can do:
(insert* '() 8 3 6 4 7)
;;=> (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)
The nice thing is, we used a local (let ((tree tree)) ...)
and we loop over the elements and do (setf tree ...) meaning we mutate the local tree only. So the global variable given for tree is unaffected.
Unless we setf the new result to the global tree's variable.
Like this:
(defparameter *tree* '())
(setf *tree* (insert* *tree* 8 3 6 4 7))
*tree*
;;=> (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)
setf is necessary to change the *tree* value.
Look:
(defparameter *tree* '())
(insert* *tree* 8 3 6 4 7)
*tree*
;;=> NIL ;; original *tree* value is not altered by `insert*` function!
Destructive insert!
I also tried a destructive insert!.
However, perhaps things could be improved. I am open for suggestions.
(defun %insert! (tree element &optional (acc '()))
"Generate setf expression for `insert!` macro!"
(cond ((null tree)
(nreverse (cons (list element nil nil) acc)))
((>= element (car tree))
(%insert! (third tree) element (cons 'third acc)))
(t
(%insert! (second tree) element (cons 'second acc)))))
(defun butlast-last (l &optional (acc '()))
(cond ((or (null l) (null (cdr l))) (values (nreverse acc) (car l)))
(t (butlast-last (cdr l) (cons (car l) acc)))))
(defun %insert!-to-setf (%insert!-expression tree)
(multiple-value-bind (seq expr) (butlast-last %insert!-expression)
(append (cons 'setf (list (reduce (lambda (res e) (cons e (list res))) seq :initial-value tree)))
(list (cons 'quote (list expr))))))
(defmacro insert! (tree element)
(eval `(%insert!-to-setf (%insert! ,tree ,element) ',tree)))
The usage of eval in the macro already signals something is very bad in this code.
See the last section of this answer to see how a better insert! and insert*! can be written!
Destructive insert! and insert*! as pure functions
Finally, I figured out how to do destructive insert! and insert*! as pure functions.
(defun insert! (tree element)
(let ((e (list element nil nil)))
(cond ((null tree)
(setf tree e))
(t
(labels ((%insert! (itree)
(cond ((>= element (first itree))
(if (null (third itree))
(setf (third itree) e)
(%insert! (third itree))))
(t
(if (null (second itree))
(setf (second itree) e)
(%insert! (second itree)))))))
(%insert! tree))))
tree))
(defun insert*! (tree &rest elements)
(loop for e in elements
do (setf tree (insert! tree e))
finally (return tree)))
(defparameter *t* '())
(setf *t* (insert! *t* 3))
(setf *t* (insert! *t* 8))
(setf *t* (insert! *t* 7))
(setf *t* (insert! *t* 5))
(insert*! '() 3 8 7 5)
And finally make out of them imperative macros
Imperative in that way that they are mutating the tree argument.
And you don't need to assign the results to a new value.
I think these macros are what you actually wanted to program!
BUT destructive insert! and insert*! as pure functions is more lispier than the macros which are following now.
(defun %insert! (tree element)
(let ((e (list element nil nil)))
(cond ((null tree)
(setf tree e))
(t
(labels ((%%insert! (itree)
(cond ((>= element (first itree))
(if (null (third itree))
(setf (third itree) e)
(%%insert! (third itree))))
(t
(if (null (second itree))
(setf (second itree) e)
(%%insert! (second itree)))))))
(%%insert! tree))))
tree))
(defun %insert*! (tree &rest elements)
(loop for e in elements
do (setf tree (%insert! tree e))
finally (return tree)))
(defmacro insert! (tree element)
`(setf ,tree (%insert! ,tree ,element)))
(defmacro insert*! (tree &rest elements)
`(setf ,tree (%insert*! ,tree ,#elements)))
(defparameter *t* '())
(insert! *t* 3)
(insert! *t* 8)
(insert! *t* 7)
(insert! *t* 5)
(defparameter *t* '())
(insert*! *t* 3 8 7 5)
I am trying to code a function that will let me input a list, and it will produce a list of lists. Each list in the product will contain i+1 duplicates of the what was in index i of the original list.
So something like (expand (list "a" "b" "c")) will give me (list (list "a") (list "b" "b") (list "c" "c" "c")).
I am using Racket Beginning Student with List Abbreviations, and I am not allowed to use the "make-list" function.
Write helper function with new argument (i = number of duplicates) and use function make-list for repeating given element i times (or write your own version of make-list):
(define (my-make-list i elem)
(if (<= i 0) '()
(cons elem (my-make-list (- i 1) elem))))
(define (expand-help lst i)
(if (null? lst) '()
(cons (my-make-list i (car lst))
(expand-help (cdr lst) (+ i 1)))))
(define (expand lst)
(expand-help lst 1))
Example:
> (expand (list "a" "b" "c"))
(list (list "a") (list "b" "b") (list "c" "c" "c"))
I'm trying to teach myself Racket. I'm currently trying to write a function to help understand nested lists. The function takes a nested list and a procedure and applies the procedure to each element to produce a new list. An example:
(map-tree even? '(1 2 3 4)) => '(#f #t #f #t)
Here's what I've got so far:
(define (map-tree proc tree)
(map-tree-aux tree proc '() ))
(define (map-tree-aux tree proc lst)
(if (null? tree)
lst
(if (list? tree)
(if (null? (cdr tree))
(if (number? (car tree))
(map-tree-aux (car tree) proc (append-end (proc (car tree)) lst))
(map-tree-aux (car tree) proc lst))
(if (number? (car tree))
(map-tree-aux (cdr tree) proc (append-end (proc (car tree)) (map-tree-aux (car tree) proc lst)))
(map-tree-aux (cdr tree) proc lst)))
lst)))
(define (append-end elem lst)
(append lst (list elem)))
While this works with the original example I supplied, a more complex example comes out incorrectly:
(map-tree even? '(1 (2 (3 (4))))) should be '(#f (#t (#f (#t)))), but is currently (#f #t #f #t).
I know it's just a matter is "listing" somewhere, but I'm having an issue finding out how to do it.
My first thought was to apply the list procedure to the lst if the tree is null and (car tree) is not a number, but I get the opposite of what I want (the resultant list is nested in the opposite direction). I'd really appreciate your help.
Thanks!
When iterating over list of lists, the general idea for the cases to check is:
if list is empty (null? lst), do something ...
if the first item in list is atomic (not (pair? (car lst))), do something else ...
if the first item in list is a list itself (pair? (car lst)), else ...
Choosing the right construct is also important, ie. instead of nesting if statements, using cond or match etc. is preferred.
Also try and avoid using non-constant time procedures (such as append) in your recursive steps to improve efficiency.
With these in mind, one approach to create the function in question is by simply using cons to build a new list while preserving the structure of the old, as follows:
(define (my-map pred lst)
(cond
((null? lst) '())
((not (pair? (car lst)))
(cons (pred (car lst))
(my-map pred (cdr lst))))
(else
(cons (my-map pred (car lst))
(my-map pred (cdr lst))))))
You can write the same function using match instead of cond:
(define (my-map pred lst)
(match lst
['() '()]
[(cons (? pair?) b)
(cons (my-map pred (car lst))
(my-map pred (cdr lst)))]
[(cons a b)
(cons (pred (car lst))
(my-map pred (cdr lst)))]))
You can also build a tail-recursive function that does this:
(define (my-map pred lst)
(let loop ((lst lst)
(acc '()))
(cond
((null? lst)
(reverse acc))
((not (pair? (car lst)))
(loop (cdr lst) (cons (pred (car lst)) acc)))
(else
(loop (cdr lst) (cons (loop (car lst) '()) acc))))))
Notice that (reverse acc) is returned in the base case because the list being built in the accumulator acc is in reverse order from the original list lst. To avoid this, we can modify this function to accumulate a continuation instead:
(define (my-map pred lst)
(let loop ((lst lst)
(acc identity))
(cond
((null? lst)
(acc '()))
((not (pair? (car lst)))
(loop (cdr lst) (lambda (r)
(acc (cons (pred (car lst)) r)))))
(else
(loop (cdr lst)
(lambda (r)
(acc (cons (loop (car lst) identity) r))))))))
For all cases, you will have:
(my-map even? '(1 2 3 4 5 7))
=> '(#f #t #f #t #f #f)
(my-map even? '(1 (2 (3 (4 (5 (7)))))))
=> '(#f (#t (#f (#t (#f (#f))))))
I am learning Lisp and I had to write a function whose return value was a list containing the odd integers (if any) from the given input. In code I have this:
(defun f3 (a)
(cond
((null a) nil )
((and (numberp (car a)) (oddp (car a))) (cons (car a) (f3 (cdr a))))
(T (f3 (cdr a)))
) ; end cond
)
I originally wanted to use the append function, but I kept getting errors.
It was recommended to me to use cons function. When I did this my function started working (code is above). I originally had this:
(defun f3 (a)
(cond
((null a) ())
((and (numberp (car a)) (oddp (car a))) (append (f3 (cdr a)) (car a))))
(T (append () (f3 (cdr a))))
)
)
but kept getting errors. For example, if I called (f3 '(1 2 3)) it would say "error 3 is not type LIST". So, my questions are why does cons work here and why did append not work? How does cons work? Thanks in advance.
append wants list arguments, and (car a) is not a list. Instead of (car a) you'd need (list (car a)). In other words, (append (f3 (cdr a)) (list (car a))).
That will basically work, but you'll get the result in reverse order. So that should be (append (list (car a)) (f3 (cdr a))).
Also note that your (append () (f3 (cdr a))) is equivalent to just (f3 (cdr a)).
The resulting changes in your original would be:
(defun f3 (a)
(cond
((null a) ())
((and (numberp (car a)) (oddp (car a)))
(append (list (car a)) (f3 (cdr a)))))
(T (f3 (cdr a)))))
But, you wouldn't normally use append to prepend a single element to a list. It would more naturally be done using cons. So
(append (list (car a)) (f3 (cdr a)))
Is more appropriately done by:
(cons (car a) (f3 (cdr a)))
Which finally takes you right to the working version you showed.
While something like mbratch's answer will help you in learning about list manipulation (and so is probably a more useful answer for you at this point in your study), it's also important to learn about the standard library of the language that you're using. In this case, you're trying to filter out everything except odd numbers. Using remove-if-not, that's just:
(defun keep-odd-numbers (list)
(remove-if-not (lambda (x)
(and (numberp x) (oddp x)))
list))
CL-USER> (keep-odd-numbers '(1 a 2 b 3 c 4 d 5 e))
;=> (1 3 5)
While this isn't a fix to your actual problem, which #mbratch provided, here's the way I would implement something like this using the LOOP macro (another part of the standard library):
(defun keep-odd-numbers (list)
(loop for x in list collecting x when (and (numberp x) (oddp x))))
I ran over an example of a problem which should determine the list of all non-numeric atoms at any level in a non-linear list.
(Defun Lis(L)
(Cond
((Null L) Nil)
((Not (Numberp (Car L))) (Cons (Car L) (Lis (Cdr L))))
((Atom (Car L)) (Lis (Cdr L)))
(T (Append (Lis (Car L)) (Lis (Cdr L))))
))
I took an example, (Lis '(1 A ((B) 6) (2 (C 3)) D 4)) which should return (A B C D)
Now I don't understand how can the list be created when the 3rd element of the list is evaluated ((B) 6).It will enter on the 2nd branch and do the cons?But that isn't constructing the new list with ((B) 6)?When will it enter on the last branch? I'm a little confused of how this algorithm works,can somebody make it clear for me?
The code works fine if you "invert" the 2 middle tests:
(defun lis(L)
(cond
((null L) nil)
((numberp (car L)) (lis (cdr L)))
((atom (car L)) (cons (car L) (lis (cdr L))))
(t (append (lis (car L)) (lis (cdr L))))))
because (not (numberp (car L))) is also true for lists so in the initial version the code never recurses down into a sublist.
I would write it as:
(defun tree-keep-if (predicate tree)
"Returns the list of all non-numeric atoms at any level in a cons tree."
(mapcan (lambda (item)
(cond ((consp item) (tree-keep-if predicate item))
((funcall predicate item) (list item))
((atom item) nil)))
tree))
Using it:
CL-USER > (tree-keep-if (complement #'numberp) '(1 A ((B) 6) (2 (C 3)) D 4))
(A B C D)
A more sophisticated version might remove the recursion to not be limited by stack size.