I'm trying to write an iterative procedure called precedes which inputs a list of identifiers and two identifiers from the list, and returns #t if the first of these identifiers occurs before the second, otherwise #f.
This is my code.
(define (precedes id1 id2 lst)
(define (iter lst n x)
(cond ((null? lst) #f)
((eq? (car lst) n) #t)
(else (iter (cdr lst) (+ 1 n) x))))
(iter '() 0 1))
An example output of this procedure is (precedes 'e 'c '(d b e a c g f)) = #t
Thanks.
Alexander's remarks are correct; also, you don't keep the information whether you found id1. Here's an example how you could do:
(define (precedes id1 id2 lst)
(define (iter lst foundid1)
(printf "~a ~a\n" lst foundid1) ; for debugging
(cond ((null? lst)
#f) ; never found id2 so #f
((eq? (car lst) id2)
foundid1) ; found id2 so result is whether we found id1 before
((eq? (car lst) id1)
(iter (cdr lst) #t)) ; found id1 so iterate, set found flag to #t
(else
(iter (cdr lst) foundid1)))) ; found nothing, iterate
(iter lst #f))
and here's the output:
> (precedes 'e 'c '(d b e a c g f))
(d b e a c g f) #f
(b e a c g f) #f
(e a c g f) #f
(a c g f) #t
(c g f) #t
#t
> (precedes 'x 'c '(d b e a c g f))
(d b e a c g f) #f
(b e a c g f) #f
(e a c g f) #f
(a c g f) #f
(c g f) #f
#f
> (precedes 'x 'y '(d b e a c g f))
(d b e a c g f) #f
(b e a c g f) #f
(e a c g f) #f
(a c g f) #f
(c g f) #f
(g f) #f
(f) #f
() #f
#f
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)
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.
It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 10 years ago.
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 'endsmatch' function that would do as such:
ENDSMATCH:
(endsmatch 1st) which should return #t if the first element in the list is the same as the last element in the list, and return
#f otherwise. That is,
(endsmatch '(s t u v w x y z) )
would/should return:
#f
(endsmatch (LIST 'j 'k 'l 'm 'n 'o 'j)
would/should return:
#t
and
Both (endsmatch '()) and (endsmatch '(a))
should return #t, etc.
Also is the function can read complex lists such as:
(endsmatch '((a b) c (d e d) c (a b)) )
which would then return:
#t
and:
(endsmatch '((a b) c (d e d) c (b a)) )
(endsmatch '((y z) y) )
should both return #f
How might this function be coded because i am new to scheme and would see what it may look like, Thank You in advance.
Try this, it's as simple as it gets:
(define (endsmatch lst)
(if (null? lst)
#t
(equal? (first lst) (last lst))))
If your Scheme interpreter doesn't include the procedures first and last, they're very simple to implement:
(define (first lst)
(car lst))
(define (last lst)
(cond ((null? lst) #f)
((null? (cdr lst)) (car lst))
(else (last (cdr lst)))))
I've come up with this solution, but it fails for the 2 last tests you describe:
(define (endsmatch lst)
(let loop ((lst lst) (first '()) (last '()))
(cond
((null? lst) (eq? first last))
((pair? (car lst)) (loop (car lst) first last)
(loop (cdr lst) first last))
((null? first) (loop (cdr lst) (car lst) (car lst)))
(else (loop (cdr lst) first (car lst))))))
; racket test code
(require rackunit)
(check-eq? (endsmatch '(s t u v w x y z)) #f)
(check-eq? (endsmatch (list 'j 'k 'l 'm 'n 'o 'j)) #t)
(check-eq? (endsmatch '()) #t)
(check-eq? (endsmatch '(a)) #t)
(check-eq? (endsmatch '((a b) c (d e d) c (b a))) #t)
; these fail
(check-eq? (endsmatch '((a b) c (d e d) c (b a))) #f)
(check-eq? (endsmatch '((y z) y)) #f)
and indeed you say both
"(endsmatch '((a b) c (d e d) c (b a)) ) which would then return: #t"
and
"(endsmatch '((a b) c (d e d) c (b a)) ) should return #f"
which is contradictory.
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))