Prev: a small SBCL question
Next: combinations iterator
From: John Thingstad on 31 Dec 2006 11:41
This is a excerpt from my code:

--------------------------------------------------------------------------

(defun write-trace (body)
(format *trace-output* "~&~A~%" body))

(defmacro output (body)
`(progn
;(write-trace ',body)
,body))

(defun nrotate (vector start end)
(rotatef (aref vector start) (aref vector end)))

(defun forall-combinations (vector function)
"Compute the combinations on 'vector' and call 'function'
on each combination. 'function' is assumed to be a function that
takes a vector argument and does not modify this.
Note that the vector argument given to 'function' is volatile and must be
copied
if it is stored."
(check-type vector simple-vector)
(check-type function function)
(let ((length (length vector))
(copy (copy-seq vector)))
(labels ((recurse (index)
(loop repeat (- length index) do
(if (< index (- length 2))
(recurse (1+ index))
(output (funcall function copy)))
(output (nrotate copy index (1+ index))))))
(recurse 0)))
(values))

(defun list->vector (list)
(make-array (length list) :initial-contents list))

(defun vector->list (vector)
(loop for element across vector collect element))

(defun print-combinations (sequence)
"Output the combinations a line at a time to standard output.
'sequence' can be either a list or vector.
If 'sequence' is a vector prints as #(...), if it is a list (..)
ex. (print-combinations '(1 2)) prints
1: (1 2)
2: (2 1)"
(check-type sequence (or simple-vector cons))
(let ((count 0)
(vector (if (listp sequence) (list->vector sequence) sequence))
(seq-op (if (listp sequence) #'vector->list #'identity)))
(flet ((display (vector)
(incf count)
(format t "~&~3d: ~A~%" count (funcall seq-op vector))))
(forall-combinations vector #'display))))

--------------------------------------------------------------------------

Problem:
1. The combinations are not computed right.
To dumb to see what I am missing I guess.
ex: (print-combinations '(1 2 3))
1: (1 2 3)
2: (1 3 2)
3: (2 1 3)
4: (2 3 1)
5: (1 2 3)
6: (1 3 2)
What is wrong? Is there a better way?

2. The macro output (with the ; removed) just prints the call verbatim.
ex. (output (nrotate copy start (1+ start)) prints
(nrotate copy start (1+ start))
I would like it to resolve the variables.
ex. (output (nrotate copy start (1+ start)) prints
(nrotate #(1 2 3) 1 2)
How do I do this?

--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
From: Pascal Bourguignon on 31 Dec 2006 12:13
"John Thingstad" <john.thingstad(a)chello.no> writes:

> This is a excerpt from my code:
> [...]
>
> Problem:
> 1. The combinations are not computed right.
> To dumb to see what I am missing I guess.
> ex: (print-combinations '(1 2 3))
> 1: (1 2 3)
> 2: (1 3 2)
> 3: (2 1 3)
> 4: (2 3 1)
> 5: (1 2 3)
> 6: (1 3 2)
> What is wrong? Is there a better way?

You don't put the rotated elements back in place. The following work:

(defun permute (vector index action)
(cond
((zerop index) (funcall action vector))
(t (permute vector (1- index) action)
(dotimes (i index)
(rotatef (aref vector index) (aref vector i))
(permute vector (1- index) action)
(rotatef (aref vector index) (aref vector i))))))

C/USER[830]> (permute #(1 2 3) 2 (function print))

#(1 2 3)
#(2 1 3)
#(3 1 2)
#(1 3 2)
#(1 2 3)
#(2 1 3)
NIL

If you remove the last ROTATEF, it gives results similar to yours.


> 2. The macro output (with the ; removed) just prints the call verbatim.
> ex. (output (nrotate copy start (1+ start)) prints
> (nrotate copy start (1+ start))
> I would like it to resolve the variables.
> ex. (output (nrotate copy start (1+ start)) prints
> (nrotate #(1 2 3) 1 2)
> How do I do this?

(output `(nrotate ,copy ,start ,(1+ start)))

