In below situation, I want to get same results for a and (car b) like (10 10). But just symbol A is shown as a result of (car b). Can we get 10 with like (something (car b)) code?
(let* ((a 10)
(b '(a)))
(list a (car b))) ; (10 A)
;; Hoping to get (10 10) with (list a (something (car b)))
I also tried below ones but couldn't get the answer.
(let* ((a 10)
(b '(a))
(c `(,a)))
(list a ; 10
'a ; A
(car b) ; A
(eq (car b) 'a) ; T
(car c) ; 10
;; (eval 'a) ; Error - The variable A is unbound.
;; (symbol-value (car b)) ; Error - The variable A is unbound.
))
My motivation is to make symbols and params lists with let like below. But the part of foo is not working as I expected now. I believe above question will solve (or help) this also. (This part is not question)
(defmacro my-let (binds &body body)
`(let ((symbols (mapcar #'car ',binds))
(params (mapcar #'(lambda (x) (eval (cadr x))) ',binds))) ; I may need to modify here
(let ,binds
,#body)))
(defun foo (bar)
(my-let ((b bar))
(list symbols params)))
(foo "baz") ; Error - The variable BAR is unbound.
[I wrote this mostly before coredump's answer was posted and then forgot about it. I think that answer is probably the one you want but perhaps this is worth reading as well.]
You can't retrieve the values of lexically-bound variables from their names. However, you can (as I think you are trying to do) write macros which bind variables and then remember the names of the bindings. Here are two, both of which introduce a local function called valof which lets you get at the value of a binding by name. Neither are completely correct: see the end for why.
For both of these macros the trick is to maintain a secret association list between names and values.
(defmacro let/names (bindings &body forms)
(let ((<map> (make-symbol "MAP")))
`(let ,bindings
(let ((,<map> (list ,#(mapcar (lambda (b)
(etypecase b
(symbol
`(cons ',b ,b))
(cons
`(cons ',(car b) ,(car b)))))
bindings))))
(flet ((valof (s)
(let ((m (assoc s ,<map>)))
(if m
(values (cdr m) t)
(values nil nil)))))
,#forms)))))
Here is what the expansion of this looks like (here *print-circle* is true so you can see that the gensymed name is used):
(let/names ((a 1))
(valof 'a))
-> (let ((a 1))
(let ((#1=#:map (list (cons 'a a))))
(flet ((valof (s)
(let ((m (assoc s #1#)))
(if m (values (cdr m) t) (values nil nil)))))
(valof 'a))))
Now, for instance:
> (let/names ((a 1))
(valof 'a))
1
t
> (let/names ((a 1))
(valof 'b))
nil
nil
But this macro is not actually really correct:
> (let/names ((a 1))
(setf a 2)
(valof 'a))
1
t
To deal with this problem the trick is to build a bunch of little functions which access the values of bindings. While doing that we can also allow assignment: mutation of the bindings.
(defmacro let/names (bindings &body forms)
(let ((<map> (make-symbol "MAP")))
`(let ,bindings
(let ((,<map> (list ,#(mapcar (lambda (b)
(etypecase b
(symbol
`(cons ',b
(lambda (&optional (v nil vp))
(if vp
(setf ,b v)
,b))))
(cons
`(cons ',(car b)
(lambda (&optional (v nil vp))
(if vp
(setf ,(car b) v)
,(car b)))))))
bindings))))
(flet ((valof (s)
(let ((m (assoc s ,<map>)))
(if m
(values (funcall (cdr m)) t)
(values nil nil))))
((setf valof) (n s)
(let ((m (assoc s ,<map>)))
(unless m
(error "~S unbound" s))
(funcall (cdr m) n))))
,#forms)))))
Here, again, is what the expansion looks like (much more complicated now):
(let/names ((a 1))
(valof 'a))
-> (let ((a 1))
(let ((#1=#:map
(list (cons 'a
(lambda (&optional (v nil vp))
(if vp (setf a v) a))))))
(flet ((valof (s)
(let ((m (assoc s #1#)))
(if m (values (funcall (cdr m)) t) (values nil nil))))
((setf valof) (n s)
(let ((m (assoc s #1#)))
(unless m (error "~S unbound" s))
(funcall (cdr m) n))))
(valof 'a))))
Now everything is better:
> (let/names ((a 1))
(valof 'a))
1
t
> (let/names ((a 1))
(valof 'b))
nil
nil
> (let/names ((a 1))
(setf a 2)
(valof 'a))
2
t
> (let/names ((a 1))
(setf (valof 'a) 3)
a)
3
Why neither of these macros is completely right. Neither macro deals with declarations properly: in a case like
(let/names ((a 1))
(declare (type fixnum a))
...)
The declaration will end up in the wrong place. Dealing with this requires 'lifting' declarations to the right place, which is easy to do but I'm not going to make these even more complicated than they already are.
Would something like this solve your problem?
(defmacro my-let ((&rest bindings) &body body)
`(let ,bindings
(let ((symbols ',(mapcar #'car bindings))
(values (list ,#(mapcar #'car bindings))))
,#body)))
((lambda (bar)
(my-let ((b bar))
(list symbols values)))
"baz")
((B) ("baz"))
Related
This program is meant to multiply all the elements of an array together in scheme and output the total but so far it has only been returning 0 as the output.
(define (mult-list lst)
(if (null? lst)
0
(* (car lst)
(mult-list (cdr lst)))) )
The problem is that 0 * <anything> is still 0, and the multiplication by 0 gets propagated up the function calls since the last function call will always return 0 (which then gets multiplied by the next number, which is still 0, and the next, still 0, etc).
The solution to this would be to return 1 instead of 0, since 1 is the multiplicative identity the same way 0 is the additive identity. Since anything multiplied by 1 is itself, this will mean that the last item in the list gets multiplied by 1 (still = to the last item) which then gets multiplied by the second-to-last item, etc.
Alternatively, instead of returning 1 when the list is empty, you can return the only item in the list ((car lst)) when the list has 1 item left in it ((null? (cdr lst))).
I'm more a fan of Church numerals, which are, along with arithmetic operations on them, expressed as applications of functions in the elegant and fundamental lambda calculus. Note the absence of *.
(define (mult-list lst)
(letrec ((mul (lambda (m n) (lambda (f) (lambda (x) ((m (n f)) x)))))
(church (lambda (n)
(if (= n 0)
(lambda (f) (lambda (x) x))
(lambda (f) (lambda (x) (f (((church (- n 1)) f) x)))))))
(unchurch (lambda (cn) ((cn (lambda (x) (+ x 1))) 0))))
(let loop ((lst (map church lst))
(acc (church 1)))
(if (null? lst)
(unchurch acc)
(loop (cdr lst) (mul (car lst) acc))))))
(write (mult-list '(2 3 4)) ; 24
You might also be interested in the use of a named let to express recursion instead of calling the top-level function directly. Very useful in more complicated functions.
(define mul1 (lambda (l) (apply * l)))
(define mul2 (lambda (l) (reduce-left * 1 l)))
(define mul3
(lambda (l)
((lambda (s) (s s l))
(lambda (s l)
(or (and (null? l) 1)
(* (car l) (s s (cdr l))))))))
And here I wrote the Peano multiplication that looks more complicated, but in fact it is simpler, as it multiplies by using recursive addition! It uses only the operator SUCC, the predicate EQUALP and the constructor ZERO.
(define mul/peano
(lambda (l)
(define SUCC (lambda (x) (+ x 1)))
(define EQUALP =)
(define ZERO 0)
;; Peano Axioms
(define ZEROP (lambda (x) (EQUALP x ZERO)))
(define ONE (SUCC ZERO))
(define SUB1 (lambda (x)
((lambda (s)
(if (ZEROP x) ZERO (s s ONE)))
(lambda (s x+)
(if (EQUALP x x+)
ZERO
(SUCC (s s (SUCC x+))))))))
(define ADD
(lambda (a b r)
((lambda (s) (s s a r))
(lambda (s a c)
(or (and (ZEROP a) (c b))
(s s (SUB1 a)
(lambda (x)
(c (SUCC x)))))))))
((lambda (s) (s s l (lambda (total) total)))
(lambda (s l ret)
(or (and (null? l) (ret ONE))
(and (ZEROP (car l)) (ret ZERO))
(s s (cons (SUB1 (car l)) (cdr l))
(lambda (r1)
(s s (cdr l)
(lambda (r2)
(ADD r1 r2 ret))))))))))
Note that I defined 0-1=0, as this is how Peano does.
If we're willing to count in unary as in the other answers, we might as well just count in unary -- with length:
(define (mult-list lst)
(length
(crossProduct
(map mkList lst))))
(define (mkList n)
(cond ((> n 0) (cons n (mkList (- n 1))))
(else (list))))
(define (crossProduct xs)
(cond
((null? xs) (list (list)))
(else
(let* ((a (car xs))
(d (cdr xs))
(p (crossProduct d)))
(apply append
(map (lambda (x)
(map (lambda (q) (cons x q))
p))
a))))))
Testing:
> (mult-list '(2 3 4))
24
> (crossProduct (map mkList '(2)))
'((2) (1))
> (crossProduct (map mkList '(2 3)))
'((2 3) (2 2) (2 1) (1 3) (1 2) (1 1))
> (crossProduct (map mkList '(2 0 3)))
'()
now I have a list:
(+ x (- 4 9))
I first need (- 4 9) change to (- (4 . 0) (9 . 0))
(please do worry this part too much)
(defun typecheck (A)
(cond
((numberp A)
(cons A 0))
((equal A 'x)
(cons 1 1))
(t A)))
then I need to subtract (4 . 0) and (9 . 0) (still this is not my problem, I don't want to post this function because it is too long...
so it becomes
(+ x (-5 . 0))
now this time I change x to (1 . 1) so the list becomes (+ (1 . 1) (- 5 . 0))
I finally add them together (final result is (-4 . 1))
My main problem is how to let Lisp know I want to calculate them first after I got (- (4 . 0) (9 .0)) ? My function will just go stright to (+ (1 . 1) ((- 4 .0) (9 . 0)) and gave me an error msg.
My process :
(defun check (A)
(cond
((atom A)
(let ((newA (typecheck A)))
(calucalte A)))
((listp A)
(mapcar #'check A))
but this function won't store anything...and I have no idea how to do it :( can anyone give me some help? THANK YOU.
If I understood the problem correctly you should just write a single recursive function handling operations and number/symbol conversion, for example:
(defun tcheck (expr)
(cond
((numberp expr)
(cons expr 0))
((eq expr 'x)
(cons 1 1))
((listp expr)
(cond
((eq (first expr) '+)
(let ((a (tcheck (second expr)))
(b (tcheck (third expr))))
(cons (+ (car a) (car b))
(+ (cdr a) (cdr b)))))
((eq (first expr) '-)
(let ((a (tcheck (second expr)))
(b (tcheck (third expr))))
(cons (- (car a) (car b))
(- (cdr a) (cdr b)))))
(T
(error "Unknown operation"))))
(T expr)))
With the above function
(tcheck '(+ x (- 4 9)))
returns (-4 . 1)
How do I recursively merge jumping pairs of elements of a list of lists? I need to have
'((a b c) (e d f) (g h i))
from
'((a b) c (e d) f (g h) i)
My attempt
(define (f lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (append (car lst) (list (cadr lst)))
(list (append (caddr lst) (cdddr lst))))))
works if I define
(define listi '((a b) c (d e) f))
from which I obtain
((a b c) (d e f))
by doing simply
(f listi)
but it does not work for longer lists. I know I need recursion but I don't know where to insert f again in the last sentence of my code.
A simpler case that your algorithm fails: (f '((1 2) 3)) should result in '((1 2 3)), but yours results in an error.
We will define some terms first:
An "element" is a regular element, like 1 or 'a.
A "plain list" is simply a list of "element"s with no nested list.
E.g., '(1 2 3) is a plain list. '((1 2) 3) is not a plain list.
A "plain list" is either:
an empty list
a cons of an "element" and the next "plain list"
A "list of jumping pairs" is a list of even length where the odd index has a "plain list", and the even index has an element. E.g., '((1) 2 (a) 4) is a "list of jumping pairs". A "list of jumping pairs" is either:
an empty list
a cons of
a "plain list"
a cons of an "element" and the next "list of jumping pairs"
We are done with terminology. Before writing the function, let's start with some examples:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
(f '((1 2) 3 (4) a)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
(cons (cons 4 empty)
(cons 'a
empty)))))
should output '((1 2 3) (4 a))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
(cons (cons 4 (cons 'a empty))
empty))
So, f is a function that consumes a "list of jumping pairs" and returns a list of "plain list".
Now we will write the function f:
(define (f lst)
???)
Note that the type of lst is a "list of jumping pairs", so we will perform a case analysis on it straightforwardly:
(define (f lst)
(cond
[(empty? lst) ???] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
we know that the empty case should return an empty list, so let's fill in the hole accordingly:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
we know that we definitely want to put the "element" into the back of the "plain list" to obtain the resulting "plain list" that we want:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the next "list of jumping pairs"
(rest (rest lst))
;; that are available for us to use
???]))
There's still the next "list of jumping pairs" left that we need to deal with, but we have a way to deal with it already: f!
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the list of "plain list"
(f (rest (rest lst)))
;; that are available for us to use
???]))
And then we can return the answer:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case returns
;; the resulting list of "plain list" that we want
(cons (append (first lst) (cons (first (rest lst)) empty))
(f (rest (rest lst))))]))
Pattern matching (using match below) is insanely useful for this kind of problem -
(define (f xs)
(match xs
;; '((a b) c . rest)
[(list (list a b) c rest ...)
(cons (list a b c)
(f rest))]
;; otherwise
[_
empty]))
define/match offers some syntax sugar for this common procedure style making things even nicer -
(define/match (f xs)
[((list (list a b) c rest ...))
(cons (list a b c)
(f rest))]
[(_)
empty])
And a tail-recursive revision -
(define (f xs)
(define/match (loop acc xs)
[(acc (list (list a b) c rest ...))
(loop (cons (list a b c) acc)
rest)]
[(acc _)
acc])
(reverse (loop empty xs)))
Output for each program is the same -
(f '((a b) c (e d) f (g h) i))
;; '((a b c) (e d f) (g h i))
(f '((a b) c))
;; '((a b c))
(f '((a b) c x y z))
;; '((a b c))
(f '(x y z))
;; '()
(f '())
;; '()
As an added bonus, this answer does not use the costly append operation
There is no recursive case in your code so it will just work statically for a 4 element list. You need to support the following:
(f '()) ; ==> ()
(f '((a b c) d (e f g) h)) ; ==> (cons (append '(a b c) (list 'd)) (f '((e f g) h)))
Now this requires exactly even number of elements and that every odd element is a proper list. There is nothing wrong with that, but onw might want to ensure this by type checking or by adding code for what should happen when it isn't.
I'm trying to add a given variable x to a list L. Both of which are parameters of the function ADDV. The code I have so far is as follows:
(defun addV(L x)
(cond
((eq L nil) nil)
((eq (cdr L) nil) (list(+(car L) x)))
(+ x (first(last L)))
(butlast L)
(append L x) ) )
With the parameters
L = '(1 2 3 4)
x = 2
When the statement: (+ x (first(last L)))) is evaluated, it's value is 4. The final goal should be
L = '(1 2 3 6)
I'm not sure what I'm doing wrong. Any help would be greatly appreciated. Thanks.
Your code is badly formatted. Re-indenting, we get
(defun addV(L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(+
x
(first (last L)))
(butlast
L)
(append
L
x) ) )
do you see the problem now?
Since (not +) is NIL, the corresponding clause in the COND form is entered. Its body's forms (x and (first (last L))) are evaluated for effects, of which there are none. Then the last form's value is returned.
What you evidently wanted it to be, is
(defun addV (L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(T
(append
(butlast L)
(list (+ x (first (last L))))))))
Coincidentally, the 2nd clause it completely unnecessary and may just be omitted, making it
(defun addV (L x)
(if (not (null L))
(append (butlast L)
(list (+ x (first (last L)))))))
If you can do this destructively, then you can use incf and last:
(defun increment-last (list x)
(prog1 list ; return the list
(incf (first (last list)) x)))
If you do need to make a new list, you'll have to walk to the end of the list to get to the last element. While you're doing that, you could keep track of the elements you've already seen (in reverse order) and efficiently use that reverse order list to construct the new list for you using nreconc:
(defun plus-last (list x)
(do ((list list (rest list))
(rhead '() (list* (first list) rhead)))
((endp (rest list))
(nreconc rhead (list (+ x (first list)))))))
CL-USER> (plus-last '(1 2 3 4) 2)
(1 2 3 6)
If you're not so comfortable with do syntax, you could use a tail recursive function, too (which some Common Lisp implementations can optimize into a loop):
(defun plus-last (list x)
(labels ((pl (list rhead)
(if (endp (rest list))
(nreconc rhead (list (+ x (first list))))
(pl (rest list)
(list* (first list) rhead)))))
(pl list '())))
You could also use loop, and express the logic pretty clearly:
(defun plus-last (list x)
(loop for (a . b) on list
if (null b) collect (+ a x)
else collect a))
This could also be done with maplist:
(defun plus-last (list x)
(maplist (lambda (list)
(if (endp (rest list))
(+ x (first list))
(first list)))
list))
From any given list in lisp, I want to get the two element combinations of the elements of that list without having duplicate combinations ( meaning (a b) = (b a) and one should be removed)
So for example if I have a list that is (a b c d),
I want to get ((a b) (a c) (a d) (b c) (b d) (c d))
(defun combinations (list)
(loop for (a1 . r1) on list
nconc (loop for a2 in r1 collect (list a1 a2))))
CL-USER 172 > (combinations '(a b c d))
((A B) (A C) (A D) (B C) (B D) (C D))
Assuming I'm understanding you correctly, I'd use mapcar and friends.
(defun pair-with (elem lst)
(mapcar (lambda (a) (list elem a)) lst))
(defun unique-pairs (lst)
(mapcon (lambda (rest) (pair-with (car rest) (cdr rest)))
(remove-duplicates lst)))
That should let you
CL-USER> (unique-pairs (list 1 2 3 4 5))
((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
CL-USER> (unique-pairs (list :a :b :c :a :b :d))
((:C :A) (:C :B) (:C :D) (:A :B) (:A :D) (:B :D))
If you're not scared of loop, you can also write the second one slightly more clearly as
(defun unique-pairs (lst)
(loop for (a . rest) on (remove-duplicates lst)
append (pair-with a rest)))
instead. I'm reasonably sure that loops append directive is more efficient than the function of the same name.
Scheme solution:
(define (lol lst)
(let outer ((lhs lst))
(if (null? lhs)
'()
(let inner ((rhs (cdr lhs)))
(if (null? rhs)
(outer (cdr lhs))
(cons (list (car lhs) (car rhs)) (inner (cdr rhs))))))))
And a Common Lisp translation of same:
(defun lol (list)
(labels ((outer (lhs)
(and lhs (labels ((inner (rhs)
(if rhs
(cons (list (car lhs) (car rhs))
(inner (cdr rhs)))
(outer (cdr lhs)))))
(inner (cdr lhs))))))
(outer list)))
Sorry, I'm not a Common Lisper, so I hope this isn't too ugly. :-)
This is similar to Rainer's Joswig answer, in principle, except it doesn't use loops.
(defun combinations (list)
(mapcon (lambda (x) (mapcar (lambda (y) (list (car x) y)) (cdr x))) list))
One thing that confuses me about your example is that (a a) matches your verbal description of the desired result, but in the example of the result you've excluded it.
This is my own initial answer. It might not be completely efficient but it solves the problem.
(remove nil (let ((res))
(dotimes (n (length test-list) res)
(setq res
(append res
(let ((res2) (rest-list (remove (nth n test-list) test-list)))
(dotimes (m (length rest-list) res2)
(setq res2
(append res2
(list (if (< (nth n test-list) (nth m rest-list))
(list (nth n test-list) (nth m rest-list))
nil)))))))))))
If the "if statement" on line 9 is removed, the result will include also duplicates and the result will be
((a b) (a c) (a d) (a a) (b a) (b c) (b d) (b b)
(c a) (c b) (c d) (c c) (d a) (d b) (d c) (d d))