Re: efficiently accumulating values


Alexander Schmolck wrote:
liyer.vijay@xxxxxxxxx writes:

liyer.vijay@xxxxxxxxx wrote:
[snip my own stuff]

Hi,

I found the reference in PCL (Peter, if you're reading this, thanks)
to VECTOR-PUSH-EXTEND which dramatically reduces time to 0.346
seconds. Here is the program:

(defun find-words (graph)
"Given GRAPH find all possible words."
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = (make-array 0 :adjustable t :fill-pointer 0)
as i from 0 to (1- m)
do (loop as j from 0 to (1- n)
do (loop as word in (get-words graph i j)
if (and (zerop i) (zerop j))
do (vector-push-extend word result)))
finally (return (coerce result '(or cons list))))))

However, I'd still like to know if there's a better way, and since I
didn't mention it in my last post, any suggestions, comments,
criticisms on coding style, programming are greatly appreciated.

I was about to suggest vector-push-extend. I have only glanced over your code
but I'd think the next thing you could do is pass the vector in to get-words
to be destructively modified there.

Hi,

Alexander, I've tested all the other suggestions except yours, I'll do
that next :-)

Thanks for all the comments, I did some better timing tests with the
various suggestions.

Since single calls to CL:TIME do not give consistent results, and I
didn't like SB-PROFILE:PROFILE I wrote the following macros.

(in-package :boggle)

(shadow '#:time)
(defmacro time (form &optional (run 50))
"Execute FORM RUN times and give the average time taken in seconds."
(let ((runval (gensym))
(start (gensym))
(stop (gensym))
(sum (gensym)))
`(loop with ,runval = ,run and ,start and ,stop
repeat ,runval
do (setq ,start (get-internal-real-time))
do ,form
do (setq ,stop (get-internal-real-time))
summing (- ,stop ,start) into ,sum
finally (return (float (/ ,sum ,runval 1000))))))

(defmacro run (&rest defuns)
(let ((stack (gensym)))
`(let ((,stack '()))
,@(loop as defun in defuns
collect defun
collect `(push
(list (documentation 'find-words 'function)
(time (boggle "rstcsdeiaegnlrpeatesmssid")))
,stack))
(format t "~{~{~25,a --> ~a~}~%~}" (nreverse ,stack)))))

At the REPL:

Times summarized at the bottom

BOGGLE>
(run
(defun find-words (graph)
"Use tail pointer"
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = () and tail = ()
as i from 0 below m
do (loop as j from 0 below n
as gotten-words = (get-words graph i j)
if result do (rplacd tail gotten-words)
else do (setf result gotten-words)
do (setf tail (last gotten-words)))
finally (return result))))

(defun find-words (graph)
"LOOP NCONCs"
(destructuring-bind (m n) (array-dimensions graph)
(loop as i from 0 below m
nconcing (loop as j from 0 below n
nconcing (get-words graph i j)))))

(defun find-words (graph)
"Reduce calls to NCONC"
(destructuring-bind (m n) (array-dimensions graph)
(flet ((get-ij (num)
(let ((i (floor (/ num m))))
(list i (- num (* i m))))))
(loop as num from 0 below (* m n)
as (i j) = (get-ij num)
nconcing (get-words graph i j)))))

(defun find-words (graph)
"HASH-TABLE"
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = (make-hash-table :test #'equal)
as i from 0 below m
do (loop as j from 0 below n
do (loop as word in (get-words graph i j)
do (setf (gethash word result) nil)))
finally (return (loop as key being the hash-key in result
collect key)))))

(defun find-words (graph)
"VECTOR-PUSH-EXTEND"
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = (make-array 0 :fill-pointer 0 :adjustable t)
as i from 0 below m
do (loop as j from 0 below n
do (loop as word in (get-words graph i j)
do (vector-push-extend word result)))
finally (return (coerce result '(or nil cons))))))

(defun find-words (graph)
"CONCATENATE"
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = (make-array 0 :fill-pointer 0 :adjustable t)
as i from 0 below m
do (loop as j from 0 below n
do (setq result
(concatenate 'vector result
(get-words graph i j))))
finally (return (coerce result '(or nil cons))))))

(defun find-words (graph)
"Discarding results"
(destructuring-bind (m n) (array-dimensions graph)
(loop as i from 0 below m
do (loop as j from 0 below n
do (get-words graph i j)))))
)
STYLE-WARNING: redefining FIND-WORDS in DEFUN
STYLE-WARNING: redefining FIND-WORDS in DEFUN
STYLE-WARNING: redefining FIND-WORDS in DEFUN
STYLE-WARNING: redefining FIND-WORDS in DEFUN
STYLE-WARNING: redefining FIND-WORDS in DEFUN
STYLE-WARNING: redefining FIND-WORDS in DEFUN
STYLE-WARNING: redefining FIND-WORDS in DEFUN
Use tail pointer --> 1.28368
LOOP NCONCs --> 1.26204
Reduce calls to NCONC --> 1.24862
HASH-TABLE --> 0.83552
VECTOR-PUSH-EXTEND --> 1.25718
CONCATENATE --> 1.25342
Discarding results --> 0.15608
NIL


As Kenny Tilton pointed out, LOOP is quite smart when it comes to
NCONCing and it is approximately the same speed as hard-coding. My
results last night must have been because of a single call to CL:TIME.

I am quite surprised that making only O(m*n) calls to NCONC in LOOP
takes more time. Are arithmetic operations that expensive?

Not bothering to accumulate the results shows significant
speed-up and using a hash-table is second best.

I will try passing the vector to GET-WORDS explicitly also.

Any other suggestions? What am I doing wrong?

Cheers
Vijay

Can we quote you on that?
A long time ago, someone in the Lisp industry told me it was poor form
quote people; it suggests that they lack value.
-- Kent M Pitman <pitman@xxxxxxxxxxxxx> in comp.lang.lisp

.

Relevant Pages

  • Re: efficiently accumulating values
    ... Here is the lisp I wrote when I fisrt came with my questions. ... (loop as line = (read-line stream nil nil) ... (defun find-words (graph) ... "Given GRAPH find all possible words." ...
    (comp.lang.lisp)
  • Re: efficiently accumulating values
    ... (defun find-words (graph) ... "Given GRAPH find all possible words." ... If get-words has no side effect, then the loops are useless, since i ... (loop as word in (get-words graph i j) ...
    (comp.lang.lisp)
  • Re: an old worn interview question
    ... I suppose Oracle could implement this in a cheesy fashion: ... the size of the graph, ... I doubt hierarchical query loop detection is possible. ...
    (comp.programming)
  • Re: efficiently accumulating values
    ... do (loop as j from 0 to (1- n) ... (setf result gotten-words)) ... NCONCING accumulation clause: ... "Given GRAPH find all possible words." ...
    (comp.lang.lisp)
  • Re: Capture Graph with VMR9 in Windowless mode
    ... my message handler I call a function that does the graph tear down, ... rebuild, and restart before the FreeEventParams is called. ... Yes - using the while loop was what I meant. ... Restart the graph. ...
    (microsoft.public.win32.programmer.directx.video)