can u pls help me guys, its a tutorial question given to us by our lecturer & we can't actually seem to crack it no matter how much we tried. plz help
; perform some type/error checking,
; then call function h to ....
(defun f (L N)
(cond
( (not (listp L) ) nil)
( (not (integerp N) ) nil)
( (< N 1) nil)
( (< (length L) N) nil)
(t (h L N '() ) )
)
)
(defun h (L N Acc)
(cond
( (eq N 1) (append Acc (cdr L) ) )
(t (h (cdr L) (- N 1) (append Acc (list (car L) ) ) ) )
)
)
For the function call (f '(1 2 3) 1) show the sequence of calls (if any) made to function h, and show the final value returned by function f.
For the function call (f '(1 2 3 4) 3) show the sequence of calls (if any) made to function h, and show the final value returned by function f.
If we observe that function f appears to carry out some basic type/error checking and then calls function h to do the "real" work, what is it that h actually accomplishes?
General remarks
You cannot assume EQ will work reliably with numbers, according to the specification. Since N is a number, you should use = instead.
The COND in H has only two possible outcomes; that may be rewritten with an IF.
Do not add spaces between parentheses, do not let parentheses alone on a line. Please follow the usual formatting of Lisp forms (see for example http://lisp-lang.org/style-guide).
The overuse of APPEND in H is making the code more complex than it should be.
Function F
(defun f (L N)
(cond
( (not (listp L) ) nil)
( (not (integerp N) ) nil)
( (< N 1) nil)
( (< (length L) N) nil)
(t (h L N '() ) )
)
)
Function F calls H only when the code reaches the clauses guarded by T, which happens only when all the previous test fails.
Let's invert all tests to simplify a little bit, and use WHEN.
The equivalent form is:
(defun f (list number)
(when (and (listp list)
(integerp number)
(<= 1 number (length list)))
(h list number)))
The third argument to h is omitted, because we do not need it.
Function H
(defun h (L N Acc)
(cond
( (eq N 1) (append Acc (cdr L) ) )
(t (h (cdr L) (- N 1) (append Acc (list (car L) ) ) ) )
)
)
The code is using APPEND at each step of recursion. The accumulator might have been added to make the function tail-recursive, or maybe just to obfuscate the intent. You could rewrite H without the auxiliary list to better understand what it does:
(defun h (list number)
(if (= number 1)
(cdr list)
(cons (car list)
(h (cdr list) (- number 1)))))
And some tests:
(f '(a b c d e f) 3)
=> (A B D E F)
(f '(a b c d e f) 2)
=> (A C D E 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
Preface: I'm currently taking a condensed course that is apparently taught in LISP and I've never worked with LISP in my life so I had to learn the language over a weekend. I apologize in advance for the abysmal code. I'm just familiar enough with LISP's syntax to get the code working and not much more.
I'm currently working on a program that solves the map coloring problem. This code takes a sequence where the first element of each sub sequence is a state and the second element represents a color. ex: '((A R) (B G) (C G) (D Y) (E B) (F B)) and then checks to make sure that no state has the same color as a state it's constrained by (defined by the constraint list). I know there are probably a lot of cleaner and simpler ways to do this but what I'm currently struggling with is having my dolist loops immediately return the value T whenever the if statement is met. So far I've been unable to get the functions to simply return a value and had to resort to this really ugly/wrong method of setting a variable to true and waiting for the loop to finish in order to make the code work. I've tried using return and just having T inside the if statements but, in both cases, the loop would finish instead of returning a value and I have no idea why.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (f s)
(setf ans nil)
(dolist (state constraint)
(if (eq (first state) f)
(if (search (list s) (second state))
(setf ans T) ;;where I want it to just return T
)
)
)
ans
)
;;ex: ((A R) (B R) (C B) (D R) (E B) (F G))
(defun check_conflict (lst)
(setf anb nil)
(dolist (state lst)
(dolist (neighbor (remove state lst))
(if (check_constraint (first state) (first neighbor))
(if (eq (second state) (second neighbor))
(setf anb T)) ;;where I want it to just return T
)
)
)
anb
)
EDIT: I ended up just fixing this with recursion. The code is cleaner now but I'd still love to know what my issue was. This is the recursive code.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (lst f s)
(COND
((null lst) nil)
((search (list (car (car lst))) f)
(if (search s (second (car lst))) T))
(t (check_constraint (cdr lst) f s))
)
)
(defun check_neighbor (check lst)
(COND
((null lst) nil)
((check_constraint constraint (list (car check)) (list (first (first lst))))
(if (eq (second check) (second (car lst))) T))
(t (check_neighbor check (cdr lst)))
)
)
;;(check_state '((A R) (B R) (C B) (D R) (E B) (F G)))
(defun check_state (lst)
(COND
((null lst) nil)
((check_neighbor (car lst) (cdr lst)) T)
(t (check_state (cdr lst)))
)
)
First a few style issues. You should use DEFVAR or DEFPARAMETER to declare global variables. Those should also have asterisks around the name to show that they are global (or special actually).
(defparameter *constraint*
'((A (B C E))
(B (A E F))
(C (A E F))
(D (F))
(E (A B C F))
(F (B C D E))))
The lisp convention for naming things is to use dashes between words (CHECK-CONSTRAINT instead of CHECK_CONSTRAINT). You should also prefer full words for variable names instead of abbreviations (LIST instead of LST). The closing parentheses should not be written on their own line.
Then the actual problem. You can use RETURN to return a value from a block named NIL. Loops establish such a block, so you can write the first function like
(defun check-constraint (first second)
(dolist (state *constraint*)
(when (and (eq first (first state))
(member second (second state)))
(return t))))
It's better to use WHEN instead of IF when there's only a then-branch. I also combined the two IFs into one using AND. Since you were wrapping S in a list for using SEARCH, I figured you probably want to use MEMBER instead (although I'm not sure since I don't exactly know what the code is supposed to do). You can change that back if it's wrong.
You probably could also simplify it to
(defun check-constraint (first second)
(member second (second (find first *constraint* :key #'first))))
In the second function you have two loops. If you use RETURN to return from the inner one, you just end up continuing the outer loop and ignoring the return value. So you have to use RETURN-FROM to return from the function instead of the inner loop.
(defun check-conflict (list)
(dolist (state list)
(dolist (neighbor (remove state list))
(when (and (check-constraint (first state) (first neighbor))
(eq (second state) (second neighbor)))
(return-from check-conflict t)))))
I have this example in LISP that removes from every level of a list a given number:
(defun remove_aux (e l)
(cond
((equal e l) nil)
((atom l) (list l))
(t(list(apply 'append (mapcar #'(lambda (l) (remove_aux e l)) l))))))
(defun remove_el (e l)
(car (remove_aux e l)))
So, if it run like this: (remove_el 2 '(1 2 3 ((2 3 2) 4))) => (1 3 ((3) 4))
What I don't exactly understand is how this line works: (t(list(apply 'append (mapcar #'(lambda (l) (sterge_aux e l)) l))))
If I have the line without list and append ((t(mapcar #'(lambda (l) (remove_aux e l)) l))) the result is ((1) NIL (3) ((NIL (3) NIL) (4)))) if it has append but not list ( (t(apply 'append (mapcar #'(lambda (l) (remove_aux e l)) l))) ) then the result is (1 3 3 4) and I don't get why because I did (apply 'append '((1) NIL (3) ((NIL (3) NIL) (4))))) in the Common Lisp console and the result was ((1 3 (NIL (3) NIL) (4))) so I'm really confused. Can somebody explain to me how this all works step by step?
I've annotated the code below to, I hope, explain what's going on. You're probably getting confused because l is getting redefined within a lambda... so the t line (in your example) has 2 "l"s on it but the first one isn't the same as the second one.
(defun remove_aux (e l)
(cond
((equal e l) nil) ;if e equals l return nil
((atom l) (list l)) ;if l is an atom return a list with just l in it
(t ; otherwise...
(list ;create a list
(apply 'append ; whose contents are created by appending
; together the lists that come out of this mapcar
; (apply the append method)
(mapcar #'(lambda (l) ( ; iterate over each of the elements in list l
; the one after the lambda not the one
; being passed to the lambda.
; (this is a horrible name choice
; lambda(l-item) would be much better)
remove_aux e l
; recursively call this method
; with e (which was passed in at the start)
; and l which isn't the l passed in,
; but is an entry of it (see why naming's
; so important?)
; this returns a list
; which will get appended by the append
; with the results of all the other calls
; to remove_aux for each item in the outer l
)
) l)
)))))
(defun remove_el (e l)
(car (remove_aux e l)
)
)
;; append elements of each list in argument together
(append '(a) '(b) '(c d) '(e)) ; ==> (a b c d e)
;; append elements of each sublist in argument
(apply #'append '((a) (b) (c d) (e))) ; ==> (a b c d e)
;; apply function on each element of list into new list
(mapcar #'(lambda (x) (+ x 1)) '(1 3 5 6)) ; ==> (2 4 6 7)
So what does the default case do in your function.. Well it applies itself to each sublist of lst and wrap it in a list so if l is '(a y 2 z) and e is 2, well then the result from mapcar is '((a) (y) () (z)) which is then the argument to apply-append which connects the elements together into one list again. When connecting the lists the element that was to be removed is an empty list and it's effectively ignored in the concatenation process.
Since all the lists appended you create in the helper, you could replace the apply-append with (mapcan #'(lambda (l) (remove_aux e l)) l). A more obvious way to do this would be using reduce while a more efficient way might use loop.
A procedure that achieve what you want to achieve is essentially like below procedure:
(defun remove-all (e l)"Removes all occurrences of e from a list l."
(cond
((null l) '())
((equal e (car l)) (remove-all e (cdr l)))
((not (atom (car l)))
(cons (remove-all e (car l))
(remove-all e (cdr l))))
(t (cons (car l)
(remove-all e (cdr l))))))
;note: the e is not neccessarily an atom, the l is not necessarily a list of atoms.
The procedure in your question has unnecessarily cluttered pieces, like append, maps etc.
if you recomment below i will explain the algorithm.
have a nice hack.
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 '()?
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)))