I have a list
'((1 2 (A B C)) (2 3 (B C D)) (4 5 (C D F)))
I want to process the elements in the inner list, (in this case, I want to change (A B C) and other lists to (M M M)).
I wrote a code (process lst), which will do this task for the inner list.
(defun process (lst)
(cond
((null lst) '())
(T (cons 'M (process (cdr last))))))
And when I call from the main function,
(defun iterate-list (lst)
(cond
((null lst) '())
((listp (car lst))
(cons (process (car lst))
(iterate-list (cdr lst))))
(T
(cons (car lst)
(iterate-list (cdr lst))))))
I am getting ((M M M) (M M M) (M M M)) instead of ((1 2 (M M M)) (2 3 (M M M)) (4 5 (M M M))).
But when I use the same function, with just (cons (car lst)) (iterate-list (cdr lst))) in the second condition (listp (car lst)), I am getting the correct answer, that is
'((1 2 (A B C)) (2 3 (B C D)) (4 5 (C D F)))
I don't know where I am making the mistake.
If you want something practical, I would suggest the subst function from the Common LISP Standard Library.
http://clhs.lisp.se/Body/f_substc.htm
(setq tree1 '(1 (1 2) (1 2 3) (1 2 3 4))) => (1 (1 2) (1 2 3) (1 2 3 4))
(subst "two" 2 tree1) => (1 (1 "two") (1 "two" 3) (1 "two" 3 4))
(subst "five" 5 tree1) => (1 (1 2) (1 2 3) (1 2 3 4))
You can also add you own equality function by using the variant subst-if with a lambda function.
NB. You need to rename last to lst in process.
I am getting ((M M M) (M M M) (M M M)) instead of ((1 2 (M M M)) (2 3 (M M M)) (4 5 (M M M))).
The code works, but not that at the depth you want:
(process '(a b c d))
=> (M M M M)
(iterate-list '(1 2 (A B C)))
=> (1 2 (M M M))
In order to process all lists in your root list, you could do this:
(mapcar #'iterate-list '((1 2 (A B C))
(2 3 (B C D))
(4 5 (C D F))))
=> ((1 2 (M M M)) (2 3 (M M M)) (4 5 (M M M)))
Related
This procedure to identify that a tic-tac-toe row is marked does not work (X _ _ row is identified as fully marked when it is not)
(define (won? b m)
(define (row-marked? r)
(every?-ec (:vector c (index i) b) (if (memv i r)) [char=? c m]))
"Returns #t if the mark m won"
(let ([rr '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))])
`(or ,#(map (lambda (r) `(row-marked? (list ,#r))) rr))))
while the procedure below works
(define (won? b m)
(define (row-marked? r)
(every?-ec (:vector c (index i) b) (if (memv i r)) [char=? c m]))
"Returns #t if the mark m won"
(or (row-marked? '(0 1 2)) (row-marked? '(3 4 5)) (row-marked? '(6 7 8))
(row-marked? '(0 3 6)) (row-marked? '(1 4 7)) (row-marked? '(2 5 8))
(row-marked? '(0 4 8)) (row-marked? '(2 4 6))))
I've tried with no luck
(let ([rr '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))])
`(or ,#(map (lambda (r) `(row-marked? ,r)) rr)))
and
(let ([rr '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))])
`(or ,#(map (lambda (r) `(row-marked? ',r)) rr)))
as well. What I'm doing wrong?
My goal is to avoid code repetition and automatically generate the executable (or ...) expression while keeping the short-circuiting of both or and every-ec
Thank you!
What you need isn't a macro (and as you've specified it it can not be done by a macro), it's SRFI 1's any function:
(define (won? b m)
(define (row-marked? r)
(every?-ec (:vector c (index i) b) (if (memv i r)) [char=? c m]))
"Returns #t if the mark m won"
(any row-marked?
'((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))))
A single-list version of any, which is all you need, is very easy to write:
(define (any/1 p l)
(if (null? l)
#f
(or (p (first l))
(any/1 p (rest l)))))
A fully-fledged any is a bit harder to get right, especially if you want it to be efficient in the simple cases.
It's worth while perhaps seeing why what you want to achieve can't be done with a macro. If you consider the fragment
(let ([rr ...])
(m row-marked? rr))
Then can m be a macro whose expansion is (or (row-marked ...) ...)? No, it can't be, because macros transform source code and the list which is bound to rr is not available until run time: the macro does not have the source code it needs to transform.
Really, the thing you want to avoid here, is that the forms in the body of row-marked? should be evaluated only as many times until they return true, and the mechanism for doing that is just wrapping them up in a function and calling it only as many times as needed.
However that mechanism is sometimes a bit syntactically clumsy: if I have something like
(any (λ (e1 e2)
(and (integer? e1) (integer? e2)
(even? e1) (even? e2))
(not (= e1 e2)))
l1 l2)
I might rather write this as
(finding-first ((e1 l1) (e2 l2))
(and (integer? e1) (integer? e2)
(even? e1) (even? e2)
(not (= e1 e2))))
And, of course, you can:
(define-syntax finding-first
(syntax-rules ()
[(_ ((v l) ...) form ...)
(any (λ (v ...) form ...) l ...)]))
I have the following task:
To build the function (REMOVE EL), that removes given atom or list from another list, and this should apply on each level of the list
Example :
L=(A B A (B A C X ) X B)
(REMOVE A L ) -> (B (B C X) X B)
I wrote the following code :
(defun removeel(el tree)
(mapcan (lambda(subtree)
(cond ((null subtree) (list nil))
((consp subtree) (list (removeel el subtree)))
((eql subtree el) nil)
(t (list subtree))))
tree))
The problem is that when I remove atom, it works excellent
(removeel 'B' (A B A (B A C X ) X B))
(A A (A C X) X)
But it doesn't work If I want to remove a list
(removeel '(B A C X) ' (A B A (B A C X ) X B))
(A B A (B A C X) X B)
What should be done to make it to remove lists too ?
the simplest way would be to introduce optional equality test function, as in remove standard procedure.
it could look this way:
(defun rem-rec (item data &key (test #'eql))
(mapcar (lambda (x) (if (listp x)
(rem-rec item x :test test)
x))
(remove item data :test test)))
CL-USER> (rem-rec 1 `(1 2 (3 4 (1 2 3)) (1 (1 2 3) 3 4)))
;;=> (2 (3 4 (2 3)) ((2 3) 3 4))
for lists equality you can use equal (or equalp or anything more specific)
CL-USER> (rem-rec '(1 2 3) '(1 2 (3 4 (1 2 3)) (1 (1 2 3) 3 4)) :test #'equal)
;;=> (1 2 (3 4) (1 3 4))
Now, just by looking at the question and the variables L and X, I can see, more or less, at the very minimum how these answers come to fruition.
But this time I would like to know the inner workings, step by step, as to how these answers come about. My professor is absolutely terrible and can't explain anything for his life.
L = (D B B A A A A C)
X = ((2B) (4A) (1C))
Q1) (cons (list (+ (caar X) 1) (cadar X)) (cdr X))
Answer: ((3B) (4A) (1C))
Q2) (cons (list 1 (car L)) X)
Answer: ((1D) (2B) (4A) (1C))
Are you sure you didn't miss spaces in the definition of X?
Looks like, it should be defined like this:
X = ((2 B) (4 A) (1 C))
The computation is like this:
;;; Setup.
(defvar L '(D B B A A A A C))
(defvar X '((2 B) (4 A) (1 C)))
;;; Q1:
(cons (list (+ (caar X) 1) (cadar X)) (cdr X))
;;; ^^^^^^^^
;;; (caar X) = 2
(cons (list (+ 2 1) (cadar X)) (cdr X))
;;; ^^^^^^^
;;; (+ 2 1) = 3
(cons (list 3 (cadar X)) (cdr X))
;;; ^^^^^^^^^
;;; (cadar X) = B
(cons (list 3 'B) (cdr X))
;;; ^^^^^^^^^^^
;;; (list 3 'B) = (3 B)
(cons '(3 B) (cdr X))
;;; ^^^^^^^
;;; (cdr X) = ((4 A) (1 C))
(cons '(3 B) '((4 A) (1 C)))
;;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;;; (cons '(3 B) '((4 A) (1 C))) = ((3 B) (4 A) (1 C))
'((3 B) (4 A) (1 C))
;;; Q2:
(cons (list 1 (car L)) X)
;;; ^^^^^^^
;;; (car L) = D
(cons (list 1 'D) X)
;;; ^^^^^^^^^^^
;;; (list 1 'D) = (1 D)
(cons '(1 D) X)
;;; ^^^^^^^^^^^^^^^
;;; (cons '(1 D) X) = ((1 D) (2 B) (4 A) (1 C))
'((1 D) (2 B) (4 A) (1 C))
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))