A better way is not to modify your source, and use TRACE (and UNTRACE
when you're done debugging).


--
__Pascal Bourguignon__ http://www.informatimago.com/

"Debugging? Klingons do not debug! Our software does not coddle the
weak."
From: John Thingstad on 31 Dec 2006 13:26
On Sun, 31 Dec 2006 18:13:24 +0100, Pascal Bourguignon
<pjb(a)informatimago.com> wrote:

>
> If you remove the last ROTATEF, it gives results similar to yours.
>

Thanks! Yes I see it now..

>
>> 2. The macro output (with the ; removed) just prints the call verbatim.
>> ex. (output (nrotate copy start (1+ start)) prints
>> (nrotate copy start (1+ start))
>> I would like it to resolve the variables.
>> ex. (output (nrotate copy start (1+ start)) prints
>> (nrotate #(1 2 3) 1 2)
>> How do I do this?
>
> (output `(nrotate ,copy ,start ,(1+ start)))
>
> A better way is not to modify your source, and use TRACE (and UNTRACE
> when you're done debugging).
>
>

Not really what I asked for. I needs macro 'output' to generate

(output (nrotate copy start (1+ start)) =>
(progn
(write-trace `(nrotate ,copy ,start ,(1+ start))
(nrotate copy start (1+ start)))

I have:
(defmacro output (body)
(let ((expr (append (list (first body))
(loop for element in (rest body)
collect `(#\, ,element)))))
`(progn
(write-trace (list #\` ,expr))
,body)))

which gives:

(PROGN
(WRITE-TRACE (LIST #\` (NROTATE (#\, COPY) (#\, INDEX) (#\,
(1+ INDEX)))))
(NROTATE COPY INDEX (1+ INDEX)))

Which still isn't there. But it should give you a idea.

--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
From: nallen05 on 31 Dec 2006 21:24
John Thingstad wrote:
> This is a excerpt from my code:
>
> --------------------------------------------------------------------------
>
> (defun write-trace (body)
> (format *trace-output* "~&~A~%" body))
>
> (defmacro output (body)
> `(progn
> ;(write-trace ',body)
> ,body))
>
> (defun nrotate (vector start end)
> (rotatef (aref vector start) (aref vector end)))
>
> (defun forall-combinations (vector function)
> "Compute the combinations on 'vector' and call 'function'
> on each combination. 'function' is assumed to be a function that
> takes a vector argument and does not modify this.
> Note that the vector argument given to 'function' is volatile and must be
> copied
> if it is stored."
> (check-type vector simple-vector)
> (check-type function function)
> (let ((length (length vector))
> (copy (copy-seq vector)))
> (labels ((recurse (index)
> (loop repeat (- length index) do
> (if (< index (- length 2))
> (recurse (1+ index))
> (output (funcall function copy)))
> (output (nrotate copy index (1+ index))))))
> (recurse 0)))
> (values))
>
> (defun list->vector (list)
> (make-array (length list) :initial-contents list))
>
> (defun vector->list (vector)
> (loop for element across vector collect element))
>
> (defun print-combinations (sequence)
> "Output the combinations a line at a time to standard output.
> 'sequence' can be either a list or vector.
> If 'sequence' is a vector prints as #(...), if it is a list (..)
> ex. (print-combinations '(1 2)) prints
> 1: (1 2)
> 2: (2 1)"
> (check-type sequence (or simple-vector cons))
> (let ((count 0)
> (vector (if (listp sequence) (list->vector sequence) sequence))
> (seq-op (if (listp sequence) #'vector->list #'identity)))
> (flet ((display (vector)
> (incf count)
> (format t "~&~3d: ~A~%" count (funcall seq-op vector))))
> (forall-combinations vector #'display))))
>
> --------------------------------------------------------------------------
>
> Problem:
> 1. The combinations are not computed right.
> To dumb to see what I am missing I guess.
> ex: (print-combinations '(1 2 3))
> 1: (1 2 3)
> 2: (1 3 2)
> 3: (2 1 3)
> 4: (2 3 1)
> 5: (1 2 3)
> 6: (1 3 2)
> What is wrong? Is there a better way?
>

Pascal already mentioned why the combinations aren't working...

In the big scheme of things, I think it would be probubly be much more
useful to make a macro that executed a body of code for every possible
permutation of the vector with a variable bound to it than a function
that applies a unary function to the vector for every possible
permutation...

this is how I would do it:

(defmacro with-permuting-vector ((var vector &optional return) &body
body)
(let ((s (gensym)))
`(let* ((,var ,vector)
(,s (length ,var)))

(labels ((rfn (start)
(if (= start ,s)
(progn ,@body) ;Execute body
(do ((n start (incf n)))
((>= n ,s))
(rotatef (svref ,var start) (svref ,var n))
(rfn (1+ start))
(rotatef (svref ,var start) (svref ,var n))))))
(rfn 0)
,return))))

CL-USER> (with-permuting-vector (v #(1 2 3) 'done)
(print v))

#(1 2 3)
#(1 3 2)
#(2 1 3)
#(2 3 1)
#(3 2 1)
#(3 1 2)
DONE
CL-USER>




> 2. The macro output (with the ; removed) just prints the call verbatim.
> ex. (output (nrotate copy start (1+ start)) prints
> (nrotate copy start (1+ start))
> I would like it to resolve the variables.
> ex. (output (nrotate copy start (1+ start)) prints
> (nrotate #(1 2 3) 1 2)
> How do I do this?
>

as for the output thing

(defun prepare-form (sexp)
(if (listp sexp)
`(list ',(prepare-form (first sexp))
,@(mapcar #'prepare-form (rest sexp)))
sexp))t

(defmacro output (&body body)
`(progn
(format t "~{~&~A~}" ,`(list ,@(mapcar #'prepare-form body)))
,@body))

CL-USER> (macroexpand-1 '(output (foo x) (bar y) (baz (+ x y))))
(PROGN (FORMAT T "~{~&~A~}" (LIST (LIST 'FOO X) (LIST 'BAR Y) (LIST
'BAZ (LIST '+ X Y)))) (FOO X) (BAR Y) (BAZ (+ X Y)))
T
CL-USER> (with-permuting-vector (v #(1 2 3))
(output (print v)))
(PRINT #(1 2 3))
#(1 2 3)
(PRINT #(1 3 2))
#(1 3 2)
(PRINT #(2 1 3))
#(2 1 3)
(PRINT #(2 3 1))
#(2 3 1)
(PRINT #(3 2 1))
#(3 2 1)
(PRINT #(3 1 2))
#(3 1 2)
NIL
CL-USER>

hth, take care

Nick



> --
> Using Opera's revolutionary e-mail client: http://www.opera.com/mail/

From: Rainer Joswig on 1 Jan 2007 05:25
Am 01.01.2007 3:24 Uhr schrieb "nallen05(a)gmail.com" unter
<nallen05(a)gmail.com> in
1167618292.403491.55120(a)s34g2000cwa.googlegroups.com:


>
> Pascal already mentioned why the combinations aren't working...
>
> In the big scheme of things, I think it would be probubly be much more
> useful to make a macro that executed a body of code for every possible
> permutation of the vector with a variable bound to it than a function
> that applies a unary function to the vector for every possible
> permutation...

How would that be more useful? Why is a macro more useful than a function
in this case?

>
> this is how I would do it:
>
> (defmacro with-permuting-vector ((var vector &optional return) &body
> body)
> (let ((s (gensym)))
> `(let* ((,var ,vector)
> (,s (length ,var)))
>
> (labels ((rfn (start)
> (if (= start ,s)
> (progn ,@body) ;Execute body
> (do ((n start (incf n)))
> ((>= n ,s))
> (rotatef (svref ,var start) (svref ,var n))
> (rfn (1+ start))
> (rotatef (svref ,var start) (svref ,var n))))))
> (rfn 0)
> ,return))))
>
> CL-USER> (with-permuting-vector (v #(1 2 3) 'done)
> (print v))

So that is more useful than something like (permute-vector #(1 2 3) #'print)
? How?

 |  Next  |  Last
Pages: 1 2 3 4
Prev: a small SBCL question
Next: combinations iterator