How to achieve this in Common lisp?
(logselect (t nil t) (list1 list2 list3)) ---> (list1 list2)
I have coded the below function but I think there is a better way (maybe a built-in function?).
(defun logselect (loglist lista)
(let ((listaL) (maskL) (toremove))
(setq listaL (mapcar #'list lista))
(setq maskL (mapcar #'cons loglist listaL))
(setq toremove (mapcar #'(lambda (x) (car (and (car x) (cdr x)))) maskL))
(remove nil toremove)
)
)
Thank you in advance.
This is easily done using LOOP:
(defun logselect (loglist lista)
(loop for test in loglist
for value in lista
when test collect value))
If you prefer a more "lispy" solution, you can do it with mapcan:
(defun logselect (loglist lista)
(mapcan #'(lambda (test value)
(when test (list value)))
loglist lista))
mapcan is a useful function when you want to use a mapping function to add list elements conditionally. The function returns a list, and they're all concatenated to create the final result, so it can return an empty list if it doesn't want to add something.
Related
I need to write the lisp macro in scheme (please on hygienic macros and syntax-rules etc) that will have function call and Alist as argument
I want function and macro that call that function to have syntax like this:
(foo '(10 (a (lambda () (display "10")) b (lambda () (display "20"))))
or macro without quotes.
My last code is working, but not sure if this is how you suppose to write function/macro like this. It seems that I need double backquote but don't know how to write it. (I'm right now reading On Lips by Paul Graham and he said that double backquote is very hard and only need by macros defining macros, but It seems that this is what I need).
(define (foo expr)
`(list ,(car expr)
(,(string->symbol "quasiquote") ,(pair-map (lambda (a b)
(cons (symbol->string a)
(list 'unquote b)))
(cadr expr)))))
(define-macro (bar expr)
(foo expr))
(define xx (bar (10 (a 20 b (lambda () (display "x") (newline))))))
;; (list 10 `((a . ,20) (b . ,(lambda () (display "x") (newline))))
(define bfn (cdr (assoc "b" (cadr xx)))))
(bfn)
;; "x"
and here is definition of pair-map
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
with (string->symbol "quasiquote") I was able not to use double backquote, can this be written with double backquote/quasiquote? How this should look like?
I'm asking if this can be written different way so I can fix few issues in my own lisp interpreter (not sure if is working correctly but it seems that this final version works the same in guile).
I came up with shorter quasiquote version, but still it require inserting symbols:
(define (foo expr)
`(list ,(car expr)
(,'quasiquote ,(pair-map (lambda (a b)
`(,(symbol->string a) . (,'unquote ,b)))
(cadr expr)))))
i worte this function to remove numbers from a list x
(defun rm-nums (x)
(cond
((null x) nil)
(t (mapcar 'numberp x))))
however when i enter (rm-nums '(32 A T 4 3 E))
returns (T NIL NIL T T NIL)
i want it instead of returning T or Nil, i want it to return the values that caused NIL only [which are not numbers]
so this example should return (A T E)
i am supposed to use mapcar WITHOUT recursion or iteration or the bultin function "remove-if"
i think it is related to something called apply-append but i know nothing about it. any help?
I think your course had this in mind:
(defun my-remove-if (pred lst)
(apply #'append (mapcar (lambda (x)
(and (not (funcall pred x))
(list x)))
lst)))
It does use apply and append and mapcar, like you said. Example usage:
(my-remove-if #'numberp '(32 a t 4 3 e))
=> (a t e)
More idiomatic solution suggested by Rörd:
(defun my-remove-if (pred lst)
(mapcan (lambda (x)
(and (not (funcall pred x))
(list x)))
lst))
i've seen several examples of implementing append an element to a list, but all are not using tail recursion. how to implement such a function in a functional style?
(define (append-list lst elem)
expr)
The following is an implementation of tail recursion modulo cons optimization, resulting in a fully tail recursive code. It copies the input structure and then appends the new element to it, by mutation, in the top-down manner. Since this mutation is done to its internal freshly-created data, it is still functional on the outside (does not alter any data passed into it and has no observable effects except for producing its result):
(define (add-elt lst elt)
(let ((result (list 1)))
(let loop ((p result) (lst lst))
(cond
((null? lst)
(set-cdr! p (list elt))
(cdr result))
(else
(set-cdr! p (list (car lst)))
(loop (cdr p) (cdr lst)))))))
I like using a "head-sentinel" trick, it greatly simplifies the code at a cost of allocating just one extra cons cell.
This code uses low-level mutation primitives to accomplish what in some languages (e.g. Prolog) is done automatically by a compiler. In TRMC-optimizing hypothetical Scheme, we would be able to write the following tail-recursive modulo cons code, and have a compiler automatically translate it into some equivalent of the code above:
(define (append-elt lst elt) ;; %% in Prolog:
(if (null lst) ;; app1( [], E,R) :- Z=[X].
(list elt) ;; app1( [A|D],E,R) :-
(cons (car lst) ;; R = [A|T], % cons _before_
(append-elt (cdr lst) elt)))) ;; app1( D,E,T). % tail call
If not for the cons operation, append-elt would be tail-recursive. This is where the TRMC optimization comes into play.
2021 update: of course the whole point of having a tail-recursive function is to express a loop (in a functional style, yes), and so as an example, in e.g. Common Lisp (in the CLISP implementation), the loop expression
(loop for x in '(1 2) appending (list x))
(which is kind of high-level specification-y if not even functional in its own very specific way) is translated into the same tail-cons-cell tracking and altering style:
[20]> (macroexpand '(loop for x in '(1 2) appending (list x)))
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
(BLOCK NIL
(LET ((#:G3047 '(1 2)))
(PROGN
(LET ((X NIL))
(LET ((#:ACCULIST-VAR-30483049 NIL) (#:ACCULIST-VAR-3048 NIL))
(MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
(TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:G3047) (LOOP-FINISH))
(SETQ X (CAR #:G3047))
(PROGN
(LET ((#:G3050 (COPY-LIST (LIST X))))
(IF #:ACCULIST-VAR-3048
(SETF #:ACCULIST-VAR-30483049
(LAST (RPLACD #:ACCULIST-VAR-30483049 #:G3050)))
(SETF #:ACCULIST-VAR-30483049
(LAST (SETF #:ACCULIST-VAR-3048 #:G3050))))))
(PSETQ #:G3047 (CDR #:G3047)) (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
(MACROLET
((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
(RETURN-FROM NIL #:ACCULIST-VAR-3048)))))))))) ;
T
[21]>
(with the mother of all structure-mutating primitives spelled R.P.L.A.C.D.) so that's one example of a Lisp system (not just Prolog) which actually does something similar.
Well it is possible to write a tail-recursive append-element procedure...
(define (append-element lst ele)
(let loop ((lst (reverse lst))
(acc (list ele)))
(if (null? lst)
acc
(loop (cdr lst) (cons (car lst) acc)))))
... but it's more inefficient with that reverse thrown in (for good measure). I can't think of another functional (e.g., without modifying the input list) way to write this procedure as a tail-recursion without reversing the list first.
For a non-functional answer to the question, #WillNess provided a nice Scheme solution mutating an internal list.
This is a functional, tail recursive append-elt using continuations:
(define (cont-append-elt lst elt)
(let cont-loop ((lst lst)
(cont values))
(if (null? lst)
(cont (cons elt '()))
(cont-loop (cdr lst)
(lambda (x) (cont (cons (car lst) x)))))))
Performance-wise it's close to Will's mutating one in Racket and Gambit but in Ikarus and Chicken Óscar's reverse did better. Mutation was always the best performer though. I wouldn't have used this however, but a slight version of Óscar's entry, purely because it is easier to read.
(define (reverse-append-elt lst elt)
(reverse (cons elt (reverse lst))))
And if you want mutating performance I would have done:
(define (reverse!-append-elt lst elt)
(let ((lst (cons elt (reverse lst))))
(reverse! lst)
lst))
You can't naively, but see also implementations that provide TCMC - Tail Call Modulo Cons. That allows
(cons head TAIL-EXPR)
to tail-call TAIL-EXPR if the cons itself is a tail-call.
This is Lisp, not Scheme, but I am sure you can translate:
(defun append-tail-recursive (list tail)
(labels ((atr (rest ret last)
(if rest
(atr (cdr rest) ret
(setf (cdr last) (list (car rest))))
(progn
(setf (cdr last) tail)
ret))))
(if list
(let ((new (list (car list))))
(atr (cdr list) new new))
tail)))
I keep the head and the tail of the return list and modify the tail as I traverse the list argument.
I'm trying to branch out and learn lisp. One of the basics would be to implement a simple stack. Everything works but my pop function.
;Returns and removes the first element of the stack
(defun my-pop ()
(let (temp (car *stack*))
(setq *stack* (cdr *stack*))
temp))
This correctly removes the "top" of the stack, but does not return it. Earlier, I had this:
;Returns and removes the first element of the stack
(defun my-pop ()
(print (car *stack*)
(setq *stack* (cdr *stack*)))
But I'd rather return the top.
What am I doing wrong? (I assume this has something to do with scope...)
Nothing to do with scope, it's a syntax problem. The syntax of LET is:
(let ((var1 val1)
(var2 val2)
...)
body)
Additionally, a (varN valN) may be abbreviated to just varN, which is equivalent to (varN nil). So what you wrote is equivalent to:
(let ((temp nil) ; bind TEMP to NIL
(car *stack*)) ; bind CAR to value of *STACK*
(setq *stack* (cdr *stack*))
temp)
You need an extra set of parentheses in your LET-bindings:
(let ((temp (car *stack*)))
(setq *stack* (cdr *stack*))
temp)
You could also use the built-in operator PROG1:
(prog1
(car *stack*)
(setq *stack* (cdr *stack)))
I am trying to write a function (lnn; list-not-nil) similar to list that only appends values that are not nil.
(list nil 3) --> (NIL 3)
(lnn nil 3) --> (3)
Here is the code I have so far. For some reason it causes infinite recursion on any input that I try.
(defun lnn (&rest items)
(lnn-helper nil items))
(defun lnn-helper (so-far items)
(cond ((null items)
so-far)
((null (car items))
(lnn-helper so-far (cdr items)))
(t (lnn-helper (append so-far (list (car items))) (cdr items)))))
Any ideas? Thanks very much.
(defun lnn-helper (so-far &rest items)
...)
With this argument list, items will never be nil if you always call lnn-helper with two arguments. Remove the &rest specifier, and it'll work.
Matthias' answer should have helped. Also note, that this is just a simple reduction:
(defun lnn (&rest elements)
(reduce (lambda (elt acc) (if elt (cons elt acc) acc))
elements
:from-end t
:initial-value nil))
Or even (less efficient):
(defun lnn (&rest elements)
(reduce #'cons (remove nil elements) :from-end t :initial-value nil))
Then:
(defun lnn (&rest elements)
(remove nil elements))
:)
P.S.: I know this was probably just an exercise in recursion, but SCNR.