Say I have a function:
(defun distribution-to-list (distribution)
(check-type distribution hash-table)
(loop for key being each hash-key of distribution
using (hash-value value) nconc (loop repeat value collect key)))
I want to ensure that at least all the values of the hash-table that are passed in are integers, as I'm using them to repeat values into a big list. Is there any way to do so with check-type before the inner loop? Or would it be good enough practice to let the inner loop macro throw a type error when it tries to repeat a string? (or whatever non integer type)
If you can write a function that can check whether a value is acceptable, then you can use satisfies to construct a type specifier, such as (satisfies is-acceptable). E.g.,
(defun all-integer-keys-p (ht)
(loop for k being each hash-key in ht
always (integerp k)))
(let ((h (make-hash-table)))
;; when the table contains only integer
;; keys, we're fine
(setf (gethash 1 h) 'foo
(gethash 2 h) 'bar)
(check-type h (satisfies all-integer-keys-p))
;; but a non-integer key will lead to an
;; error from CHECK-TYPE
(setf (gethash 'three h) 'baz)
(check-type h (satisfies all-integer-keys-p)))
With deftype, you can define a type as shorthand for (satisfies all-integer-keys-p), which you may find more readable:
(deftype all-integer-key-hash-table ()
`(satisfies all-integer-keys-p))
(let ((h (make-hash-table)))
(setf (gethash 1 h) 'foo
(gethash 2 h) 'bar)
(check-type h all-integer-key-hash-table)
(setf (gethash 'three h) 'baz)
(check-type h all-integer-key-hash-table))
Related
I want to define a macro of the following form, where each of the rules (nested in the parameter list) are recorded into a hash-table:
(proc-rule
((100 ((+ w 10) (- h 25)))
((+ ip 12) ((* w .2) (* h .1)))
((* ip 2) ((+ ix (* 2 w)) iy))
(45.5 ((+ ix (* 2 w)) iy)))
table)
These rules can contain references to specific argument names. The first list (which is also the only obligatory one!):
(100 ((+ w 10) (- h 25)))
has a head which is a value, and a tail consisting of two other expressions (which could refer to w y or not) which i add to the hash-table this way:
(setq table (make-hash-table :test #'equalp))
(defmacro proc-rule (rule table)
(destructuring-bind (ip (ix iy)) (car rule)
`(progn
;; Record the initial forms
(setf (gethash ,ip ,table) #'(lambda (w h) (list ,ix ,iy)))
;;
)))
Till now works as expected, when looking for the value 100 i get the function which i can call with arguments as w and h:
(funcall (gethash 100 table) 100 100) ; (110 75)
Now i want to iterate over the rest of the rules and add them to the table. The head of each of these rules could be an expression having reference to the head of the very first rule (called ip) or be just another fresh value (which evaluates to itself. Here is the complete macro definition again):
(defmacro proc-rule (rule table)
(destructuring-bind (ip (ix iy)) (car rule)
`(progn
;; Record the initial forms
(setf (gethash ,ip ,table) #'(lambda (w h) (list ,ix ,iy)))
;; Add the rest of the rules
(dolist (pattern (cdr rule))
(setf (gethash (car pattern) ,table)
#'(lambda (w h) (list (caadr pattern) (cadadr pattern)))))
)))
The value to this key is also a closure with again two parameters W H which also now can contain references to the passed in arguments which i have labeled as ix iy. Compiling this expansion:
(PROGN
(SETF (GETHASH 100 TABLE) #'(LAMBDA (W H) (LIST (+ W 10) (- H 25))))
(DOLIST (PATTERN (CDR RULE))
(SETF (GETHASH (CAR PATTERN) TABLE)
#'(LAMBDA (W H) (LIST (CAADR PATTERN) (CADADR PATTERN))))))
leads to a funcall error because of the unquoted ,(cdr rule):
(((+ IP 12) ((* W 0.2) (* H 0.1))) ((* IP 2) ((+ IX (* 2 W)) IY))
(45.5 ((+ IX (* 2 W)) IY)))
Changing that part to (cdr ',rule) results of course in recording quoted conses as values to the keys so that:
(funcall (gethash 45.5 table) 100 100) ;(((+ IX (* 2 W)) IY) NIL)
How could i get tails of these rules to be saved as function bodies and not conses so that calling them computes the supplied expressions?
Second question: is this all in all a good design, and if not please explain why not? (I wanted the user to supply the expressions in a more convenient form like ((+ ip 12) ((* w .2) (* h .1))).
Basic Rule for writing Macros
Write down the code you want to generate. Then write the code transforming code which generates this code.
Example
See this example for generated code - not specifically for your example, but similar - I'm also using LOOP instead of DOLIST, because it does destructuring:
(loop for ((one two)) in '((((+ a b) (- a b)))
(((- a b) (+ a b))))
collect (lambda (a b) (list one two)))
Above does not work as intended, because forms like (+ a b) are treated as lists and a variable like one does just return such a list. It also does not work because of using the iteration variables.
To address the later we could rebind them:
(loop for ((one two)) in '((((+ a b) (- a b)))
(((- a b) (+ a b))))
collect (let ((one one)
(two two))
(lambda (a b) (list one two))))
Still in above code we have lists and not code for the expressions.
If you want to create functions from source code you need to call EVAL or COMPILE:
(loop for ((one two)) in '((((+ a b) (- a b)))
(((- a b) (+ a b))))
collect (compile nil `(lambda (a b) (list ,one ,two))))
Above creates code and compiles it at runtime.
That would be code to generate. But you would generate code which explicitly calls EVAL or COMPILE. This is a typical anti-pattern. A macro creates code which then gets automatically evaluated. One rarely needs another step of evaluation - so always think whether it's possible to get rid of that added evaluation step.
But what you really want is to generate this code:
(list (lambda (a b) (list (+ a b) (- a b)))
(lambda (a b) (list (- a b) (+ a b))))
Think about how to change your macro to create fully expanded code like above.
Macro Syntax
I would name the macro differently, change the argument order and get rid of the list:
(define-proc-rules table
(100 ((+ w 10) (- h 25)))
((+ ip 12) ((* w .2) (* h .1)))
((* ip 2) ((+ ix (* 2 w)) iy))
(45.5 ((+ ix (* 2 w)) iy)))
The macro would then be defined with:
(defmacro define-proc-rules (table &body rules) ...)
Allow me to format it a bit differently:
(proc-rule ((100 ((+ w 10) (- h 25)))
((+ ip 12) ((* w .2) (* h .1)))
((* ip 2) ((+ ix (* 2 w)) iy))
(45.5 ((+ ix (* 2 w)) iy)))
table)
It seems that:
the 100 must be a literal value
the first form of each rule should be evaluated with ip bound to that first key (100)
the second form of each rule is a list of two expressions such that these forms describe a function that returns a list of evaluating these two expressions
the two parameters of these functions are always named w and h
they can also refer to ix and iy which are the two elements of the return list of the first rule function
I see two ways of accomplishing that last part:
either ix and iy are symbol macros that expand to the forms given in the first rule at macro expansion time. This would maybe be a bit hairy.
or each subsequent rule function should call the first rule function and bind ix and iy to its return list; something like this (untested sketch):
(defmacro proc-rule (rules table)
(let ((ip (first (first rules))))
`(setf ,#(loop :for (keyform expr) :in rules
:collect `(gethash (let ((ip ,ip)) ,keyform) ,table)
:collect `(lambda (w h)
(destructuring-bind (ix iy)
(funcall (gethash ,ip ,table) w h)
(declare (ignorable ix iy))
(list ,#expr)))))))
However, from personal convictions, I'd advise against these implicit bindings and try to find a better way to express these rules.
Here's the exact question:
COUNT-BASES counts the number of bases of each type in
either single- or double-stranded DNA and returns the result
as a table.
(COUNT-BASES '((G C) (A T) (T A) (C G))) should return
((A 2) (T 2) (G 2) (C 2))
(COUNT-BASES '(A G T A C T C T)) should return
((A 2) (T 3) (G 1) (C 2)).
I've written a function my-count that returns the occurences of one char but can't figure out how to apply this for all 4 letters (A T G C) and return as a table.
;returns the count of a base (a) from a list (L)
(defun my-count (a L)
(cond ((null L) 0)
((equal a (car L)) (+ 1 (my-count a (cdr L))))
(t (my-count a (cdr L)))))
I'd handle the flat case (single stranded, i. e. a list of bases) first. Loop over the list and count each base into a hash table:
(defun count-bases (dna)
(let ((counts (make-hash-table)))
(dolist (base dna counts)
(incf (gethash base counts 0)))))
Now, it might be double stranded, so each element is not a base, but a list of bases. But we already know how to handle a list of bases. In order to count into a single table, make it possible to pass it into the recursive call:
(defun count-bases (dna &optional (counts (make-hash-table)))
(dolist (base-or-pair dna counts)
(if (symbolp base-or-pair)
(incf (gethash base-or-pair counts 0))
(count-bases base-or-pair counts))))
A purely imperative version of the code could be as follows:
(defun count-bases (bases)
(let ((atgc (vector 0 0 0 0)))
(dolist (dna bases (map 'list #'list #(a t g c) atgc))
(dolist (base (if (listp dna) dna (list dna)))
(incf (svref atgc (position base #(a t g c))))))))
Create a vector of 4 elements, that store counters for all bases.
Iterate over all entries in the list, and iterate over all bases in each entry: typically this is done with alexandria:ensure-list, but here it is written in plain.
Find the position of each base in the literal vector #(a t g c), a vector of symbols. Use the returned position to increment the associated counter.
Finally (last form in DOLIST), build the return value in the expected format:
MAP over both #(a t g c) and the counter vector atgc, build a 'list by applying the function #'list to each pair of elements taken from both sequences: for example, the first iteration visits a and the counter for base a, and calls #'list on them, which builds (a ...), where ... is the actual value.
I'm trying to create a simple memo defun. How can I prevent evaluating of args form in this code?
(defmacro defun/memo (name args &rest body)
`(let ((memo (make-hash-table :test 'equalp)))
(defun ,name ,args
(if (gethash (loop for x in ,args collect x) memo)
(gethash (loop for x in ,args collect x) memo)
(let ((result (progn ,#body)))
(setf (gethash (loop for x in ,args collect x) memo) result)
result)))))
Error:
; in: DEFUN ADD
; (X Y)
;
; caught STYLE-WARNING:
; undefined function: X
;
; compilation unit finished
; Undefined function:
; X
(defmacro defun/memo (name args &rest body)
You generally declare body with &body body, not &rest body.
Variable capture
`(let ((memo (make-hash-table :test 'equalp)))
The memo symbol is going to end in the generated code. If body contains references to memo, for example a symbol that was lexically bound outside of a call to defun/memo, then it will use your variable. You should use a fresh symbol instead, generated inside the macro with gensym (outside of backquotes). For example, you could do the following to avoid evaluating expr twice:
(let ((var-expr (gensym)))
`(let ((,var-expr ,expr))
(+ ,var-expr ,var-expr)))
Loop
(if (gethash (loop for x in ,args collect x) memo)
(gethash (loop for x in ,args collect x) memo)
(let ((result (progn ,#body)))
(setf (gethash (loop for x in ,args collect x) memo) result)
result)))))
What is the following supposed to do?
(loop for x in ,args collect x)
Let's say you define a function with (defun/memo test (a b c) ...), you will inject the literal list of arguments in the above, which will result in code that contains:
(loop for x in (a b c) collect x)
As you saw, the code is now trying to call function a with arguments b and c.
What if you quoted args, in your macro?
(loop for x in ',args collect x)
Then, you would obtain:
(loop for x in '(a b c) collect x)
And now, you are just copying a literal list. When the above generated code is run, it will only build a fresh list (a b c). Is that what you need?
What you want is to take all the arguments of your function, i.e. the list of values you were given. The loop could be replaced by:
(list ,#args)
Which would expand as:
(list a b c)
And here you have all your values, in a list.
But Common Lisp already provides a way to get all arguments as a list:
(defun foo (&rest args)
;; args is bound to a list of values
)
Your generated function could do the same.
Gethash
Also, (if (gethash ...) (gethash ...) other) can be written (or (gethash ...) other). This has the benefits of evaluating the call to gethash only once.
More importantly (thanks #Sylwester), since you are writing a generic macro, you cannot know in advance if nil will be a possible returned value. Having a nil value would make the result recomputed each time, given how the if/or is written. You need to use the secondary return value from gethash to check if the element existed:
(multiple-value-bind (value exists-p) (gethash ...)
(if exists-p
value
(setf (gethash ...) ...)))
Also, if your cached function return multiple values, you may want to grab them all with multiple-value-list and returns them with values-list.
Setf
By the way, the following code:
(let ((result expr))
(setf place result)
result)
... has little reason not to be written as:
(setf place expr)
The return value of setf is required to be the new value. In some cases it could lead to bad style, but here that would be fine.
I'm trying different binding models for macro lambda lists.
Edit: in fact the lambda list for my test macros is always (&rest ...). Which means that I'm 'destructuring' the argument list and not the lambda list. I try to get a solution that works for combining optional with key arguments or rest/body with key arguments - both combinations don't work in the Common Lisp standard implementation.
So I have different functions giving me a list of bindings having the same syntax as used by 'let'.
E.g:
(build-bindings ...) => ((first 1) middle (last "three"))
Now I thought to use a simple macro inside my test macros feeding such a list to 'let'.
This is trivial if I have a literal list:
(defmacro let-list (_list &rest _body)
`(let ,_list ,#_body))
(let-list ((a 236)) a) => 236
But that's the same as a plain 'let'.
What I'd like to have is the same thing with a generated list.
So e.g.
(let-list (build-bindings ...)
(format t "first: ~s~%" first)
last)
with (build-bindings ...), evaluated in the same lexical scope as the call (let-list ...), returning
((first 1) middle (last "three"))
the expansion of the macro should be
(let
((first 1) middle (last "three"))
(format t "first: ~s~%" first)
last)
and should print 1 and return "three".
Any idea how to accomplish that?
Edit (to make the question more general):
If I have a list of (symbol value) pairs, i.e. same syntax that let requires for it's list of bindings, e.g. ((one 1) (two 'two) (three "three")), is there any way to write a macro that creates lexical bindings of the symbols with the supplied values for it's &rest/&body parameter?
This is seems to be a possible solution which Joshua pointed me to:
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z))))
evaluates to:
;Compiler warnings :
; In an anonymous lambda form: Undeclared free variable X
; In an anonymous lambda form: Undeclared free variable Y
; In an anonymous lambda form: Undeclared free variable Z
x 23, y 6, z NIL
I could also easily rearrange my build-bindings functions to return the two lists needed.
One problem is, that the compiler spits warnings if the variables have never been declared special.
And the other problem that, if the dynamically bound variables are also used in a surrounding lexical binding, they a shadowed by the lexical binding - again if they have never been declared special:
(let ((x 47) (y 11) (z 0))
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z)))))
evaluates to:
x 47, y 11, z 0
A better way could be:
(let ((x 47) (y 11) (z 0))
(locally
(declare (special x y))
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z))))))
evaluates to:
;Compiler warnings about unused lexical variables skipped
x 23, y 6, z NIL
I can't see at the moment whether there are other problems with the dynamic progv bindings.
But the whole enchilada of a progv wrapped in locally with all the symbols declared as special cries for a macro again - which is again not possible due to same reasons let-list doesn't work :(
The possiblilty would be a kind of macro-lambda-list destructuring-hook which I'm not aware of.
I have to look into the implementation of destructuring-bind since that macro does kind of what I'd like to do. Perhaps that will enlight me ;)
So a first (incorrect) attempt would look something like this:
(defun build-bindings ()
'((first 1) middle (last "three")))
(defmacro let-list (bindings &body body)
`(let ,bindings
,#body))
Then you could try doing something like:
(let-list (build-bindings)
(print first))
That won't work, of course, because the macro expansion leaves the form (build-bindings) in the resulting let, in a position where it won't be evaluated:
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
(print first))))
(LET (BUILD-BINDINGS)
(PRINT FIRST))
Evaluation during Macroexpansion time
The issue is that you want the result of build-bindings at macroexpansion time, and that's before the code as a whole is run. Now, in this example, build-bindings can be run at macroexpansion time, because it's not doing anything with any arguments (remember I asked in a comment what the arguments are?). That means that you could actually eval it in the macroexpansion:
(defmacro let-list (bindings &body body)
`(let ,(eval bindings)
,#body))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
(print first))))
(LET ((FIRST 1) MIDDLE (LAST "three"))
(PRINT FIRST))
Now that will work, insofar as it will bind first, middle, and last to 1, nil, and "three", respectively. However, if build-bindings actually needed some arguments that weren't available at macroexpansion time, you'd be out of luck. First, it can take arguments that are available at macroexpansion time (e.g., constants):
(defun build-bindings (a b &rest cs)
`((first ',a) (middle ',b) (last ',cs)))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 1 2 3 4 5)
(print first))))
(LET ((FIRST '1) (MIDDLE '2) (LAST '(3 4 5)))
(PRINT FIRST))
You could also have some of the variables appear in there:
(defun build-bindings (x ex y why)
`((,x ,ex) (,y ,why)))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 'a 'ay 'b 'bee)
(print first))))
(LET ((A AY) (B BEE))
(PRINT FIRST))
What you can't do, though, is have the variable names be determined from values that don't exist until runtime. E.g., you can't do something like:
(let ((var1 'a)
(var2 'b))
(let-list (build-bindings var1 'ay var2 'bee)
(print first))
because (let-list (build-bindings …) …) is macroexpanded before any of this code is actually executed. That means that you'd be trying to evaluate (build-bindings var1 'ay var2 'bee) when var1 and var2 aren't bound to any values.
Common Lisp does all its macroexpansion first, and then evaluates code. That means that values that aren't available until runtime are not available at macroexpansion time.
Compilation (and Macroexpansion) at Runtime
Now, even though I said that Common Lisp does all its macroexpansion first, and then evaluates code, the code above actually uses eval at macroexpansion to get some extra evaluation earlier. We can do things in the other direction too; we can use compile at runtime. That means that we can generate a lambda function and compile it based on code (e.g., variable names) provided at runtime. We can actually do this without using a macro:
(defun %dynamic-lambda (bindings body)
(flet ((to-list (x) (if (listp x) x (list x))))
(let* ((bindings (mapcar #'to-list bindings))
(vars (mapcar #'first bindings))
(vals (mapcar #'second bindings)))
(apply (compile nil `(lambda ,vars ,#body)) vals))))
CL-USER> (%dynamic-lambda '((first 1) middle (last "three"))
'((list first middle last)))
;=> (1 NIL "three")
This compiles a lambda expression that is created at runtime from a body and a list of bindings. It's not hard to write a macro that takes some fo the quoting hassle out of the picture:
(defmacro let-list (bindings &body body)
`(%dynamic-lambda ,bindings ',body))
CL-USER> (let-list '((first 1) middle (last "three"))
(list first middle last))
;=> (1 NIL "three")
CL-USER> (macroexpand-1 '(let-list (build-bindings)
(list first middle last)))
;=> (%DYNAMIC-LAMBDA (BUILD-BINDINGS) '((LIST FIRST MIDDLE LAST)))
CL-USER> (flet ((build-bindings ()
'((first 1) middle (last "three"))))
(let-list (build-bindings)
(list first middle last)))
;=> (1 NIL "three")
This gives you genuine lexical variables from a binding list created at runtime. Of course, because the compilation is happening at runtime, you lose access to the lexical environment. That means that the body that you're compiling into a function cannot access the "surrounding" lexical scope. E.g.:
CL-USER> (let ((x 3))
(let-list '((y 4))
(list x y)))
; Evaluation aborted on #<UNBOUND-VARIABLE X {1005B6C2B3}>.
Using PROGV and special variables
If you don't need lexical variables, but can use special (i.e., dynamically scoped) variables instead, you can establish bindings at runtime using progv. That would look something like:
(progv '(a b c) '(1 2 3)
(list c b a))
;;=> (3 2 1)
You'll probably get some warnings with that if run it, because when the form is compiled, there's no way to know that a, b, and c are supposed to be special variables. You can use locally to add some special declarations, though:
(progv '(a b c) '(1 2 3)
(locally
(declare (special a b c))
(list c b a)))
;;=> (3 2 1)
Of course, if you're doing this, then you have to know the variables in advance which is exactly what you were trying to avoid in the first place. However, if you're willing to know the names of the variables in advance (and your comments seem like you might be okay with that), then you can actually use lexical variables.
Lexical variables with values computed at run time
If you're willing to state what the variables will be, but still want to compute their values dynamically at run time, you can do that relatively easily. First, lets write the direct version (with no macro):
;; Declare three lexical variables, a, b, and c.
(let (a b c)
;; Iterate through a list of bindings (as for LET)
;; and based on the name in the binding, assign the
;; corresponding value to the lexical variable that
;; is identified by the same symbol in the source:
(dolist (binding '((c 3) (a 1) b))
(destructuring-bind (var &optional value)
(if (listp binding) binding (list binding))
(ecase var
(a (setf a value))
(b (setf b value))
(c (setf c value)))))
;; Do something with the lexical variables:
(list a b c))
;;=> (1 NIL 3)
Now, it's not too hard to write a macrofied version of this. This version isn't perfect, (e.g., there could be hygiene issues with names, and declarations in the body won't work (because the body is being spliced in after some stuff). It's a start, though:
(defmacro computed-let (variables bindings &body body)
(let ((assign (gensym (string '#:assign-))))
`(let ,variables
(flet ((,assign (binding)
(destructuring-bind (variable &optional value)
(if (listp binding) binding (list binding))
(ecase variable
,#(mapcar (lambda (variable)
`(,variable (setf ,variable value)))
variables)))))
(map nil #',assign ,bindings))
,#body)))
(computed-let (a b c) '((a 1) b (c 3))
(list a b c))
;;=> (1 NIL 3)
One way of making this cleaner would be to avoid the assignment altogether, and the computed values to provide the values for the binding directly:
(defmacro computed-let (variables bindings &body body)
(let ((values (gensym (string '#:values-)))
(variable (gensym (string '#:variable-))))
`(apply #'(lambda ,variables ,#body)
(let ((,values (mapcar #'to-list ,bindings)))
(mapcar (lambda (,variable)
(second (find ,variable ,values :key 'first)))
',variables)))))
This version creates a lambda function where the arguments are the specified variables and the body is the provided body (so the declarations in the body are in an appropriate place), and then applies it to a list of values extracted from the result of the computed bindings.
Using LAMBDA or DESTRUCTURING-BIND
since I'm doing some "destructuring" of the arguments (in a bit a different way), I know which arguments must be present or have which
default values in case of missing optional and key arguments. So in
the first step I get a list of values and a flag whether an optional
or key argument was present or defaulted. In the second step I would
like to bind those values and/or present/default flag to local
variables to do some work with them
This is actually starting to sound like you can do what you need to by using a lambda function or destructuring-bind with keyword arguments. First, note that you can use any symbol as a keyword argument indicator. E.g.:
(apply (lambda (&key
((b bee) 'default-bee b?)
((c see) 'default-see c?))
(list bee b? see c?))
'(b 42))
;;=> (42 T DEFAULT-SEE NIL)
(destructuring-bind (&key ((b bee) 'default-bee b?)
((c see) 'default-see c?))
'(b 42)
(list bee b? see c?))
;;=> (42 T DEFAULT-SEE NIL)
So, if you just make your function return bindings as a list of keyword arguments, then in the destructuring or function application you can automatically bind corresponding variables, assign default values, and check whether non-default values were provided.
Acting a bit indirectly:
a solution that works for combining optional with key arguments or
rest/body with key arguments
Have you considered the not-entirely-uncommon paradigm of using a sub-list for the keywords?
e.g.
(defmacro something (&key (first 1) second) &body body) ... )
or, a practical use from Alexandria:
(defmacro with-output-to-file ((stream-name file-name
&rest args
&key (direction nil direction-p)
&allow-other-keys)
&body body)
I apologize for the bad English..
I have a task to write a function called "make-bag" that counts occurences of every value in a list
and returns a list of dotted pairs like this: '((value1 . num-occurences1) (value2 . num-occurences2) ...)
For example:
(make-bag '(d c a b b c a))
((d . 1) (c . 2) (a . 2) (b . 2))
(the list doesn't have to be sorted)
Our lecturer allows us to us functions MAPCAR and also FILTER (suppose it is implemented),
but we are not allowed to use REMOVE-DUPLICATES and COUNT-IF.
He also demands that we will use recursion.
Is there a way to count every value only once without removing duplicates?
And if there is a way, can it be done by recursion?
First of, I agree with Mr. Joswig - Stackoverflow isn't a place to ask for answers to homework. But, I will answer your question in a way that you may not be able to use it directly without some extra digging and being able to understand how hash-tables and lexical closures work. Which in it's turn will be a good exercise for your advancement.
Is there a way to count every value only once without removing duplicates? And if there is a way, can it be done by recursion?
Yes, it's straight forward with hash-tables, here are two examples:
;; no state stored
(defun make-bag (lst)
(let ((hs (make-hash-table)))
(labels ((%make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(%make-bag (cdr lst)))
hs)))
(%make-bag lst))))
Now, if you try evaluate this form twice, you will get the same answer each time:
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
And this is a second example:
;; state is stored....
(let ((hs (make-hash-table)))
(defun make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(make-bag (cdr lst)))
hs)))
Now, if you try to evaluate this form twice, you will get answer doubled the second time:
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 5
> T
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 10
> T
Why did the answer doubled?
How to convert contents of a hash table to an assoc list?
Also note that recursive functions usually "eat" lists, and sometimes have an accumulator that accumulates the results of each step, which is returned at the end. Without hash-tables and ability of using remove-duplicates/count-if, logic gets a bit convoluted since you are forced to use basic functions.
Well, here's the answer, but to make it a little bit more useful as a learning exercise, I'm going to leave some blanks, you'll have to fill.
Also note that using a hash table for this task would be more advantageous because the access time to an element stored in a hash table is fixed (and usually very small), while the access time to an element stored in a list has linear complexity, so would grow with longer lists.
(defun make-bag (list)
(let (result)
(labels ((%make-bag (list)
(when list
(let ((key (assoc (car <??>) <??>)))
(if key (incf (cdr key))
(setq <??>
(cons (cons (car <??>) 1) <??>)))
(%make-bag (cdr <??>))))))
(%make-bag list))
result))
There may be variations of this function, but they would be roughly based on the same principle.