need help with lists
Dan Kruchinin
beautiful solution than i have.
so the question is:
i have a list always containing 2 integer elements. each element can
be negative, positive or zero.
i need to get a list containing 3 lists using the following strategy:
if an element from source list is negative, it should be included to
the first sublist,
if it is positive, it should be placed to the third sublist
and if it is zero, it should be placed to the second sublist.
(note#1: each element should be abs'ed before including)
(note#2: i need side-effect safe solution)
for example i have a list from 2 elements: (setf l '(-2 35))
i should get the following list containing 3 sublists:
'((2) nil (35))
or if l is '(-2 -3)
the result list should be
'((2 3) nil nil)
or if l is '(0 5):
'(nil (0) (5))
and so on.
my implementation:
(labels ((dispose (src-lst pos-lst)
(if (null src-lst)
pos-lst
(let
((abs-el (abs (car src-lst))))
(case (signum (car src-lst))
(1
(dispose (cdr src-lst) (list (cons abs-el (first pos-lst))
(second pos-lst) (third pos-lst))))
(-1
(dispose (cdr src-lst) (list (first pos-lst) (second pos-lst)
(cons abs-el (third pos-lst)))))
(0
(dispose (cdr src-lst) (list (first pos-lst) (cons abs-el
(second pos-lst)) (third pos-lst)))))))))
(dispose given-list-from-2-elems '(nil nil nil)))
i don't like this implementation, because it quite ugly and i think
that this simple idea can be implemented more graceful, but i havn't
enough experience with lisp to do it.
thanks for help.
Dan Kruchinin
> may be it's quite stupid question, but i don't know how to get more
> beautiful solution than i have.
> so the question is:
> i have a list always containing 2 integer elements. each element can
> be negative, positive or zero.
> i need to get a list containing 3 lists using the following strategy:
> if an element from source list is negative, it should be included to
> the first sublist,
> if it is positive, it should be placed to the third sublist
> and if it is zero, it should be placed to the second sublist.
> (note#1: each element should be abs'ed before including)
> (note#2: i need side-effect safe solution)
>
> for example i have a list from 2 elements: (setf l '(-2 35))
> i should get the following list containing 3 sublists:
> '((2) nil (35))
> or if l is '(-2 -3)
> the result list should be
> '((2 3) nil nil)
> or if l is '(0 5):
> '(nil (0) (5))
> and so on.
uff, sorry, i made an error in the description
if the element is negative it should be included to the *third*
sublist
and if it is positive it should be included to the *first* sublist.
so the examples will be:
src: '(-2 35)
res: '((35) nil (2))
--
src: '(-2 -3)
res: '(nil nil (2 3))
--
src :'(0 5)
res: ((5) (0) nil)
Mark Tarver
>
> - Show quoted text -
Dan,
You need to learn about accumulators and help functions.
Probably somebody here can recommend an introductory book.
In Qi
(define seperate
Ns -> (s-help Ns [] [] []))
Pos Zero Neg are accumulators
(define s-help
[] Pos Zero Neg -> [Pos Zero Neg]
[P | Ns] Pos Zero Neg -> (s-help Ns [P | Pos] Zero Neg) where (> P
0)
[0 | Ns] Pos Zero Neg -> (s-help Ns Pos [0 | Zero] Neg)
[N | Ns] Pos Zero Neg -> (s-help Ns Pos Zero [N | Neg]))
or in Lisp
(defun seperate (Ns) (s-help Ns () () ()))
(defun s-help (Ns Pos Zero Neg)
(cond ((null Ns) (list Pos Zero Neg))
((> (car Ns) 0) (s-help (cdr Ns) (cons (car Ns) Pos) Zero
Neg))
((zerop (car Ns)) (s-help (cdr Ns) Pos (cons 0 Zero) Neg))
(t (s-help (cdr Ns) Pos Zero (cons (car Ns) Neg)))))
I'm typing this wondering if its a homework question - but you've had
a bash yourself so a bit of help is ok.
Mark
Ken Tilton
The "ugly" solution was supplied as part of the question, with the
instructions to find something more elegant.
Fortunately you answered in Qi, I am hard at work on a solution using
Cells, and I wonder where is the F# answer?
kt
--
http://www.theoryyalgebra.com/
"Career highlights? I had two. I got an intentional walk
from Sandy Koufax and I got out of a rundown against the Mets."."
- Bob Uecker
Kamen TOMOV
> (defun seperate (Ns) (s-help Ns () () ()))
>
seperate would make sense if:
(defun seperate (arglst &optional (lst nil))
(if (null arglst)
lst
(seperate (cdr arglst)
(s-help (car arglst) (first lst) (second lst) (third lst)))))
> (defun s-help (Ns Pos Zero Neg)
> (cond ((null Ns) (list Pos Zero Neg))
> ((> (car Ns) 0) (s-help (cdr Ns) (cons (car Ns) Pos) Zero Neg))
> ((zerop (car Ns)) (s-help (cdr Ns) Pos (cons 0 Zero) Neg))
> (t (s-help (cdr Ns) Pos Zero (cons (car Ns) Neg)))))
--
Камен
Mark Tarver
>
> - Show quoted text -
Oh - I skimmed the bit about the absolute value. Well I leave that to
you. It should not be a problem.
Mark
Mark Tarver
>
> "Career highlights? I had two. I got an intentional walk
> from Sandy Koufax and I got out of a rundown against the Mets."."
>
> - Show quoted text -
I figure I'd put in my 2ps worth because the next offer is bound to
have a FOR loop in it :)
Mark
Dan Kruchinin
i think i should to reread chapter about utils in "onlisp"...
wbr
Mattias Nilsson
> I figure I'd put in my 2ps worth because the next offer is bound to
> have a FOR loop in it :)
Not quite - I really like DOLIST:
(defun separate (list)
(let ((result (list nil nil nil)))
(dolist (n list result)
(push (abs n) (nth (- 1 (signum n)) result)))))
Mattias
Ken Tilton
Sweet! But are you allowed to use SETF? Remember, this is homework with
artificial limitations meant to channel student learning in specific
directions, in this case towards comp.lang.lisp.
With a few bits left as an exercise for c.l.f, I get (using my pref, loop):
(let ((aa ...)
(labels ((bb (cc dd ee)
(if (eql cc (hh dd))
(cons (ii dd) ee)
ee))
(gg (ff)
(if ff
(loop for l in (gg (cdr ff))
for cc in '(1 0 -1)
collecting (bb cc (car ff) l ))
(list nil nil nil))))
(gg aa)))
kenny
--
Slobodan Blazeski
(defun separate (lst)
(mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
(list #'plusp #'zerop #'minusp)))
Slobodan Blazeski
>
> - Show quoted text -
Not much of an improvement:
(defun separate (lst)
(iter (for el in (list #'plusp #'zerop #'minusp))
(collect (mapcar #'abs (remove-if-not el lst)))))
Two-liner would be great to see. I will try with series, maybe I could
improve it a bit.
Mark how does Qi syntax looks like for my (reverse) solution?
cheers
Slobodan
Ken Tilton
Traversing the list four times and a superfluous consing of the list?
I'd give you a "B", but in a competitve setting with other students
actually making an effort the curve would push this grade school hack
down a grade and the OP gets a "C". Next thing you know the kid flunks
out and comp.lang.lisp gets blamed and we have twenty years of HW Winter
for Lisp.
Juuuuuuussst peachy.
kt
Slobodan Blazeski
> Slobodan Blazeski wrote:
> > I didn't read your whole post but your test cases seems fine.
> > (defun separate (lst)
> > (mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
> > (list #'plusp #'zerop #'minusp)))
>
> Traversing the list four times and a superfluous consing of the list?
> I'd give you a "B", but in a competitve setting with other students
> actually making an effort the curve would push this grade school hack
> down a grade and the OP gets a "C". Next thing you know the kid flunks
> out and comp.lang.lisp gets blamed and we have twenty years of HW Winter
> for Lisp.
>
> Juuuuuuussst peachy.
>
> kt
>
> --http://www.theoryyalgebra.com/
I wonder how does an A grade solution looks like master ?
waiting humbly for an answer
Slobodan Blazeski
A typical computer session from 1974:
$ bio 8/19/1942
bio: not found
$/usr/local/games/bio
bio: not enough arguments
$man bio
man :no entry for bio in the manual.
$/usr/local/games/bio 8/19/1942
bio: not enough arguments
$/usr/local/games/bio 8 19 1942
bio: there are only 12 months in a year!!!
$/usr/local/games/bio 1942 8 19
bio: please enter a year between 1900 and 1979
$/usr/local/games/bio 42 8 19
x
x
x
x
^C
$
Ken Tilton
Slobodan Blazeski wrote:
> On Oct 21, 12:29 pm, Ken Tilton <kennytil...@optonline.net> wrote:
>
>>Slobodan Blazeski wrote:
>>
>>>I didn't read your whole post but your test cases seems fine.
>>>(defun separate (lst)
>>> (mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
>>> (list #'plusp #'zerop #'minusp)))
>>
>>Traversing the list four times and a superfluous consing of the list?
>>I'd give you a "B", but in a competitve setting with other students
>>actually making an effort the curve would push this grade school hack
>>down a grade and the OP gets a "C". Next thing you know the kid flunks
>>out and comp.lang.lisp gets blamed and we have twenty years of HW Winter
>>for Lisp.
>>
>>Juuuuuuussst peachy.
>>
>>kt
>>
>>--http://www.theoryyalgebra.com/
>
>
> I wonder how does an A grade solution looks like master ?
Since you called me that I'll tell you, but first yours (a fun solution,
btw, albeit inefficient):
(defconstant *cll* '(-2 0 -4 8 -6 35))
(defun slobby-sep (ct lst)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(loop repeat ct do
(mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
(list #'plusp #'zerop #'minusp))))
(time (slobby-sep 10000 *cll*))
; cpu time (non-gc) 62 msec user, 0 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 62 msec user, 0 msec system
; real time 63 msec
; space allocation:
; 210,002 cons cells, 0 other bytes, 0 static bytes
...and then Mine (I don't need no stinkin optimize):
(defun master-sep (ct ns)
(loop repeat ct do
(labels ((ptn(ns)
(bwhen (n (car ns))
(multiple-value-bind (p z m) (ptn(cdr ns))
(let ((s (signum n))
(a (abs n)))
(values
(if (= s 1) (cons a p) p)
(if (zerop s)(cons a z) z)
(if (= s -1)(cons a m) m)))))))
(multiple-value-list (ptn ns)))))
(time (master-sep 10000 *cll*))
; cpu time (non-gc) 15 msec user, 0 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 15 msec user, 0 msec system
; real time 16 msec
; space allocation:
; 90,002 cons cells, 0 other bytes, 0 static bytes
But I keep wondering if there is any way to leverage the bit in the spec
that guarantees there will be two values to partition.
kt
ps. When you get tired of typing the #' in front of (lambda...), just
stop. kt
Rob St. Amant
Not nearly as elegant, but in unobfuscated loop form:
(defun separate (list)
(loop for element in list
if (plusp element)
collect element into positives
else if (minusp element)
collect (abs element) into minuses
else collect element into zeroes
finally (return (list minuses zeroes positives))))
Ken Tilton
A beautiful transliteration from spec to Lisp, but I think it scores a
zero: "collect" works by side-effect, a violation of the HW rules.
kzo
--
namekuseijin
in Scheme:
; test
(define numbers '(-2 0 -4 8 -6 35))
(define (separate numbers)
(let loop ((ls numbers) (ps '()) (zs '()) (ns '()))
(if (null? ls) (list ps zs ns)
(let ((n (car ls)))
(cond
((zero? n) (loop (cdr ls) ps (cons n zs) ns))
((> 0 n) (loop (cdr ls) ps zs (cons n ns)))
(#t (loop (cdr ls) (cons n ps) zs ns)))))))
(separate numbers)
;=> ((35 8) (0) (-6 -4 -2))
; if order is important...
(map reverse (separate numbers))
;=> ((8 35) (0) (-2 -4 -6))
namekuseijin
namekuseijin
> > In Qi
>
> > (define seperate
> > Ns -> (s-help Ns [] [] []))
>
> > Pos Zero Neg are accumulators
>
> > (define s-help
> > [] Pos Zero Neg -> [Pos Zero Neg]
> > [P | Ns] Pos Zero Neg -> (s-help Ns [P | Pos] Zero Neg) where (> P
> > 0)
> > [0 | Ns] Pos Zero Neg -> (s-help Ns Pos [0 | Zero] Neg)
> > [N | Ns] Pos Zero Neg -> (s-help Ns Pos Zero [N | Neg]))
>
> Cells, and I wonder where is the F# answer?
Mark's Qi solution actually looks a lot like an F#/ML/Haskell solution
would look like, by defining a function in term of pattern-matched
arguments...
Bob Felts
Ok, I'll bite.
To run your code under SBCL on my Mac I had to:
1) Change the (bwhen (n (car ns)) to (bwhen n (car ns) ...
2) Include bwhen, bif, and with-unique-names from
http://www.galoot.org/~bill/code/utils.lisp.html
For a baseline comparison:
(time (master-sep 100000 *cll*))
Evaluation took:
0.048 seconds of real time
0.04664 seconds of user run time
9.73e-4 seconds of system run time
[Run times include 0.007 seconds GC run time.]
0 calls to %EVAL
0 page faults and
7,203,200 bytes consed.
-------------------------
Compare this with an accumulator based version:
(defun kruchinin (l)
(labels ((k-acc (l p z n)
(if (null l)
(list (nreverse p) (nreverse z) (nreverse n))
(let ((e (first l))
(r (rest l)))
(cond ((zerop e) (k-acc r p (cons e z) n))
((plusp e) (k-acc r (cons e p) z n))
(t (k-acc r p z (cons (abs e) n))))))))
(k-acc l nil nil nil)))
CL-USER> (time (dotimes (i 100000) (kruchinin *cll*)))
Evaluation took:
0.031 seconds of real time
0.029282 seconds of user run time
3.81e-4 seconds of system run time
[Run times include 0.006 seconds GC run time.]
0 calls to %EVAL
0 page faults and
7,194,784 bytes consed.
-------------------------
Mattias Nilsson's version (note: this returns the elements in the wrong
order: '(-2 -3) => (nil nil (2 3)); this version returns (nil nil (3
2))
(defun separate (list)
(let ((result (list nil nil nil)))
(dolist (n list result)
(push (abs n) (nth (- 1 (signum n)) result)))))
CL-USER> (time (dotimes (i 100000) (separate *cll*)))
Evaluation took:
0.058 seconds of real time
0.056407 seconds of user run time
8.21e-4 seconds of system run time
[Run times include 0.007 seconds GC run time.]
0 calls to %EVAL
0 page faults and
7,199,144 bytes consed.
-------------------------
Rob St. Amant's version: (has the positive and negative lists swapped):
(defun amant (list)
(loop for element in list
if (plusp element)
collect element into positives
else if (minusp element)
collect (abs element) into minuses
else collect element into zeroes
finally (return (list minuses zeroes positives))))
(time (dotimes (i 100000) (amant *cll*)))
Evaluation took:
0.031 seconds of real time
0.027443 seconds of user run time
0.001024 seconds of system run time
[Run times include 0.007 seconds GC run time.]
0 calls to %EVAL
0 page faults and
9,601,016 bytes consed.
Rob Warnock
+---------------
| Slobodan Blazeski wrote:
| > I didn't read your whole post but your test cases seems fine.
| > (defun separate (lst)
| > (mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
| > (list #'plusp #'zerop #'minusp)))
|
| Traversing the list four times and a superfluous consing of the list?
| I'd give you a "B", but in a competitve setting with other students
| actually making an effort the curve would push this grade school hack
| down a grade and the OP gets a "C". Next thing you know the kid flunks
| out and comp.lang.lisp gets blamed and we have twenty years of HW Winter
| for Lisp.
Yeah, Slobodan's version was so cute [albeit, as you note, horribly
inefficient] that I had to do a double-take before I could parse it.
So as long as we're offering homework solutions that won't be accepted
anyway [due to not using politically-correct recursive methods or
due to using "things we haven't covered yet"], why not have one
that's at least efficient and perspicuous *and* also incidentally
preserves the order of the input values? ;-}
(defun separate (list)
(loop for item in list
when (zerop item)
collect item into zeroes
else when (plusp item)
collect item into positives
else
collect (abs item) into negatives
finally (return (list positives zeroes negatives))))
-Rob
-----
Rob Warnock <rp...@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
Rob Warnock
+---------------
| ...why not have one that's at least efficient and perspicuous
| *and* also incidentally preserves the order of the input values? ;-}
| (defun separate (list)
+---------------
My apologies for not reading the *entire* thread tree
before replying, or I would have seen that Rob St. Amant
had beat me with this version by nearly six hours. (*sigh*)
Slobodan Blazeski
result in correct order.
Kenny's solution was uncompilable (*), LW 5 Windows so I changed it as
per Rob Warnocks tip.
Master Kenny please check is it genuine?
Ordered by LOC :
1.slobodan-blazeski 3
2.mattias-nilson 4
3.mark-tarver 6
4.rob-st-amant 8
5.dan-kruchinin 10
6.ken-tilton 11
By efficiency , average from three runs (***):
1.rob-st-amant 8 4.0086665
2.mark-tarver 6 4.6763334 (+ 16.65559%)
3.mattias-nilson 4 5.487 (+ 36.87844%)
4.slobodan-blazeski 3 7.337 (+ 83.02845%)
5.dan-kruchinin 10 9.049335 (+ 125.74425%)
6.ken-tilton 11 12.360667 (+ 208.3486%)
cheers
Slobodan Blazeski
(*)
(defun master-sep (ct ns)
(loop repeat ct do
(labels ((ptn(ns)
(bwhen (n (car ns))
(multiple-value-bind (p z m) (ptn(cdr ns))
(let ((s (signum n))
(a (abs n)))
(values
(if (= s 1) (cons a p) p)
(if (zerop s)(cons a z) z)
(if (= s -1)(cons a m) m)))))))
(multiple-value-list (ptn ns)))))
MASTER-SEP
PAIR-SPLIT 78 : 5 > (master-sep 10 *cll*)
Error: The value (N (CAR NS)) of ORG.GALOOT.UTILS::NAME is not of type
SYMBOL.
1 (continue) Supply a new value of ORG.GALOOT.UTILS::NAME.
2 (abort) Return to level 5.
3 Return to debug level 5.
4 Return to level 4.
5 Return to debug level 4.
6 Return to level 3.
7 Return to debug level 3.
8 Return to level 2.
9 Return to debug level 2.
10 Return to level 1.
11 Return to debug level 1.
12 Return to level 0.
13 Return to top loop level 0.
Type :b for backtrace, :c <option number> to proceed, or :? for other
options
PAIR-SPLIT 79 : 6 > :b
Call to FUNCALL
Interpreted call to PTN
Interpreted call to MASTER-SEP
Call to EVAL
Call to INVOKE-DEBUGGER
Call to INVOKE-DEBUGGER
Call to (METHOD EDITOR:STREAM-RUBOUT-HANDLER (EDITOR::RUBBER-STREAM T
T))
Call to EDITOR:RUBBER-READ-A-COMMAND
Call to INVOKE-DEBUGGER
Call to EVAL
Call to INVOKE-DEBUGGER
Call to EVAL
Call to INVOKE-DEBUGGER
Call to EVAL
Call to CAPI::CAPI-TOP-LEVEL-FUNCTION
Call to CAPI::INTERACTIVE-PANE-TOP-LOOP
Call to (HARLEQUIN-COMMON-LISP:SUBFUNCTION MP::PROCESS-SG-FUNCTION
MP::INITIALIZE-PROCESS-STACK)
(**) The final look of the functons tested
(defpackage pair-split
(:use :cl :org.galoot.utils))
(in-package pair-split)
(defconstant *cll* '(-2 0 -4 8 -6 35))
(defun slobodan-blazeski (lst)
(mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
(list #'plusp #'zerop #'minusp)))
(defun mattias-nilson (list)
(let ((result (list nil nil nil)))
(dolist (n list result)
(push (abs n) (nth (- 1 (signum n)) result)))))
(defun mark-tarver (Ns) (s-help Ns () () ()))
(defun s-help (Ns Pos Zero Neg)
(cond ((null Ns) (list Pos Zero Neg))
((> (car Ns) 0) (s-help (cdr Ns) (cons (abs (car Ns)) Pos)
Zero Neg))
((zerop (car Ns)) (s-help (cdr Ns) Pos (cons 0 Zero) Neg))
(t (s-help (cdr Ns) Pos Zero (cons (abs (car Ns)) Neg)))))
;;
(defun rob-st-amant (list)
(loop for element in list
if (plusp element)
collect element into positives
else if (minusp element)
collect (abs element) into minuses
else collect element into zeroes
finally (return (list positives zeroes minuses))))
(defun dan-kruchinin (l)
(labels ((k-acc (l p z n)
(if (null l)
(list (nreverse p) (nreverse z) (nreverse n))
(let ((e (first l))
(r (rest l)))
(cond ((zerop e) (k-acc r p (cons e z) n))
((plusp e) (k-acc r (cons e p) z n))
(t (k-acc r p z (cons (abs e) n))))))))
(k-acc l nil nil nil)))
(defun ken-tilton (ns)
(labels ((ptn(ns)
(bwhen n (car ns)
(multiple-value-bind (p z m) (ptn(cdr ns))
(let ((s (signum n))
(a (abs n)))
(values
(if (= s 1) (cons a p) p)
(if (zerop s)(cons a z) z)
(if (= s -1)(cons a m) m)))))))
(multiple-value-list (ptn ns))))
(***)
PAIR-SPLIT 8 : 1 > (time (dotimes (i 1000000) (dan-kruchinin
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (DAN-KRUCHININ *CLL*))
User time = 9.123
System time = 0.000
Elapsed time = 9.233
Allocation = 132011396 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 9 : 1 > (time (dotimes (i 1000000) (dan-kruchinin
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (DAN-KRUCHININ *CLL*))
User time = 9.093
System time = 0.000
Elapsed time = 9.403
Allocation = 132010996 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 10 : 1 > (time (dotimes (i 1000000) (dan-kruchinin
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (DAN-KRUCHININ *CLL*))
User time = 8.932
System time = 0.000
Elapsed time = 9.093
Allocation = 132011232 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 11 : 1 > (/ (+ 8.932 9.093 9.123) 3)
9.049335
PAIR-SPLIT 12 : 1 > (time (dotimes (i 1000000) (rob-st-amant
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (ROB-ST-AMANT *CLL*))
User time = 4.266
System time = 0.010
Elapsed time = 4.387
Allocation = 132011028 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 13 : 1 > (time (dotimes (i 1000000) (rob-st-amant
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (ROB-ST-AMANT *CLL*))
User time = 3.835
System time = 0.010
Elapsed time = 3.925
Allocation = 132008832 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 14 : 1 > (time (dotimes (i 1000000) (rob-st-amant
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (ROB-ST-AMANT *CLL*))
User time = 3.925
System time = 0.000
Elapsed time = 4.026
Allocation = 132008960 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 15 : 1 > (/ (+ 3.925 3.835 4.266) 3)
4.0086665
PAIR-SPLIT 16 : 1 > (time (dotimes (i 1000000) (mark-tarver
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MARK-TARVER *CLL*))
User time = 4.606
System time = 0.030
Elapsed time = 4.717
Allocation = 132009660 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 17 : 1 > (time (dotimes (i 1000000) (mark-tarver
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MARK-TARVER *CLL*))
User time = 5.117
System time = 0.000
Elapsed time = 5.198
Allocation = 132009528 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 18 : 1 > (time (dotimes (i 1000000) (mark-tarver
*cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MARK-TARVER *CLL*))
User time = 4.306
System time = 0.010
Elapsed time = 4.376
Allocation = 132009280 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 19 : 1 > (/ (+ 4.306 5.117 4.606) 3)
4.6763334
PAIR-SPLIT 20 : 1 > (time (dotimes (i 1000000) (mattias-
nilson *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MATTIAS-NILSON *CLL*))
User time = 5.497
System time = 0.000
Elapsed time = 5.588
Allocation = 132014112 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 21 : 1 > (time (dotimes (i 1000000) (mattias-
nilson *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MATTIAS-NILSON *CLL*))
User time = 5.457
System time = 0.000
Elapsed time = 5.568
Allocation = 132014316 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 22 : 1 > (time (dotimes (i 1000000) (mattias-
nilson *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MATTIAS-NILSON *CLL*))
User time = 5.507
System time = 0.000
Elapsed time = 5.628
Allocation = 132009812 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 23 : 1 > (/ (+ 5.507 5.457 5.497) 3)
5.487
PAIR-SPLIT 24 : 1 > (time (dotimes (i 1000000) (slobodan-
blazeski *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (SLOBODAN-BLAZESKI
*CLL*))
User time = 7.150
System time = 0.020
Elapsed time = 7.281
Allocation = 240010836 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 25 : 1 > (time (dotimes (i 1000000) (slobodan-
blazeski *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (SLOBODAN-BLAZESKI
*CLL*))
User time = 7.120
System time = 0.010
Elapsed time = 7.261
Allocation = 240010892 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 26 : 1 > (time (dotimes (i 1000000) (slobodan-
blazeski *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (SLOBODAN-BLAZESKI
*CLL*))
User time = 7.741
System time = 0.020
Elapsed time = 7.872
Allocation = 240011156 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 27 : 1 > (/ (+ 7.120 7.741 7.150) 3)
7.337
PAIR-SPLIT 3 > (time (dotimes (i 1000000) (ken-tilton *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (KEN-TILTON *CLL*))
User time = 12.127
System time = 0.000
Elapsed time = 12.318
Allocation = 132012628 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 4 > (time (dotimes (i 1000000) (ken-tilton *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (KEN-TILTON *CLL*))
User time = 12.297
System time = 0.010
Elapsed time = 12.608
Allocation = 132013860 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 5 > (time (dotimes (i 1000000) (ken-tilton *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (KEN-TILTON *CLL*))
User time = 12.658
System time = 0.020
Elapsed time = 12.959
Allocation = 132013540 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
PAIR-SPLIT 7 : 1 > (/ (+ 12.658 12.297 12.127) 3)
12.360667
Ken Tilton
That was mine until I remembered a requirement that the solution be
"side-effect safe", which I assume is a misreporting of the teacher's
requirement that it be "side-effect free".
Ken Tilton
Slobodan Blazeski wrote:
> My results , I tweaked a little rob-st-amant function to return the
> result in correct order.
> Kenny's solution was uncompilable (*), LW 5 Windows so I changed it as
> per Rob Warnocks tip.
> Master Kenny please check is it genuine?
Yeah, I just used my bwhen without thinking, surprised that and BIF did
not make it into the standard. But you used some other God's bwhen, not
the one from Cells, you might want to avoid thunderheads for a while.
Rob St. Amant
> Oops! I just wrote:
> +---------------
> | ...why not have one that's at least efficient and perspicuous
> | *and* also incidentally preserves the order of the input values? ;-}
> | (defun separate (list)
> | (loop for item in list ...
> +---------------
>
> My apologies for not reading the *entire* thread tree
> before replying, or I would have seen that Rob St. Amant
> had beat me with this version by nearly six hours. (*sigh*)
I'm pleased to find that we have similar intuitions about naming Lisp
variables. I was thinking, "What should these collections be called?"
Slobodan Blazeski
> Slobodan Blazeski wrote:
> > My results , I tweaked a little rob-st-amant function to return the
> > result in correct order.
> > Kenny's solution was uncompilable (*), LW 5 Windows so I changed it as
> > per Rob Warnocks tip.
> > Master Kenny please check is it genuine?
>
> Yeah, I just used my bwhen without thinking, surprised that and BIF did
> not make it into the standard. But you used some other God's bwhen, not
> the one from Cells, you might want to avoid thunderheads for a while.
>
> kt
>
>
> "Career highlights? I had two. I got an intentional walk
> from Sandy Koufax and I got out of a rundown against the Mets."."
> - Bob Uecker
I included cells so your definition is like you wrote it, with one
loop removed:
(defun master-sep (ns)
(labels ((ptn(ns)
(bwhen (n (car ns))
(multiple-value-bind (p z m) (ptn(cdr ns))
(let ((s (signum n))
(a (abs n)))
(values
(if (= s 1) (cons a p) p)
(if (zerop s)(cons a z) z)
(if (= s -1)(cons a m) m)))))))
(multiple-value-list (ptn ns))))
The result are like this (one run only):
1 mark-tarver 3.975
2.rob-st-amant 4.446
3. mattias-nilson 5.367
4 dan-kruchinin 10.094
5. ken-tilton 11.045
6. slobodan-blazeski 13.319
So my time is significantly slower now , I wonder why? But the rest
of the timings are about the same. BTW where's the frog when we need
him? He certainly could show us how to write it with 2 LOC and be it
faster than lisp solutions.
slobodan
(*)
CELLS 22 : 6 >
(time (dotimes (i 1000000)
(mark-tarver *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MARK-TARVER *CLL*))
User time = 3.975
System time = 0.020
Elapsed time = 4.035
Allocation = 132009732 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
CELLS 23 : 6 >
(time (dotimes (i 1000000)
(rob-st-amant *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (ROB-ST-AMANT *CLL*))
User time = 4.446
System time = 0.010
Elapsed time = 4.517
Allocation = 132015536 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
CELLS 25 : 6 >
(time (dotimes (i 1000000) (dan-kruchinin *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (DAN-KRUCHININ *CLL*))
User time = 10.094
System time = 0.050
Elapsed time = 13.099
Allocation = 132013808 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
CELLS 26 : 6 >
(time (dotimes (i 1000000) (mattias-nilson *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MATTIAS-NILSON *CLL*))
User time = 5.367
System time = 0.000
Elapsed time = 6.009
Allocation = 132010924 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
CELLS 27 : 6 >
(time (dotimes (i 1000000) (slobodan-blazeski *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (SLOBODAN-BLAZESKI
*CLL*))
User time = 13.319
System time = 0.000
Elapsed time = 13.880
Allocation = 240018400 bytes
0 Page faults
Calls to %EVAL 13000053
NIL
CELLS 28 : 6 >
(time (dotimes (i 1000000) (master-sep *cll*)))
Timing the evaluation of (DOTIMES (I 1000000) (MASTER-SEP *CLL*))
User time = 11.045
System time = 0.000
Elapsed time = 11.247
Allocation = 132012688 bytes
Ken Tilton
compiles? I was worried about the dotimes being outside the function.
What is the timing on the null case? And I was going to whine that you
did not show space as well as time, but aside from yours I see everyone
seems to think 132mb is a fine number.
kt
ps. the bwhen's are the only difference? Did you at least run the tests
a couple of times to see if the times are representative? One will
occasionally get an outlier for reasons known only to Lisp compiler geeks. k
--
Jed Davis
> But I keep wondering if there is any way to leverage the bit in the
> spec that guarantees there will be two values to partition.
"Yes."
(defmacro sepbuilder (fs es &rest as)
(if (null es) `(list ,@as)
(let* ((e (gensym))
(ps (nconc (mapcar (lambda (f) `(,f ,e)) fs) '(t)))
(as (if as as (make-list (length ps)))))
`(let ((,e ,(car es)))
(cond
,(loop for p in ps
for i from 0
for aes = (loop for a in as
for j from 0
collect (if (= i j) `(cons ,e ,a) a))
collect `(,p (sepbuilder ,fs ,(cdr es) ,@aes))))))))
(defun separate (l) (sepbuilder (plusp zerop) ((cadr l) (car l))))
The original plan was for a sepbuilderbuilder, but the nested
backquotes were making my head hurt, and it wasn't helping any that
(car ',x) is an error.
--
extern"C"void putchar(int);template<char a,class D>struct C{template<class K>
void z(K k){putchar(a);k.z(D());}};template<char a,class D>C<a,D>c(D){return
C<a,D>();}struct N{template<class K>void z(K){}}n;int main(){c<'J'>(c<'d'>(c<
'D'>(c<'v'>(c<'s'>(n))))).z(c<'e'>(c<'\040'>(c<'a'>(c<'i'>(c<'\n'>(23))))));}
Ken Tilton
> 4 dan-kruchinin 10.094
These two are as ugly as the OPs, so are no help since the RFP specified
prettier:
> 1 mark-tarver 3.975
> 5. ken-tilton 11.045
These two break the no-side-effect rule, so are no help:
> 2.rob-st-amant 4.446
> 3. mattias-nilson 5.367
You win!
> 6. slobodan-blazeski 13.319
But could you lose #' on the lambda? Makes you look like a rookie.
kt
Carl Taylor
"Dan Kruchinin" <just....@gmail.com> wrote in message
news:1192957644....@y27g2000pre.googlegroups.com...
> may be it's quite stupid question, but i don't know how to get more
> beautiful solution than i have.
The thread is getting long, but I don't think anyone has offered a recursive
solution.
The trick is to place the conses as args to the recursive calls.
Carl Taylor
CL-USER 1 >
(defun signum-separate (n-list &optional p z m)
(if (endp n-list)
(mapcar #'nreverse (list p z m))
(let ((numb (car n-list))
(rest (cdr n-list)))
(if (plusp numb)
(signum-separate rest (cons numb p) z m)
(if (minusp numb)
(signum-separate rest p z (cons (abs numb) m))
(signum-separate rest p (cons numb z) m))))))
SIGNUM-SEPARATE
CL-USER 2 >
(compile *)
SIGNUM-SEPARATE
NIL
NIL
CL-USER 3 >
(signum-separate '(3 0 -5 -1 86 29 0 0 -78 -3 3 1 0 -11 8 0 -61))
((3 86 29 3 1 8) (0 0 0 0 0) (5 1 78 3 11 61))
Bob Felts
> btw, the OPs was;
> > 4 dan-kruchinin 10.094
>
Actually, that's mine. I just used the name of the OP to name the
function. And I get completely different timing results than Slobodan.
> These two are as ugly as the OPs,
You callin' my baby ugly? It conses less than any of the other
solutions and is as fast as Rob's.
Slobodan Blazeski
> Although the timings --- ah, I get it, you are using a Lisp that always
> compiles? I was worried about the dotimes being outside the function.
> What is the timing on the null case? And I was going to whine that you
> did not show space as well as time, but aside from yours I see everyone
> seems to think 132mb is a fine number.
>
> kt
>
> ps. the bwhen's are the only difference? Did you at least run the tests
> a couple of times to see if the times are representative? One will
> occasionally get an outlier for reasons known only to Lisp compiler geeks. k
> --http://www.theoryyalgebra.com/
>
functions are compiled.
I run them for a three times in the first testing and calculated the
average, for the second testing I did I run them all of them for at
least two times, but beside mine, which showed significant slowdown
and your taht was completely rewritten the timings were close. So I
got lazy to calculate the and just shown one run for each definition.
Slobodan Blazeski
Jed Davis
> Ken Tilton <kenny...@optonline.net> writes:
>
>> But I keep wondering if there is any way to leverage the bit in the
>> spec that guarantees there will be two values to partition.
>
> "Yes."
Oh, but I forgot the abs, and made a trivial but horribly embarrassing
typo besides. Let's try that again:
(defmacro sepbuilder (fs xs es &rest as)
(if (null es) `(list ,@as)
(let* ((e (gensym))
(exs (mapcar (lambda (x) (if x `(,x ,e) e)) xs))
(ps (nconc (mapcar (lambda (f) `(,f ,e)) fs) '(t)))
(as (if as as (make-list (length ps)))))
`(let ((,e ,(car es)))
(cond
,@(loop for p in ps
for i from 0
for aes = (loop for a in as
for j from 0
for ex in exs
collect (if (= i j) `(cons ,ex ,a) a))
collect `(,p (sepbuilder ,fs ,xs ,(cdr es) ,@aes))))))))
(defun separate (l)
(sepbuilder (plusp zerop) (nil nil -) ((cadr l) (car l))))
--
(let ((C call-with-current-continuation)) (apply (lambda (x y) (x y)) (map
((lambda (r) ((C C) (lambda (s) (r (lambda l (apply (s s) l)))))) (lambda
(f) (lambda (l) (if (null? l) C (lambda (k) (display (car l)) ((f (cdr l))
(C k))))))) '((#\J #\d #\D #\v #\s) (#\e #\space #\a #\i #\newline)))))
Slobodan Blazeski
> btw, the OPs was;
> > 4 dan-kruchinin 10.094
>
> These two are as ugly as the OPs, so are no help since the RFP specified
> prettier:
>
> > 1 mark-tarver 3.975
> > 5. ken-tilton 11.045
>
> These two break the no-side-effect rule, so are no help:
>
> > 2.rob-st-amant 4.446
> > 3. mattias-nilson 5.367
>
> You win!
>
> > 6. slobodan-blazeski 13.319
>
> But could you lose #' on the lambda? Makes you look like a rookie.
>
> kt
>
>
> "Career highlights? I had two. I got an intentional walk
> from Sandy Koufax and I got out of a rundown against the Mets."."
> - Bob Uecker
Thanks for the good words but after repeating the tests with Allegro
8.1 Express (including the latest Carl Taylor solution) I started to
doubt my own measurements. The result differ so much that I don't
find sense in publishing them. Anyway It was great to see so many
different implementation and that even naive lisp solution isn't
lagging a magnitude(s). Side effects free doesn't have to mean slow as
per the last measurements Mark Tarver and Carl Taylor solutions score
in the top 3.
cheers
Slobodan Blazeski
Slobodan Blazeski
> Ken Tilton <kennytil...@optonline.net> wrote:
> > btw, the OPs was;
> > > 4 dan-kruchinin 10.094
>
> Actually, that's mine. I just used the name of the OP to name the
> function. And I get completely different timing results than Slobodan.
I'm sorry for not crediting you, assumed that's OP code. I remeasured
with ACL8.1 and timings were really different.
PAIR-SPLIT(12): (time (dotimes (i 1000000) (mark-tarver *cll*)))
; cpu time (non-gc) 10,245 msec user, 10 msec system
; cpu time (gc) 1,502 msec user, 0 msec system
; cpu time (total) 11,747 msec user, 10 msec system
; real time 12,037 msec
; space allocation:
; 17,000,148 cons cells, 1,264 other bytes, 0 static bytes
NIL
PAIR-SPLIT(18): (time (dotimes (i 1000000) (rob-st-amant *cll*)))
; cpu time (non-gc) 10,396 msec user, 40 msec system
; cpu time (gc) 1,761 msec user, 0 msec system
; cpu time (total) 12,157 msec user, 40 msec system
; real time 12,497 msec
; space allocation:
; 20,000,146 cons cells, 1,264 other bytes, 0 static bytes
NIL
PAIR-SPLIT(15): (time (dotimes (i 1000000) (bob-felts *cll*)))
; cpu time (non-gc) 11,879 msec user, 20 msec system
; cpu time (gc) 1,450 msec user, 10 msec system
; cpu time (total) 13,329 msec user, 30 msec system
; real time 13,650 msec
; space allocation:
; 17,000,162 cons cells, 1,264 other bytes, 0 static bytes
NIL
PAIR-SPLIT(5): (time (dotimes (i 1000000) (carl-taylor *cll*)))
; cpu time (non-gc) 12,378 msec user, 0 msec system
; cpu time (gc) 1,772 msec user, 0 msec system
; cpu time (total) 14,150 msec user, 0 msec system
; real time 14,531 msec
; space allocation:
; 20,000,172 cons cells, 1,264 other bytes, 0 static bytes
NIL
CELLS(31): (time (dotimes (i 1000000) (ken-tilton *cll*)))
; cpu time (non-gc) 13,288 msec user, 30 msec system
; cpu time (gc) 1,233 msec user, 0 msec system
; cpu time (total) 14,521 msec user, 30 msec system
; real time 14,851 msec
; space allocation:
; 17,000,174 cons cells, 1,296 other bytes, 0 static bytes
NIL
PAIR-SPLIT(20): (time (dotimes (i 1000000) (mattias-nilson *cll*)))
; cpu time (non-gc) 14,410 msec user, 20 msec system
; cpu time (gc) 1,472 msec user, 10 msec system
; cpu time (total) 15,882 msec user, 30 msec system
; real time 16,323 msec
; space allocation:
; 17,000,194 cons cells, 1,264 other bytes, 0 static bytes
NIL
PAIR-SPLIT(9): (time (dotimes (i 1000000) (slobodan-blazeski *cll*)))
; cpu time (non-gc) 17,443 msec user, 20 msec system
; cpu time (gc) 2,605 msec user, 0 msec system
; cpu time (total) 20,048 msec user, 20 msec system
; real time 20,429 msec
; space allocation:
; 29,000,238 cons cells, 1,264 other bytes, 0 static bytes
NIL
Ken Tilton
Carl Taylor wrote:
>
> "Dan Kruchinin" <just....@gmail.com> wrote in message
> news:1192957644....@y27g2000pre.googlegroups.com...
>
>> may be it's quite stupid question, but i don't know how to get more
>> beautiful solution than i have.
>
>
> The thread is getting long,
You seem to be unaware of The Headscarf Precedent.
:)
kt
--
Ken Tilton
Bob Felts wrote:
> Ken Tilton <kenny...@optonline.net> wrote:
>
>
>>btw, the OPs was;
>> > 4 dan-kruchinin 10.094
>>
>
>
> Actually, that's mine. I just used the name of the OP to name the
> function. And I get completely different timing results than Slobodan.
>
>
>>These two are as ugly as the OPs,
>
>
> You callin' my baby ugly? It conses less than any of the other
> solutions and is as fast as Rob's.
Two efficiency metrics as a defense against an aesthetics charge?
Thanks, that will keep me cheerful all week. :)
Ken Tilton
Slobodan Blazeski wrote:
> On Oct 22, 11:54 am, Ken Tilton <kennytil...@optonline.net> wrote:
>
>>Although the timings --- ah, I get it, you are using a Lisp that always
>>compiles? I was worried about the dotimes being outside the function.
>>What is the timing on the null case? And I was going to whine that you
>>did not show space as well as time, but aside from yours I see everyone
>>seems to think 132mb is a fine number.
>>
>>kt
>>
>>ps. the bwhen's are the only difference? Did you at least run the tests
>>a couple of times to see if the times are representative? One will
>>occasionally get an outlier for reasons known only to Lisp compiler geeks. k
>>--http://www.theoryyalgebra.com/
>>
>
> The dotimes are outside a function for every test,...
Doesn't matter if the dotimes-million runs interpreted when trying to
benchmark compiled functions.
kt
Ken Tilton
We can only hope this is the one that gets turned in.
:)
kenny
Rob St. Amant
> "Dan Kruchinin" <just....@gmail.com> wrote in message
> news:1192957644....@y27g2000pre.googlegroups.com...
>> may be it's quite stupid question, but i don't know how to get more
>> beautiful solution than i have.
>
> The thread is getting long, but I don't think anyone has offered a
> recursive solution.
> The trick is to place the conses as args to the recursive calls.
>
> Carl Taylor
>
>
> CL-USER 1 >
> (defun signum-separate (n-list &optional p z m)
> (if (endp n-list)
> (mapcar #'nreverse (list p z m))
> (let ((numb (car n-list))
> (rest (cdr n-list)))
> (if (plusp numb)
> (signum-separate rest (cons numb p) z m)
> (if (minusp numb)
> (signum-separate rest p z (cons (abs numb) m))
> (signum-separate rest p (cons numb z) m))))))
> SIGNUM-SEPARATE
Nice. I was going to post something very similar, but I resisted,
under the assumption that optional arguments are not valid
homeworkese.
Bob Felts
> Bob Felts wrote:
> > Ken Tilton <kenny...@optonline.net> wrote:
> >
> >
> >>btw, the OPs was;
> >> > 4 dan-kruchinin 10.094
> >>
> >
> >
> > Actually, that's mine. I just used the name of the OP to name the
> > function. And I get completely different timing results than Slobodan.
> >
> >
> >>These two are as ugly as the OPs,
> >
> >
> > You callin' my baby ugly? It conses less than any of the other
> > solutions and is as fast as Rob's.
>
> Two efficiency metrics as a defense against an aesthetics charge?
>
> Thanks, that will keep me cheerful all week. :)
>
Then my work is done.
My notions of Lisb beauty are still young and malleable so I'm
interested in why you think it's aesthetically challenged.
Ken Tilton
Stare at Mattias's until you achieve enlightenment, then report back
with your own answer (and I apologize for the redundancy (it won't be an
answer until it is your own)):
> (defun separate (list)
> (let ((result (list nil nil nil)))
> (dolist (n list result)
> (push (abs n) (nth (- 1 (signum n)) result)))))
hth,kt
Rob Warnock
...
| > ...why not have one that's at least efficient and perspicuous *and*
| > also incidentally preserves the order of the input values? ;-}
| > (defun separate (list)
| > (loop for item in list
| > when (zerop item)
| > collect item into zeroes
| > else when (plusp item)
| > collect item into positives
| > else
| > collect (abs item) into negatives
| > finally (return (list positives zeroes negatives))))
|
| That was mine until I remembered a requirement that the solution be
| "side-effect safe", which I assume is a misreporting of the teacher's
| requirement that it be "side-effect free".
I didn't read it that way, which is why I thought using LOOP...COLLECT
would be fine.
To me, "side-effect safe" meant that the *inputs* were to be safe
from side effects, not that no internal implementation of a CL builtin
had to be free of mutation under the hood. After all, with the
fabled "sufficiently smart compiler", it *is* possible to implement
LOOP...COLLECT by pushing onto the head of an internal anonymous
[or GENSYM'd] list and then making the collection variable be a
SYMBOL-MACROLET for (REVERSE #:Gnnn), yes? So the LOOP...COLLECT
version *might* be "side-effect free" [for whatever good that does],
but in any event the LOOP...COLLECT version is always at least
"side-effect safe".
Anyway, in the immortal workds of Colin Quinn,
"that's my story & I'm sticking to it..."[1]
-Rob
[1] Which <http://en.wikipedia.org/wiki/Colin_Quinn> says actually
came from the 1993 country song by Collin Raye, but who's quibbling?
Ken Tilton
Rob Warnock wrote:
> Ken Tilton <kent...@gmail.com> wrote:
> +---------------
> | Rob Warnock wrote:
> ...
> | > ...why not have one that's at least efficient and perspicuous *and*
> | > also incidentally preserves the order of the input values? ;-}
> | > (defun separate (list)
> | > (loop for item in list
> | > when (zerop item)
> | > collect item into zeroes
> | > else when (plusp item)
> | > collect item into positives
> | > else
> | > collect (abs item) into negatives
> | > finally (return (list positives zeroes negatives))))
> |
> | That was mine until I remembered a requirement that the solution be
> | "side-effect safe", which I assume is a misreporting of the teacher's
> | requirement that it be "side-effect free".
> +---------------
>
> I didn't read it that way, which is why I thought using LOOP...COLLECT
> would be fine.
>
> To me, "side-effect safe" meant that the *inputs* were to be safe
> from side effects,---
Are you trying to say "non-destructive"? :)
Your guess is as good as mine (literally!), we won't know until the OP
starts a "Lisp Sucks" blog blaming you setf-happy people for his
flunking out of school and ending up living under a bridge in Florida.
Hope yer happy!
:)
Leandro Rios
> "Carl Taylor" <carlt...@att.net> writes:
>>
>> CL-USER 1 >
>> (defun signum-separate (n-list &optional p z m)
>> (if (endp n-list)
>> (mapcar #'nreverse (list p z m))
>> (let ((numb (car n-list))
>> (rest (cdr n-list)))
>> (if (plusp numb)
>> (signum-separate rest (cons numb p) z m)
>> (if (minusp numb)
>> (signum-separate rest p z (cons (abs numb) m))
>> (signum-separate rest p (cons numb z) m))))))
>> SIGNUM-SEPARATE
>
> Nice. I was going to post something very similar, but I resisted,
> under the assumption that optional arguments are not valid
> homeworkese.
That's easy to fix:
(defun signum-separate (n-list)
(labels ((helper (n-list p z m)
(if (endp n-list)
(mapcar #'nreverse (list p z m))
(let ((numb (car n-list))
(rest (cdr n-list)))
(if (plusp numb)
(helper rest (cons numb p) z m)
(if (minusp numb)
(helper rest p z (cons (abs numb) m))
(helper rest p (cons numb z) m)))))))
(helper n-list nil nil nil)))
Leandro
Duane Rettig
> I remeasured with ACL8.1 and timings were really different.
> PAIR-SPLIT(12): (time (dotimes (i 1000000) (mark-tarver *cll*)))
That's because you are mostly measuring interpreted-loop time.
Put the loop into a test function, pass the loop count and the target
function (e.g. #'mark-tarver) in as arguments, and _compile_ the test
function. Or, use the Runtime Analyzer to show yourself what you are
really timing, if you don't believe me...
--
Duane Rettig du...@franz.com Franz Inc. http://www.franz.com/
555 12th St., Suite 1450 http://www.555citycenter.com/
Oakland, Ca. 94607 Phone: (510) 452-2000; Fax: (510) 452-0182
Slobodan Blazeski
Thanks Duane but this is far from LW and ACL comparasion, as there
are were more processes running in the background while doing ACL
tests.
Slobodan
Ken Tilton
Just when I was starting to think there was some hope for you. First a
God of Application Programming and then a God of Compiler Programming
try to help you and you just keep spouting non sequitors. "more
processes in the background"? Is the refrigerator also running?
We see again why in the Asian tradition students just STFU.
Not that you have any hope of understanding this, but for the thirtd
time: ACL uses a separate Lisp interpreter at the REPL and (I think) to
interactively evaluate forms while editing. Maybe you do not understand
that interpreters are slower than compiled code?
Interesting, the potential explanation of your cluelessness is expanding
the more you try.
hthbdi,kt
Duane Rettig
> On Oct 23, 8:04 am, Duane Rettig <du...@franz.com> wrote:
>> Slobodan Blazeski <slobodan.blaze...@gmail.com> writes:
>> > I remeasured with ACL8.1 and timings were really different.
>> > PAIR-SPLIT(12): (time (dotimes (i 1000000) (mark-tarver *cll*)))
>>
>> That's because you are mostly measuring interpreted-loop time.
>> Put the loop into a test function, pass the loop count and the target
>> function (e.g. #'mark-tarver) in as arguments, and _compile_ the test
>> function. Or, use the Runtime Analyzer to show yourself what you are
>> really timing, if you don't believe me...
> Thanks Duane but this is far from LW and ACL comparasion,
What does LW vs ACL have to do with this? I have given you general
advice on how to time functionality in CL. When you time an open
dotimes in a CL that has an interpreter and doesn't compile by
default, then you're _not_ _testing_ what you think you're testing.
If you run the same test in another lisp which also doesn't compile
its forms by default, you're _not_ _testing_ what you think you're
testing. That's true whether it's in Allegro CL or any other lisp
that doesn't compile by default. If you place the definition into a
test function and compile it, it removes the overhead of the
interpreter so that you can test what you think you're testing. And
if the CL you're running in does happen to automatically compile for
you, you've lost nothing, because you still have a compiled function
that you're calling and thus low overhead.
> as there
> are were more processes running in the background while doing ACL
> tests.
This further illustrates the point that you're _not_ _testing_ what
you think you're testing. However, since you've obviously not taken
my advice to actually _measure_ what you're testing, try it trivially,
e.g.:
(prof:with-profiling () (dotimes (i 1000000) (mark-tarver *cll*)))
(prof:show-flat-profile)
My guess is that regardless of what is going on in the background,
you'll see a lot of interpreter functionality and not as much
of #'mark-tarver - how do you then expect to accurately compare it
against any others, such as #'ken-tilton or #'rob-st-amant?
Slobodan Blazeski
Since the functions were compiled themselves I didn't expect such
overhead from interpreted dotimes loop anyway here's the correct
measurement.
CELLS(24):
(defun million-loops (fn)
(dotimes (i 1000000)
(funcall fn *cll*)))
MILLION-LOOPS
CELLS(25): (compile 'million-loops)
MILLION-LOOPS
NIL
NIL
CELLS(26): (compiled-function-p #'million-loops)
T
All the other functions are compiled, checked with compiled-function-
p, median from three runs,
CELLS(50): (time (million-loops #'rob-st-amant))
; cpu time (non-gc) 1,802 msec user, 0 msec system
; cpu time (gc) 1,163 msec user, 0 msec system
; cpu time (total) 2,965 msec user, 0 msec system
; real time 2,984 msec
; space allocation:
; 12,000,033 cons cells, 56 other bytes, 0 static bytes
NIL
CELLS(44): (time (million-loops #'mark-tarver))
; cpu time (non-gc) 1,832 msec user, 0 msec system
; cpu time (gc) 942 msec user, 0 msec system
; cpu time (total) 2,774 msec user, 0 msec system
; real time 2,814 msec
; space allocation:
; 9,000,032 cons cells, 56 other bytes, 0 static bytes
NIL
CELLS(36): (time (million-loops #'ken-tilton))
; cpu time (non-gc) 2,925 msec user, 20 msec system
; cpu time (gc) 890 msec user, 0 msec system
; cpu time (total) 3,815 msec user, 20 msec system
; real time 3,905 msec
; space allocation:
; 9,000,014 cons cells, 56 other bytes, 0 static bytes
NIL
CELLS(32): (time (million-loops #'slobodan-blazeski))
; cpu time (non-gc) 7,830 msec user, 50 msec system
; cpu time (gc) 2,054 msec user, 0 msec system
; cpu time (total) 9,884 msec user, 50 msec system
; real time 10,035 msec
; space allocation:
; 21,000,101 cons cells, 360 other bytes, 0 static bytes
NIL
cheers
Slobodan
Ken Tilton
Slobodan Blazeski wrote:
> Since the functions were compiled themselves I didn't expect such
> overhead from interpreted dotimes loop
Suppose you are asked to make a copy of a reference manual that comes in
a looseleaf binder, mounted in a big rack of binders, so what you do is
take the first page out, walk across the room to a table, sit down, and
retype it by hand on a manual typewriter with keys that keep getting
stuck and you do not know how to type anyway and your eyes are pretty
bad and the light is not so good.
The time walking back and forth across the room will not be a big
fraction of the overall timing, and if we were testing you against
someone else we would not worry if one of you used a cane and one a
skateboard.
If, however, we were trying to compare the speed of two photcopiers and
we even held the transport variable constant by using the same courier
to shuttle the pages back and forth, the variations in the speed of the
photocopiers would be lost in the noise.
hth,kt
Ken Tilton
Now if one of the copiers had a high-speed automatic sheetfeeder...
Thomas A. Russ
>
> What does LW vs ACL have to do with this? I have given you general
> advice on how to time functionality in CL. When you time an open
> dotimes in a CL that has an interpreter and doesn't compile by
> default, then you're _not_ _testing_ what you think you're testing.
> test function and compile it, it removes the overhead of the
> interpreter so that you can test what you think you're testing.
Since this seems to come up over and over again, I wonder if it would be
worthwhile to add some argument checking to the TIME macro that will
print some sort of warning/complaint/note if it gets invoked with
something other than a compiled function call?
I know this is contrary to the standard lisp anti-coddling policy, but
in this case it might be somewhat worthwhile.
--
Thomas A. Russ, USC/Information Sciences Institute
Duane Rettig
> Duane Rettig <du...@franz.com> writes:
>>
>> What does LW vs ACL have to do with this? I have given you general
>> advice on how to time functionality in CL. When you time an open
>> dotimes in a CL that has an interpreter and doesn't compile by
>> default, then you're _not_ _testing_ what you think you're testing.
>> ...If you place the definition into a
>> test function and compile it, it removes the overhead of the
>> interpreter so that you can test what you think you're testing.
>
> Since this seems to come up over and over again, I wonder if it would be
> worthwhile to add some argument checking to the TIME macro that will
> print some sort of warning/complaint/note if it gets invoked with
> something other than a compiled function call?
What if someone wants to measure the speed of the interpreter?
> I know this is contrary to the standard lisp anti-coddling policy, but
> in this case it might be somewhat worthwhile.
Not anti-coddling; it just means that all rope we provide makes
equally good nooses. Lisp is good for making lots of things with
rope, _including_ nooses. Once in a while I point out to someone that
he is making himself a noose. But if the rope were made to somehow
refuse to be formed into a noose, what good is it? It just means it's
not really a general purpose rope...
Kent M Pitman
> Since this seems to come up over and over again, I wonder if it would be
> worthwhile to add some argument checking to the TIME macro that will
> print some sort of warning/complaint/note if it gets invoked with
> something other than a compiled function call?
>
> I know this is contrary to the standard lisp anti-coddling policy, but
> in this case it might be somewhat worthwhile.
Adding args to system functions is hard for vendors.
But nothing keeps TIME from printing a warning and including in the warning
the name of an implementation-specific option variable you can set to muffle
the warning if you're a sophisticated user trying to do something useful
like measure the speed of the evaluator.
Rob Warnock
+---------------
| Since this seems to come up over and over again, I wonder if it would be
| worthwhile to add some argument checking to the TIME macro that will
| print some sort of warning/complaint/note if it gets invoked with
| something other than a compiled function call?
I'd rather not, since that prohibits typing simple examples at the
REPL. Rather, I think CMUCL [one of the CLs which does run stuff
in the REPL in an interpreter by default] does it the right way.
In CMUCL, TIME does automatically compile its arg:
cmu> (time (dotimes (i 2000000000)))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:
; Evaluation took:
; 1.83f0 seconds of real time
; 1.811377f0 seconds of user run time
; 0.002219f0 seconds of system run time
; 4,037,066,749 CPU cycles
; 0 page faults and
; 0 bytes consed.
;
NIL
cmu>
Aside: Yes, that's only 2 CPU cycles/iteration.
But TIME *doesn't* try to recursively compile *everything*,
so if you call an "outside" function, the top-level call is
compiled, yes, but the called function runs in whatever mode
it already was -- interpreted, byte-compiled, or native machine-
code compiled:
cmu> (defun foo () () (dotimes (i 1000000)))
FOO ; An interpreted function.
cmu> (time (foo))
; Compiling LAMBDA NIL: ; Only the call was compiled.
; Compiling Top-Level Form:
; [GC threshold exceeded with 13,261,344 bytes in use. Commencing GC.]
; [GC completed with 1,319,360 bytes retained and 11,941,984 bytes freed.]
; [GC will next occur when at least 13,319,360 bytes are in use.]
; [GC threshold exceeded with 13,328,184 bytes in use. Commencing GC.]
; [GC completed with 1,327,552 bytes retained and 12,000,632 bytes freed.]
; [GC will next occur when at least 13,327,552 bytes are in use.]
; [GC threshold exceeded with 13,337,016 bytes in use. Commencing GC.]
; [GC completed with 1,345,808 bytes retained and 11,991,208 bytes freed.]
; [GC will next occur when at least 13,345,808 bytes are in use.]
; [GC threshold exceeded with 13,351,176 bytes in use. Commencing GC.]
; [GC completed with 1,349,904 bytes retained and 12,001,272 bytes freed.]
; [GC will next occur when at least 13,349,904 bytes are in use.]
; Evaluation took:
; 3.09f0 seconds of real time
; 3.054258f0 seconds of user run time
; 0.0f0 seconds of system run time
; 6,832,567,756 CPU cycles
; [Run times include 0.07f0 seconds GC run time]
; 0 page faults and
; 48,010,608 bytes consed.
;
NIL
cmu>
So that's ~6800 CPU cycles/iteration when run interpreted.
But CMUCL also has a byte-code compiler [though it's not
used by default, since it optimizes size over speed]:
cmu> (let ((c::*byte-compile* t))
(compile 'foo))
; Byte Compiling LAMBDA NIL:
; Byte Compiling Top-Level Form:
FOO
NIL
NIL
cmu> (time (foo))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:
; Evaluation took:
; 0.36f0 seconds of real time
; 0.356608f0 seconds of user run time
; 1.3f-4 seconds of system run time
; 795,761,092 CPU cycles
; 0 page faults and
; 0 bytes consed.
;
NIL
cmu>
The byte-coded version runs at ~800 CPU cycles/iteration.
And we already know from above what we'll get from the next one...
[Note: CMUCL won't let you machine-compile a byte-code-compiled
function, so we have to redefine it first.]
cmu> (defun foo () () (dotimes (i 1000000)))
FOO
cmu> (compile *)
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:
FOO
NIL
NIL
cmu> (time (foo))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:
; Evaluation took:
; 0.0f0 seconds of real time
; 9.07f-4 seconds of user run time
; 6.f-6 seconds of system run time
; 2,010,596 CPU cycles
; 0 page faults and
; 0 bytes consed.
;
NIL
cmu>
Back to 2 CPU cycles/iteration, as with the open-coded
top-level call to TIME.
This is as it should be, IMHO. Simple REPL examples get compiled,
for convenience, but users still have a way to control what kind
of code is being timed if they want to.
-Rob
p.s. Another way to defeat the automatic compilation ny TIME
in CMUCL is to call TIME in a non-null lexical environment:
cmu> (let ((n 1000000))
(time (dotimes (i n))))
Warning: TIME form in a non-null environment, forced to interpret.
Compiling entire form will produce more accurate times.
; [GC threshold exceeded with 13,354,376 bytes in use. Commencing GC.]
; [GC completed with 1,458,880 bytes retained and 11,895,496 bytes freed.]
; [GC will next occur when at least 13,458,880 bytes are in use.]
; [GC threshold exceeded with 13,468,072 bytes in use. Commencing GC.]
; [GC completed with 1,464,848 bytes retained and 12,003,224 bytes freed.]
; [GC will next occur when at least 13,464,848 bytes are in use.]
; [GC threshold exceeded with 13,478,408 bytes in use. Commencing GC.]
; [GC completed with 1,474,912 bytes retained and 12,003,496 bytes freed.]
; [GC will next occur when at least 13,474,912 bytes are in use.]
; [GC threshold exceeded with 13,488,472 bytes in use. Commencing GC.]
; [GC completed with 1,484,976 bytes retained and 12,003,496 bytes freed.]
; [GC will next occur when at least 13,484,976 bytes are in use.]
; Evaluation took:
; 3.12f0 seconds of real time
; 3.081772f0 seconds of user run time
; 0.0f0 seconds of system run time
; 6,885,980,850 CPU cycles
; [Run times include 0.06f0 seconds GC run time]
; 0 page faults and
; 48,010,624 bytes consed.
;
NIL
cmu>
Rob Warnock
+---------------
| Rob Warnock wrote:
| > Ken Tilton <kent...@gmail.com> wrote:
| > +---------------
| > | "side-effect safe", which I assume is a misreporting of the teacher's
| > | requirement that it be "side-effect free".
| > +---------------
| >
| > I didn't read it that way, which is why I thought using LOOP...COLLECT
| > would be fine.
| > To me, "side-effect safe" meant that the *inputs* were to be safe
|
| Are you trying to say "non-destructive"? :)
Yeah, probably, as in "safe to pass quoted constants to".
+---------------
| Your guess is as good as mine (literally!), we won't know until the OP
| starts a "Lisp Sucks" blog blaming you setf-happy people for his
| flunking out of school and ending up living under a bridge in Florida.
+---------------
As I pointed out, one can't be *sure* that LOOP...COLLECT uses SETFs
under the hood in the student's CL implementation. It doesn't *have* to.
+---------------
| Hope yer happy!
+---------------
Happy, happy, joy, joy, John Spartan! May you have a tranquil day!
-Rob
Kamen TOMOV
> cmu> (time (dotimes (i 2000000000)))
> ; Compiling LAMBDA NIL:
> ; Compiling Top-Level Form:
>
> ; Evaluation took:
> ; 1.83f0 seconds of real time
> ; 1.811377f0 seconds of user run time
> ; 0.002219f0 seconds of system run time
> ; 4,037,066,749 CPU cycles
> ; 0 page faults and
> ; 0 bytes consed.
> ;
> NIL
> cmu>
>
> Aside: Yes, that's only 2 CPU cycles/iteration.
Does the runtime mean a CPU instruction when it says CPU cycle in the
context of instruction pipelines?
--
Камен
Rob Warnock
+---------------
No, it really means CPU pipeline clock cycles. On superscalar
machines such as an AMD Athlon/Opteron, one pipeline clock can
execute multiple instructions, and indeed, below is the code for
the inner loop of the DOTIMES that CMUCL generates for the above,
where those two cycles per iteration above comprise *four* instructions
[one of them a totally useless MOV, *bad* compiler!]:
cmu> (disassemble (compile nil (lambda () (dotimes (i 2000000000)))))
...
;;; [2] (DOTIMES (I 2000000000))
51: L0: INC EAX ; [:BLOCK-START]
52: L1: MOV ECX, EAX ; [:BLOCK-START]
54: CMP ECX, 2000000000
5A: JB L0
...
cmu>
Yes, I forgot to mention that I was running my examples on an
Athlon [a 2.2 GHz machine in the above case, as it happens].
Sorry 'bout that...
-Rob
Kamen TOMOV
Not necessarily bad. If the pipeline is 2 instructions per cycle
(although I doubt) then if 4 instructions are 2 cycles, how many
cycles would be 3 instructions?
While pipelining might increase the performance by factor of the
number of stages, in practise the compilator should "adjust" the
sequence so that piplining is applyable. So perhaps the compiler is
smart enough and the MOVE instruction is the "adjustment" ;-)
> cmu> (disassemble (compile nil (lambda () (dotimes (i 2000000000)))))
> ...
> ;;; [2] (DOTIMES (I 2000000000))
> 51: L0: INC EAX ; [:BLOCK-START]
> 52: L1: MOV ECX, EAX ; [:BLOCK-START]
> 54: CMP ECX, 2000000000
> 5A: JB L0
> ...
> cmu>
>
> Yes, I forgot to mention that I was running my examples on an
> Athlon [a 2.2 GHz machine in the above case, as it happens].
> Sorry 'bout that...
--
Камен
Raymond Toy (RT/EUS)
Rob> Kamen TOMOV <ka...@cybuild.com> wrote:
Rob> +---------------
Rob> | Rob Warnock wrote:
Rob> | > cmu> (time (dotimes (i 2000000000)))
Rob> | > ; Compiling LAMBDA NIL:
Rob> | > ; Compiling Top-Level Form:
Rob> | >
Rob> | > ; Evaluation took:
Rob> | > ; 1.83f0 seconds of real time
Rob> | > ; 1.811377f0 seconds of user run time
Rob> | > ; 0.002219f0 seconds of system run time
Rob> | > ; 4,037,066,749 CPU cycles
Rob> | > ; 0 page faults and
Rob> | > ; 0 bytes consed.
Rob> | > ;
Rob> | > NIL
Rob> | > cmu>
Rob> | >
Rob> | > Aside: Yes, that's only 2 CPU cycles/iteration.
Rob> |
Rob> | Does the runtime mean a CPU instruction when it says CPU cycle
Rob> | in the context of instruction pipelines?
Rob> +---------------
Rob> No, it really means CPU pipeline clock cycles. On superscalar
Rob> machines such as an AMD Athlon/Opteron, one pipeline clock can
Rob> execute multiple instructions, and indeed, below is the code for
Rob> the inner loop of the DOTIMES that CMUCL generates for the above,
Rob> where those two cycles per iteration above comprise *four* instructions
Rob> [one of them a totally useless MOV, *bad* compiler!]:
To be precise, CMUCL reads the clock/timer/whatever register on the
CPU and reports the difference in the clock/timer/whatever between the
start and end points.
For x86 and sparc, the timer register is clocked at the CPU clock
rate. For ppc, it's some multiple of the CPU clock, so the CPU cycles
displayed has to be computed.
Ray
Thomas A. Russ
> t...@sevak.isi.edu (Thomas A. Russ) writes:
> > Since this seems to come up over and over again, I wonder if it would be
> > worthwhile to add some argument checking to the TIME macro that will
> > print some sort of warning/complaint/note if it gets invoked with
> > something other than a compiled function call?
>
> What if someone wants to measure the speed of the interpreter?
Then they ignore the warning or note. I'm not suggesting that TIME
refuse to operate, just that it print something indicating that it is
interpreted code, rather than compiled code that is being timed.
namekuseijin
guys. And I thought they had better/higher level things to do...
Kamen TOMOV
> wow. Common Lispers are just as obsessed with performance as C++
> guys. And I thought they had better/higher level things to do...
If C++ guys were obsessed with performance as much as we are, they
wouldn't write in C++.
--
Камен
Juho Snellman
> Then they ignore the warning or note. I'm not suggesting that TIME
> refuse to operate, just that it print something indicating that it is
> interpreted code, rather than compiled code that is being timed.
In SBCL TIME prints the number of evaluations that were done by the
interpreter. That seems like a clear enough indication.
--
Juho Snellman
Ken Tilton
namekuseijin wrote:
> wow. Common Lispers are just as obsessed with performance as C++
> guys. And I thought they had better/higher level things to do...
>
Only after mastering The Cons. Until then one runs the risk of hosing
one's system with the most innocent snippets of code. Lisp make it easy
to write slow code, C++ makes it hard to write any code.
George Neuner
wrote:
All you can tell is how many clock cycles the code takes to finish,
the number of cycles any individual instructions takes is variable and
depends on the surrounding context. Most CPU manufacturers don't even
publish instruction timings any more because the context matters so
much.
>While pipelining might increase the performance by factor of the
>number of stages, in practise the compilator should "adjust" the
>sequence so that piplining is applyable. So perhaps the compiler is
>smart enough and the MOVE instruction is the "adjustment" ;-)
>
>> cmu> (disassemble (compile nil (lambda () (dotimes (i 2000000000)))))
>> ...
>> ;;; [2] (DOTIMES (I 2000000000))
>> 51: L0: INC EAX ; [:BLOCK-START]
>> 52: L1: MOV ECX, EAX ; [:BLOCK-START]
>> 54: CMP ECX, 2000000000
>> 5A: JB L0
>> ...
>> cmu>
>>
>> Yes, I forgot to mention that I was running my examples on an
>> Athlon [a 2.2 GHz machine in the above case, as it happens].
>> Sorry 'bout that...
George
--
for email reply remove "/" from address
WJ
>
>
> Slobodan Blazeski wrote:
> >On Oct 21, 12:29 pm, Ken Tilton <kennytil...@optonline.net> wrote:
> >
> > > Slobodan Blazeski wrote:
> > >
> > > > I didn't read your whole post but your test cases seems fine.
> > > > (defun separate (lst)
> >>> (mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
> >>> (list #'plusp #'zerop #'minusp)))
> > >
> > > Traversing the list four times and a superfluous consing of the
> > > list? I'd give you a "B", but in a competitve setting with other
> > > students actually making an effort the curve would push this
> > > grade school hack down a grade and the OP gets a "C". Next thing
> > > you know the kid flunks out and comp.lang.lisp gets blamed and we
> > > have twenty years of HW Winter for Lisp.
> > >
> > > Juuuuuuussst peachy.
> > >
> > > kt
> > >
> > > --http://www.theoryyalgebra.com/
> >
> >
> > I wonder how does an A grade solution looks like master ?
>
> Since you called me that I'll tell you, but first yours (a fun
> solution, btw, albeit inefficient):
>
> (defconstant cll '(-2 0 -4 8 -6 35))
>
> (defun slobby-sep (ct lst)
> (declare (optimize (speed 3) (safety 0) (debug 0)))
> (loop repeat ct do
> (mapcar #'(lambda (n) (mapcar #'abs (remove-if-not n lst)))
> (list #'plusp #'zerop #'minusp))))
>
> (time (slobby-sep 10000 cll))
> ; cpu time (non-gc) 62 msec user, 0 msec system
> ; cpu time (gc) 0 msec user, 0 msec system
> ; cpu time (total) 62 msec user, 0 msec system
> ; real time 63 msec
> ; space allocation:
> ; 210,002 cons cells, 0 other bytes, 0 static bytes
>
> ...and then Mine (I don't need no stinkin optimize):
>
> (defun master-sep (ct ns)
> (loop repeat ct do
> (labels ((ptn(ns)
> (bwhen (n (car ns))
> (multiple-value-bind (p z m) (ptn(cdr ns))
> (let ((s (signum n))
> (a (abs n)))
> (values
> (if (= s 1) (cons a p) p)
> (if (zerop s)(cons a z) z)
> (if (= s -1)(cons a m) m)))))))
> (multiple-value-list (ptn ns)))))
>
Guile:
(use-modules (srfi srfi-8)) ; receive (multiple values)
(define (sep lst)
(receive (neg rest) (span negative? (sort lst <))
(receive (zero pos) (span zero? rest)
(list (map abs neg) zero pos))))
==> ((6 4 2) (0) (8 35))
Clojure:
(defn sign [n] (cond (neg? n) -1 (pos? n) 1 :else 0))
(defn sep [lst]
(let [[a b c] (partition-by sign (sort lst))]
(list (map #(Math/abs %) a) b c)))
Ruby:
list = [-2, 0, -4, 8, -6, 35]
n,z,p = list.group_by{|n| n <=> 0}.values_at( -1, 0, 1 )
[ n.map(&:abs), z, p ]
==> [[2, 4, 6], [0], [8, 35]]
WJ
user=> (dotimes [n 8] (time (dotimes [_ 9999] (sep cll))))
"Elapsed time: 153.592426 msecs"
"Elapsed time: 54.826801 msecs"
"Elapsed time: 53.764934 msecs"
"Elapsed time: 51.181644 msecs"
"Elapsed time: 52.007727 msecs"
"Elapsed time: 52.998077 msecs"
"Elapsed time: 51.541746 msecs"
"Elapsed time: 52.487956 msecs"
nil
WJ
> (time (master-sep 10000 cll))
> ; cpu time (non-gc) 15 msec user, 0 msec system
> ; cpu time (gc) 0 msec user, 0 msec system
> ; cpu time (total) 15 msec user, 0 msec system
> ; real time 16 msec
Bigloo Scheme.
(module try
(option (set! *genericity* #f))
(library srfi1))
;; Requires SRFI1.
(define (sep lst)
(receive (neg rest) (span negative? (sort lst <))
(receive (zero pos) (span zero? rest)
(list (map abs neg) zero pos))))
For more accurate timing, I increased the iterations to
100_000. Running it 11 times yielded a low of 125 milliseconds
and a high of 203 milliseconds.
WJ
Let's do it in Scheme and demonstrate that grotesque and arabesque
facilities such as BWHEN, LOOP, and MULTIPLE-VALUE-BIND are not
needed.
Using Bigloo and compiling with -Obench:
(module try
(option (set! *genericity* #f)))
(define cll '(-2 0 -4 8 -6 35))
(define (sep2 lst)
(let recur ((lst lst) (n '()) (z '()) (p '()))
(if (null? lst) (list n z p)
(let ((i (car lst)))
(recur
(cdr lst)
(if (< i 0) (cons (abs i) n) n)
(if (= i 0) (cons i z) z)
(if (> i 0) (cons i p) p))))))
10_000 iterations take about 7.8 milliseconds.
WJ
> ; space allocation:
> ; 90,002 cons cells, 0 other bytes, 0 static bytes
>
Using Gambit Scheme:
(define cll '(-2 0 -4 8 -6 35))
(define (master-sep count lst)
(if (positive? count)
(begin
(let recur ((lst lst) (n '()) (z '()) (p '()))
(if (null? lst)
(list n z p)
(let ((i (car lst)))
(recur
(cdr lst)
(if (< i 0) (cons (abs i) n) n)
(if (= i 0) (cons i z) z)
(if (> i 0) (cons i p) p)))))
(master-sep (- count 1) lst))))
;; 10 times as many iterations.
(time (master-sep 100000 cll))
==>
94 ms real time
78 ms cpu time (78 user, 0 system)
131 collections accounting for 79 ms real time (47 user, 0 system)
21600000 bytes allocated
no minor faults
no major faults
This is on a laptop computer.
WJ
>
> But I keep wondering if there is any way to leverage the bit in the spec
> that guarantees there will be two values to partition.
You want partition?
Using Gambit Scheme:
;; requires SRFI-1 for "partition"
;; We don't need no stinkin' loops!
(define (separate lst)
(receive (neg other) (partition negative? lst)
(receive (zero pos) (partition zero? other)