I have created a Common Lisp library binding for libbladerf and can receive signals in Common Lisp. I have a function that demodulates an FM signal and is defined as follows:
(defun fm-demodulate-sc16-q11-samples (device frequency)
(configure-channel device (channel-rx 0) frequency 1000 40000000 30)
(init-sync device)
(enable-module device (channel-rx 0) t)
(with-foreign-objects ((rx-samples :uint16 8192)
(metadata :pointer))
(let ((status (bladerf_sync_rx (mem-ref device :pointer) rx-samples 4096 metadata 5000))
(samples-array (make-array 8192 :element-type 'float :initial-element 0.0 :fill-pointer 0)))
(if (< status 0)
(error "Failed to recieve IQ samples error: ~S" status)
(progn
(loop for i below 4096 by 4
do
(let* ((previous-i (mem-aref rx-samples :int16 (1+ i)))
(previous-q (mem-aref rx-samples :int16 i))
(current-i (mem-aref rx-samples :int16 (+ i 3)))
(current-q (mem-aref rx-samples :int16 (+ i 2)))
(previous-complex (complex previous-i previous-q))
(current-complex (complex current-i current-q))
(dif-complex (* (conjugate previous-complex) current-complex)))
(vector-push (atan-complex-number dif-complex) samples-array)))
samples-array)))))
I then pass this to cl-portaudio using the following code:
(defconstant +frames-per-buffer+ 1024)
(defconstant +sample-rate+ 44100d0)
(defconstant +sample-format+ :float)
(defconstant +num-channels+ 2)
(defun play-demodulated-fm ()
(with-audio
(with-default-audio-stream (astream +num-channels+ +num-channels+ :sample-format +sample-format+ :sample-rate +sample-rate+ :frames-per-buffer +frames-per-buffer+)
(dotimes (i 20)
(write-stream astream (fm-demodulate-sc16-q11-samples *dev* 863000000)))))
When I play this all I hear is a clipping sound and the following warning:
array is copied and/or coerced, lisp type is T, requested CFFI type is FLOAT
ALSA lib pcm.c:8432:(snd_pcm_recover) underrun occurred
What is the correct way of playing an FM demodulated signal with cl-portaudio?
I tried to play a simple tone with cl-portaudio and got the very same error as you reported:
array is copied and/or coerced, lisp type is T, requested CFFI type is FLOAT
After a long night of trying and digging the net I finally cooked the following piece of code making a sound. Probably not 'CleanCode', but should do as a start.
(eval-when (:compile-toplevel)
(ql:quickload "cl-portaudio"))
(defconstant +sample-rate+ 44100d0)
(defconstant +sample-format+ :float)
(defconstant +input-channels+ 0)
(defconstant +output-channels+ 1)
(defconstant +sound-frequency+ 800)
(defconstant +angle-per-tick+ (* 2d0 pi (/ +sound-frequency+ +sample-rate+)))
(defconstant +audio-buffer-size+ 4096
"The number of samples in the audio buffer.")
(defconstant +audio-buffer-time+ (* +audio-buffer-size+ (/ +sample-rate+))
"The total time the information in the audio buffer represents, in seconds.")
(defun make-audio-buffer ()
(make-array +audio-buffer-size+
:element-type 'single-float
:initial-element 0.0))
(defun make-sine-wave (&optional (angle 0d0))
(loop
with buffer = (make-audio-buffer)
for i from 0 below +audio-buffer-size+
for cur-angle = (+ angle (* i +angle-per-tick+))
do
(setf (aref buffer i) (coerce (sin cur-angle) 'single-float))
finally
(return-from make-sine-wave (values buffer (mod cur-angle (* 2 pi))))))
(defun play-note()
(portaudio:with-audio
(portaudio:with-default-audio-stream
(audio-stream +input-channels+ +output-channels+
:sample-format :float
:sample-rate +sample-rate+
:frames-per-buffer +audio-buffer-size+)
(loop
for i from 1 to 8
with angle = 0d0
do
(multiple-value-bind
(buffer new-angle)
(make-sine-wave angle)
(portaudio:write-stream audio-stream buffer)
(setf angle new-angle))))))
I would like to do something similar to matplotlib.pyplot.matshow with racket. I understand this is a trivial question and maybe I'm just being stupid, but I was unsuccessful after reading the Racket plotting documentation.
An example matrix that would be translated into the image of a circle:
#lang typed/racket
(require math/array)
(require plot)
(: sq (-> Integer Integer))
(define (sq [v : Integer])
(* v v))
(: make-2d-matrix (-> Integer Integer (Array Boolean)))
(define (make-2d-matrix [s : Integer] [r : Integer])
(let ([center : Integer (exact-round (/ s 2))])
(let ([a (indexes-array ((inst vector Integer) s s))])
(let ([b (inline-array-map (λ ([i : (Vectorof Index)])
(+
(sq (- (vector-ref i 0) center))
(sq (- (vector-ref i 1) center))))
a)])
(array<= b (array (sq r)))
))))
(array-map (λ ([i : Boolean]) (if (eq? i #f) 0 1)) (make-2d-matrix 20 6))
Can someone give me a hint?
Totally not a dumb question. This is one of those areas where it's hard to compete with an army of python library programmers. Here's how I'd do it in Racket:
#lang racket
(require 2htdp/image
math/array)
;; a 10x10 array
(define a
(build-array #(10 10)
(λ (e)
(match e
[(vector x y)
(cond [(= x y) x]
[else 0])]))))
;; map a value to a color
(define (cmap v)
(color (floor (* 255 (/ v 10)))
0
(floor (* 255 (- 1 (/ v 10))))))
(apply
above
(for/list ([y (in-range 10)])
(apply
beside
(for/list ([x (in-range 10)])
(rectangle 10 10 'solid (cmap (array-ref a (vector x y))))))))
Depending on you situation, you might be interested in flomaps:
http://docs.racket-lang.org/images/flomap_title.html?q=flbitmap
I'm not sure exactly what you want to plot. The plot library is designed around plotting functions, but I don't know what function you want to express.
Here are two ways of plotting a matrix:
(plot (points (cast (array->vector* m) (Vectorof (Vectorof Real)))
(plot3d (points3d (cast (array->vector* m) (Vectorof (Vectorof Real)))
The cast is needed because the type of array->vector* is not specific enough.
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%.
I'm trying to make a function in Clojure that is local to the body of a (let ...) function. I tried the following, but (defn ...) defines things in the global namespace.
(let [] (defn power [base exp]
(if (= exp 0)
1
(if (> exp 0)
; Exponent greater than 0
(* base (power base (- exp 1)))
; Exponent less than 0
(/ (power base (+ exp 1)) base))))
(println (power -2 3)))
; Function call outside of let body
(println (power -2 3))
Now, I also tried:
(let [power (fn [base exp]
(if (= exp 0)
1
(if (> exp 0)
; Exponent greater than 0
(* base (power base (- exp 1)))
; Exponent less than 0
(/ (power base (+ exp 1)) base))))]
(println (power -2 3)))
; Function call outside of let body
(println (power -2 3))
But then I get the error:
Exception in thread "main" java.lang.Exception: Unable to resolve symbol: power in this context (math.clj:6)
How do I make a function whose namespace is local to the let body and can recursively call itself?
For this you can use letfn:
(letfn [(power [base exp]
(cond
(= exp 0)
1
(> exp 0) ; Exponent greater than 0
(* base (power base (dec exp)))
:else ; Exponent less than 0
(/ (power base (inc exp)) base)))]
(print (power -2 3)))
Note that I also changed your nested if-construction to cond, I think it is more readable. Also I changed (+ exp 1) and (- exp 1) to (inc exp) and (dec exp) respectively. You can even improve your function more like using recur and an accumulator argument, but maybe that goes beyond the scope of your question. Also see Brian Carper's comment below.
letfn is the best solution for your particular case. However, you can also created a named "anonymous" function like so:
(let [power (fn power [base exp] ...)]
(println (power -2 3)))
However, this style doesn't allow for mutually recursive functions, which letfn does.
Besides to good answer of Michel: Using high order function on lazy sequences often allow consise solutions compared to explicit recursion:
(defn power [base exp]
(reduce * (repeat exp base)))
Here is a solution which is an example of Michiel's last statement about using an accumulator. This lets you use recur to gain advantage of tail call optimization. This gives you the advantage of not consuming stack space with each recursion.
(defn pow [base exp]
(letfn [(power [base exp accum]
(cond
(= exp 0) accum
(> exp 0) (recur base (dec exp) (* accum base))
:else (recur base (inc exp) (/ accum base))))]
(power base exp 1)))
user> (pow -3 2)
9
user> (pow -3 3)
-27
If you are simply looking to write a function which does raises a base number to a power don't forget you can call out to methods which already exist in Java. java.util.Math can help you out here.
(Math/pow -2 3)