Problem 19-2 in "Lisp" by Winston and Horn states,
In depth-first search, all of the
partial paths in the queue at a given
point in the search are related to
one another in a simple way: each is
the extension by one node of the
partial path after it in the queue.
The queue might, for example, look
like this:
((D C B A) (C B A) (B A) (A))
However, I don't see how that's the case. For example, I get output
like the following:
(depth-first 's 'f)
queue: ((S))
(S)
queue: ((A S) (D S))
(S A)
queue: ((B A S) (D A S) (D S))
(S A B)
queue: ((C B A S) (E B A S) (D A S) (D S))
(S A B C)
queue: ((E B A S) (D A S) (D S))
(S A B E)
queue: ((D E B A S) (F E B A S) (D A S) (D S))
(S A B E D)
queue: ((F E B A S) (D A S) (D S))
(S A B E F)
where I put a print statement at the beginning of the routine:
(defun depth-first (start finish &optional
(queue (list (list start))))
(format t "~%queue: ~a" queue)
(cond ((endp queue) nil)
((eq finish (first (first queue)))
(reverse (first queue)))
(t (depth-first
start
finish
(append (extend (first queue))
(rest queue))))))
In this case, no partial path in the queue is the extension by one
node of the partial path after it in the queue.
Is this a misprint in the exercise or is there some input that does
actually give the queue he gives?
See answer by Pascal Bourguignon.
Related
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
I am trying to remove the duplicate occurrences of the atoms in the given list.
My code is as below -
(defun combine (item List)
(if (member item List)
List (cons item List)))
(defuneliminateDuplicates(L)
(do
((M L) M)
((null L) M)
(setq M (combine (car L) M))
(setq L (cdr L))
))
This code works fine, it removes duplicates from the list -
[3]> (eliminateduplicates '(a b b c a c g a))
(G C B A)
[4]> (eliminateduplicates '(a a a a a a))
(A)
[5]> (eliminateduplicates '(a b c d))
(D C B A)
Here, I want the results to be in the same order as they are present in the given list.
i.e., the result of the (eliminateduplicates '(a b b c a c g a)) should be (B C G A), but not (G C B A)
How can I achieve this? Thanks.
I suggest using a different approach, it's simpler and the result is as expected:
(defun eliminateDuplicates (L)
(cond ((null L) L)
((member (car L) (cdr L))
(eliminateDuplicates (cdr L)))
(t (cons (car L) (eliminateDuplicates (cdr L))))))
For example:
(eliminateDuplicates '(a b b c a c g a))
=> (B C G A)
I have list witch contain other lists (2 levels only)
((S U S U R) (S U S R) (S U R))
How to remove the lists from list which contains some pairs, the same combination of 2 element on first ans second position in list or 3th and 4th position (in my example "S U") and to return ((S U S R) (S U R))
I need to transform
((S U S U R) (S U S R) (S U R)) to => ((S U S R) (S U R))
((S U R S U) (S U S R) (S U R)) to => ((S U R S U) (S U S R) (S U R)) - do not change, because here is pairs have S U, R S, U and no S U 2 or more times
REMOVE-IF
(remove-if #'oddp '(1 2 3 4 5))
=> (2 4)
LAMBDA
(funcall (lambda (x) (string x)) :example)
=> "EXAMPLE"
EQUALP
(equalp '(S U) (list 's 'u))
=> T
SUBSEQ
(subseq '(a b c d) 0 3)
=> (A B C)
Careful:
(subseq '(a b c d) 0 10)
=> ERROR
You can also use LENGTH to get the size of a list. You could also use following functions...
NTHCDR
(nthcdr '(s u s u r u) 5)
=> (U)
LDIFF
(let ((list '(a b c d)))
(ldiff list (nthcdr 10 list)))
=> (A B C D)
(let ((list '(a b c d)))
(ldiff list (nthcdr 2 list)))
=> (A B)
What you want to do
You want to remove elements from the input list that satisfy the following predicate: given a list, a subset of this list is equal to (S U) (see comments).
Your code will looks like this:
(defun remove-s-u-at-pos-3 (list)
(remove-if (lambda (...) ...) list))
You need to extract a part of each visited list and compare it to (S U).
How can i return elements if they are in two given lists?
Example:
L1 = (a b c d e a b c)
L2 = (a d f g k c c)
Result = (a a a c c c c d d)
I want to remove elements that arent in both lists and, then, append the resultant lists
You can start with a hash table, mapping a list element to a pair, first being elements from the first list, second - elements from the second. Then you collect the elements:
(defun common-elements (l1 l2 &key (test 'eql))
(let ((ht (make-hash-table :test test)) ret)
(dolist (e l1)
(let ((pair (gethash e ht)))
(if pair
(push e (car pair))
(setf (gethash e ht) (cons (list e) nil)))))
(dolist (e l2)
(let ((pair (gethash e ht)))
(when pair ; no need to store e when it is not in l1
(push e (cdr pair)))))
(maphash (lambda (e pair)
(declare (ignore e))
(when (cdr pair) ; we know (car pair) is non-nil
(setq ret (nconc (car pair) (cdr pair) ret))))
ht)
ret))
(common-elements '(a b c d e a b c) '(a d f g k c c))
==> (A A A C C C C D D)
Note that the order in which the list elements are returned is not defined.
I am implementing an interpreter for the LISP defined in,
http://www.scribd.com/vacuum?url=http://www.ee.ryerson.ca/~elf/pub/misc/micromanualLISP.pdf
My problem is the paper states that a LIST is,
4. (LIST e1 ... en) is defined for each n to be
(CONS e1 (CONS ... (CONS en NIL))).
So when a read in a list from the user such as,
(QUOTE (B C D (E F)))
using the above structure it becomes,
(QUOTE B C D E F)
There is no way to differentiate nested lists it all becomes a giant chain of cons.
Am I missing something here?
(QUOTE (B C D (E F))) is
(CONS B (CONS C (CONS D (CONS (CONS E (CONS F NIL)) NIL))))
(QUOTE (B C D E F)) is
(CONS B (CONS C (CONS D (CONS E (CONS F NIL)) NIL)))
Or to put it another way:
(LIST D (LIST E F)) = (CONS D (CONS (LIST E F) NIL))
(LIST D E F) = (CONS D (LIST E F))
(QUOTE (B C D (E F)))
= (... (CONS (E F) NIL))).
= (... (CONS (CONS E (CONS F NIL)) NIL))).
which is different from
( ...(CONS D (CONS E (CONS F NIL))).
(QUOTE (B C D (E F))) = (LIST B C D (LIST E F))