I'm looking for a way to modify a property value in a property list by multiplying it with a given factor similar to using incf for adding to a value.
With incf I could say:
(let ((seq '(:x 10 :y 3)))
(incf (getf seq :y) 3)
seq)
-> (:x 10 :y 5)
Using a macro I could obtain the result in the following way, but this uses getf twice:
(defmacro multf (place val)
`(setf ,place (* ,place ,val)))
(let ((seq '(:x 10 :y 3)))
(multf (getf seq :y) 2)
seq)
-> (:x 10 :y 6)
How would I do this so that I could obtain the same result using getf only once?
Maybe there are packages with this functionality, but I couldn't find it in the net. Any help is appreciated! This is no homework, I'm just trying to optimize my code and I'm curious to better understand the language. I read about setf-expanders and compiler-macros, but I don't know whether they apply here and how to make use of them.
but this uses getf twice
the first is a SETF form and the second one is a getter. The first one will be expanded by SETF.
A short definition of multf using define-modify-macro might be:
CL-USER 28 > (define-modify-macro multf (&optional (number 1)) *)
MULTF
CL-USER 29 > (let ((seq '(:x 10 :y 3)))
(multf (getf seq :y) 2)
seq)
(:X 10 :Y 6)
The full expansion in LispWorks looks like this:
(LET ((SEQ '(:X 10 :Y 3)))
(LET* ((#:G1158 :Y))
(LET* ()
(LET ((#:G1157 (* (GETF SEQ #:G1158) 2)))
(LET ((#:|Store-Var-1156| (SYSTEM::PRIMITIVE-PUTF SEQ #:G1158 #:G1157)))
(SETQ SEQ #:|Store-Var-1156|)
#:G1157))))
SEQ)
Related
I am trying to learn Common Lisp with the book Common Lisp: A gentle introduction to Symbolic Computation. In addition, I am using SBCL, Emacs and Slime.
In chapter 7, the author suggests there are three styles of programming the book will cover: recursion, iteration and applicative programming.
I am interested on the last one. This style is famous for the applicative operator funcall which is the primitive responsible for other applicative operators such as mapcar.
Thus, with an educational purpose, I decided to implement my own version of mapcar using funcall:
(defun my-mapcar (fn xs)
(if (null xs)
nil
(cons (funcall fn (car xs))
(my-mapcar fn (cdr xs)))))
As you might see, I used recursion as a programming style to build an iconic applicative programming function.
It seems to work:
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list ))
NIL
;; comparing the results with the official one
CL-USER> (mapcar (lambda (n) (+ n 1)) (list ))
NIL
CL-USER> (mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
Is there a way to implement mapcar without using recursion or iteration? Using only applicative programming as a style?
Thanks.
Obs.: I tried to see how it was implemented. But it was not possible
CL-USER> (function-lambda-expression #'mapcar)
NIL
T
MAPCAR
I also used Emacs M-. to look for the documentation. However, the points below did not help me. I used this to find the files below:
/usr/share/sbcl-source/src/code/list.lisp
(DEFUN MAPCAR)
/usr/share/sbcl-source/src/compiler/seqtran.lisp
(:DEFINE-SOURCE-TRANSFORM MAPCAR)
/usr/share/sbcl-source/src/compiler/fndb.lisp
(DECLAIM MAPCAR SB-C:DEFKNOWN)
mapcar is by itself a primitive applicative operator (pag. 220 of Common Lisp: A gentle introduction to Symbolic Computation). So, if you want to rewrite it in an applicative way, you should use some other primitive applicative operator, for instance map or map-into. For instance, with map-into:
CL-USER> (defun my-mapcar (fn list &rest lists)
(apply #'map-into (make-list (length list)) fn list lists))
MY-MAPCAR
CL-USER> (my-mapcar #'1+ '(1 2 3))
(2 3 4)
CL-USER> (my-mapcar #'+ '(1 2 3) '(10 20 30) '(100 200 300))
(111 222 333)
Technically, recursion can be implemented as follows:
(defun fix (f)
(funcall (lambda (x) (funcall x x))
(lambda (x) (funcall f (lambda (&rest y) (apply (funcall x x) y))))))
Notice that fix does not use recursion in any way. In fact, we could have only used lambda in the definition of f as follows:
(defconstant fix-combinator
(lambda (g) (funcall
(lambda (x) (funcall x x))
(lambda (x) (funcall
g
(lambda (&rest y) (apply (funcall x x)
y)))))))
(defun fix-2 (f)
(funcall fix-combinator f))
The fix-combinator constant is more commonly known as the y combinator.
It turns out that fix has the following property:
Evaluating (apply (fix f) list) is equivalent to evaluating (apply (funcall f (fix f)) list). Informally, we have (fix f) = (funcall f (fix f)).
Thus, we can define map-car (I'm using a different name to avoid package lock) by
(defun map-car (func lst)
(funcall (fix (lambda (map-func) (lambda (lst) ; We want mapfunc to be (lambda (lst) (mapcar func lst))
(if (endp lst)
nil
(cons (funcall func (car lst))
(funcall map-func (cdr lst)))))))
lst))
Note the lack of recursion or iteration.
That being said, generally mapcar is just taken as a primitive notion when using the "applicative" style of programming.
Another way you can implement mapcar is by using the more general reduce function (a.k.a. fold). Let's name the user-provided function f and define my-mapcar.
The reduce function carries an accumulator value that builds up the resulting list, here it is going take a value v, a sublist rest, and call cons with (funcall f v) and rest, so as to build a list.
More precisely, here reduce is going to implement a right-fold, since cons is right-associative (e.g. the recursive list is the "right" hand side, ie. the second argument of cons, e.g. (cons a (cons b (cons nil)))).
In order to define a right-fold with reduce, you pass :from-end t, which indicates that it builds-up a value from the last element and the initial accumulator to obtain a new accumulator value, then the second to last element with that new accumulator to build a new accumulator, etc. This is how you ensure that the resulting elements are in the same order as the input list.
In that case, the reducing function takes its the current element as its first argument, and the accumulator as a second argument.
Since the type of the elements and the type of the accumulator are different, you need to pass an :initial-value for the accumulator (the default behavior where the initial-value is taken from the list is for functions like + or *, where the accumulator is in the same domain as the list elements).
With that in mind, you can write it as follows:
(defun my-map (f list)
(reduce (lambda (v rest) (cons (funcall f v) rest))
list
:from-end t
:initial-value nil))
For example:
(my-map #'prin1-to-string '(0 1 2 3))
; => ("0" "1" "2" "3")
I've got a data structure that consists of two parts:
A hash table mapping symbols to indices
A vector of vectors containing data
For example:
(defparameter *h* (make-hash-table))
(setf (gethash 'a *h*) 0)
(setf (gethash 'b *h*) 1)
(setf (gethash 'c *h*) 2)
(defparameter *v-of-v* #(#(1 2 3 4) ;vector a
#(5 6 7 8) ;vector b
#(9 10 11 12))) ;vector c
I'd like to define a symbol macro to get at vector a without going through the hashmap. At the REPL:
(define-symbol-macro a (aref *v-of-v* 0))
works fine:
* a
#(1 2 3 4)
but there could be potentially many named vectors, and I don't know what the mappings will be ahead of time, so I need to automate this process:
(defun do-all-names ()
(maphash #'(lambda (key index)
(define-symbol-macro key (aref *v-of-v* index)))
*h*))
But that does nothing. And neither does any of the combinations I have tried of making do-all-names a macro, back-quote/comma templates, etc. I am beginning to wonder if this doesn't have something to do with the define-symbol-macro itself. It seems a little used feature, and On Lisp only mentions it twice. Not too many mentions here nor elsewhere either. In this case I'm using SBCL 2.1
Anyone have any ideas?
You need something like above to do it at runtime:
(defun do-all-names ()
(maphash #'(lambda (key index)
(eval `(define-symbol-macro ,key (aref *v-of-v* ,index)))
*h*))
DEFINE-SYMBOL-MACRO is a macro and does not evaluate all its arguments. So you need to generate a new macro form for each argument pair and evaluate it.
The other way to do it, usually at compile time, is to write a macro which generates these forms on the toplevel:
(progn
(define-symbol-macro a (aref *v-of-v* 0))
(define-symbol-macro b (aref *v-of-v* 1))
; ....
)
I'm not too sure on what you mean by "I don't know what the mappings will be ahead of time".
You could do something like:
(macrolet ((define-accessors ()
`(progn
,#(loop for key being the hash-keys of *h*
collect
`(define-symbol-macro ,key (aref *v-of-v* ,(gethash key *h*)))))))
(define-accessors))
If you know you do not require global access, then, you could do:
(defmacro with-named-vector-accessors (&body body) ; is that the name you want?
`(symbol-macrolet (,#(loop for key being the hash-keys of *h*
collect `(,key (aref *v-of-v* ,(gethash key *h*)))))
,#body))
;;; Example Usage:
(with-named-vector-accessors
(list a b c)) ;=> (#(1 2 3 4) #(5 6 7 8) #(9 10 11 12))
Also,
If you know *h* and the indices each symbol maps to at macroexpansion time, the above works.
If you know *h* at macroexpansion but the indices each symbol maps to will change after macroexpansion, you will want to collect (,key (aref *v-of-v* (gethash ,key *h*))).
PS: If you find loop ugly for hash-tables, you could use the iterate library with the syntax:
(iter (for (key value) in-hashtable *h*)
(collect `(,key (aref *v-of-v* ,value))))
Hi i am looking for a bit of help with some Clojure code. I have written a function that will take in a list and calculate the qty*price for a list eg. '(pid3 6 9)
What i am looking for is to expand my current function so that it recursively does the qty*price calculation until it reaches the end of the list.
My current function is written like this:
(defn pid-calc [list] (* (nth list 1) (nth list 2)))
I have tried implementing it into a recursive function but have had no luck at all, i want to be able to call something like this:
(pid-calcc '( (pid1 8 5) (pid2 5 6))
return==> 70
Thats as close as i have came to an answer and cannot seem to find one. If anyone can help me find a solution i that would be great. As so far i am yet to find anything that will compile.
(defn pid-calc [list]
(if(empty? list)
nil
(* (nth list 1) (nth list 2)(+(pid-calc (rest list))))))
You don't need a recursive function. Just use + and map:
(defn pid-calc [list]
(letfn [(mul [[_ a b]] (* a b))]
(apply + (map mul list))))
#sloth's answer, suitably corrected, is a concise and fast enough way to solve your problem. It shows you a lot.
Your attempt at a recursive solution can be (a)mended to
(defn pid-calc [list]
(if (empty? list)
0
(let [x (first list)]
(+ (* (nth x 1) (nth x 2)) (pid-calc (next list))))))
This works on the example, but - being properly recursive - will run out of stack space on a long enough list. The limit is usually about 10K items.
We can get over this without being so concise as #sloth. You might find the following easier to understand:
(defn pid-calc [list]
(let [line-total (fn [item] (* (nth item 1) (nth item 2)))]
(apply + (map line-total list))))
reduce fits your scenario quite well:
(def your-list [[:x 1 2] [:x 1 3]])
(reduce #(+ %1 (* (nth %2 1) (nth %2 2))) 0 your-list)
(reduce #(+ %1 (let [[_ a b] %2] (* a b)) 0 your-list)
(defstruct (mydate (:constructor make-mydate (year month day)))
(year 1970)
(month 1)
(day 1))
(defvar *date1* (make-mydate 1992 1 1))
The problem is more general, but say I would like to convert an object like date1 to a "document" I can persist to a database (e.g. mongoDB, using package cl-mongo). So I write
(defun mydate->document (mydate)
(cl-mongo:$ (cl-mongo:$ "year" (mydate-year mydate))
(cl-mongo:$ "month" (mydate-month mydate))
(cl-mongo:$ "day" (mydate-day mydate))))
REPL--> (mydate->doc *date1*)
kv-container : #(#S(CL-MONGO::PAIR :KEY year :VALUE 1992)
#S(CL-MONGO::PAIR :KEY month :VALUE 1)
#S(CL-MONGO::PAIR :KEY day :VALUE 1))
But could I, instead of having to write down all fields of my struct, obtained their names and values programmatically? After all, my lisp runtime can do that:
REPL--> (describe *date1*)
#S(MYDATE :YEAR 1992 :MONTH 1 :DAY 1)
[structure-object]
Slots with :INSTANCE allocation:
YEAR = 1992
MONTH = 1
DAY = 1
On the other hand, I did not find anything relevant in any book, and I noticed that the library cl-json cannot convert structs to JSON format (even though it does convert lists and CLOS objects). I guess that if there was a function to convert a struct to a plist, the problem would be solved.
There is no portable way.
Implementations do it differently. Probably most have a way to access the names of the slots. It's not clear to me why such functionality is missing from the standard.
LispWorks for example has:
(structure:structure-class-slot-names (find-class 'some-structure-class))
Maybe there is already a compatibility library somewhere. It would make sense to use the Meta-Object Protocol functionality for CLOS also for structure classes.
SBCL:
* (sb-mop:class-slots (find-class 'foo))
(#<SB-PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION A>
#<SB-PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION B>)
* (mapcar 'sb-mop:slot-definition-name *)
(A B)
What you are looking for is called Meta-Object Protocol.
Common lisp pioneered MOP, but only for CLOS objects, not for defstruct objects.
Some CL implementations support defstruct MOP, but not all of them, you can check that using:
(defstruct s a)
(slot-definition-initargs (car (class-direct-slots (find-class 's))))
This is SBCL specific:
In REPL is can do this:
(struct-to-list '(NIL #S(N :V 78) #S(OP :V #\*)
#S(E :V1 #S(N :V 456) :OP #S(OP :V #\+) :V2 #S(N :V 123))))
which will give this result =>
(NIL
((N (V 78))
((OP (V #\*)) ((E (V1 (N (V 456))) (OP (OP (V #\+))) (V2 (N (V 123)))) NIL))))
The code used:
(defun struct-names (struct)
(loop for sl in (sb-mop::class-direct-slots (class-of struct))
collect (list
(sb-mop:slot-definition-name sl)
(slot-value sl 'sb-pcl::internal-reader-function))))
(defun struct-values (struct)
(cons (type-of struct)
(loop for np in (struct-names struct)
collect (cons (car np)
(funcall (cadr np) struct)))))
(defun structp (val)
(equalp 'STRUCTURE-OBJECT
(sb-mop:class-name (car (sb-mop:class-direct-superclasses (class-of val))))))
(defun struct-to-list (val)
(cond
((structp val)
(loop for v in (struct-values val)
collect (struct-to-list v)))
((consp val)
(cons (struct-to-list (car val))
(struct-to-list (cdr val))))
(T val)))
I'm a CommonLisp noob with a question. I have these two functions below.
A helper function:
(defun make-rests (positions rhythm)
"now make those positions negative numbers for rests"
(let ((resultant-rhythm rhythm))
(dolist (i positions resultant-rhythm)
(setf (nth i resultant-rhythm) (* (nth i resultant-rhythm) -1)))))
And a main function:
(defun test-return-rhythms (rhythms)
(let ((positions '((0 1) (0)))
(result nil))
(dolist (x positions (reverse result))
(push (make-rests x rhythms) result))))
When I run (test-return-rhythms '(1/4 1/8)), it evaluates to: ((1/4 -1/8) (1/4 -1/8))
However, I expected: (test-return-rhythms '(1/4 1/8)) to evaluate to: ((-1/4 -1/8) (-1/4 1/8)).
What am I doing wrong?
Your implementation of make-rests is destructive.
CL-USER> (defparameter *rhythm* '(1/4 1/4 1/4 1/4))
*RHYTHM*
CL-USER> (make-rests '(0 2) *rhythm*)
(-1/4 1/4 -1/4 1/4)
CL-USER> *rhythm*
(-1/4 1/4 -1/4 1/4)
So, if you run your test, the second iteration will see (-1/4 -1/8), and (make-rests '(0) '(-1/4 -1/8)) returns (1/4 -1/8). Your use of let in make-rests does not copy the list, it just creates a new binding that references it. Use copy-list in your let, or write a non-destructive version in the first place:
(defun make-rests (positions rhythm)
(loop for note in rhythm
for i from 0
collect (if (member i positions) (* note -1) note)))