I want to convert integer number (milliseconds) to the following format:
HH:MM:SS,SSS
For example time stamp 12,5 seconds is 00:00:12,500 and 1 hour, 38 minutes and 10 seconds like that 01:38:10,000.
I am pretty new to Lisp programming but here is what I have so far.
(defun ms->time (ms)
(let ((hours 0)
(minutes 0)
(seconds ms))
(progn
(and (>= seconds 3600000)
(progn
(setq hours (floor (/ seconds 3600000)))
(setq seconds (mod seconds 3600000))))
(and (>= seconds 60000)
(progn
(setq minutes (floor (/ seconds 60000)))
(setq seconds (mod seconds 60000))))
(format nil "~2,'0d:~2,'0d:~6,'0:d" hours minutes seconds))))
And here is the simple output:
CL> (ms->time 12500)
"00:00:12,500"
CL> (ms->time 5890000)
"01:38:10,000"
Looks great, exactly as I wanted. However...
CL> (ms->time 0)
"00:00:000000"
CL> (ms->time 999)
"00:00:000999"
How can I fix this problem? format is so advanced that I am pretty sure there is a way to do what I need. And of course if you have any ideas how to change my function to be more lispy please - do not hesitate. My current approach looks almost the same as my C++ version.
Thanks!
An easy solution would be to separate seconds into their own component like hours and minutes. I also use LET* to shadow MS in order to avoid having to SETQ variables:
(defun ms->time (ms)
(let* ((hours (floor ms 3600000))
(ms (mod ms 3600000))
(minutes (floor ms 60000))
(ms (mod ms 60000))
(seconds (floor ms 1000))
(ms (mod ms 1000)))
(format nil "~2,'0d:~2,'0d:~2,'0d,~3,'0d"
hours minutes seconds ms)))
(ms->time 0)
;=> "00:00:00,000"
(ms->time 999)
;=> "00:00:00,999"
I left out the checks for whether there are enough milliseconds to make hours or minutes. The math works out anyway, and I can't imagine the extra computation being a bottleneck.
About style (see jkiiski's answer for the functional improvement):
no PROGN needed inside LET
using AND this way is unusual, avoid
(floor (/ x a)) is (floor x a)
Your code can be written a bit shorter.
top function variables can be specified in the arglist as &aux. This can be useful to remove one layer of parentheses, by getting rid of the LET.
WHEN instead of AND
SETF instead of SETQ - it can set more than one place
Example:
(defun ms->time (ms &aux (hours 0) (minutes 0) (seconds ms))
(when (>= seconds 3600000)
(setf hours (floor seconds 3600000)
seconds (mod seconds 3600000)))
(when (>= seconds 60000)
(setf minutes (floor seconds 60000)
seconds (mod seconds 60000)))
(format nil "~2,'0d:~2,'0d:~6,'0:d" hours minutes seconds))
I would probably do this by using the fact that floor returns two values (the integer part of the division, as well as the reminder).
(defun ms->time (ms &optional (stream nil))
(multiple-value-bind (rest ms) (floor ms 1000)
(multiple-value-bind (rest s) (floor rest 60)
(multiple-value-bind (h m) (floor rest 60)
(format stream "~2,'0d:~2,'0d:~2,'0d,~3,'0d" h m s ms)))))
Related
I am trying to compare the performance of a function and a macro.
EDIT: Why do I want to compare the two?
Paul Graham wrote in his ON LISP book that macros can be used to make a system more efficient because a lot of the computation can be done at compile time. so in the example below (length args) is dealt with at compile time in the macro case and at run time in the function case. So, I just wanted how much faster did (avg2 super-list) get computed relative to (avg super-list).
Here is the function and the macro:
(defun avg (args)
(/ (apply #'+ args) (length args)))
(defmacro avg2 (args)
`(/ (+ ,#args) ,(length args)))
I have looked at this question How to pass a list to macro in common lisp? and a few other ones but they do not help because their solutions do not work; for example, in one of the questions a user answered by saying to do this:
(avg2 (2 3 4 5))
instead of this:
(avg2 '(2 3 4))
This works but I want a list containg 100,000 items:
(defvar super-list (loop for i from 1 to 100000 collect i))
But this doesnt work.
So, how can I pass super-list to avg2?
First of all, it simply makes no sense to 'compare the performance of a function and a macro'. It only makes sense to compare the performance of the expansion of a macro with a function. So that's what I'll do.
Secondly, it only makes sense to compare the performance of a function with the expansion of a macro if that macro is equivalent to the function. In other words the only places this comparison is useful is where the macro is being used as a hacky way of inlining a function. It doesn't make sense to compare the performance of something which a function can't express, like if or and say. So we must rule out all the interesting uses of macros.
Thirdly it makes no sense to compare the performance of things which are broken: it is very easy to make programs which do not work be as fast as you like. So I'll successively modify both your function and macro so they're not broken.
Fourthly it makes no sense to compare the performance of things which use algorithms which are gratuitously terrible, so I'll modify both your function and your macro to use better algrorithms.
Finally it makes no sense to compare the performance of things without using the tools the language provides to encourage good performance, so I will do that as the last step.
So let's address the third point above: let's see how avg (and therefore avg2) is broken.
Here's the broken definition of avg from the question:
(defun avg (args)
(/ (apply #'+ args) (length args)))
So let's try it:
> (let ((l (make-list 1000000 :initial-element 0)))
(avg l))
Error: Last argument to apply is too long: 1000000
Oh dear, as other people have pointed out. So probably I need instead to make avg at least work. As other people have, again, pointed out, the way to do this is reduce:
(defun avg (args)
(/ (reduce #'+ args) (length args)))
And now a call to avg works, at least. avg is now non-buggy.
We need to make avg2 non-buggy as well. Well, first of all the (+ ,#args) thing is a non-starter: args is a symbol at macroexpansion time, not a list. So we could try this (apply #'+ ,args) (the expansion of the macro is now starting to look a bit like the body of the function, which is unsurprising!). So given
(defmacro avg2 (args)
`(/ (apply #'+ ,args) (length ,args)))
We get
> (let ((l (make-list 1000000 :initial-element 0)))
(avg2 l))
Error: Last argument to apply is too long: 1000000
OK, unsurprising again. let's fix it to use reduce again:
(defmacro avg2 (args)
`(/ (reduce #'+ ,args) (length ,args)))
So now it 'works'. Except it doesn't: it's not safe. Look at this:
> (macroexpand-1 '(avg2 (make-list 1000000 :initial-element 0)))
(/ (reduce #'+ (make-list 1000000 :initial-element 0))
(length (make-list 1000000 :initial-element 0)))
t
That definitely is not right: it will be enormously slow but also it will just be buggy. We need to fix the multiple-evaluation problem.
(defmacro avg2 (args)
`(let ((r ,args))
(/ (reduce #'+ r) (length r))))
This is safe in all sane cases. So this is now a reasonably safe 70s-style what-I-really-want-is-an-inline-function macro.
So, let's write a test-harness both for avg and avg2. You will need to recompile av2 each time you change avg2 and in fact you'll need to recompile av1 for a change we're going to make to avg as well. Also make sure everything is compiled!
(defun av0 (l)
l)
(defun av1 (l)
(avg l))
(defun av2 (l)
(avg2 l))
(defun test-avg-avg2 (nelements niters)
;; Return time per call in seconds per iteration per element
(let* ((l (make-list nelements :initial-element 0))
(lo (let ((start (get-internal-real-time)))
(dotimes (i niters (- (get-internal-real-time) start))
(av0 l)))))
(values
(let ((start (get-internal-real-time)))
(dotimes (i niters (float (/ (- (get-internal-real-time) start lo)
internal-time-units-per-second
nelements niters)))
(av1 l)))
(let ((start (get-internal-real-time)))
(dotimes (i niters (float (/ (- (get-internal-real-time) start lo)
internal-time-units-per-second
nelements niters)))
(av2 l))))))
So now we can test various combinations.
OK, so now the fouth point: both avg and avg2 use awful algorithms: they traverse the list twice. Well we can fix this:
(defun avg (args)
(loop for i in args
for c upfrom 0
summing i into s
finally (return (/ s c))))
and similarly
(defmacro avg2 (args)
`(loop for i in ,args
for c upfrom 0
summing i into s
finally (return (/ s c))))
These changes made a performance difference of about a factor of 4 for me.
OK so now the final point: we should use the tools the language gives us. As has been clear throughout this whole exercise only make sense if you're using a macro as a poor-person's inline function, as people had to do in the 1970s.
But it's not the 1970s any more: we have inline functions.
So:
(declaim (inline avg))
(defun avg (args)
(loop for i in args
for c upfrom 0
summing i into s
finally (return (/ s c))))
And now you will have to make sure you recompile avg and then av1. And when I look at av1 and av2 I can now see that they are the same code: the entire purpose of avg2 has now gone.
Indeed we can do even better than this:
(define-compiler-macro avg (&whole form l &environment e)
;; I can't imagine what other constant forms there might be in this
;; context, but, well, let's be safe
(if (and (constantp l e)
(listp l)
(eql (first l) 'quote))
(avg (second l))
form))
Now we have something which:
has the semantics of a function, so, say (funcall #'avg ...) will work;
isn't broken;
uses a non-terrible algorithm;
will be inlined on any competent implementation of the language (which I bet is 'all implementations' now) when it can be;
will detect (some?) cases where it can be compiled completely away and replaced by a compile-time constant.
Since the value of super-list is known, one can do all computation at macro expansion time:
(eval-when (:execute :compile-toplevel :load-toplevel)
(defvar super-list (loop for i from 1 to 100000 collect i)))
(defmacro avg2 (args)
(setf args (eval args))
(/ (reduce #'+ args) (length args)))
(defun test ()
(avg2 super-list))
Trying the compiled code:
CL-USER 10 > (time (test))
Timing the evaluation of (TEST)
User time = 0.000
System time = 0.000
Elapsed time = 0.000
Allocation = 0 bytes
0 Page faults
100001/2
Thus the runtime is near zero.
The generated code is just a number, the result number:
CL-USER 11 > (macroexpand '(avg2 super-list))
100001/2
Thus for known input this macro call in compiled code has a constant runtime of near zero.
I don't think you really want a list of 100,000 items. That would have terrible performance with all that cons'ing. You should consider a vector instead, e.g.
(avg2 #(2 3 4))
You didn't mention why it didn't work; if the function never returns, it's likely a memory issue from such a large list, or attempting to apply on such a large function argument list; there are implementation defined limits on how many arguments you can pass to a function.
Try reduce on a super-vector instead:
(reduce #'+ super-vector)
The function set-difference is restricted to finding the difference between two sets. Can this be efficiently extended to allow more set arguments--eg, (my-set-difference A B C)--in the same way the function - works--eg, (- 9 3 1) => 5? Using (reduce #'set-difference ...) is not very efficient, as it first requires appending all of the set arguments into a sequence.
Actually, I think concatenating all the lists except the first one is probably the best solution.
Each invocation of set-difference will be O(n) (where n is the maximum size of the two lists), so reducing will be O(n*m) (where m is the number of lists). But if you do
(set-difference A (append B C D E F ...))
Appending all the lists is O(total length of B...), and the complexity of set-difference will be similar.
I don't know how accurate the following quick test is, but it says Barmar's append method is about 14 times faster than the reduce method, but conses twice as much.
(defparameter A
(mapcar (lambda (elt)
(declare (ignore elt))
(random 100))
(make-list 100)))
(defparameter B
(mapcar (lambda (elt)
(declare (ignore elt))
(random 100))
(make-list 100)))
(defparameter C
(mapcar (lambda (elt)
(declare (ignore elt))
(random 100))
(make-list 100)))
* (time (dotimes (i 100000) (reduce #'set-difference (list A B C))))
Evaluation took:
0.877 seconds of real time
0.875000 seconds of total run time (0.875000 user, 0.000000 system)
[ Run times consist of 0.016 seconds GC time, and 0.859 seconds non-GC time. ]
99.77% CPU
3,155,360,287 processor cycles
78,380,176 bytes consed
NIL
* (time (dotimes (i 100000) (set-difference A (append B C))))
Evaluation took:
0.064 seconds of real time
0.062500 seconds of total run time (0.062500 user, 0.000000 system)
96.88% CPU
229,293,666 processor cycles
159,971,568 bytes consed
NIL
But I've heard the SBCL time report is not very accurate (and this test may be faulty!).
How do I use cons or other way to print a list of Pell numbers till the Nth number?
(defun pellse (k)
(if (or (zerop k) (= k 1))
k
(+ (* 2 (pellse (- k 1)))
(pellse (- k 2)))))
(print (pellse 7))
Here is how to do it in a way that won’t be exponential:
(defun pells (n)
(loop repeat n
for current = 0 then next
and next = 1 then (+ (* 2 next) current)
collect current))
The time complexity to calculate the nth element given the two previous elements is O(log(Pn)) where Pn is the nth Pell number; you need log(Pn) bits for the answer and log(Pn) operations for the addition. We don’t actually need to work out what Pn is: It is defined by a simple linear recurrence relation so the solution must be exponential so log(Pn) = O(n). Therefore the complexity of calculating the first n Pell numbers is O(n*n) = O(n2).
One cannot[*] do better than O(n2) as one must write O(n2) bits to represent all these numbers.
[*] Although I very much doubt this, it might, in theory, be possible to represent the list in some more compact way by somehow sharing data.
Here is an approach to solving this problem which works by defining an infinite stream of Pell numbers. This is based on the ideas presented in SICP, and particularly section 3.5. Everyone should read this book.
First of all we need to define a construct which will let us talk about infinite data structures. We do this by delaying the evaluation of all but a finite part of them. So start with a macro called delay which delays the evaluation of a form, returning a 'promise' (which is a function of course), and a function called force which forces the system to make good on its promise:
(defmacro delay (form)
;; Delay FORM, which may evaluate to multiple values. This has
;; state so the delayed thing is only called once.
(let ((evaluatedp-n (make-symbol "EVALUATEDP"))
(values-n (make-symbol "VALUES")))
`(let ((,evaluatedp-n nil) ,values-n)
(lambda ()
(unless ,evaluatedp-n
(setf ,evaluatedp-n t
,values-n (multiple-value-list
(funcall (lambda () ,form)))))
(values-list ,values-n)))))
(defun force (promise)
;; force a promise (delayed thing)
(funcall promise))
(This implementation is slightly overcomplex for our purposes, but it's what I had to hand.).
Now we'll use delay to define streams which are potentially infinite chains of conses. There are operations on these corresponding to operations on conses but prefixed by stream-, and there is an object called null-stream which corresponds to () (and is in fact the same object in this implementation).
(defmacro stream-cons (car cdr)
;; a cons whose cdr is delayed
`(cons ,car (delay ,cdr)))
(defun stream-car (scons)
;; car of a delayed cons
(car scons))
(defun stream-cdr (scons)
;; cdr of a delayed cons, forced
(force (cdr scons)))
(defconstant null-stream
;; the empty delayed cons
nil)
(defun stream-null (stream)
;; is a delayed cons empty
(eq stream null-stream))
Now define a function pell-stream which returns a stream of Pell numbers. This function hand-crafts the first two elements of the stream, and then uses a generator to make the rest.
(defun pell-stream ()
;; A stream of Pell numbers
(labels ((pell (pn pn-1)
(let ((p (+ (* 2 pn) pn-1)))
(stream-cons p (pell p pn)))))
(stream-cons 0 (stream-cons 1 (pell 1 0)))))
And now we can simply repeatedly takes stream-cdr to compute Pell numbers.
(defun n-pell-numbers (n)
(loop repeat n
for scons = (pell-stream) then (stream-cdr scons)
collect (stream-car scons)))
And now
> (n-pell-numbers 20)
(0
1
2
5
12
29
70
169
408
985
2378
5741
13860
33461
80782
195025
470832
1136689
2744210
6625109)
Note that, in fact, pell-stream can be a global variable: it doesn't need to be a function:
(defparameter *pell-stream*
(labels ((pell (pn pn-1)
(let ((p (+ (* 2 pn) pn-1)))
(stream-cons p (pell p pn)))))
(stream-cons 0 (stream-cons 1 (pell 1 0)))))
(defun n-stream-elements (stream n)
(loop repeat n
for scons = stream then (stream-cdr scons)
collect (stream-car scons)))
If we define a little benchmarking program:
(defun bench-pell (n)
(progn (n-stream-elements *pell-stream* n) n))
Then it's interesting to see that this is clearly essentially a linear process (it slows down for later elements because the numbers get big and so operations on them take a long time), and that the stateful implementation of promises makes it much faster after the first iteration (at the cost of keeping quite a lot of bignums around):
> (time (bench-pell 100000))
Timing the evaluation of (bench-pell 100000)
User time = 2.020
System time = 0.803
Elapsed time = 2.822
Allocation = 1623803280 bytes
441714 Page faults
100000
> (time (bench-pell 100000))
Timing the evaluation of (bench-pell 100000)
User time = 0.007
System time = 0.000
Elapsed time = 0.006
Allocation = 1708248 bytes
0 Page faults
100000
One possible solution would be to use the LOOP macro of Common Lisp, e.g.:
(print
(loop for x in '(1 2 3 4 5 6 7)
for y = (pellse x)
collect y))
That prints out the following result:
(1 2 5 12 29 70 169)
Based on this, you can build the following function:
(defun list-of-n-pell-numbers (n)
(loop for x from 0 to n
for y = (pellse x)
collect y))
And run it like the following:
(print (list-of-n-pell-numbers 7))
(0 1 2 5 12 29 70 169)
But please be careful when using this code, because your definition of pellse function is recursive, and has the risk of a stack overflow: make it call itself repeatedly enough (e.g. for big values of N), and it might blow up the call stack, unless you do some tail recursion. You might want to check the following explanations:
http://www.lispworks.com/documentation/lcl50/aug/aug-51.html
https://0branch.com/notes/tco-cl.html
Problem
Let's say you have a number of lists or arrays, let's say two for the sake of example :
(defparameter *arr* #(1 2 3))
(defparameter *list* '(4 5 6))
You can loop over them using either across or in keywords :
(loop for elem across *arr* do (format t "~a" elem))
=> 123
(loop for elem in *list* do (format t "~a" elem))
=> 456
I want to be able to loop over these arrays or lists using the same syntax. I am using SBCL and execution speed is a concern.
Using being the elements of
This syntax is nice, as it works regardless of its argument being a list or array.
(loop for elem being the elements of *arr* do (format t "~a" elem))
=> 123
(loop for elem being the elements of *list* do (format t "~a" elem))
=> 456
But its speed is horrendous. If we do a quick comparison by accessing lists or arrays of 100 elements 1M times :
(format t "# Test 1.1.1 : Accessing list of doubles with loop 'in': ") (terpri)
(let ((test-list (make-list 100 :initial-element 12.2d0))
(testvar 0d0))
(declare (optimize (speed 3))
(type list test-list)
(type double-float testvar))
(time (dotimes (it 1000000 t) (loop for el in test-list do
(setf testvar (the double-float el))))))
(format t "# Test 1.1.2 : Accessing list of doubles with loop 'elements': ") (terpri)
(let ((test-list (make-list 100 :initial-element 12.2d0))
(testvar 0d0))
(declare (optimize (speed 3))
(type list test-list)
(type double-float testvar))
(time (dotimes (it 1000000 t) (loop for el being the elements of test-list do
(setf testvar (the double-float el))))))
(format t "# Test 1.2.1 : Accessing simple-array of doubles using loop 'across' : ") (terpri)
(let ((test-array (make-array 100 :initial-element 12.2d0 :element-type 'double-float))
(testvar 0d0))
(declare (optimize (speed 3))
(type double-float testvar)
(type simple-array test-array))
(time (dotimes (it 1000000 t) (loop for el across test-array do
(setf testvar (the double-float el))))))
(format t "# Test 1.2.2 : Accessing simple-array of doubles using loop 'elements' : ") (terpri)
(let ((test-array (make-array 100 :initial-element 12.2d0 :element-type 'double-float))
(testvar 0d0))
(declare (optimize (speed 3))
(type double-float testvar)
(type simple-array test-array))
(time (dotimes (it 1000000 t) (loop for el being the elements of test-array do
(setf testvar (the double-float el))))))
It gives us :
# Test 1.1.1 : Accessing list of doubles with loop 'in':
Evaluation took:
0.124 seconds of real time
0.123487 seconds of total run time (0.123471 user, 0.000016 system)
99.19% CPU
445,008,960 processor cycles
672 bytes consed
# Test 1.1.2 : Accessing list of doubles with loop 'elements':
Evaluation took:
0.843 seconds of real time
0.841639 seconds of total run time (0.841639 user, 0.000000 system)
99.88% CPU
3,034,104,192 processor cycles
0 bytes consed
# Test 1.2.1 : Accessing simple-array of doubles using loop 'across' :
Evaluation took:
0.062 seconds of real time
0.062384 seconds of total run time (0.062384 user, 0.000000 system)
100.00% CPU
224,896,032 processor cycles
0 bytes consed
# Test 1.2.2 : Accessing simple-array of doubles using loop 'elements' :
Evaluation took:
1.555 seconds of real time
1.554472 seconds of total run time (1.541572 user, 0.012900 system)
[ Run times consist of 0.094 seconds GC time, and 1.461 seconds non-GC time. ]
99.94% CPU
5,598,161,100 processor cycles
1,600,032,848 bytes consed
I think it must use the elt accessor ? Anyway the penalty in speed is unacceptable.
Trying to be smart with macros
I wrote something to be able to achieve my goal of having the same syntax for list and array. I think it's not great because it seems overly awkward, but here :
(defun forbuild (el-sym list-or-array list-or-array-sym)
"Outputs either :
* (for el-sym in list-or-array)
* (for el-sym across list-or-array)
Depending on type of list-or-array.
el-sym : symbol, eg. 'it1
list-or-array : declared, actual data for list or array
list-or-array-sym : symbol name for the table, to avoid writing the data in full
in the 'loop' call using eval.
Example call : (forbuild 'it1 arr 'arr)"
(cond ((typep list-or-array 'array)
`(for ,el-sym across ,list-or-array-sym))
((typep list-or-array 'list)
`(for ,el-sym in ,list-or-array-sym))))
(defun forbuild-l (l-elsyms l-lars l-larsyms)
"forbuild but over lists of things."
(let ((for-list nil)
(list-temp nil))
(loop for elem in l-elsyms
for lar in l-lars
for larsym in l-larsyms do
(setf list-temp (forbuild elem lar larsym))
(loop for word-temp in list-temp do
(push word-temp for-list)))
(nreverse for-list)))
(defun loop-expr (forlist body)
"Creates the expression ready to be evaluated to execute the loop.
forlist : List of symbols to be inserted syntactically. eg.
FOR IT1 ACROSS ARR1 FOR IT2 IN ARR2
body : all the expression after the 'for' clauses in the 'loop'."
`(loop ,#forlist ,#body))
(defmacro looparl (element list-or-array &rest body)
(let ((forlist (gensym)))
`(let ((,forlist (forbuild2-l (quote ,element)
(list ,#list-or-array)
(quote ,list-or-array))))
(loop-expr ,forlist (quote ,body)))))
Basically I build the right loop syntax from the arguments. The version of looparl given here can be called this way :
(let ((arr1 #(7 8 9))
(list2 (list 10 11 12)))
(looparl (it1 it2) (arr1 list2) do (format t "~a ~a" it1 it2) (terpri)))
=> (LOOP FOR IT1 ACROSS ARR1
FOR IT2 IN LIST2
DO (FORMAT T "~a ~a" IT1 IT2) (TERPRI))
The actual evaluation of this outputted expression is omitted in this example, because it doesn't work on non-global names. If we throw in an eval at the end of looparl :
(defmacro looparl (element list-or-array &rest body)
(let ((forlist (gensym)))
`(let ((,forlist (forbuild2-l (quote ,element)
(list ,#list-or-array)
(quote ,list-or-array))))
(eval (loop-expr ,forlist (quote ,body))))))
And work on global variables, we see that we still have a speed issue, since there are evaluations happening at runtime :
(looparl (it1 it2) (*arr* *list*) for it from 100
do (format t "~a ~a ~a" it1 it2 it) (terpri))
=> 1 4 100
2 5 101
3 6 102
(time (dotimes (iter 1000 t) (looparl (it1 it2) (*arr* *list*) for it from 100
do (format t "~a ~a ~a" it1 it2 it) (terpri))))
=> Evaluation took:
1.971 seconds of real time
1.932610 seconds of total run time (1.892329 user, 0.040281 system)
[ Run times consist of 0.097 seconds GC time, and 1.836 seconds non-GC time. ]
98.07% CPU
1,000 forms interpreted
16,000 lambdas converted
7,096,353,696 processor cycles
796,545,680 bytes consed
The macros are evaluated each one at a time a thousand times. But surely the type is known at compile time no ? The type of syntax in looparl is very nice, and I'd like to be able to use it without speed penalty.
I read this note in Peter Seibel's book Practical Common Lisp, chapter "Loop for Black Belts"
3 You may wonder why LOOP can't figure out whether it's looping over a list or a vector without needing different prepositions. This is another consequence of LOOP being a macro: the value of the list or vector won't be known until runtime, but LOOP, as a macro, has to generate code at compile time. And LOOP's designers wanted it to generate extremely efficient code. To be able to generate efficient code for looping across, say, a vector, it needs to know at compile time that the value will be a vector at runtime--thus, the different prepositions are needed.
Am I committing some big Common-Lisp nonsense ? How would you go about creating a working, quick looparl ?
Edit 1 : FOR library
Thank you Ehvince for the reference to the FOR library. The over keyword in the for:for function is indeed exactly what I'd need. However the benchmarks are really underwhelming :
(let ((test-list (make-list 100 :initial-element 12.2d0))
(testvar 0d0))
(declare (optimize (speed 3))
(type list test-list)
(type double-float testvar))
(time (dotimes (it 1000000 t)
(for:for ((el over test-list))
(setf testvar (the double-float el))))))
(let ((test-array (make-array 100 :initial-element 12.2d0))
(testvar 0d0))
(declare (optimize (speed 3))
(type simple-array test-array)
(type double-float testvar))
(time (dotimes (it 1000000 t)
(for:for ((el over test-array))
(setf testvar (the double-float el))))))
Evaluation took:
4.802 seconds of real time
4.794485 seconds of total run time (4.792492 user, 0.001993 system)
[ Run times consist of 0.010 seconds GC time, and 4.785 seconds non-GC time. ]
99.83% CPU
17,286,934,536 processor cycles
112,017,328 bytes consed
Evaluation took:
6.758 seconds of real time
6.747879 seconds of total run time (6.747879 user, 0.000000 system)
[ Run times consist of 0.004 seconds GC time, and 6.744 seconds non-GC time. ]
99.85% CPU
24,329,311,848 processor cycles
63,995,808 bytes consed
The speed of this library using the specialized keywords in and across is the same as for the standard loop. But very slow with over.
Edit 2 : map and etypecase
Thank you sds and Rainer Joswig for the suggestions. It would indeed work for the simple case in which I would only have one array/list to iterate over. Let me tell you about one use case I had in mind : I was implementing a gnuplot wrapper, both as training and to have my own program in my toolkit. I wanted to take from the user lists or arrays indifferently to serve as series to pipe to gnuplot. This is why I need to be able to loop over multiple array/lists simultaneously + using the elegant loop clauses for iteration number etc.
In this use case (gnuplot wrapper), I only have two or three for clauses in my loop for each "data block", so I have thought of writing each combination depending on the type of input by hand and it is possible, but very awkward. And I'd be stuck if I had to do something like :
(loop for el1 in list1
for el2 across arr1
for el3 in list2
for el4 in list3
...)
With the list-i and arr-i being inputs. Another fallback plan for this use case is just to convert everything to arrays.
I thought that since it is quite easily conceptualized, I could write something flexible and fast once and for all, but there must be a reason why it is neither in the specs nor in SBCL-specific code.
What you are looking for is called
map:
both
(map nil #'princ '(1 2 3))
and
(map nil #'princ #(1 2 3))
print 123.
However, lists and arrays are very different beasts, and it is best to decide in advance which one you want to use.
The library For, by Shinmera, has the generic over iterator:
(ql:quickload "for")
(for:for ((a over *arr*)
(b over *list*))
(print (list a b)))
;; (1 4)
;; (2 5)
;; (3 6)
It also has "in" and "accross", so it might help to use "over" during development and to refine later, if needed.
I'll let you do the benchmarks :)
For trivial uses you might do
(flet ((do-something (e)
...))
(etypecase foo
(vector (loop for e across foo do (do-something e)))
(list (loop for e in foo do (do-something e))))
The runtime type dispatch probably will be faster than a generic iteration construct using the sequence abstraction.
Coercing an array to a list and then looping in gives the same performance as if it had been a list in the first place, which isn't as good as with array, but not nearly so bad as using element and it does have the virtue of working with either a list or an array without additional machinery:
(loop for x in (coerce array 'list) do something)
I have a problem in understanding the performance of a Common Lisp function (I am still a novice). I have two versions of this function, which simply computes the sum of all integers up to a given n.
Non-tail-recursive version:
(defun addup3 (n)
(if (= n 0)
0
(+ n (addup (- n 1)))))
Tail-recursive version:
(defun addup2 (n)
(labels ((f (acc k)
(if (= k 0)
acc
(f (+ acc k) (- k 1)))))
(f 0 n)))
I am trying to run these functions in CLISP with input n = 1000000. Here is the result
[2]> (addup3 1000000)
500000500000
[3]> (addup2 1000000)
*** - Program stack overflow. RESET
I can run both successfully in SBCL, but the non-tail-recursive one is faster (only by a little, but that seems strange to me). I've scoured Stackoverflow questions for answers but couldn't find something similar. Why do I get a stack overflow although the tail-recursive function is designed NOT to put all recursive function calls on the stack? Do I have to tell the interpreter/compiler to optimise tail calls? (I read something like (proclaim '(optimize (debug 1)) to set the debug level and optimize at the cost of tracing abilities, but I don't know what this does).
Maybe the answer is obvious and the code is bullshit, but I just can't figure it out.
Help is appreciated.
Edit: danlei pointed out the typo, it should be a call to addup3 in the first function, so it is recursive. If corrected, both versions overflow, but not his one
(defun addup (n)
"Adds up the first N integers"
(do ((i 0 (+ i 1))
(sum 0 (+ sum i)))
((> i n) sum)))
While it may be a more typical way to do it, I find it strange that tail recursion is not always optimised, considering my instructors like to tell me it's so much more efficient and stuff.
There is no requirement for a Common Lisp implementation to have tail call optimization. Most do, however (I think that ABCL does not, due to limitations of the Java virtual machine).
The documentation of the implementation should tell you what optimization settings should be chosen to have TCO (if available).
It is more idiomatic for Common Lisp code to use one of the looping constructs:
(loop :for i :upto n
:sum i)
(let ((sum 0))
(dotimes (i n)
(incf sum (1+ i))))
(do ((i 0 (1+ i))
(sum 0 (+ sum i)))
((> i n) sum))
In this case, of course, it is better to use the "little Gauß":
(/ (* n (1+ n)) 2)
Well, your addup3 just isn't recursive at all.
(defun addup3 (n)
(if (= n 0)
0
(+ n (addup (- n 1))))) ; <--
It calls whatever addup is. Trying a corrected version in SBCL:
CL-USER> (defun addup3 (n)
(if (= n 0)
0
(+ n (addup3 (- n 1)))))
ADDUP3
CL-USER> (addup3 100000)
Control stack guard page temporarily disabled: proceed with caution
; ..
; Evaluation aborted on #<SB-SYS:MEMORY-FAULT-ERROR {C2F19B1}>.
As you'd expect.
Using GNU CommonLisp, GCL 2.6.12, compilation of addup2 will optimize tail calls, here is what I got:
>(compile 'addup2)
Compiling /tmp/gazonk_3012_0.lsp.
End of Pass 1.
;; Note: Tail-recursive call of F was replaced by iteration.
End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
Finished compiling /tmp/gazonk_3012_0.lsp.
Loading /tmp/gazonk_3012_0.o
start address -T 0x9556e8 Finished loading /tmp/gazonk_3012_0.o
#<compiled-function ADDUP2>
NIL
NIL
>>(addup2 1000000)
500000500000
>(addup3 1000000)
Error: ERROR "Invocation history stack overflow."
Fast links are on: do (si::use-fast-links nil) for debugging
Signalled by IF.
ERROR "Invocation history stack overflow."
Broken at +. Type :H for Help.
1 Return to top level.
>>(compile 'addup3)
Compiling /tmp/gazonk_3012_0.lsp.
End of Pass 1.
End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
Finished compiling /tmp/gazonk_3012_0.lsp.
Loading /tmp/gazonk_3012_0.o
start address -T 0x955a00 Finished loading /tmp/gazonk_3012_0.o
#<compiled-function ADDUP3>
NIL
NIL
>>(addup3 1000000)
Error: ERROR "Value stack overflow."
Hope it helps.
In SBCL User Manual:
The compiler is “properly tail recursive.” [...] The elimination of tail-recursive frames can be prevented by disabling tail-recursion optimization, which happens when the debug optimization quality is greater than 2.
And works as is in the REPL of a fresh image:
(defun sum-no-tail (n)
(if (zerop n)
0
(+ n (sum-no-tail (- n 1)))))
(defun sum-tail (n &key (acc 0))
(if (zerop n)
acc
(sum-tail (- n 1) :acc (+ n acc))))
CL-USER> (sum-no-tail 10000)
50005000 (26 bits, #x2FB0408)
CL-USER> (sum-no-tail 100000)
Control stack guard page temporarily disabled: proceed with caution
; Debugger entered on #<SB-KERNEL::CONTROL-STACK-EXHAUSTED {10026620A3}>
[1] CL-USER>
; Evaluation aborted on #<SB-KERNEL::CONTROL-STACK-EXHAUSTED {10026620A3}>
CL-USER> (sum-tail 100000)
5000050000 (33 bits, #x12A06B550)
CL-USER> (sum-tail 1000000)
500000500000 (39 bits, #x746A5A2920)
CL-USER> (sum-tail 10000000)
50000005000000 (46 bits, #x2D7988896B40)
Hope it helps in SBCL.