thanks for your support, I am a newbie...
I would like to swap elements BETWEEN two lists in Common-LISP given a certain index of the first and second list, for example:
(1 2 3 4) (A B C D) -> (D 2 3 4) when specified indexes are (0 3).
It might look randomish but it has a nice utility in musical sequences...
Thanks,
Alessandro
If you need to use an index, maybe a vector can be more sensible. Use for example ROTATEF, as explained by jkiiski:
CL-USER> (let ((a (vector 1 2 3 4))
(b (vector 'a 'b 'c 'd)))
(rotatef (aref a 0) (aref b 3))
(values a b))
#(D 2 3 4)
#(A B C 1)
If you really want to use lists, then use NTH, or ELT, which works on both kinds of sequences.
Preemptive remark: you cannot modify constant data. Note how vectors a and b are allocated at runtime. Constant data is data that was computed at read-time or compile-time, and should not be modified at runtime. Quoted lists are constant, as shown by this example:
CL-USER> (let ((list '(a b))) (setf (first list) 0) list)
; in: LET ((LIST '(A B)))
; (SETF (FIRST LIST) 0)
; ==>
; (SB-KERNEL:%RPLACA LIST 0)
;
; caught WARNING:
; Destructive function SB-KERNEL:%RPLACA called on constant data: (A B).
; See also:
; The ANSI Standard, Special Operator QUOTE
; The ANSI Standard, Section 3.2.2.3
;
Related
I am wondering how one can achieve the following. Suppose I have a list of variables that are bound by some let above. I would like to turn this list into a list of the values to which those variables are bound.
That is, suppose we have
(define make-plist-from-variables (variables)
(let ((keys variables)
(values (mapcar #'identity variables)))
(if (eq (length keys) (length values))
(make-plist keys values)
nil))))
What can I use in place of #'identity to unpack those values properly?
At the moment, the following call produces the following output.
CL-USER> (let ((a 2) (b 3)) (make-plist-from-variables '(a b)))
(A A B B)
I would like it to be (A 2 B 3)
It needs to be a macro because there is no way to fetch a variable's lexical value based on its symbol.
(defmacro make-plist-from-variables (&rest variables)
(loop :for binding :in variables
:collect `',binding :into result
:collect binding :into result
:finally (return `(list ,#result))))
(macroexpand-1 '(make-plist-from-variables a b))
; ==> (list 'a a 'b b)
(let ((a 2) (b 3))
(make-plist-from-variables a b))
; ==> (a 2 b 3)
EDIT
Implementation without loop using mapcan:
(defmacro make-plist-from-variables (&rest variables)
`(list ,#(mapcan (lambda (v) `(',v ,v)) variables))
Functions don't have access to the lexical environment of their callers.
More precisely, during evaluation you cannot access the values of lexical variables knowing only their symbols. Only macros have access to environment objects.
Special variables
You can use dynamic binding:
(defun foo ()
(declare (special a))
(symbol-value 'a))
(let ((a 3))
(declare (special a))
(foo))
=> 3
In your case, you would collect the symbol along its value, by using SYMBOL-vaLUE on all your symbols.
Related to your question is how to dynamically bind variables to values where the variable names and/or values are known at evaluation time; see special operator PROGV.
Macros
You could obtain e.g. an association list by writing the following code:
(acons 'a a (acons 'b b nil))
Depending on the use case behind your question, you may want to have a macro that expands into such code, that references the variables you want to evaluate.
I am trying to understand how vector-set! is implemented. It looks to me like vector-set! is a special form - much like set! is. When I look at examples using vector-set! I see the following, desirable behavior (in guile).
(define test (lambda (v i) (vector-set! v i 0)))
(define v (make-vector 5 1))
v
$1 = #(1 1 1 1 1)
(test v 0)
v
$2 = #(0 1 1 1 1)
I can also do this (in guile)
(define test (lambda (v i) (vector-set! (eval v (interaction-environment)) i 0)))
(test (quote v) 3)
v
$21 = #(0 1 1 0 1)
Contrasting to the set! behavior:
(define a 1)
(define test2 (lambda b (begin (set! b 0) b)))
(test2 (quote a))
$26 = 0
a
$27 = 1
In this case, to my understanding the set! changes b to 0 (and not the 'evaluated" b (which should be a). The eval trick from above does not work here.
My question is: How is vector-set! implemented compared to set! (or set-variable-value!). Does vector-set! peak at it's first argument? Or something else? I have tried to look at some of scheme implementations but extracting the gist from the code is tricky. Perhaps someone has an explanation or a link to some (sicp style) scheme implementation.
The function vector-set! is a so-called primitive.
It is a function (not a special form), but it must be implemented within the runtime.
Note: A special form is a form that uses an evaluation order different from the order used in a normal application. Therefore if, cond, or and others are special forms.
Some implementations (I can't remember if Guile is one of them) has a function primitive? that can be used to test whether a function is a primitive or not.
> (primitive? vector-set!)
#t
In "some SICP-style Scheme implementation", where vector-set! would be handled by eval-vector-mutation, it could be
(define (eval-vector-mutation exp env)
; exp = (vector-set! vec idx val)
(let ((vec (eval (vector-mutation-vec exp) env))
(idx (eval (vector-mutation-idx exp) env))
(val (eval (vector-mutation-val exp) env)))
(begin
(set-car! (cddr (drop vec idx)) val) ; srfi-1 drop
vec)))
and make-vector handled by
(define (eval-vector-creation exp env)
; exp = (make-vector cnt val)
(let ((cnt (eval (vector-creation-cnt exp) env))
(val (eval (vector-creation-val exp) env)))
(cons 'vector ; tagged list
(cons cnt ; vector size
(make-list cnt val))))) ; srfi-1 make-list
Here vectors are represented by tagged lists in the underlying Scheme implementation (not the Scheme being defined), and its mutation primitives, like set-car!, are used to manipulate them. If your implementation language were C, say, you'd just use C arrays as your vectors representation, or perhaps a structure coupling an array with the additional pertinent info, like its size ,etc.
Here is my problem:Without using MEMBER, complete the following definition of a recursive function POS
such that if L is a list and E is an element of L then (POS E L) returns the position of the first
occurrence of E in L, and such that if E is not an element of L then (POS E L) returns 0.This is the solution have come up with:
(DEFUN POS (E L)
(COND ((ENDP L) 0)
((EQUAL E (CAR L)) 1 )
(T
(+ 1 (POS E (CDR L)) )
)))
The algorithm works fine if the element I am looking for is in the list. My problem is that when the element is not in the list I will get the length of the list.
Example:
list[1,2,3,4] Find: 5 will reurn 4
How do I get it to return 0 if element is not found. And as it is functional programming I can't use loops or variable.
You always return (+ 1 <recursive-call>). But what if the recursive result is zero? You should check that return value before computing the result.
if you find an occurence, return 1
if you don't find a result, compute recursively, which gives you R
if R is zero, return zero
otherwise, return R + 1
As an aside, the Common Lisp way would be:
(or (position E L :test #'equal) 0)
As #coredump has explained, the problem is that you are always adding 1 to the result, even if you haven't found the element. I would keep the track of the current position within the list by adding an extra parameter to function POS:
(defun pos (element list &optional (start 0))
(cond ((endp list) 0)
((equal element (first list)) (1+ start))
(t (pos element (rest list) (1+ start)))))
Testing:
(pos 'a '(b a c d a))
2
(pos 'a '(a d a f g))
1
(pos 'w '(a b c d e f))
0
One extra benefit: this function generates iterative process due to recursive call being in tail-call position (however, ANSI Common Lisp does not guarantee it will do tail-call optimization! AFAIK, CLisp doesn't do it; SBCL and CCL will do for optimized code, see DECLARE). More idiomatic Common Lisp solution would be using LOOP:
(defun pos (element list)
(loop for x in list
counting x into pos
when (equal element x)
return pos
end
finally (return 0)))
Let's say I have two matrices (in the form of a Common Lisp array) foo and bar such that:
(defvar foo #2A((2 1 6) (7 3 4)))
(defvar bar #2A((3 1) (6 5) (2 3)))
I would like to perform a matrix multiplication using BLAS without using wrappers such as Matlisp, GSLL, LLA, & co. so that I get an array with the result:
#2A((24 25) (47 34))
Which steps should I take to perform such operation?
My understanding is that I should call the BLAS matrix multiplication function from the REPL and pass it my arguments foo and bar.
In R, I can easily do it like this:
foo %*% bar
How can I do it in Common Lisp?
Disclaimer:
1) I use SBCL
2) I am not a seasoned computer scientist
Here's the perfect answer I was looking for. Credits to Miroslav Urbanek from Charles University in Prague.
"Here's the basic idea. I find a function I want to use from
BLAS/LAPACK. In case of matrix multiplication, it's DGEMM. "D" stands
for double float, "GE" stands for general matrices (without a special
shape like symmetric, triangular, etc.), and "MM" stands for matrix
multiplication. The documentation is here:
http://www.netlib.org/lapack/explore-html/d7/d2b/dgemm_8f.html
Then I define an alien routine using SBCL FFI. I pass Lisp array
directly using some special SBCL functions. The Lisp arrays must be
created with an option :element-type 'double-float.
An important point is that SBCL stores array elements in row-major
order, similarly to C. Fortran uses column-major order. This
effectively corresponds to transposed matrices. The order of matrices
and their dimensions must be therefore changed when calling DGEMM from
Lisp."
;; Matrix multiplication in SBCL using BLAS
;; Miroslav Urbanek <mu#miroslavurbanek.com>
(load-shared-object "libblas.so.3")
(declaim (inline dgemm))
(define-alien-routine ("dgemm_" dgemm) void
(transa c-string)
(transb c-string)
(m int :copy)
(n int :copy)
(k int :copy)
(alpha double :copy)
(a (* double))
(lda int :copy)
(b (* double))
(ldb int :copy)
(beta double :copy)
(c (* double))
(ldc int :copy))
(defun pointer (array)
(sap-alien (sb-sys:vector-sap (array-storage-vector array)) (* double)))
(defun mm (a b)
(unless (= (array-dimension a 1) (array-dimension b 0))
(error "Matrix dimensions do not match."))
(let* ((m (array-dimension a 0))
(n (array-dimension b 1))
(k (array-dimension a 1))
(c (make-array (list m n) :element-type 'double-float)))
(sb-sys:with-pinned-objects (a b c)
(dgemm "n" "n" n m k 1d0 (pointer b) n (pointer a) k 0d0 (pointer c) n))
c))
(defparameter a (make-array '(2 3) :element-type 'double-float :initial-contents '((2d0 1d0 6d0) (7d0 3d0 4d0))))
(defparameter b (make-array '(3 2) :element-type 'double-float :initial-contents '((3d0 1d0) (6d0 5d0) (2d0 3d0))))
(format t "a = ~A~%b = ~A~%" a b)
(defparameter c (mm a b))
In R you are using the R wrapper. You cannot avoid using a "wrapper". So you should use that best suits you.
Sorry if this isn't much helpful, but that's how things are.
Marco
In my little project I have two arrays, lets call them A and B. Their values are
#(1 2 3) and #(5 6 7). I also have two lists of symbols of identical length, lets call them C and D. They look like this: (num1 num2 num3) and (num2 num3 num4).
You could say that the symbols in lists C and D are textual labels for the values in the arrays A and B. So num1 in A is 1. num2 in A is 2. num2 in B is 5. There is no num1 in B, but there is a num3, which is 6.
My goal is to produce a function taking two arguments like so:
(defun row-join-function-factory (C D)
...body...)
I want it to return a function of two arguments:
(lambda (A B) ...body...)
such that this resulting function called with arguments A and B results in a kind of "join" that returns the new array: #(1 5 6 7)
The process taking place in this later function obtained values from the two arrays A and B such that it produces a new array whose members may be represented by (union C D). Note: I haven't actually run (union C D), as I don't actually care about the order of the symbols contained therein, but lets assume it returns (num1 num2 num3 num4). The important thing is that (num1 num2 num3 num4) corresponds as textual labels to the new array #(1 5 6 7). If num2, or any symbol, exists in both C and D, and subsequently represents values from A and B, then the value from B corresponding to that symbol is kept in the resulting array rather than the value from A.
I hope that gets the gist of the mechanical action here. Theoretically, I want row-join-function-factory to be able to do this with arrays and symbol-lists of any length/contents, but writing such a function is not beyond me, and not the question.
The thing is, I wish the returned function to be insanely efficient, which means that I'm not willing to have the function chase pointers down lists, or look up hash tables at run time. In this example, the function I require to be returned would be almost literally:
(lambda (A B)
(make-array 4
:initial-contents (list (aref A 0) (aref B 0) (aref B 1) (aref B 2))))
I do not want the array indexes calculated at run-time, or which array they are referencing. I want a compiled function that does this and this only, as fast as possible, which does as little work as possible. I do not care about the run-time work required to make such a function, only the run-time work required in applying it.
I have settled upon the use of (eval ) in row-join-function-factory to work on symbols representing the lisp code above to produce this function. I was wondering, however, if there is not some simpler method to pull off this trick that I am not thinking of, given one's general cautiousness about the use of eval...
By my reasoning, i cannot use macros by themselves, as they cannot know what all values and dimensions A, B, C, D could take at compile time, and while I can code up a function that returns a lambda which mechanically does what I want, I believe my versions will always be doing some kind of extra run-time work/close over variables/etc...compared to the hypothetical lambda function above
Thoughts, answers, recommendations and the like are welcome. Am I correct in my conclusion that this is one of those rare legitimate eval uses? Apologies ahead of time for my inability to express the problem as eloquently in english...
(or alternatively, if someone can explain where my reasoning is off, or how to dynamically produce the most efficient functions...)
From what I understand, you need to precompute the vector size and the aref args.
(defun row-join-function-factory (C D)
(flet ((add-indices (l n)
(loop for el in l and i from 0 collect (list el n i))))
(let* ((C-indices (add-indices C 0))
(D-indices (add-indices D 1))
(all-indices (append D-indices
(set-difference C-indices
D-indices
:key #'first)))
(ns (mapcar #'second all-indices))
(is (mapcar #'third all-indices))
(size (length all-indices)))
#'(lambda (A B)
(map-into (make-array size)
#'(lambda (n i)
(aref (if (zerop n) A B) i))
ns is)))))
Note that I used a number to know if either A or B should be used instead of capturing C and D, to allow them to be garbage collected.
EDIT: I advise you to profile against a generated function, and observe if the overhead of the runtime closure is higher than e.g. 5%, against a special-purpose function:
(defun row-join-function-factory (C D)
(flet ((add-indices (l n)
(loop for el in l and i from 0 collect (list el n i))))
(let* ((C-indices (add-indices C 0))
(D-indices (add-indices D 1))
(all-indices (append D-indices
(set-difference C-indices
D-indices
:key #'first)))
(ns (mapcar #'second all-indices))
(is (mapcar #'third all-indices))
(size (length all-indices))
(j 0))
(compile
nil
`(lambda (A B)
(let ((result (make-array ,size)))
,#(mapcar #'(lambda (n i)
`(setf (aref result ,(1- (incf j)))
(aref ,(if (zerop n) 'A 'B) ,i)))
ns is)
result))))))
And validate if the compilation overhead indeed pays off in your implementation.
I argue that if the runtime difference between the closure and the compiled lambda is really small, keep the closure, for:
A cleaner coding style
Depending on the implementation, it might be easier to debug
Depending on the implementation, the generated closures will share the function code (e.g. closure template function)
It won't require a runtime license that includes the compiler in some commercial implementations
I think the right approach is to have a macro which would compute the indexes at compile time:
(defmacro my-array-generator (syms-a syms-b)
(let ((table '((a 0) (b 0) (b 1) (b 2)))) ; compute this from syms-a and syms-b
`(lambda (a b)
(make-array ,(length table) :initial-contents
(list ,#(mapcar (lambda (ai) (cons 'aref ai)) table))))))
And it will produce what you want:
(macroexpand '(my-array-generator ...))
==>
#'(LAMBDA (A B)
(MAKE-ARRAY 4 :INITIAL-CONTENTS
(LIST (AREF A 0) (AREF B 0) (AREF B 1) (AREF B 2))))
So, all that is left is to write a function which will produce
((a 0) (b 0) (b 1) (b 2))
given
syms-a = (num1 num2 num3)
and
syms-b = (num2 num3 num4)
Depends on when you know the data. If all the data is known at compile time, you can use a macro (per sds's answer).
If the data is known at run-time, you should be looking at loading it into an 2D array from your existing arrays. This - using a properly optimizing compiler - should imply that a lookup is several muls, an add, and a dereference.
By the way, can you describe your project in a wee bit more detail? It sounds interesting. :-)
Given C and D you could create a closure like
(lambda (A B)
(do ((result (make-array n))
(i 0 (1+ i)))
((>= i n) result)
(setf (aref result i)
(aref (if (aref use-A i) A B)
(aref use-index i)))))
where n, use-A and use-index are precomputed values captured in the closure like
n --> 4
use-A --> #(T nil nil nil)
use-index --> #(0 0 1 2)
Checking with SBCL (speed 3) (safety 0) the execution time was basically identical to the make-array + initial-contents version, at least for this simple case.
Of course creating a closure with those precomputed data tables doesn't even require a macro.
Have you actually timed how much are you going to save (if anything) using an unrolled compiled version?
EDIT
Making an experiment with SBCL the closure generated by
(defun merger (clist1 clist2)
(let ((use1 (list))
(index (list))
(i1 0)
(i2 0))
(dolist (s1 clist1)
(if (find s1 clist2)
(progn
(push NIL use1)
(push (position s1 clist2) index))
(progn
(push T use1)
(push i1 index)))
(incf i1))
(dolist (s2 clist2)
(unless (find s2 clist1)
(push NIL use1)
(push i2 index))
(incf i2))
(let* ((n (length index))
(u1 (make-array n :initial-contents (nreverse use1)))
(ix (make-array n :initial-contents (nreverse index))))
(declare (type simple-vector ix)
(type simple-vector u1)
(type fixnum n))
(print (list u1 ix n))
(lambda (a b)
(declare (type simple-vector a)
(type simple-vector b))
(let ((result (make-array n)))
(dotimes (i n)
(setf (aref result i)
(aref (if (aref u1 i) a b)
(aref ix i))))
result)))))
runs about 13% slower than an hand-written version providing the same type declarations (2.878s instead of 2.529s for 100,000,000 calls for the (a b c d)(b d e f) case, a 6-elements output).
The inner loop for the data based closure version compiles to
; 470: L2: 4D8B540801 MOV R10, [R8+RCX+1] ; (aref u1 i)
; 475: 4C8BF7 MOV R14, RDI ; b
; 478: 4C8BEE MOV R13, RSI ; source to use (a for now)
; 47B: 4981FA17001020 CMP R10, 537919511 ; (null R10)?
; 482: 4D0F44EE CMOVEQ R13, R14 ; if true use b instead
; 486: 4D8B540901 MOV R10, [R9+RCX+1] ; (aref ix i)
; 48B: 4B8B441501 MOV RAX, [R13+R10+1] ; load (aref ?? i)
; 490: 4889440B01 MOV [RBX+RCX+1], RAX ; store (aref result i)
; 495: 4883C108 ADD RCX, 8 ; (incf i)
; 499: L3: 4839D1 CMP RCX, RDX ; done?
; 49C: 7CD2 JL L2 ; no, loop back
The conditional is not compiled to a jump but to a conditional assignment (CMOVEQ).
I see a little room for improvement (e.g. using CMOVEQ R13, RDI directly, saving an instruction and freeing a register) but I don't think this would shave off that 13%.