set-car! and let in scheme language - lisp

I am little bit confused by the result of this example:
(define mk-q
(lambda ()
(let ([l '(x)])
(cons l l))))
(define q (mk-q))
q
=> ((x) x)
(set-car! (cdr q) 'y)
=> ((y) y)
I am wondering why both x atoms have been replaced by set-car! procedure (my first guess for what the result would be was ((x) y))?
For example:
(define mk-q2
(lambda ()
(let ([l '(x)])
(cons l (cons l l)))))
(define q2 (mk-q2))
(set-car! (cdr q2) 'y)
=> ((x) y x) which fits my understanding of set-car!
Why are both xs in the first example replaced?

In the first example, you have something equivalent to this:
(define cell (cons 'x null))
(define q (cons cell cell))
As you can see, there's only one cons cell with x at the car position, that is being shared in two different parts of the resulting list structure. When you execute (set-car! (cdr q) 'y) the x in the single cell gets replaced by y in all the parts where it's being shared. Remembering that both (cons 'x null) cells are really the same, we're going from this:
(cons (cons 'x null) (cons 'x null))
; '((x) x)
to this:
(cons (cons 'y null) (cons 'y null))
; '((y) y)
For the second example the same considerations apply (all three (cons 'x null) cells are actually the same one being shared), but you're replacing a whole cons cell, so basically we're going from this:
(cons (cons 'x null) (cons (cons 'x null) (cons 'x null)))
; '((x) (x) x)
to this:
(cons (cons 'x null) (cons 'y (cons 'x null)))
; '((x) y x)
To prove my point that both of the examples in the question demonstrate the same situation, execute this expressions:
(define q2 (mk-q2))
(set-car! (cadr q2) 'y) ; notice the extra `a`
q2
=> '((y) (y) y)

Related

LISP function to make all possible pairs from a list?

I'm trying to create a LISP function that creates from a list all possible pairs.
Example of what I'm trying to achieve: (a b c d) --> ((a b) (a c) (a d) (b c) (b d) (c d))
Any advice please? I'm not sure how to approach this problem
Here is a simple solution:
(defun make-couples (x l)
"makes a list of couples whose first element is x and the second is each element of l in turn"
(loop for y in l collect (list x y)))
(defun all-pairs (l)
"makes a list of all the possible pairs of elements of list l"
(loop for (x . y) on l nconc (make-couples x y)))
A recursive solution is:
(defun make-couples (x l)
"makes a list of couples whose first element is x and the second is each element of l in turn"
(if (null l)
nil
(cons (cons x (first l)) (make-couples x (rest l)))))
(defun all-pairs (l)
"makes a list of all the possible pairs of elements of list l"
(if (null l)
nil
(nconc (make-couples (first l) (rest l))
(all-pairs (rest l)))))
Here is a version (this is quite closely related to Gwang-Jin Kim's) which has two nice properties:
it is tail recursive;
it walks no list more than once;
it allocates no storage that it does not use (so there are no calls to append and so on);
it uses no destructive operations.
It does this by noticing that there's a stage in the process where you want to say 'prepend a list of pairs of this element with the elements of this list to this other list' and that this can be done without using append or anything like that.
It does return the results in 'reversed' order, which I believe is inevitable given the above constraints.
(defun all-pairs (l)
(all-pairs-loop l '()))
(defun all-pairs-loop (l results)
(if (null (rest l))
results
(all-pairs-loop (rest l)
(prepend-pairs-to (first l) (rest l) results))))
(defun prepend-pairs-to (e them results)
(if (null them)
results
(prepend-pairs-to e (rest them) (cons (list e (first them))
results))))
the simplest tail recursive variant without explicit loops / mapcar could also look like this:
(defun pairs (data)
(labels ((rec (ls a bs res)
(cond
((null ls) (nreverse res))
((null bs) (rec
(cdr ls)
(car ls)
(cdr ls)
res))
(t (rec
ls
a
(cdr bs)
(cons (cons a (car bs)) res))))))
(rec data nil nil nil)))
CL-USER> (pairs (list 1 2 3 4))
;; ((1 . 2) (1 . 3) (1 . 4) (2 . 3) (2 . 4) (3 . 4))
Tail call recursive solution:
(defun pairs (lst &key (acc '()))
(if (null (cdr lst))
(nreverse acc)
(pairs (cdr lst)
:acc (append (nreverse
(mapcar #'(lambda (el)
(list (car lst) el))
(cdr lst)))
acc))))
Both nreverses are there just for aesthetics (for a nicer looking output). They can be left out.
Try it with:
(pairs '(a b c d))
;; => ((A B) (A C) (A D) (B C) (B D) (C D))
General Combinations
(defun pair (el lst)
"Pair el with each element of lst."
(mapcar (lambda (x) (cons el x)) lst))
(defun dedup (lst &key (test #'eql))
"Deduplicate a list of lists by ignoring order
and comparing the elements by test function."
(remove-duplicates lst :test (lambda (x y) (null (set-difference x y :test test)))))
(defun comb (lst &key (k 3) (acc '()) (test #'eql))
"Return all unique k-mer combinations of the elements in lst."
(labels ((%comb (lst &key (k k) (acc '()) (test #'eql) (total lst))
(let ((total (if total total lst)))
(cond ((or (null (cdr lst)) (zerop k)) (nreverse acc))
((= k 1) (mapcar #'list lst))
(t (let* ((el (car lst))
(rst (remove-if (lambda (x) (funcall test x el)) total)))
(dedup (%comb (cdr lst)
:k k
:total total
:test test
:acc (append (pair el (comb rst :k (1- k) :test test))
acc)))))))))
(%comb lst :k k :acc acc :test test :total lst)))
The number of combinations are calculatable with the combinations formula:
(defun fac (n &key (acc 1) (stop 1))
"n!/stop!"
(if (or (= n stop) (zerop n))
acc
(fac (1- n) :acc (* acc n) :stop stop)))
(defun cnr (n r)
"Number of all r-mer combinations given n elements.
nCr with n and r given"
(/ (fac n :stop r) (fac (- n r))))
We can test and count:
(comb '(a b c d) :k 2)
;; => ((A D) (B D) (B A) (C D) (C B) (C A))
(comb '(a b c d e f) :k 3)
;; => ((B A F) (C B A) (C B F) (C A F) (D C A) (D C B)
;; => (D C F) (D B A) (D B F) (D A F) (E D A) (E D B)
;; => (E D C) (E D F) (E C A) (E C B) (E C F) (E B A)
;; => (E B F) (E A F))
(= (length (comb '(a b c d e f) :k 3)) (cnr 6 3)) ;; => T
(= (length (comb '(a b c d e f g h i) :k 6)) (cnr 9 6)) ;; => T

How do I fix "BINDING form is not a proper list" error

I'm new in lisp, I'm trying to define a simple function that search an element in a list.
I'm not finding myself comfortable with the sintax of the language, also I don't quite understand the error/warning messages.
(defun in-list (x l)
(let y (car l))
(let z (cdr l))
(if (null l)
nil
(if (equal x y)
t
(in-list x z)
)
)
)
I also tried to replace let with seq, but still gave me warnings on "variables assumed to be special".
There is an error in the syntax of let. The correct form is:
(let ((var1 exp1)
(var2 exp2)
...
(varn expn))
body-of-let)
So you should write:
(defun in-list (x l)
(let ((y (car l))
(z (cdr l)))
(if (null l)
nil
(if (equal x y)
t
(in-list x z)))))
Note that it is not necessary define the two local variables since the corresponding expression is used only once, so you could abbreviate the function in this way:
(defun in-list (x l)
(if (null l)
nil
(if (equal x (car l))
t
(in-list x (cdr l)))))
and, since you have three different cases in the body, you could use a single cond instead of two if:
(defun in-list (x l)
(cond ((null l) nil)
((equal x (car l)) t)
(t (in-list x (cdr l)))))
There are very good free books on the web to learn the basis of the language. See for instance this one.
To be able to use setq, you can declare your function's inner variables after the &aux keyword in the function's lambda-list:
(defun in-list (x l &aux y z)
(setq y (car l)
z (cdr l))
(and l
(or (equal x y)
(in-list x z))))
A better style is to give the auxiliary variables their values right at the point of declaration:
(defun in-list (x l &aux (y (car l)) (z (cdr l)))
(and l
(or (equal x y)
(in-list x z))))

Difference between '(()) and (cons null null)

I am confused about the difference between '(()) and (cons null null) in scheme.
The code below show that b and c are completely the same thing.
(define (dup2 x)
(let ((d '(())))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup2 a))
(define c (dup2 a))
(set-car! b 2)
> c ;; --> (2 2)
However, when I used dup instead of dup2:
(define (dup x)
(let ((d (cons null null)))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup a))
(define c (dup a))
(set-car! b 2)
> c ;; --> (1 2)
Variable b and c are different. I have done some experiments, but I haven't understand yet.
The value of d in the first implementation is literal data, and is modified with undefined consequences. To highlight what's happening, consider the following code:
(define (incorrect-list-null-and-x x)
(let ((l '(()))) ; a list of the form (() . ())
(set-cdr! l (cons x (cdr l))) ; (cdr l) is (), so (cons x (cdr l)) should be (x . ()) == (x), right?
; and now l should be (() . (x . ())) == (() x), right?
l))
The expected result is that (incorrect-list-null-and-x n) should return a list of the form (() n), and it does the first time, but successive calls are still accessing the same data:
(incorrect-list-null-and-x 1) ;=> (() 1)
(incorrect-list-null-and-x 2) ;=> (() 2 1)
(incorrect-list-null-and-x 3) ;=> (() 3 2 1)
(incorrect-list-null-and-x 4) ;=> (() 4 3 2 1)
The same problem manifests itself a bit differently in your dup2. Every value returned from dup2 is actually the same pair:
(let* ((x (dup2 (cons 1 2)))
(y (dup2 (cons 3 4))))
(display x)
(display y))
outputs:
(3 . 4)(3 . 4)
because the call (dup2 (cons 3 4)) modifies the same structure that was previously returned by (dup2 (cons 1 2)).
Data literals, like '(()), are meant to be read-only, and modifying it using set-car! or set-cdr! has undefined behaviour. For predictable behaviour, use the (cons '() '()) version if you want to use set-car! or set-cdr! on it.
In particular, cons creates a new cons cell, whereas a data literal usually won't.
Still, for the purposes of implementing dup, why are you using set-car! and set-cdr! anyway? Just use cons directly:
(define (dup x)
(cons (car x) (cdr x)))
In your first code snippet you use (d '(())) which ends up binding a literal to d. You then modify the literal which is generally undefined. In your second code snippet you use (d (cons null null)) which binds d to a newly created 'cons cell' which you then modify. There is no problem modifying that.
Note: you've not defined null. Perhaps you meant '()?

Scheme Function that can select nth term of a list

So here i have a couple of defined list that i would like to use:
(DEFINE list0 (LIST 'j 'k 'l 'm 'n 'o 'j) )
(DEFINE list1 (LIST 'a 'b 'c 'd 'e 'f 'g) )
(DEFINE list2 (LIST 's 't 'u 'v 'w 'x 'y 'z) )
(DEFINE list3 (LIST 'j 'k 'l 'm 'l 'k 'j) )
(DEFINE list4 (LIST 'n 'o 'p 'q 'q 'p 'o 'n) )
(DEFINE list5 '( (a b) c (d e d) c (a b) ) )
(DEFINE list6 '( (h i) (j k) l (m n) ) )
(DEFINE list7 (f (a b) c (d e d) (b a) f) )
what i would like to do is create a recursive function for a 'middle' function that would do as such:
MIDDLE:
(middle 1st) should return a one-element list consisting of just the middle element of the 1st [or return the empty list if there were an even number of elements in 1st]. That is,
(middle '(a b c d e f g) )
should/would return:
(d)
(middle '(s t u v w x y z) )
should/would return the empty string.
(middle '( (a b) c (d e d) c (b a) ) )
should/would return:
( (d e d) )
Note that ( (d e d) ) is a list containing the thing that was in the middle, which happened to itself be a list.
I think that i have to break it into two problems.
First is that i need a function that can select the nth term of a list. which i little knowledge on creating it.
Second you need a functions to determine the position of the middle term and if there exists a middle term. (which also i have minimum knowledge on how to create it.
Then
(define middle
(lambda (L)
(if (middle? L)
(nth-term (middle L) L)
'())))
Here is my evens function that i would like to know if there might be an easier way to go about it:
(define evens
(lambda (L)
(if (or (NULL? (cddr L)))
'()
(cons (cadr L) (evens (cddr L))))))
The easiest way to do this is to use the length function to get the length of the list, then make sure the length is an not an even number (and if it is, to return an empty list). Once we know that the length is odd, return the element of the list that is half the length of the list minus one. The result is the middle of the list. Here is what the code actually looks like:
(define (middle lis)
(let ((list-length (length lis)))
(if (even? list-length)
'()
(list (list-ref lis (/ (- list-length 1) 2))))))
To answer the question in your subject line, you get the nth item of a list with the list-ref procedure, like so:
> (list-ref '(a b c d) 2)
'c
If there's anything you are still confused about, let me know and I'll do my best to clarify.
The answer can be improved a bit as follows:
(define (middle lst)
(let ((len (length lst)))
(if (even? len)
'()
(list (list-ref lst (quotient len 2))))))
Notice that there was a simpler way to obtain the index of the middle element.
The obvious method (compute the length; divide by two; seek through the list) requires two passes through the list.
Here is an alternative that requires only one pass:
(define (middle lst)
(letrec
((middle-odd
(lambda (x y) (if (null? x) (list (car y)) (middle-even (cdr x) (cdr y)))))
(middle-even
(lambda (x y) (if (null? x) '() (middle-odd (cdr x) y)))))
(middle-even lst lst)))

Count of atoms on the each level, Scheme

Please, help me with one simple exercise on the Scheme.
Write function, that return count of atoms on the each level in the
list. For example:
(a (b (c (d e (f) k 1 5) e))) –> ((1 1) (2 1) (3 2) (4 5) (5 1))
My Solution:
(define (atom? x)
(and (not (pair? x)) (not (null? x))))
(define (count L)
(cond ((null? L) 0)
((pair? (car L))
(count (cdr L)))
(else
(+ 1 (count (cdr L))))))
(define (fun L level)
(cons
(list level (count L))
(ololo L level)))
(define (ololo L level)
(if (null? L)
'()
(if (atom? (car L))
(ololo (cdr L) level)
(fun (car L) (+ level 1)))))
(fun '(a (b (c (d e (f) k 1 5) e))) 1)
It's work fine, but give not correctly answer for this list:
(a (b (c (d e (f) (k) 1 5) e)))
is:
((1 1) (2 1) (3 2) (4 4) (5 1))
But we assume that 'f' and 'k' on the one level, and answer must be:
((1 1) (2 1) (3 2) (4 4) (5 2))
How should I edit the code to make it work right?
UPD (29.10.12):
My final solution:
(define A '(a (b (c (d e (f) k 1 5) e))))
(define (atom? x)
(and (not (pair? x)) (not (null? x))))
(define (unite L res)
(if (null? L) (reverse res)
(unite (cdr L) (cons (car L) res))))
(define (count-atoms L answ)
(cond ((null? L) answ)
((pair? (car L))
(count-atoms (cdr L) answ))
(else
(count-atoms (cdr L) (+ answ 1)))))
(define (del-atoms L answ)
(cond ((null? L) answ)
((list? (car L))
(begin
(del-atoms (cdr L) (unite (car L) answ))))
(else
(del-atoms (cdr L) answ))))
(define (count L)
(define (countme L level answ)
(if (null? L) (reverse answ)
(countme (del-atoms L '()) (+ level 1) (cons (cons level (cons (count-atoms L 0) '())) answ))))
(countme L 1 '()))
(count A)
What can you say about this?
Do you know what you get if you run this?
(fun '(a (b (c (d e (f) k 1 5) e)) (a (b (c)))) 1)
You get this:
((1 1) (2 1) (3 2) (4 5) (5 1))
The whole extra nested structure that I added on the right has been ignored. Here is why...
Each recursion of your function does two things:
Count all the atoms at the current "level"
Move down the level till you find an s-expression that is a pair (well, not an atom)
Once it finds a nested pair, it calls itself on that. And so on
What happens in oLoLo when fun returns from the first nested pair? Why, it returns! It does not keep going down the list to find another.
Your function will never find more than the first list at any level. And if it did, what would you to do add the count from the first list at that level to the second? You need to think carefully about how you recur completely through a list containing multiple nested lists and about how you could preserve information at each level. There's more than one way to do it, but you haven't hit on any of them yet.
Note that depending on your implementation, the library used here may need to be imported in some other way. It might be painstakingly difficult to find the way it has to be imported and what are the exact names of the functions you want to use. Some would have it as filter and reduce-left instead. require-extension may or may not be Guile-specific, I don't really know.
(require-extension (srfi 1))
(define (count-atoms source-list)
(define (%atom? x) (not (or (pair? x) (null? x))))
(define (%count-atoms source-list level)
(if (not (null? source-list))
(cons (list level (count %atom? source-list))
(%count-atoms (reduce append '()
(filter-map
(lambda (x) (if (%atom? x) '() x))
source-list)) (1+ level))) '()))
(%count-atoms source-list 1))
And, of course, as I mentioned before, it would be best to do this with hash-tables. Doing it with lists may have some didactic effect. But I have a very strong opposition to didactic effects that make you write essentially bad code.