I have this function:
(define (unfold f init)
(if (eq? (f init) '())
(list)
(cons (car (f init)) (unfold f (cdr (f init))))))
I want to use it to define a function that does:
(hypothetical-function '(1 2 3 4 5))
which should return:
'((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5)
Okay, you want
(define (tails xs) (unfold foo xs))
and for that you need to define the appropriate foo. Now, what should foo do? It should return a pair, the first component of which becomes the car of the resulting list, and the second component of which becomes the seed for the recursive call - unless the unfolding is to stop, when foo should return an empty list. So
(define (foo xs)
(if (stop-condition)
'()
(cons car-of-result next-seed)))
Filling in the remaining details is left as an exercise to the reader.
Related
Can someone explain to me what this code does and how it works ?
(defun f (&optional (x nil) (y (if (atom x) nil (car x))))
(cond ((atom x) y)
((< (car x) y) (f (cdr x) y))
(t (f (cdr x) (car x)))))
A quick run through the code shows it's a function which returns the largest number given two numbers or a list of numbers. It'll return nil if given an atom and an error if one of the elements of the list is not a number.
here are some of the results I got:
CL-USER> (f '(1 2 3 4))
4
CL-USER> (f '(1 5 2 4))
5
CL-USER> (f '(1 5 2 4 7))
7
CL-USER> (f 'y)
NIL
CL-USER> (f 3 'y)
Y
A type error comes up when there is a non-numeric in the list:
CL-USER> (f '(1 x 2 4 7))
gives the following error
The value
X
is not of type
NUMBER
when binding SB-KERNEL::X
[Condition of type TYPE-ERROR]
As for how it works? The function compares numbers in a list, the first parameter, and a number, second param and returns the largest of them all. It does this by recursively comparing the first two numbers of the list returning the larger number which it compares to the rest of the list.
How to convert a flat list into an arbitrarily complex tree-like structure? First, a simple example, convert '(1 2 3 4) into '(1 (2 (3 (4)))). I know how to do it with classical recursion:
(defun nestify (xs)
(if (null xs)
(list)
(list (car xs) (nestify (cdr xs)))))
Now, what if the nested structure is arbitrarily complex? For example, I want to convert '(1 2 3 4 5 6 7 8) into '(1 (2 3) (4 (5 6) 7) 8). How can I write a general function that is able to convert a flat list in any such nested structure? I can think of giving a template with dummy values. For example:
* (nestify '(1 2 3 4 5 6 7 8) '(t (t t) (t (t t) t) t))
'(1 (2 3) (4 (5 6) 7) 8)
My first attempt using recursion and custom tree size finding function:
(defun length* (tr)
"Count number of elements in a tree."
(cond ((null tr) 0)
((atom tr) 1)
(t (+ (length* (car tr))
(length* (cdr tr))))))
(defun tree-substitute (xs tpl)
"(tree-substitute '(1 2 3) '(t (t) t)) -> '(1 (2) 3)"
(cond ((null tpl) nil)
((atom (car tpl))
(cons (car xs) (tree (cdr xs) (cdr tpl))))
(t (cons (tree xs (car tpl))
(tree (nthcdr (length* (car tpl)) xs) (cdr tpl))))))
Is there any way to do this better, in a more elegant and concise way? For example, the function converting a list into a tree might not use the template, although I can't think of the method. Can I abstract away recursion and other details and have a neat reduce or some other high-level function?
Turning (1 2 3 4) into (1 (2 (3 (4)))) actually isn't quite as simple as you might hope, if you're using reduce. You need to specify :from-end t if you want to process 4 first, and the reduction function is either called with 3 and 4, if no :initial-value is specified, or with 4 and the initial value, if one is. That means you can use something like this, where the function checks for the special initial case:
(reduce (lambda (x y)
(if y
(list x y)
(list x)))
'(1 2 3 4)
:from-end t
:initial-value nil)
;=> (1 (2 (3 (4))))
A solution that involves a template is much more interesting, in my opinion. It's easy enough to define a maptree function that maps a function over a tree and returns a new tree with the function results:
(defun maptree (function tree)
"Return a tree with the same structure as TREE, but
whose elements are the result of calling FUNCTION with
the element from TREE. Because TREE is treated as an
arbitrarily nested structure, any occurrence of NIL is
treated as an empty tree."
(cond
((null tree) tree)
((atom tree) (funcall function tree))
((cons (maptree function (car tree))
(maptree function (cdr tree))))))
(maptree '1+ '(1 2 (3 (4 5)) (6 7)))
;=> (2 3 (4 (5 6)) (7 8))
Given the maptree function, it's not hard to call it with a function that provides an element from a list of elements, until that list of element is exhausted. This provides a definition of substitute-into:
(defun substitute-into (items tree)
"Return a tree like TREE, but in which the elements
of TREE are replaced with elements drawn from ITEMS.
If there are more elements in TREE than there are in
ITEMS, the original elements of TREE remain in the result,
but a new tree structure is still constructed."
(maptree #'(lambda (x)
(if (endp items) x
(pop items)))
tree))
(substitute-into '(1 2 3 4 5) '(t (u (v)) (w x)))
;=> (1 (2 (3)) (4 5))
(substitute-into '(1 2 3 4 5) '(t u (v w x) y z))
;=> (1 2 (3 4 5) Y Z)
See Also
The maptree above is actually just a special case of a more general reduce, or fold, function for trees. Have a look at Using reduce over a tree in Lisp for some more information about how you can fold over trees. In this case, you could use my tree-reduce function from my answer to that question:
(defun tree-reduce (node-fn leaf-fn tree)
(if (consp tree)
(funcall node-fn
(tree-reduce node-fn leaf-fn (car tree))
(tree-reduce node-fn leaf-fn (cdr tree)))
(funcall leaf-fn
tree)))
and define maptree in terms of it:
(defun maptree (function tree)
(tree-reduce 'cons function tree))
My attempt:
(defun mimicry (source pattern)
(labels ((rec (pattern)
(mapcar (lambda (x)
(if (atom x)
(pop source)
(rec x)))
pattern)))
(rec pattern)))
Test:
CL-USER> (mimicry '(1 2 3 4 5) '(t (u (v)) (w x)))
(1 (2 (3)) (4 5))
I have two lists: (1 2 3) and (a b) and I need to create something like this (1 2 3 1 2 3). The result is a concatenation of the first list as many times as there are elements in the second. I should use some of the functions (maplist/mapcar/mapcon, etc.). This is exactly what I need, although I need to pass first list as argument:
(mapcan #'(lambda (x) (list 1 2 3)) (list 'a 'b))
;=> (1 2 3 1 2 3)
When I try to abstract it into a function, though, Allegro freezes:
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) (list 'a 'b))
; <freeze>
Why doesn't this definition work?
There's already an accepted answer, but I think some more explanation about what's going wrong in the original code is in order. mapcan applies a function to each element of a list to generate a bunch of lists which are destructively concatenated together. If you destructively concatenate a list with itself, you get a circular list. E.g.,
(let ((x (list 1 2 3)))
(nconc x x))
;=> (1 2 3 1 2 3 1 2 3 ...)
Now, if you have more concatenations than one, you can't finish, because to concatenate something to the end of a list requires walking to the end of the list. So
(let ((x (list 1 2 3)))
(nconc (nconc x x) x))
; ----------- (a)
; --------------------- (b)
(a) terminates, and returns the list (1 2 3 1 2 3 1 2 3 ...), but (b) can't terminate since we can't get to the end of (1 2 3 1 2 3 ...) in order to add things to the end.
Now that leaves the question of why
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) '(a b))
leads to a freeze. Since there are only two elements in (a b), this amounts to:
(let ((x (list 1 2 3)))
(nconc x x))
That should terminate and return an infinite list (1 2 3 1 2 3 1 2 3 ...). In fact, it does. The problem is that printing that list in the REPL will hang. For instance, in SBCL:
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
; <I manually stopped this, because it hung.
CL-USER> (let ((x (list 1 2 3)))
(nconc x x) ; terminates
nil) ; return nil, which is easy to print
NIL
If you set *print-circle* to true, you can see the result from the first form, though:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
#1=(1 2 3 . #1#) ; special notation for reading and
; writing circular structures
The simplest way (i.e., fewest number of changes) to adjust your code to remove the problematic behavior is to use copy-list in the lambda function:
(defun foo (a b)
(mapcan #'(lambda (x)
(copy-list a))
b))
This also has an advantage over a (reduce 'append (mapcar ...) :from-end t) solution in that it doesn't necessarily allocate an intermediate list of results.
You could
(defun f (lst1 lst2)
(reduce #'append (mapcar (lambda (e) lst1) lst2)))
then
? (f '(1 2 3) '(a b))
(1 2 3 1 2 3)
Rule of thumb is to make sure the function supplied to mapcan (and destructive friends) creates the list or else you'll make a loop. The same applies to arguments supplied to other destructive functions. Usually it's best if the function has made them which makes it only a linear update.
This will work:
(defun foo (a b)
(mapcan #'(lambda (x) (copy-list a)) b))
Here is some alternatives:
(defun foo (a b)
;; NB! apply sets restrictions on the length of b. Stack might blow
(apply #'append (mapcar #'(lambda (x) a) b))
(defun foo (a b)
;; uses loop macro
(loop for i in b
append a))
I really don't understand why b cannot be a number? You're really using it as church numbers so I think I would have done this instead:
(defun x (list multiplier)
;; uses loop
(loop for i from 1 to multiplier
append list))
(x '(a b c) 0) ; ==> nil
(x '(a b c) 1) ; ==> (a b c)
(x '(a b c) 2) ; ==> (a b c a b c)
;; you can still do the same:
(x '(1 2 3) (length '(a b))) ; ==> (1 2 3 1 2 3)
I am trying to write a function that takes one or more integers and returns a list of all the arguments that have the same even-odd parity as the first argument, for example
(same-parity 1 2 3 4 5 6 7)->(1 3 5 7)
(same-parity 2 3 4 5 6)->(2 4 6).
my code is
(define (same-parity g . w)
(define (iter-parity items)
(if (= (length items) 1)
(if (= (remainder items 2) (remainder g 2))
item
'())
(if (= (remainder g 2) (remainder (car items) 2))
(cons (car items) (iter-parity (cdr items)))
(iter-parity (cdr items)))))
(cons g (iter-parity w)))
when try this (same-parity (list 1 2 3 4)), I got an error message:
the object (), passed as the first argument to car, is not the correct type.
Can I somebody tell me what is going on?
Your code
Here's a refactoring proposal, keeping with your basic structure:
(define (same-parity g . w)
(define filter-predicate? (if (odd? g) odd? even?))
(define (iter-parity items)
(if (null? items)
'()
(if (filter-predicate? (car items))
(cons (car items) (iter-parity (cdr items)))
(iter-parity (cdr items)))))
(cons g (iter-parity w)))
Note that it is more idiomatic
to use the procedures odd? and even? rather than remainder
to have as a base case when the list is empty, not when it has only one item (in your code this clearly avoids repetition as a positive effect).
Also, since there is a built-in filter procedure in Scheme, you could express it as follows:
(define (same-parity g . w)
(cons g (filter (if (odd? g) odd? even?) w)))
Your question
As for your question regarding (same-parity (list 1 2 3 4)): you need either (as described in your specification) use your procedure like so
(same-parity 1 2 3 4)
or to use apply here:
> (apply same-parity (list 1 2 3 4))
'(1 3)
because apply will transform (same-parity (list 1 2 3 4)) (1 parameter, a list) into (same-parity 1 2 3 4) (4 parameters).
i am trying to write a function in lisp which have 2 parameters one function F and one list L
if i place '> in place of F and list L is '(1 2 3 4 5) it will return 5 as 5 is biggest.
and if we put '< then it compares all list elements and gives the smallest one as output.
and so on.
we can even put custom written function in place of F for comparison.
i wish i could provide more sample code but i am really stuck at the start.
(DEFUN givex (F L)
(cond
(F (car L) (car (cdr L))
;after this i got stuck
)
)
another attemp to write this function
(defun best(F list)
(if (null (rest list)) (first list)
(funcall F (first List) (best (F list)))))
You are almost there, just the else clause returns the f's return value instead of the the best element:
(defun best (F list)
(let ((first (first list))
(rest (rest list)))
(if (null rest)
first
(let ((best (best f rest)))
(if (funcall F first best)
best
first)))))
Examples:
(best #'< '(1 2 3))
==> 3
(best #'> '(1 2 3))
==> 1
Note that this recursive implementation is not tail-recursive, so it is not the most efficient one. You might prefer this instead:
(defun best (f list)
(reduce (lambda (a b) (if (funcall f a b) b a)) list))
Or, better yet,
(defmacro fmax (f)
`(lambda (a b) (if (,f a b) b a)))
(reduce (fmax <) '(1 2 3))
==> 1
(reduce (fmax >) '(1 -2 3 -4) :key #'abs)
==> 1
(reduce (fmax <) '(1 -2 3 -4) :key #'abs)
==> 4