I observed a macro expansion I do not fully understand:
(defmacro test (cons-list)
`(list
,#(mapcar #'(lambda(elem)
elem)
cons-list)))
(defmacro test-2 ()
`(list ,#(list (cons "a" "b"))))
(defmacro test-3 (cons-list)
`(list ,#cons-list))
I'd expect both macros to expand in the same fashion, as I just use mapcar in a fancy way of creating the same list again and then use that list.
But the results observed in SBCL are:
(test (list (cons "a" "b"))) expands to (LIST LIST (CONS "a" "b"))
(test-2) expands to (LIST ("a" . "b"))
(test-3 (list (cons "a" "b"))) again expands to (LIST LIST (CONS "a" "b"))
Why don't these macro expansions behave the same?
Test-2 evaluates the form (list (cons "a" "b")), the other two do not.
Remember: the arguments to a macro are the forms read, unevaluated.
In order to get the same behaviour from test-2, you would have to quote the form: ,#'(list (cons "a" "b")).
EDIT: Here is a step-by-step expansion of test:
`(list
,#(mapcar #'(lambda (elem)
elem)
cons-list))
Removing the backquote syntactic sugar:
(list* 'list (mapcar #'(lambda (elem)
elem)
cons-list)
Argument substitution in your example:
(list* 'list (mapcar #'(lambda (elem)
elem)
'(list (cons "a" "b")))
Evaluate the mapcar form:
(list* 'list '(list (cons "a" "b")))
Evaluate the `list*' form:
'(list list (cons "a" "b"))
Related
I am trying to implement a dictionary using lists in Common Lisp. The program is supposed to take a list of words and create a word histogram with frequency of each unique word.
This is the program:
(defparameter *histo* '())
(defun scanList (list)
(loop for word in list
do (if (assoc word histo)
((setf pair (assoc word histo))
(remove pair histo)
(setf f (+ 1 (second pair)))
(setf pair ((car pair) f))
(append histo pair))
((setf pair (word '1)) (append histo pair)))))
The error I get is: (SETF PAIR (ASSOC WORD *HISTO*)) should be a lambda expression.
Where is the syntax or semantic error exactly ?
(defun scanList (list the fox jumped over the other fox))
(princ *histo*)
Use hash-table for creating the dictionary and then transform to an association-list (alist) to sort it by key or value.
(defun build-histo (l)
(let ((dict (make-hash-table :test 'equal)))
(loop for word in l
do (incf (gethash word dict))
finally (return dict))))
;; which was simplification (by #Renzo) of
;; (defun build-histo (l)
;; (let ((dict (make-hash-table :test 'equal)))
;; (loop for word in l
;; for count = (1+ (gethash word dict 0))
;; do (setf (gethash word dict) count)
;; finally (return dict))))
(defparameter *histo* (build-histo '("a" "b" "c" "a" "a" "b" "b" "b")))
(defun hash-table-to-alist (ht)
(maphash #'(lambda (k v) (cons k v)) ht))
;; which is the same like:
;; (defun hash-table-to-alist (ht)
;; (loop for k being each hash-key of ht
;; for v = (gethash k ht)
;; collect (cons k v)))
;; sort the alist ascending by value
(sort (hash-table-to-alist *histo*) #'< :key #'cdr)
;; => (("c" . 1) ("a" . 3) ("b" . 4))
;; sort the alist descending by value
(sort (hash-table-to-alist *histo*) #'> :key #'cdr)
;; => (("b" . 4) ("a" . 3) ("c" . 1))
;; sort the alist ascending by key
(sort (hash-table-to-alist *histo*) #'string< :key #'car)
;; => (("a" . 3) ("b" . 4) ("c" . 1))
;; sort the alist descending by key
(sort (hash-table-to-alist *histo*) #'string> :eky #'car)
;; => (("c" . 1) ("b" . 4) ("a" . 3))
The posted code has a whole lot of problems. The reported error is caused by superfluous parentheses. Parentheses can't be added arbitrarily to expressions in Lisps without causing problems. In this case, these are the offending expressions:
((setf pair (assoc word histo))
(remove pair histo)
(setf f (+ 1 (second pair)))
(setf pair ((car pair) f)
(append histo pair))
((setf pair (word '1)) (append histo pair))
In both of these expressions, the results of the calls to setf are placed in the function position of a list, so the code attempts to call that result as if it is a function, leading to the error.
There are other issues. It looks like OP code is trying to pack expressions into the arms of an if form; this is probably the origin of the extra parentheses noted above. But, if forms can only take a single expression in each arm. You can wrap multiple expressions in a progn form, or use a cond instead (which does allow multiple expressions in each arm). There are some typos: *histo* is mistyped as histo in most of the code; f and pair are not defined anyplace; (setf pair (word '1)) quotes the 1 unnecessarily (which will work, but is semantically wrong).
Altogether, the code looks rather convoluted. This can be made much simpler, still following the same basic idea:
(defparameter *histo* '())
(defun build-histogram (words)
(loop :for word :in words
:if (assoc word *histo*)
:do (incf (cdr (assoc word *histo*)))
:else
:do (push (cons word 1) *histo*)))
This code is almost self-explanatory. If a word has already been added to *histo*, increment its counter. Otherwise add a new entry with the counter initialized to 1. This code isn't ideal, since it uses a global variable to store the frequency counts. A better solution would construct a new list of frequency counts and return that:
(defun build-histogram (words)
(let ((hist '()))
(loop :for word :in words
:if (assoc word hist)
:do (incf (cdr (assoc word hist)))
:else
:do (push (cons word 1) hist))
hist))
Of course, there are all kinds of other ways you might go about solving this.
Suppose you have a list of lists, e.g. '(("abc" "def" "ghi") ("012" "345" "678") ("jkl" "mno" "pqr")) or '(("ab" "cd" "ef") ("01" "23" "45")).
What would be the canonical way to zip the lists inside the given list?
I.e. how would func be defined such that
(func '(("ab" "cd" "ef") ("01" "23" "45")) :sep "|" :combiner #'concat)
;; => ("ab|01" "cd|23" "ef|45")
(func '(("abc" "def" "ghi") ("012" "345" "678") ("jkl" "mno" "pqr")) ...)
;; => ("abc|012|jkl" "def|345|mno" "ghi|678|pqr")
where concat := (lambda (args) ...) is the function that combines the heads of the respective lists.
Presumably, this type of operation is known as rotation or zipMany (according to the answers for related questions for different languages).
I have something like this (double-apply)
(apply #'mapcar #'(lambda (&rest args) (apply #'concatenate 'string args)) lst)
where lst is '(("ab" "cd" "ef") ("01" "23" "45"))
for example. The combiner would be concatenate. Note that no separator is given in this example implementation.
But this seems awfully convoluted.
So, what would be a canonical implementation for this kind of operation?
For an arbitray number of lists, you'd need to get rid of apply #'mapcar, because otherwise the number of lists would be limited by call-arguments-limit.
One typical way would be to use reduce instead, combining two lists at a time:
(defun zip (list-of-lists &key (combiner #'concat))
(reduce (lambda (list-a list-b)
(mapcar combiner list-a list-b))
list-of-lists))
If you don't like the explicit lambda form, you might like curry, e. g. from alexandria:
(defun zip (list-of-lists &key (combiner #'concat))
(reduce (curry #'mapcar combiner)
list-of-lists))
Other looping constructs are loop, do, dolist, and there are also a few looping libraries, e. g. iterate, for.
Join
(defun %d (stream &rest args)
"internal function, writing the dynamic value of the variable
DELIM to the output STREAM. To be called from inside JOIN."
(declare (ignore args)
(special delim))
(princ delim stream))
(defun join (list delim)
"creates a string, with the elements of list printed and each
element separated by DELIM"
(declare (special delim))
(format nil "~{~a~^~/%d/~:*~}" list))
Goal
don't use &rest args or apply - which would limit our list lengths.
Recursive MAPCARS
(defun mapcars (f l)
(if (null (car l))
'()
(cons (funcall f (mapcar #'car l))
(mapcars f (mapcar #'cdr l)))))
Iterative MAPCARS
(defun mapcars (f l)
(loop for l1 = l then (mapcar #'cdr l1)
while (car l1)
collect (funcall f (mapcar #'car l1))))
Usage
CL-USER 10 > (mapcars (lambda (l) (join l "|")) l)
("abc|012|jkl" "def|345|mno" "ghi|678|pqr")
Your function works, but relies on APPLY.
The number of lists you can pass to apply is limited by CALL-ARGUMENTS-LIMIT, which may be large enough in a given implementation. Your function, however, is supposed to accept an arbitrary number of lists, and so, if you want to code portably, you shouldn't use apply in your case.
Zip
The zip function combines all first elements, then all second elements, etc. from a list of lists.
If your input list of lists is the following:
'((a b c d)
(0 1 2 3)
(x y z t))
Then zip will build the following list:
(list (combine (list a 0 x))
(combine (list b 1 y))
(combine (list c 2 z))
(combine (list d 3 t)))
If you look closely, you can see that you can split the work being done as mapping of the combine function over the transpose of your initial list of lists (viewed as a matrix):
((a b c d) ((a 0 x)
(0 1 2 3) ===> (b 1 y)
(x y z t)) (c 2 z)
(d 3 t))
And so, zip can be defined as:
(defun zip (combine lists)
(mapcar #'combine (transpose lists)))
Alternatively, you could use MAP-INTO, if you care about reusing the memory that is allocated when calling transpose:
(defun zip (combiner lists &aux (transposed (transpose lists)))
(map-into transposed combiner transposed))
Transpose
There are different ways to transpose a list of lists. Here I am going to use REDUCE, which is known as fold in some other functional languages. At each step of reduction, the intermediate reducing function will take a partial result and a list, and produce a new result. Our result is also a list of lists.
Below, I show the current list at each step of reduction, and the resulting list of lists.
First step
(a b c d) => ((a)
(b)
(c)
(d))
Second step
(0 1 2 3) => ((0 a)
(1 b)
(2 c)
(3 d))
Third step
(x y z t) => ((x 0 a)
(y 1 b)
(z 2 c)
(t 3 d))
Note that elements are pushed in front of each lists, which explains why each resulting list is reversed w.r.t. the expect result.
The transpose function should thus reverse each list after performing reduction:
(defun transpose (lists)
(mapcar #'reverse
(reduce (lambda (result list)
(if result
(mapcar #'cons list result)
(mapcar #'list list)))
lists
:initial-value nil)))
Like previously, it might be preferable to avoid allocating too much memory.
(defun transpose (lists)
(let ((reduced (reduce (lambda (result list)
(if result
(mapcar #'cons list result)
(mapcar #'list list)))
lists
:initial-value nil)))
(map-into reduced #'nreverse reduced)))
Example
(transpose '(("ab" "cd" "ef") ("01" "23" "45")))
=> (("ab" "01") ("cd" "23") ("ef" "45"))
(import 'alexandria:curry)
(zip (curry #'join-string "|")
'(("ab" "cd" "ef") ("01" "23" "45")))
=> ("ab|01" "cd|23" "ef|45")
Edit: the other answers already provide example definitions for join-string. You could also use the join function from cl-strings.
How about:
(defun unzip (lists &key (combiner #'list))
(apply #'mapcar combiner lists))
Then you should make join:
(defun join (l &key (sep ", "))
(format nil (format nil "~a~a~a" "~{~a~^" sep "~}") l))
Then either make a wrapper or a lambda for your specific use:
(unzip '(("abc" "def" "ghi") ("012" "345" "678") ("jkl" "mno" "pqr"))
:combiner (lambda (&rest l) (join l :sep "|")))
; ==> ("abc|012|jkl" "def|345|mno" "ghi|678|pqr")
Originally, I tried using backquote and splice ,# and defining a macro to get rid of the applys. But as #coredump pointed out, that bears then other problems.
Anyhow, you need the Pythonic function join() as a combiner, if you want to add separators between the joined elements. concatenate will make the things more complicated if the function should behave in the way you want it to.
Since I use #Sylwester's very elegant join() definition, my answer will be very similar to his. Maybe my answer is the closest to your original example.
(defun join (l &key (sep ", "))
(format nil (format nil "~a~a~a" "~{~a~^" sep "~}") l))
Using this, we can define your func to:
(defun func (lists &key (sep "|") (combiner #'join))
(apply #'mapcar
#'(lambda (&rest args) (funcall combiner args :sep sep))
lists))
Or without apply - how #Rainer Joswig points out - and all previous answerers, too - because it has restriction in number of arguments which it can take (~50):
(defun func (lists &key (sep "|") (combiner #'join))
(reduce #'(lambda (l1 l2)
(mapcar #'(lambda (e1 e2)
(funcall combiner (list e1 e2) :sep sep)) l1 l2))
lists))
Or slightly shorter:
(defun func (lists &key (sep "|") (combiner #'join))
(reduce #'(lambda (l1 l2)
(mapcar #'(lambda (&rest l) (funcall combiner l :sep sep)) l1 l2))
lists))
Testing:
(func '(("abc" "def" "ghi") ("012" "345" "678") ("jkl" "mno" "pqr")))
;; ("abc|012|jkl" "def|345|mno" "ghi|678|pqr")
Note that :sep "" makes join equivalent to the function concatenate.
(func '(("abc" "def" "ghi") ("012" "345" "678") ("jkl" "mno" "pqr")) :sep "")
;; ("abc012jkl" "def345mno" "ghi678pqr")
Thanks to #Sylwester, #coredump and #Rainer Joswig!
Why do not use the &rest in params and return that on the lambda function.
CL-USER> (mapcar (lambda (&rest l) l) '(1 2 3) '(a b c) '("cat" "duck" "fish"))
((1 A "cat") (2 B "duck") (3 C "fish"))
then you can use apply like this:
(apply #'mapcar (lambda (&rest l) l) '(("ab" "cd" "ef") ("01" "23" "45")))
; => (("ab" "01") ("cd" "23") ("ef" "45"))
until here, is what a normal zip would do, now you want to join that sublist into one string, with some custom separator.
for that the best answer is use format, and also like this answer
from stackoverflow here https://stackoverflow.com/a/41091118/1900722
(defun %d (stream &rest args)
"internal function, writing the dynamic value of the variable
DELIM to the output STREAM. To be called from inside JOIN."
(declare (ignore args)
(special delim))
(princ delim stream))
(defun join (list delim)
"creates a string, with the elements of list printed and each
element separated by DELIM"
(declare (special delim))
(format nil "~{~a~^~/%d/~:*~}" list))
Then you only need to use mapcar again on this functions and the result list from zip
(mapcar (lambda (lst) (join lst "|")) '(("ab" "01") ("cd" "23") ("ef" "45")))
; => ("ab|01" "cd|23" "ef|45")
I am working on a finite state machine in Dr. Racket, and need some help extracting the next state in my transition function.
Right now, I am not checking to make sure the chars in the string match the alphabet, or that the final state is in the list of final states, or any of that until I can get the transition from state to state recursively.
Here is where I am at right now:
#lang racket
(require math/array)
(define in_string (list "a" "b" "b" "b"))
(define alphabet (list "a" "b"))
(define initial_state 0)
(define final_states (list 2))
(define delta_fn (list
(list 0 "a" 0)
(list 0 "b" 1)
(list 1 "a" 0)
(list 1 "b" 1)))
(define current_state initial_state)
(define (transition current_state in_string delta_fn)
(writeln current_state)
(writeln in_string)
(writeln delta_fn)
(cond
[(empty? in_string) (writeln current_state)]
[else
(let ([input (car in_string)])
(set! current_state (filter (lambda (v)
(match v
[(list (== current_state) (== input) _) #t]
[_ #f]))
delta_fn)))
(writeln current_state)]
;(transition current_state in_string delta_fn)]
)
)
So at the moment, if you run this script and the type: (transition current_state in_string delta_fn), you will get the following output:
> (transition current_state in_string delta_fn)
0
("a" "b" "b" "b")
((0 "a" 0) (0 "b" 1) (1 "a" 0) (1 "b" 1))
((0 "a" 0))
That last line: ((0 "a" 0)) is a result of the (writeln current_state) command after the lambda function runs to find its match in the delta_fn list. I thought I could just type (cdr (cdr current_state)) right there to get the third item in that output, but ((0 "a" 0)) is not a list and I can't operate on it like a list.
So my question is: what is ((0 "a" 0))? Why is current_state set to that instead of '(0 "a" 0)?
Any help would be greatly appreciate, please know that I am very new to functional programming in general, so use small words =P
Solution!
(define (transition current_state in_string delta_fn)
(cond
[(empty? in_string) (writeln current_state)]
[else
(let ([input (car in_string)])
(set! filtered_delta_fn (filter (lambda (v)
(match v
[(list (== current_state) (== input) _) #t]
[_ #f]))
delta_fn)))
(set! next_state (car (cdr (cdr (car filtered_delta_fn)))))
(transition next_state (cdr in_string) delta_fn)]
)
)
You are reusing the variable current_state. Don't do that!
First it was 0, the initial state.
Then you change it to hold a totally different value, the result of filter operation. Instead, use some temporary variable for that, so current_state is not changed yet.
Now, filter returns that value you ask about, ((0 "a" 0)), because of all the entries in the delta_fn it kept the one matching your criterion, the list (0 "a" 0). So the filtered list holds one matching entry in it.
To find your next state from it, simply call
(set! next_state (car (cdr (cdr (car filtered_delta_fn)))))
; (0 "a" 0)
; ("a" 0)
; (0)
; 0
where filtered_delta_fn will be the temporary variable mentioned above.
Then, the recursive call will now be
(transition next_state in_string delta_fn)
You could use current_state in place of next_state, but that's just messy. Much better to have all your variables meaningful, with proper values corresponding to their meaning. Otherwise, it is easy to quickly get lost in all the complex confusion.
Also, the use of set! is usually frowned upon. In Scheme we usually declare a new variable to be used henceforth, like
(let ((next_state (car (cdr ..... ))))
; recursive call .....
I've been tasked with creating a function that tells the placement in numerical form of a string within a list (from left to right), so that:
(position "a" '("a" "b" "c" "d" "e"))
returns 1
(position "b" '("a" "b" "c" "d" "e"))
returns 2 and
(position "z" '("a" "b" "c" "d" "e"))
returns #f
I've written it as such:
(define (position x L)
(if (pair? L)
(if (equal? x (car L))
1
(+ 1 (position x (cdr L)))
)
#f)
)
Unfortunately,
(position "z" '("a" "b" "c" "d" "e"))
Doesn't work at all since it's trying to add #f to a number. Is there any way out of this pickle?
Your answer is correct, but I'll suggest a different approach: by using a named let for implementing tail recursion we'll obtain a more efficient solution. Also notice how using cond (instead of nesting ifs) simplifies things:
(define (position x L)
(let loop ((L L) (acc 1))
(cond ((null? L) #f)
((equal? x (car L)) acc)
(else (loop (cdr L) (add1 acc))))))
Also, in the SRFI-1 library we can find the function list-index which almost returns what you want, we just have to add one to the result to convert it to a 1-based index:
(require srfi/1)
(define (position x L)
(cond ((list-index (curry equal? x) L) => add1)
(else #f)))
I fixed it by doing:
(define (position x L)
(if (pair? L)
(if (equal? x (car L))
1
(let ((p-cdr-L (position x (cdr L))))
(if p-cdr-L
(+ 1 p-cdr-L)
#f)))
#f))
I am trying to find the other element in the nested list when querying the first one. Something like this. (findOther 'a '((a b) (b c) (a d)))--> b and d. I have done this so far: The problem is I only get b.
(defun findOther (elem L)
(cond (NIL (null L))
((eq elem (caar L)) (cdar L))
((findOther elem (cdr L)))))
First some comments on the original code:
(defun findOther (elem L)
(cond
;; NIL is always false, so you *never* end up using this
;; case. You probably want something like ((null l) '()),
;; NULL is still pretty common for this, but since you're
;; expecting a list, you could use the slighly more
;; descriptive ENDP.
(NIL (null L))
;; When you find an element, you immediately return its
;; counterpart, and don't collect it and continue on to
;; the rest of the list. It's also easier to read if
;; you use more descriptive names like FIRST and SECOND,
;; as in ((eq elem (first (first l))) (second (first l))).
;; It's worth noting that unless you have a specific reason
;; to use EQ, you might want to use EQL, which is the
;; default comparison in most CL functions.
((eq elem (caar L)) (cdar L))
;; Else, you continue to the rest of the list. In my
;; opinion, REST would be more decriptive than CDR here,
;; but recursing and returning the value *is* what you
;; want to do here.
((findOther elem (cdr L)))))
Taking some of those into consideration, we could do something like this:
(defun others (element list)
(cond
((endp list) '())
((eql element (first (first list)))
(list* (second (first list))
(others element (rest list))))
((others element (rest list)))))
All that said, the functions in the standard library
would make this much easier. E.g. using mapcan:
(defun others (element list)
(mapcan (lambda (sublist)
(when (eql (first sublist) element)
(rest sublist)))
list))
(others 'a '((a b) (b c) (a d)))
;=> (B D)
I am not sure if you are looking for pair of two elements or may be more elements in list as well. Just in case you have more elements and you want all of them as well and also of some of them are not really pairs,
(defun pair-of (elem lis)
(let ((temp nil))
(cond
((and (listp lis) (not (null lis)))
(mapcar
#'(lambda (x)
(cond
((and (listp x) (not (null x)) (eql elem (car x)))
(push (cdr x) temp))))
lis)))
(nreverse temp)))
USAGE:(pair-of 'a '((a b) (b c) (a d w) 1))
OUTPUT: ((B) (D W))
But in case you want them combined in one list,
(reduce #'append (pair-of 'a '((a s) (a 3 8) (2 5 1))):initial-value '())
=> (S 3 8)