Destructively moves the "best" element (according to the predicate
function passed in) to the front of a list. Feel free to improve the
code by using other functions, recursion, etc, but it must only visit
each element once. i.e. you can't just find the best and call (remove
best lst :test #'equal :count 1) and then cons best onto lst.
(defun nbest-to-front (lst pred)
(let ((best lst)
(par nil))
(do* ((prev lst (cdr prev))
(chk (cdr prev) (cdr prev)))
((endp chk))
(if (funcall pred (car chk) (car best))
(setq best chk par prev)))
(if par
(setf (cdr par) (cdr best)))
(setf lst (cons (car best) lst)))) ;; last line is redundant if
par = nil, but I'd like lst returned...
The alternative I thought of to that last line is:
(when par
(setf (cdr par) (cdr best))
(setf lst (cons (car best) lst)))
lst))
becase I'd like the list returned, and the latter uses more lines, I
stuck with the first.
On Dec 8, 8:29 pm, jrwats <······@gmail.com> wrote:
> i.e. you can't just find the best and call (remove
> best lst :test #'equal :count 1) and then cons best onto lst.
Why? That seems to be easiest way to do it.
easiest = most elegant.
On Dec 8, 5:44 pm, ··················@gmail.com wrote:
> On Dec 8, 8:29 pm, jrwats <······@gmail.com> wrote:
>
> > i.e. you can't just find the best and call (remove
> > best lst :test #'equal :count 1) and then cons best onto lst.
>
> Why? That seems to be easiest way to do it.
Maybe - I wasn't sure if there was a better method of doing this that
I wasn't seeing...
> easiest = most elegant.
I concur. Was also hoping for something a little more terse.
> (setf lst (cons (car best) lst))))
> ;; last line is redundant if par = nil, but I'd like lst returned...
Actually - this is buggy and will duplicate the front element if par
(parent) = nil
> The alternative I thought of to that last line is:
> (when par
> (setf (cdr par) (cdr best))
> (setf lst (cons (car best) lst)))
> lst))
>
Not an alternative - requirement...
From: Kenny
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <493dddba$0$20303$607ed4bc@cv.net>
jrwats wrote:
>> (setf lst (cons (car best) lst))))
>> ;; last line is redundant if par = nil, but I'd like lst returned...
>
>
> Actually - this is buggy and will duplicate the front element if par
> (parent) = nil
>
>
>>The alternative I thought of to that last line is:
>>(when par
>> (setf (cdr par) (cdr best))
>> (setf lst (cons (car best) lst)))
>> lst))
>>
>
>
> Not an alternative - requirement...
>
Can we use loop and rotatef? (hint)
kt
On Dec 8, 9:53 pm, Kenny <·········@gmail.com> wrote:
> jrwats wrote:
> >> (setf lst (cons (car best) lst))))
> >> ;; last line is redundant if par = nil, but I'd like lst returned...
>
> > Actually - this is buggy and will duplicate the front element if par
> > (parent) = nil
>
> >>The alternative I thought of to that last line is:
> >>(when par
> >> (setf (cdr par) (cdr best))
> >> (setf lst (cons (car best) lst)))
> >> lst))
>
> > Not an alternative - requirement...
>
> Can we use loop and rotatef? (hint)
>
> kt
Why would I do that?
(sort list pred)
And it gets all the others in the right order as a bonus!
>
> (sort list pred)
>
> And it gets all the others in the right order as a bonus!
For the rare case when you don't want the added cost of sorting
everything and want the "best in the front" :)
Now - why it's beneficial to destructively change the input list and
put the best in the front rather than simply returning the best
element... well that's a good question...
From: Kenny
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <493e0ce6$0$4879$607ed4bc@cv.net>
··················@gmail.com wrote:
> On Dec 8, 9:53 pm, Kenny <·········@gmail.com> wrote:
>
>>jrwats wrote:
>>
>>>> (setf lst (cons (car best) lst))))
>>>> ;; last line is redundant if par = nil, but I'd like lst returned...
>>
>>>Actually - this is buggy and will duplicate the front element if par
>>>(parent) = nil
>>
>>>>The alternative I thought of to that last line is:
>>>>(when par
>>>> (setf (cdr par) (cdr best))
>>>> (setf lst (cons (car best) lst)))
>>>> lst))
>>
>>>Not an alternative - requirement...
>>
>>Can we use loop and rotatef? (hint)
>>
>>kt
>
>
> Why would I do that?
Because you not know what rotatef is?
From: Kaz Kylheku
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <20081224105812.857@gmail.com>
On 2008-12-09, ··················@gmail.com <··················@gmail.com> wrote:
> On Dec 8, 9:53 pm, Kenny <·········@gmail.com> wrote:
>> jrwats wrote:
>> >> (setf lst (cons (car best) lst))))
>> >> ;; last line is redundant if par = nil, but I'd like lst returned...
>>
>> > Actually - this is buggy and will duplicate the front element if par
>> > (parent) = nil
>>
>> >>The alternative I thought of to that last line is:
>> >>(when par
>> >> (setf (cdr par) (cdr best))
>> >> (setf lst (cons (car best) lst)))
>> >> lst))
>>
>> > Not an alternative - requirement...
>>
>> Can we use loop and rotatef? (hint)
>>
>> kt
>
> Why would I do that?
>
> (sort list pred)
No cigar:
(setf list (sort list pred))
The identity of the first cons of the list may change under sort,
so you must always retain the return value in place of the original
list.
Sorting the list in a function like this is probably silly.
If you are going to extract the ``best'' item regularly, you will
probably maintain the list in sorted order. The efficient way to do that
is an ordered insert. A full sort will have to scan the whole list
once, even if it's optimized for the case when the list is nearly sorted.
By keeping the list in sorted order, you will get O(1) on extracting the best
value, but insertions are O(N). Still, in the average case the , this is a
constant factor better than inserting in random order and then having to walk
the entire list to find the best item, because insertion doesn't always have to
walk the entire list.
From: Thomas A. Russ
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <ymimyf5xmmh.fsf@blackcat.isi.edu>
Kaz Kylheku <········@gmail.com> writes:
> If you are going to extract the ``best'' item regularly, you will
> probably maintain the list in sorted order. The efficient way to do that
> is an ordered insert.
And there's even a fairly clever and simple use of built-in CL functions
to do an ordered insert, albeit destructively like sort:
(defun ordered-insert (item list predicate)
(merge 'list (list item) list predicate))
--
Thomas A. Russ, USC/Information Sciences Institute
>
> Can we use loop and rotatef? (hint)
>
> kt
Hmmm... a welcome hint:
(defun nmove-best-to-front2 (lst pred)
(loop for i on lst do
(if (funcall pred (car i) (car lst))
(rotatef (car lst) (car i)))))
I'll have to remember this rotatef voodoo...
However... it's still doing swapping on each best find. I'd imagine
it's markedly slower when using a list sorted reverse of the given
predicate (descending?). It doesn't change the runtime O(n), but ah
what the heck, slime is open, I'll run it now:
scratch that - way to slow...
CL-USER> (time (test-nmove-best-to-front2 1000000))
Evaluation took:
2.446 seconds of real time
2.424151 seconds of total run time (2.396150 user, 0.028001 system)
99.10% CPU
3,827,875,897 processor cycles
0 bytes consed
NIL
CL-USER> (time (test-nmove-best-to-front 1000000))
Evaluation took:
0.048 seconds of real time
0.040003 seconds of total run time (0.040003 user, 0.000000 system)
83.33% CPU
49,030,586 processor cycles
0 bytes consed
How about this:
(defun nmove-best-to-front3 (lst pred)
(let ((best (car lst))
(best-lst lst))
(loop for i on (cdr lst) do
(if (funcall pred (car i) best)
(setq best (car i) best-lst i)))
(rotatef (car lst) (car best-lst))))
CL-USER> (time (test-nmove-best-to-front3 1000000))
Evaluation took:
2.902 seconds of real time
2.876180 seconds of total run time (2.856178 user, 0.020002 system)
99.10% CPU
3,792,683,484 processor cycles
0 bytes consed
NIL
Hmm... that didn't help... what's going on?
On Dec 8, 9:33 pm, jrwats <······@gmail.com> wrote:
> > Can we use loop and rotatef? (hint)
>
> > kt
>
> Hmmm... a welcome hint:
>
> (defun nmove-best-to-front2 (lst pred)
> (loop for i on lst do
> (if (funcall pred (car i) (car lst))
> (rotatef (car lst) (car i)))))
>
> I'll have to remember this rotatef voodoo...
>
> However... it's still doing swapping on each best find. I'd imagine
> it's markedly slower when using a list sorted reverse of the given
> predicate (descending?). It doesn't change the runtime O(n), but ah
> what the heck, slime is open, I'll run it now:
>
> scratch that - way to slow...
>
> CL-USER> (time (test-nmove-best-to-front2 1000000))
> Evaluation took:
> 2.446 seconds of real time
> 2.424151 seconds of total run time (2.396150 user, 0.028001 system)
> 99.10% CPU
> 3,827,875,897 processor cycles
> 0 bytes consed
> NIL
> CL-USER> (time (test-nmove-best-to-front 1000000))
> Evaluation took:
> 0.048 seconds of real time
> 0.040003 seconds of total run time (0.040003 user, 0.000000 system)
> 83.33% CPU
> 49,030,586 processor cycles
> 0 bytes consed
>
> How about this:
>
> (defun nmove-best-to-front3 (lst pred)
> (let ((best (car lst))
> (best-lst lst))
> (loop for i on (cdr lst) do
> (if (funcall pred (car i) best)
> (setq best (car i) best-lst i)))
> (rotatef (car lst) (car best-lst))))
>
> CL-USER> (time (test-nmove-best-to-front3 1000000))
> Evaluation took:
> 2.902 seconds of real time
> 2.876180 seconds of total run time (2.856178 user, 0.020002 system)
> 99.10% CPU
> 3,792,683,484 processor cycles
> 0 bytes consed
> NIL
>
> Hmm... that didn't help... what's going on?
OK - one more post. To recap:
(defun nmove-best-to-front (lst pred)
(let ((best lst)
(parent nil))
(do* ((prev lst (cdr prev))
(cur (cdr prev) (cdr prev)))
((endp cur))
(if (funcall pred (car cur) (car best))
(setf best cur parent prev)))
(when parent
(setf (cdr parent) (cdr best))
(setf lst (cons (car best) lst)))
lst))
(defun nmove-best-to-front2 (lst pred)
(loop for i on (cdr lst) do
(if (funcall pred (car i) (car lst))
(rotatef (car lst) (car i)))))
(defun nmove-best-to-front3 (lst pred)
(let ((best (car lst))
(best-lst lst))
(loop for i on (cdr lst) do
(if (funcall pred (car i) best)
(setq best (car i) best-lst i)))
(rotatef (car lst) (car best-lst))))
(defun test-nmove-best-to-front3 (n)
(dotimes (i n)
(let ((lst '(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33
32 31 30 29 28 27
26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
(nmove-best-to-front3 lst #'<))))
(defun test-nmove-best-to-front2 (n)
(dotimes (i n)
(let ((lst '(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33
32 31 30 29 28 27
26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
(nmove-best-to-front2 lst #'<))))
(defun test-nmove-best-to-front (n)
(dotimes (i n)
(let ((lst '(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33
32 31 30 29 28 27
26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
(nmove-best-to-front lst #'<))))
The last post didn't make any sense and I re-tested again (after
making sure EVERYTHING was compiled). Luckily the universe makes
sense again and rotatef isn't too expensive (even when run all all the
elements of the list
CL-USER> (time (test-nmove-best-to-front3 100000000))
Evaluation took:
2.583 seconds of real time
2.560160 seconds of total run time (2.540159 user, 0.020001 system)
99.11% CPU
4,386,136,174 processor cycles
8,720 bytes consed
NIL
CL-USER> (time (test-nmove-best-to-front2 100000000))
Evaluation took:
2.663 seconds of real time
2.640165 seconds of total run time (2.624164 user, 0.016001 system)
99.14% CPU
3,986,463,619 processor cycles
0 bytes consed
NIL
CL-USER> (time (test-nmove-best-to-front 100000000))
Evaluation took:
2.984 seconds of real time
2.964185 seconds of total run time (2.948184 user, 0.016001 system)
99.33% CPU
4,185,056,895 processor cycles
0 bytes consed
> a) you are NOT allowed to destructively modify literal data. das ist
> verboten! fingerkloppen!
blinkenlights? SBCL only gave me warnings and then did what I told it
to do. I laugh in the face of danger!
> b) Common Lisp has FIRST, SECOND, THIRD, ... and REST
all of those have at least 1 character extra to type! Some even 3!
That's at least 1/2 a second of typing.
> c) You can name a variable LIST. No need to write LST, LS, or L. Try
> to use real variable names.
OK - I concede
> No need to encrypt or compress your code.
What? Oh I'm assuming this is in reference to car rather than first
and lst as opposed to list. I blame lst on reading one of these
ancient books I have that used the naming convention. I blame car
on... McCarthy... and communists.
Using iterate:
(in-package :iterate) ; it is likely you'll have symbol clashes if you
use-package;
; btw, use http://sourceforge.net/projects/iteratekeywords/
(defun test-best-to-front (n best-to-front)
(dotimes (i n)
(let ((lst (list 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35
34 33
32 31 30 29 28 27
26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
(funcall best-to-front lst #'<))))
(defun nbest-to-front-4 (lst pred)
(iter (for i in lst)
(for o on lst) (:for maybe-cut-point previous o initially nil)
(with best-i = (car lst)) (:with cut-point = nil)
(unless (first-time-p)
(when (funcall pred best-i i)
(setf best-i i cut-point maybe-cut-point)))
(finally
(return
(cond ((null cut-point) lst) ((eq cut-point lst) lst)
(t (let ((new-lst (cdr cut-point))) (shiftf (cdr cut-point)
(cdr new-l) lst)))
)))
))
(compile 'nbest-to-front-4)
(defun nbest-to-front-5 (lst pred) (loop with best = lst
for cm on (cdr lst)
when (funcall pred (car cm) (car best))
do (setf best cm)
finally (rotatef (car lst) (car best))))
(compile 'nbest-to-front-5)
ITER> (time (test-best-to-front 1000000 'nbest-to-front-4))
Evaluation took:
5.239 seconds of real time
5.212325 seconds of total run time (5.124320 user, 0.088005 system)
[ Run times consist of 0.196 seconds GC time, and 5.017 seconds non-
GC time. ]
99.48% CPU
7,833,665,384 processor cycles
400,698,840 bytes consed
NIL
ITER> (time (test-best-to-front 1000000 'nbest-to-front-5))
Evaluation took:
5.164 seconds of real time
5.152323 seconds of total run time (5.048316 user, 0.104007 system)
[ Run times consist of 0.224 seconds GC time, and 4.929 seconds non-
GC time. ]
99.77% CPU
7,720,695,931 processor cycles
400,698,904 bytes consed
Note that last Kenny's function don't keep the order of other
elements. Maybe it is right...
You see, speed is comparable. I agree my version is not elegant at
all. It would be no worse than Kenny's if
On Dec 9, 12:28 pm, budden <········@gmail.com> wrote:
> ITER> (time (test-best-to-front 1000000 'nbest-to-front-4))
> ITER> (time (test-best-to-front 1000000 'nbest-to-front-5))
It is not really useful to time these functions if you are interested
in the performance of the best-to-front functions.
Ariel
On Dec 9, 1:12 pm, ··················@gmail.com wrote:
> Because I think recursion is elegant
> -----------------------
> (defun recursive-best-to-front (list function)
> (let ((first nil)
> (best nil)
> (car (car list))
> (cdr (cdr list)))
> (setf best car)
> (setf first nil)
> (labels
> ((nthToFront-1 (list function)
> (let ((car (car list))
> (cdr (cdr list)))
> (when car
> (when (funcall function car best)
> (setf best car))
> (setf cdr (nthToFront-1 cdr function))
> (if (eq car best)
> (progn
> (setf first best)
> (setf best nil)
> cdr)
> (cons car cdr))
> ))))
> (setf cdr (nthToFront-1 cdr function))
> (cons first (cons car cdr)))))
> ---------------------
> Haven't bothered to benchmark against anything.
> Probably pretty terrible.
Ah, needs a (setf list (cons first (cons car cdr))))))
at the end there to be properly destructive, my bad.
From: Kenny
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <493ebf38$0$14305$607ed4bc@cv.net>
··················@gmail.com wrote:
> On Dec 9, 1:12 pm, ··················@gmail.com wrote:
>
>>Because I think recursion is elegant
>>-----------------------
>>(defun recursive-best-to-front (list function)
>> (let ((first nil)
>> (best nil)
>> (car (car list))
>> (cdr (cdr list)))
>> (setf best car)
>> (setf first nil)
>> (labels
>> ((nthToFront-1 (list function)
>> (let ((car (car list))
>> (cdr (cdr list)))
>> (when car
>> (when (funcall function car best)
>> (setf best car))
>> (setf cdr (nthToFront-1 cdr function))
>> (if (eq car best)
>> (progn
>> (setf first best)
>> (setf best nil)
>> cdr)
>> (cons car cdr))
>> ))))
>> (setf cdr (nthToFront-1 cdr function))
>> (cons first (cons car cdr)))))
>>---------------------
>>Haven't bothered to benchmark against anything.
>>Probably pretty terrible.
>
>
> Ah, needs a (setf list (cons first (cons car cdr))))))
> at the end there to be properly destructive, my bad.
And what, prithee, have you destroyed with that final proper crushing blow?
kxo
On Dec 9, 1:55 pm, Kenny <·········@gmail.com> wrote:
> ··················@gmail.com wrote:
> > On Dec 9, 1:12 pm, ··················@gmail.com wrote:
>
> >>Because I think recursion is elegant
> >>-----------------------
> >>(defun recursive-best-to-front (list function)
> >> (let ((first nil)
> >> (best nil)
> >> (car (car list))
> >> (cdr (cdr list)))
> >> (setf best car)
> >> (setf first nil)
> >> (labels
> >> ((nthToFront-1 (list function)
> >> (let ((car (car list))
> >> (cdr (cdr list)))
> >> (when car
> >> (when (funcall function car best)
> >> (setf best car))
> >> (setf cdr (nthToFront-1 cdr function))
> >> (if (eq car best)
> >> (progn
> >> (setf first best)
> >> (setf best nil)
> >> cdr)
> >> (cons car cdr))
> >> ))))
> >> (setf cdr (nthToFront-1 cdr function))
> >> (cons first (cons car cdr)))))
> >>---------------------
> >>Haven't bothered to benchmark against anything.
> >>Probably pretty terrible.
>
> > Ah, needs a (setf list (cons first (cons car cdr))))))
> > at the end there to be properly destructive, my bad.
>
> And what, prithee, have you destroyed with that final proper crushing blow?
>
> kxo
thought it would be funnier than it was
BTW, here is a useful abstraction of "returning the best value in
iteration". It can be used separatedly. This is a (completely non-
tested) implementation of iterate clause for that:
http://paste.lisp.org/display/71851#1
And the function would change to:
;;; iterate-keywords loaded
(defun nbest-to-front-7 (lst pred)
(iter:iter (:for place :on lst)
(:for elt :in lst)
(:finding place :yielding-best-of elt :by pred :into best)
(:finally
(rotatef (car lst) (car best))))
lst)
----------
4$/hour lisp freelancer. Hire me!
On Dec 9, 12:45 am, budden <········@gmail.com> wrote:
> CL-USER> (nbest-to-front (list 1 2 3 2 1) #'<)
> (1 1 2 3 2 1)
> ???
yeah see my (2nd?) post:
(if par ;; remove best
(setf (cdr par) (cdr best)))
(setf lst (cons (car best) lst))))
should be
(when par ;; remove best
(setf (cdr par) (cdr best))
(setf lst (cons (car best) lst)))
lst)
From: Thomas A. Russ
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <ymiiqptxmjb.fsf@blackcat.isi.edu>
jrwats <······@gmail.com> writes:
> > a) you are NOT allowed to destructively modify literal data. das ist
> > verboten! fingerkloppen!
> blinkenlights? SBCL only gave me warnings and then did what I told it
> to do. I laugh in the face of danger!
blinkenlights is okay. Its the spitzensparken you need to watch out
for. And modifying literal data gets into that realm.
--
Thomas A. Russ, USC/Information Sciences Institute
From: Kenny
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <493e16cf$0$4903$607ed4bc@cv.net>
jrwats wrote:
> On Dec 8, 9:33 pm, jrwats <······@gmail.com> wrote:
>
>>>Can we use loop and rotatef? (hint)
>>
>>>kt
>>
>>Hmmm... a welcome hint:
>>
>>(defun nmove-best-to-front2 (lst pred)
>> (loop for i on lst do
>> (if (funcall pred (car i) (car lst))
>> (rotatef (car lst) (car i)))))
>>
>>I'll have to remember this rotatef voodoo...
>>
>>However... it's still doing swapping on each best find.
No, I was not suggesting that, i was just suggesting rotatef to clean up
the final exchange and loop to clean up the do-doo.
> I'd imagine
>>it's markedly slower when using a list sorted reverse of the given
>>predicate (descending?). It doesn't change the runtime O(n), but ah
>>what the heck, slime is open, I'll run it now:
>>
>>scratch that - way to slow...
>>
>>CL-USER> (time (test-nmove-best-to-front2 1000000))
>>Evaluation took:
>> 2.446 seconds of real time
>> 2.424151 seconds of total run time (2.396150 user, 0.028001 system)
>> 99.10% CPU
>> 3,827,875,897 processor cycles
>> 0 bytes consed
>>NIL
>>CL-USER> (time (test-nmove-best-to-front 1000000))
>>Evaluation took:
>> 0.048 seconds of real time
>> 0.040003 seconds of total run time (0.040003 user, 0.000000 system)
>> 83.33% CPU
>> 49,030,586 processor cycles
>> 0 bytes consed
>>
>>How about this:
>>
>>(defun nmove-best-to-front3 (lst pred)
>> (let ((best (car lst))
>> (best-lst lst))
>> (loop for i on (cdr lst) do
>> (if (funcall pred (car i) best)
>> (setq best (car i) best-lst i)))
>> (rotatef (car lst) (car best-lst))))
>>
>>CL-USER> (time (test-nmove-best-to-front3 1000000))
>>Evaluation took:
>> 2.902 seconds of real time
>> 2.876180 seconds of total run time (2.856178 user, 0.020002 system)
>> 99.10% CPU
>> 3,792,683,484 processor cycles
>> 0 bytes consed
>>NIL
>>
>>Hmm... that didn't help... what's going on?
I don't know but you have managed to get almost two orders magnitude
difference out of equivalent code, I'd head for Vegas.
>
>
> OK - one more post. To recap:
>
> (defun nmove-best-to-front (lst pred)
> (let ((best lst)
> (parent nil))
> (do* ((prev lst (cdr prev))
> (cur (cdr prev) (cdr prev)))
> ((endp cur))
> (if (funcall pred (car cur) (car best))
> (setf best cur parent prev)))
> (when parent
> (setf (cdr parent) (cdr best))
> (setf lst (cons (car best) lst)))
> lst))
>
>
> (defun nmove-best-to-front2 (lst pred)
> (loop for i on (cdr lst) do
> (if (funcall pred (car i) (car lst))
> (rotatef (car lst) (car i)))))
>
> (defun nmove-best-to-front3 (lst pred)
> (let ((best (car lst))
> (best-lst lst))
> (loop for i on (cdr lst) do
> (if (funcall pred (car i) best)
> (setq best (car i) best-lst i)))
> (rotatef (car lst) (car best-lst))))
Ewwww! with? finally? Helllooooooo? And is your car really so slow?
Remember, car is a machine language opcode so it should be faster than
an extra setf which is a CLOS <spit> generic function and goes through
method combination*.
OTKB:
(loop with best = lst
for cm on (cdr lst)
when (funcall pred (car cm) (car best))
do (setf best cm)
finally (rotatef (car lst) (car best)))
hth,kt
* kiddinnnnnggggggg!
>
> Can we use loop and rotatef? (hint)
>
> kt
Hmmm... a welcome hint:
(defun nmove-best-to-front2 (lst pred)
(loop for i on lst do
(if (funcall pred (car i) (car lst))
(rotatef (car lst) (car i)))))
I'll have to remember this rotatef voodoo...
However... it's still doing swapping on each best find. I'd imagine
it's markedly slower when using a list sorted reverse of the given
predicate (descending?). It doesn't change the runtime O(n), but ah
what the heck, slime is open, I'll run it now:
scratch that - way to slow...
CL-USER> (time (test-nmove-best-to-front2 1000000))
Evaluation took:
2.446 seconds of real time
2.424151 seconds of total run time (2.396150 user, 0.028001 system)
99.10% CPU
3,827,875,897 processor cycles
0 bytes consed
NIL
CL-USER> (time (test-nmove-best-to-front 1000000))
Evaluation took:
0.048 seconds of real time
0.040003 seconds of total run time (0.040003 user, 0.000000 system)
83.33% CPU
49,030,586 processor cycles
0 bytes consed
How about this:
(defun nmove-best-to-front3 (lst pred)
(let ((best (car lst))
(best-lst lst))
(loop for i on (cdr lst) do
(if (funcall pred (car i) best)
(setq best (car i) best-lst i)))
(rotatef (car lst) (car best-lst))))
CL-USER> (time (test-nmove-best-to-front3 1000000))
Evaluation took:
2.902 seconds of real time
2.876180 seconds of total run time (2.856178 user, 0.020002 system)
99.10% CPU
3,792,683,484 processor cycles
0 bytes consed
NIL
Hmm... that didn't help... what's going on?
On Dec 9, 3:29 am, jrwats <······@gmail.com> wrote:
> Destructively moves the "best" element (according to the predicate
> function passed in) to the front of a list. Feel free to improve the
> code by using other functions, recursion, etc, but it must only visit
> each element once. i.e. you can't just find the best and call (remove
> best lst :test #'equal :count 1) and then cons best onto lst.
>
Kenny Tilton posted a code snippet that is close to what I would
write, but were I to take your approach (replacing conses) and style
(Graham), I would first write a utility function, MAPL2, that is
similar to MAPL, but also passes the predecessor sublist (or NIL if
there isn't one).
Ariel
On Dec 9, 2:23 am, Ariel Badichi <····@tidexsystems.com> wrote:
> On Dec 9, 3:29 am,jrwats<······@gmail.com> wrote:
>
> > Destructively moves the "best" element (according to the predicate
> > function passed in) to the front of a list. Feel free to improve the
> > code by using other functions, recursion, etc, but it must only visit
> > each element once. i.e. you can't just find the best and call (remove
> > best lst :test #'equal :count 1) and then cons best onto lst.
>
> Kenny Tilton posted a code snippet that is close to what I would
> write, but were I to take your approach (replacing conses) and style
> (Graham), I would first write a utility function, MAPL2, that is
> similar to MAPL, but also passes the predecessor sublist (or NIL if
> there isn't one).
>
> Ariel
Was the following what you were considering?
(defun mapl2 (func list)
(funcall func list nil)
(loop for sublist on list
unless (endp (cdr sublist)) do
(funcall func (cdr sublist) sublist)))
defun nmove-best-to-front3 (list func)
(let ((best (car list)) parent-list)
(mapl2 (lambda (sublist parent)
(if (funcall func (car sublist) best)
(setf parent-list parent best (car sublist))))
list)
(when parent-list
(setf list (cons best list))
(setf (cdr parent-list) (cddr parent-list)))
list))
On Dec 10, 4:57 pm, jrwats <······@gmail.com> wrote:
> On Dec 9, 2:23 am, Ariel Badichi <····@tidexsystems.com> wrote:
>
> > Kenny Tilton posted a code snippet that is close to what I would
> > write, but were I to take your approach (replacing conses) and style
> > (Graham), I would first write a utility function, MAPL2, that is
> > similar to MAPL, but also passes the predecessor sublist (or NIL if
> > there isn't one).
>
> Was the following what you were considering?
>
Not quite.
> (defun mapl2 (func list)
> (funcall func list nil)
> (loop for sublist on list
> unless (endp (cdr sublist)) do
> (funcall func (cdr sublist) sublist)))
>
This function has strange semantics. Unlike MAPL, it calls the
supplied function even when the empty list is supplied. It's also
unlike MAPL in that it doesn't return the list supplied. Here is what
I had in mind:
(defun mapl2 (function list)
(loop for sublist on list
and previous = nil then sublist
do (funcall function sublist previous))
list)
or
(defun mapl2 (function list)
(labels ((rec (sublist previous)
(when sublist
(funcall function sublist previous)
(rec (rest sublist) sublist))))
(rec list nil))
list)
> defun nmove-best-to-front3 (list func)
> (let ((best (car list)) parent-list)
> (mapl2 (lambda (sublist parent)
> (if (funcall func (car sublist) best)
> (setf parent-list parent best (car sublist))))
> list)
> (when parent-list
> (setf list (cons best list))
> (setf (cdr parent-list) (cddr parent-list)))
> list))
Again, this has strange semantics when the empty list is supplied.
The first call to the predicate is redundant, as the same element is
passed on the two sides. The operations performed when PARENT-LIST is
not the empty list are better described as PUSH and POP. It is more
idiomatic to use the reverse lambda-list, i.e. to take the function
first and the list second. Here's my take:
(defun best-to-front (predicate list)
(let ((best list)
(best-predecessor nil))
(mapl2 (lambda (current previous)
(when (funcall predicate (first current) (first best))
(setf best current)
(setf best-predecessor (or previous list))))
(rest list))
(unless (eq best list)
(pop (rest best-predecessor))
(push (first best) list)))
list)
As mentioned in my previous post, I consider something akin to Kenny
Tilton's code snippet to be more elegant.
Ariel
On Dec 10, 8:28 pm, Ariel Badichi <····@tidexsystems.com> wrote:
>
> (defun mapl2 (function list)
> (loop for sublist on list
> and previous = nil then sublist
> do (funcall function sublist previous))
> list)
>
I should also note that this MAPL2, unlike MAPL, takes just one list.
I leave it as an exercise to come up with a version taking one or more
lists. :)
Ariel
If you don't care about the order of the resulting list, this may
work:
(defun make-q (first-cons)
(cons (rplacd first-cons nil)
first-cons))
(defun q-add-end (q cons)
(prog1 (cdr cons)
(setf (cddr q) cons
(cdr q) cons)))
(defun q-add-start (q cons)
(prog1 (cdr cons)
(setf (cdr cons) (car q)
(car q) cons)))
(defun q-to-list (q)
(setf (cddr q) nil)
(car q))
(defun q-first-item (q)
(caar q))
(defun nbest-to-front (list predicate)
(if (null list) (return-from nbest-to-front nil))
(let ((q (make-q (prog1 list (setf list (cdr list))))))
(loop until (null list) do
(setf list
(if (funcall predicate (car list) (q-first-item q))
(q-add-start q list)
(q-add-end q list))))
(q-to-list q)))
From: Dimiter "malkia" Stanev
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <ghnd06$sb7$1@malkia.motzarella.org>
Here is my solution:
(defun best-to-front (list predicate)
(let ((best-element list)
(current-element list)
(before-best-element)
(previous-element))
(loop
(when (funcall predicate
(car current-element)
(car best-element))
(setf best-element current-element
before-best-element previous-element))
(shiftf previous-element current-element (cdr current-element))
(when (endp current-element)
(return
(if before-best-element
(progn
(rplacd before-best-element (cdr best-element))
(rplacd best-element list))
list))))))
(defun test-best-to-front (&optional
(n 4000000)
(best-to-front #'best-to-front))
"n should be even!"
(let ((lst (list 50 49 48 47 46 45 44 43 42 41 40
39 38 37 36 35 34 33 32 31 30 29
28 27 26 25 24 23 22 21 20 19 18
17 16 15 14 13 12 11
10 9 8 7 6 5 4 3 2 1)))
(dotimes (i (/ n 2))
(setf lst (funcall best-to-front lst #'<))
(setf lst (funcall best-to-front lst #'>)))
(print lst)))
jrwats wrote:
> Destructively moves the "best" element (according to the predicate
> function passed in) to the front of a list. Feel free to improve the
> code by using other functions, recursion, etc, but it must only visit
> each element once. i.e. you can't just find the best and call (remove
> best lst :test #'equal :count 1) and then cons best onto lst.
>
> (defun nbest-to-front (lst pred)
> (let ((best lst)
> (par nil))
> (do* ((prev lst (cdr prev))
> (chk (cdr prev) (cdr prev)))
> ((endp chk))
> (if (funcall pred (car chk) (car best))
> (setq best chk par prev)))
> (if par
> (setf (cdr par) (cdr best)))
> (setf lst (cons (car best) lst)))) ;; last line is redundant if
> par = nil, but I'd like lst returned...
>
> The alternative I thought of to that last line is:
> (when par
> (setf (cdr par) (cdr best))
> (setf lst (cons (car best) lst)))
> lst))
>
> becase I'd like the list returned, and the latter uses more lines, I
> stuck with the first.
From: Dimiter "malkia" Stanev
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <ghndt7$37u$1@malkia.motzarella.org>
Btw, the biggest bottleneck in the function is ... funcall :)
If you can make out of this a macro, which is expanded with the function
called inlined, then you would gain most speed.
As a test - just replace (funcall pred ...) with (> ...) - e.g. ignore
the prd and see the results.
I don't know if there is a way to "speed" up such call, or prepare it
for faster calling.
jrwats wrote:
> Destructively moves the "best" element (according to the predicate
> function passed in) to the front of a list. Feel free to improve the
> code by using other functions, recursion, etc, but it must only visit
> each element once. i.e. you can't just find the best and call (remove
> best lst :test #'equal :count 1) and then cons best onto lst.
>
> (defun nbest-to-front (lst pred)
> (let ((best lst)
> (par nil))
> (do* ((prev lst (cdr prev))
> (chk (cdr prev) (cdr prev)))
> ((endp chk))
> (if (funcall pred (car chk) (car best))
> (setq best chk par prev)))
> (if par
> (setf (cdr par) (cdr best)))
> (setf lst (cons (car best) lst)))) ;; last line is redundant if
> par = nil, but I'd like lst returned...
>
> The alternative I thought of to that last line is:
> (when par
> (setf (cdr par) (cdr best))
> (setf lst (cons (car best) lst)))
> lst))
>
> becase I'd like the list returned, and the latter uses more lines, I
> stuck with the first.
From: Dimiter "malkia" Stanev
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <ghpicl$gml$1@malkia.motzarella.org>
For example under Lispworks the general #'> operator is significantly
slower than in other lisp-implementations.
This is because, (as in other implementations) it needs to discover the
types of the arguments being used, their number (you can do (> 10 20
30)) and then call the specific internal function (that's not really
visible).
But there is a portable way around, that gives about x3-x4 speedup in
lispworks:
Just make a specialized version of > and < for fixnums, or later for any
type you would like:
(declaim (ftype (function (fixnum fixnum) boolean) >fixnum <fixnum)
(defun >fixnum (a b)
(declare (type fixnum a b))
(> a b))
(defun <fixnum (a b)
(declare (type fixnum a b))
(< a b))
then instead of doing
(best-to-front-macro lst #'<)
do this:
(best-to-front-macro lst #'<fixnum)
---------------------------------------------------------------
Alternative solution is to turn best-to-front into macro.
My macrology is still in infancy, so here is my quick & dirty
(non-hygienic solution):
(defmacro best-to-front-macro (the-list the-predicate)
(let* ((macro-expanded-predicate (macroexpand the-predicate))
(predicate (if (and (listp macro-expanded-predicate)
(eq (car macro-expanded-predicate)
'function))
(cadr macro-expanded-predicate)
macro-expanded-predicate)))
`(let* ((list ,the-list)
(best-element list)
(current-element list)
(before-best-element)
(previous-element))
(loop
(when (,predicate (car current-element) (car best-element))
(setf best-element current-element
before-best-element previous-element))
(shiftf previous-element current-element (cdr current-element))
(when (endp current-element)
(return
(if before-best-element
(progn
(rplacd before-best-element (cdr best-element))
(rplacd best-element list))
list)))))))
Dimiter "malkia" Stanev wrote:
> Btw, the biggest bottleneck in the function is ... funcall :)
>
> If you can make out of this a macro, which is expanded with the function
> called inlined, then you would gain most speed.
>
> As a test - just replace (funcall pred ...) with (> ...) - e.g. ignore
> the prd and see the results.
>
> I don't know if there is a way to "speed" up such call, or prepare it
> for faster calling.
>
> jrwats wrote:
>> Destructively moves the "best" element (according to the predicate
>> function passed in) to the front of a list. Feel free to improve the
>> code by using other functions, recursion, etc, but it must only visit
>> each element once. i.e. you can't just find the best and call (remove
>> best lst :test #'equal :count 1) and then cons best onto lst.
>>
>> (defun nbest-to-front (lst pred)
>> (let ((best lst)
>> (par nil))
>> (do* ((prev lst (cdr prev))
>> (chk (cdr prev) (cdr prev)))
>> ((endp chk))
>> (if (funcall pred (car chk) (car best))
>> (setq best chk par prev)))
>> (if par
>> (setf (cdr par) (cdr best)))
>> (setf lst (cons (car best) lst)))) ;; last line is redundant if
>> par = nil, but I'd like lst returned...
>>
>> The alternative I thought of to that last line is:
>> (when par
>> (setf (cdr par) (cdr best))
>> (setf lst (cons (car best) lst)))
>> lst))
>>
>> becase I'd like the list returned, and the latter uses more lines, I
>> stuck with the first.
From: Kaz Kylheku
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <20081226083205.77@gmail.com>
On 2008-12-10, Dimiter "malkia" Stanev <······@mac.com> wrote:
> For example under Lispworks the general #'> operator is significantly
> slower than in other lisp-implementations.
>
> This is because, (as in other implementations) it needs to discover the
> types of the arguments being used, their number (you can do (> 10 20
> 30)) and then call the specific internal function (that's not really
> visible).
>
> But there is a portable way around, that gives about x3-x4 speedup in
> lispworks:
>
> Just make a specialized version of > and < for fixnums, or later for any
> type you would like:
>
> (declaim (ftype (function (fixnum fixnum) boolean) >fixnum <fixnum)
> (defun >fixnum (a b)
> (declare (type fixnum a b))
> (> a b))
> (defun <fixnum (a b)
> (declare (type fixnum a b))
> (< a b))
>
> then instead of doing
>
> (best-to-front-macro lst #'<)
>
> do this:
>
> (best-to-front-macro lst #'<fixnum)
>
> ---------------------------------------------------------------
>
> Alternative solution is to turn best-to-front into macro.
Lisp has inline functions.
It also has compiler macros. You can leave smoething as a function, and write a
compiler macro that will generate your user-defined inline code for certain
cases.
Suppose have this macro:
> (defmacro best-to-front-macro (the-list the-predicate)
> ( [...] ))
We keep the function also:
;; non-inlined
(defun best-to-front (list predicate) ...)
We can arrange it so that when the programmer writes
;; call the function
(best-to-front list #'(function <name>))
(best-to-front list #'(lambda ...))
(best-to-front list (lambda ...))
it turns into a macro call. But other cases stay as function calls:
(best-to-front list foo) ;; not translated
This is done with a compiler macro:
(define-compiler-macro best-to-front (list-form predicate-form &whole form)
(cond ((and (consp predicate-form)
(member (first predicate-form) '(function lambda)))
`(best-to-front-macro ,list-form ,predicate-form))
(t form)))
Now BEST-TO-FRONT is still a function. You can indirect upon it, etc:
We can add other cases, while we are at it. For instance
(best-to-front nil ...)
Can be reduced to NIL at compile time. The compiler macro can do that.
The compiler macro can also recognize:
(best-to-front (quote <list>) (function <sym>))
Of course, best-to-front shouldn't be called on literals! But suppose that it
was callable on literals. This case could be optimized to a compile-time
constant. Doing this is a bit dangerous because if the function is
user-defined, it won't be available at compile time unless its definition is
wrapped in the right (eval-when ...) and unless that definition has been loaded
into this compile session. You could check whether <sym> is one of
a bunch bunch of Common Lisp standard functions that are likely to be used
with best-to-front.
> (let* ((macro-expanded-predicate (macroexpand the-predicate))
When a macro calls macroexpand, it must pass down the macro-expansion
environment. THE-PREDICATE may be a local macro defined with MACROLET
or SYMBOL-MACROLET.
(defmacro my-macro (... arg ... &environment env)
... (macroexpand arg env) ...)
Also note that it's probably not necessary for your macro to reduce
(funcall (function x) ...) to (x ...). If your Lisp compiler is too braindead
to make this reduction itself, your most fruitful optimization strategy would
be to get a better compiler. :)
If you make the function inlined, then the compiler also has all the info to
make the reduction. When compiling a call to the inlined function, it knows
that the function being passed is #'< and can propagate that value to where the
FUNCALL occurs and recognize that it can be reduced to a direct call.
So the compiler macro is quite probably pointless, at least for this purpose.
What it does is give us better control over code bloat. In cases where we are
not just using (function ...), we get a function call to a non-inlined
function. If we used an inline function, the compiler might inline it anyway,
resulting in code bloat that we don't want. If we use a macro, we get
code-bloat for sure. With the compiler macro, combined with a non-inline
function, we control when we get code bloat and when we don't.
Compiler macros are best, though, when you can teach the compiler to make some
non-obvious reduction based on special properties of you function.
For instance if you have functions FOO and BAR which you know are inverses of
each other, your compiler macro can reduce (FOO (BAR X)) to X. The compiler
macro can produce constant range values for certain constant domain values,
etc.
Kaz, Thanks for the useful info!
On Dec 10, 4:28 pm, Kaz Kylheku <········@gmail.com> wrote:
> On 2008-12-10, Dimiter "malkia" Stanev <······@mac.com> wrote:
>
>
>
> > For example under Lispworks the general #'> operator is significantly
> > slower than in other lisp-implementations.
>
> > This is because, (as in other implementations) it needs to discover the
> > types of the arguments being used, their number (you can do (> 10 20
> > 30)) and then call the specific internal function (that's not really
> > visible).
>
> > But there is a portable way around, that gives about x3-x4 speedup in
> > lispworks:
>
> > Just make a specialized version of > and < for fixnums, or later for any
> > type you would like:
>
> > (declaim (ftype (function (fixnum fixnum) boolean) >fixnum <fixnum)
> > (defun >fixnum (a b)
> > (declare (type fixnum a b))
> > (> a b))
> > (defun <fixnum (a b)
> > (declare (type fixnum a b))
> > (< a b))
>
> > then instead of doing
>
> > (best-to-front-macro lst #'<)
>
> > do this:
>
> > (best-to-front-macro lst #'<fixnum)
>
> > ---------------------------------------------------------------
>
> > Alternative solution is to turn best-to-front into macro.
>
> Lisp has inline functions.
>
> It also has compiler macros. You can leave smoething as a function, and write a
> compiler macro that will generate your user-defined inline code for certain
> cases.
>
> Suppose have this macro:
>
> > (defmacro best-to-front-macro (the-list the-predicate)
> > ( [...] ))
>
> We keep the function also:
>
> ;; non-inlined
> (defun best-to-front (list predicate) ...)
>
> We can arrange it so that when the programmer writes
>
> ;; call the function
> (best-to-front list #'(function <name>))
> (best-to-front list #'(lambda ...))
> (best-to-front list (lambda ...))
>
> it turns into a macro call. But other cases stay as function calls:
>
> (best-to-front list foo) ;; not translated
>
> This is done with a compiler macro:
>
> (define-compiler-macro best-to-front (list-form predicate-form &whole form)
> (cond ((and (consp predicate-form)
> (member (first predicate-form) '(function lambda)))
> `(best-to-front-macro ,list-form ,predicate-form))
> (t form)))
>
> Now BEST-TO-FRONT is still a function. You can indirect upon it, etc:
>
> We can add other cases, while we are at it. For instance
>
> (best-to-front nil ...)
>
> Can be reduced to NIL at compile time. The compiler macro can do that.
> The compiler macro can also recognize:
>
> (best-to-front (quote <list>) (function <sym>))
>
> Of course, best-to-front shouldn't be called on literals! But suppose that it
> was callable on literals. This case could be optimized to a compile-time
> constant. Doing this is a bit dangerous because if the function is
> user-defined, it won't be available at compile time unless its definition is
> wrapped in the right (eval-when ...) and unless that definition has been loaded
> into this compile session. You could check whether <sym> is one of
> a bunch bunch of Common Lisp standard functions that are likely to be used
> with best-to-front.
>
> > (let* ((macro-expanded-predicate (macroexpand the-predicate))
>
> When a macro calls macroexpand, it must pass down the macro-expansion
> environment. THE-PREDICATE may be a local macro defined with MACROLET
> or SYMBOL-MACROLET.
>
> (defmacro my-macro (... arg ... &environment env)
> ... (macroexpand arg env) ...)
>
> Also note that it's probably not necessary for your macro to reduce
> (funcall (function x) ...) to (x ...). If your Lisp compiler is too braindead
> to make this reduction itself, your most fruitful optimization strategy would
> be to get a better compiler. :)
>
> If you make the function inlined, then the compiler also has all the info to
> make the reduction. When compiling a call to the inlined function, it knows
> that the function being passed is #'< and can propagate that value to where the
> FUNCALL occurs and recognize that it can be reduced to a direct call.
>
> So the compiler macro is quite probably pointless, at least for this purpose.
> What it does is give us better control over code bloat. In cases where we are
> not just using (function ...), we get a function call to a non-inlined
> function. If we used an inline function, the compiler might inline it anyway,
> resulting in code bloat that we don't want. If we use a macro, we get
> code-bloat for sure. With the compiler macro, combined with a non-inline
> function, we control when we get code bloat and when we don't.
>
> Compiler macros are best, though, when you can teach the compiler to make some
> non-obvious reduction based on special properties of you function.
>
> For instance if you have functions FOO and BAR which you know are inverses of
> each other, your compiler macro can reduce (FOO (BAR X)) to X. The compiler
> macro can produce constant range values for certain constant domain values,
> etc.
From: William James
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <ghmqh2$9o0$1@aioe.org>
jrwats wrote:
> Destructively moves the "best" element (according to the predicate
> function passed in) to the front of a list. Feel free to improve the
> code by using other functions, recursion, etc, but it must only visit
> each element once. i.e. you can't just find the best and call (remove
> best lst :test #'equal :count 1) and then cons best onto lst.
>
> (defun nbest-to-front (lst pred)
> (let ((best lst)
> (par nil))
> (do* ((prev lst (cdr prev))
> (chk (cdr prev) (cdr prev)))
> ((endp chk))
> (if (funcall pred (car chk) (car best))
> (setq best chk par prev)))
> (if par
> (setf (cdr par) (cdr best)))
> (setf lst (cons (car best) lst)))) ;; last line is redundant if
> par = nil, but I'd like lst returned...
Ruby:
$count = 0
list = %w(bog frog zoo clean ashen plump azure svelte)
p list.sort_by{|s|
$count += 1
-(s.size * s.split(//).inject(0){|sum,c| sum + c[0]}) }
puts "Number of items in list: #{ list.size }"
puts "Number of times code-block was called: #{ $count }"
--- output ---
["svelte", "plump", "azure", "ashen", "clean", "frog", "zoo", "bog"]
Number of items in list: 8
Number of times code-block was called: 8
From: Kaz Kylheku
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <20081225110336.657@gmail.com>
On 2008-12-09, jrwats <······@gmail.com> wrote:
> Destructively moves the "best" element (according to the predicate
> function passed in) to the front of a list. Feel free to improve the
> code by using other functions, recursion, etc, but it must only visit
> each element once. i.e. you can't just find the best and call (remove
> best lst :test #'equal :count 1) and then cons best onto lst.
Since this is turning into an obfuscated programming contest, here is my
entry. First, it requires this library:
(defstruct ref
(get-func)
(set-func))
(defun deref (ref)
(funcall (ref-get-func ref)))
(defun (setf deref) (val ref)
(funcall (ref-set-func ref) val))
(defmacro naive-ref (place-expression)
`(make-ref
:get-func (lambda () ,place-expression)
:set-func (lambda (val) (setf ,place-expression val))))
(defmacro ref (var-to-rebind place-expression)
`(let ((,var-to-rebind ,var-to-rebind))
(naive-ref ,place-expression)))
(defmacro with-refs ((&rest ref-specs) &body forms)
`(symbol-macrolet
,(loop for (var ref) in ref-specs
collecting (list var `(deref ,ref)))
,@forms))
This library gives us something similar to Pascal pointers. Using
the expression (REF VAR PLACE) we capture a reference to PLACE.
The purpose of VAR is that if PLACE is computed using some variable,
such that the location of the place changes if the variable changes,
we can indicate the name of that variable.
(ref x (cdr x))
Gives us the ``address'' of the place (CDR X), such that the X variable can now
be changed to any value whatsoever without disturbing the interpretation of the
reference. There is a ``frozen X'' captured inside the reference, if you will.
Given a captured reference R, we can refer to it using (DEREF R). This
expression is a place, so we can assign to it ``through the pointer''.
Lastly, the WITH-REFS macro just provides some shorthand notation. IF you get
tired of writing (deref foo) and (deref bar) all over the place, then wrap the
code with (with-refs (f foo) (b bar) ...). Now you can write F instead
of (DEREF FOO) and B instead of (DEREF BAR).
Here is how our best function looks if we march through the list, capture the
reference to the pointer which refers to the best item, and then use these
pointers to splice out that node, and patch it to the front of the list:
(defun move-best-to-front (list predicate)
(with-refs ((best pbest) (iter piter))
(do ((piter (ref list list) (ref iter (cdr iter)))
(pbest (ref list list) (if (funcall predicate
(car iter)
(car best))
piter
pbest)))
((endp iter)
(when (and best
(not (eq best list)))
(rotatef best (cdr best) list)))))
list)
The purpose of the WHEN test is to detect when the best item is already at the
front of the list; the ROTATEF would then create a cycle because LIST
and BEST refer to the same place.
Now of course this abstraction is inefficient. Each time you take a ref, it
allocates a small structure, and puts two lambda closures in it!
Also, here the use of refs doesn't buy you much, because all the objects
are conses. You can keep a parent pointer by hanging on to the parent cons.
The first cons has no parent cons, but you can give it a surrogate one:
(let ((parent (cons nil list)))
...)
Now (cdr parent) is the start of the list. You can do much cooler things
with refs, like lift a completely arbitrary place in one place in the
program, and pass it to some completely other part of the program
which has no idea what kind of place it is.
Tests:
[1]> (move-best-to-front nil #'>)
NIL
[2]> (move-best-to-front '(1) #'>)
(1)
[3]> (move-best-to-front '(1 2) #'>)
(2 1)
[4]> (move-best-to-front '(2 1) #'>)
(2 1)
[5]> (move-best-to-front '(1 2 3) #'>)
(3 1 2)
[6]> (move-best-to-front '(1 3 2) #'>)
(3 1 2)
[7]> (move-best-to-front '(3 2 1) #'>)
(3 2 1)
For reference: same alogorithm expressed in C:
typedef struct cons {
int car;
struct cons *cdr;
} cons;
cons *move_best_to_front(cons *list, int (*predicate) (int, int))
{
cons **piter, **pbest;
for (piter = &list, pbest = &list; *piter != 0; piter = &(*piter)->cdr)
pbest = predicate((*piter)->car, (*pbest)->car) ? piter : pbest;
if (*pbest != 0 && pbest != &list) {
cons *best = *pbest;
*pbest = best->cdr;
best->cdr = list;
list = best;
}
return list;
}
Same algoritm, without refs, using explicit parent conses:
(defun move-best-to-front (list predicate)
(symbol-macrolet ((iter (cdr piter))
(best (cdr pbest)))
(let ((parent (cons nil list)))
(do ((piter parent iter)
(pbest parent (if (funcall predicate (car iter) (car best))
piter
pbest)))
((endp iter)
(when (and best (not (eq pbest parent)))
(rotatef best (cdr best) list))))))
list)
See, we avoid some ugly cases the help of PARENT, and by allowing an extra
comparison of the first item with itself.
From: Kaz Kylheku
Subject: Re: Coding challenge: Can you make this function more elegant?
Date:
Message-ID: <20081225172631.98@gmail.com>
On 2008-12-10, Kaz Kylheku <········@gmail.com> wrote:
> (defmacro naive-ref (place-expression)
> `(make-ref
> :get-func (lambda () ,place-expression)
> :set-func (lambda (val) (setf ,place-expression val))))
>
> (defmacro ref (var-to-rebind place-expression)
> `(let ((,var-to-rebind ,var-to-rebind))
> (naive-ref ,place-expression)))
Doh, it dawned on me that this problem is solved perfectly by the general
mechanism of the setf expander. This kind of situation is why one of the
values returned by the setf expander is a list of internal forms (within
the place form in question) as well as a list of gensyms to bind them.
And so here is the rewrite. NAIVE-REF is gone, and REF loses
the var-to-rebind argument. All else is the same:
(defstruct ref
(get-func)
(set-func))
(defun deref (ref)
(funcall (ref-get-func ref)))
(defun (setf deref) (val ref)
(funcall (ref-set-func ref) val))
(defmacro ref (place-expression &environment env)
(multiple-value-bind (temp-syms val-forms
store-vars store-form access-form)
(get-setf-expansion place-expression env)
(when (cdr store-vars)
(error "REF: cannot take ref of multiple-value place"))
`(multiple-value-bind (,@temp-syms) (values ,@val-forms)
(make-ref
:get-func (lambda () ,access-form)
:set-func (lambda (,@store-vars) ,store-form)))))
(defmacro with-refs ((&rest ref-specs) &body forms)
`(symbol-macrolet
,(loop for (var ref) in ref-specs
collecting (list var `(deref ,ref)))
,@forms))
New version of ref-based move-best-to-front:
(defun move-best-to-front (list predicate)
(with-refs ((best pbest) (iter piter))
(do ((piter (ref list) (ref (cdr iter)))
(pbest (ref list) (if (funcall predicate
(car iter)
(car best))
piter
pbest)))
((endp iter)
(when (and best
(not (eq best list)))
(rotatef best (cdr best) list)))))
list)
It still works. Check this out:
(macroexpand '(ref (cdr x)))
->
(LET* ((#:G3128 (MULTIPLE-VALUE-LIST (VALUES X))) (#:G3127 (POP #:G3128)))
(REFS::MAKE-REF
:GET-FUNC (LAMBDA NIL (CDR #:G3127))
:SET-FUNC (LAMBDA (#:G3126) (SYSTEM::%RPLACD #:G3127 #:G3126)))) ;
We use the SETF expander for (CDR X) which informs us that there is a form X
that needs to be bound to a temporary variable, and gives us the setter and
getter in terms of that variable.
Nice! Now REF macro correctly latches places referenced by a
mutating loop variable.