Hi,
I have a small lisp program to solve the boggle puzzle
(http://weboggle.shackworks.com/) and it generates a lot of lists.
This is the main part of the solving code:
(defun find-words (matrix)
"Given MATRIX find all possible words."
(destructuring-bind (m n) (array-dimensions matrix)
;; Find words starting at every position in the matrix
(loop with result = ()
as i from 0 to (1- m)
do (loop as j from 0 to (1- n)
do (setq result (nconc result ; <-- major consing
(get-words matrix i j))))
finally (return result))))
(defun get-words (matrix i j)
"Find all possible words starting from MATRIX position I J"
(labels ((rec (i j prefix acc)
(loop for (ni nj) in (adjacent matrix i j)
as next = (aref matrix ni nj)
as word = (concatenate 'string prefix next)
if (and (>= (length word) *minimum-length*)
(wordp word))
do (push word acc)
when (prefixp word)
do (let ((old (aref matrix i j)))
(setf (aref matrix i j) 'nil
acc (rec ni nj word acc)
(aref matrix i j) old))
finally (return acc))))
(rec i j (aref matrix i j) '())))
;;;;;;;;
Running the problem as it is, takes 2.713 seconds. Throwing away the
results obtained takes only 0.176 seconds. I changed find-words to
(defun find-words (matrix)
"Given MATRIX find all possible words."
(destructuring-bind (m n) (array-dimensions matrix)
(loop with result = (make-hash-table)
as i from 0 to (1- m)
do (loop as j from 0 to (1- n)
;; Find words starting at every position in the
matrix
do (loop as word in (get-words matrix i j)
do (setf (gethash word result) t)))
finally (return (loop as key being the hash-key in result
collect key)))))
This takes 1.786 seconds.
Is there an efficient way to accumulate values in lisp? I translated
this program almost sexp by sexp to Python and that runs in 0.61
seconds and in 0.49 seconds discarding the results.
Lisp is clearly faster except for the consing part. Any suggestions
on improving value accumulation welcome.
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 <······@world.std.com> in comp.lang.lisp
···········@gmail.com 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.
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 <······@world.std.com> in comp.lang.lisp
···········@gmail.com writes:
> ···········@gmail.com 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)
I'd write:
:for i :from 0 :below m
Some would write:
for i below 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))))))
list == (or nil cons) therefore (or cons list) == 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.
Now, what you seem to be doing in find-words, is jusd that:
(defun find-words (graph)
"Given GRAPH find all possible words."
(let ((words (get-words graph 0 0)))
(if words
(copy-list words)
'())))
Unless get-words is not a pure function. Do you have any side effect
in get-words?
--
__Pascal Bourguignon__ http://www.informatimago.com/
HEALTH WARNING: Care should be taken when lifting this product,
since its mass, and thus its weight, is dependent on its velocity
relative to the user.
Pascal Bourguignon wrote:
> ···········@gmail.com writes:
>
> > ···········@gmail.com 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)
>
> I'd write:
>
> :for i :from 0 :below m
>
> Some would write:
>
> for i below 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))))))
>
> list == (or nil cons) therefore (or cons list) == list
Pascal,
Thank you for both these suggestions, I have changed all places where
I used (loop as i from 0 to (1- m)) to (loop as i from 0 below m).
And thanks for telling me what the N in functions like nconc nreverse
nunion etc was. I'd always wondered :-)
And I now see I originally misunderstood what you meant. I should
have simply typed (coerce result '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.
>
> Now, what you seem to be doing in find-words, is jusd that:
>
> (defun find-words (graph)
> "Given GRAPH find all possible words."
> (let ((words (get-words graph 0 0)))
> (if words
> (copy-list words)
> '())))
I dont' understand, could you explain more clearly? I search for
words from every position in the graph. Or did you mean that I create
a list and throw it away immediately?
> Unless get-words is not a pure function. Do you have any side effect
> in get-words?
I don't know if I can say GET-WORDS is a pure function.
These properties of GET-WORDS are definitely true:
(eq matrix (progn (get-words matrix) matrix)) == T
and
(let* ((matrix (make-graph "rstcsdeiaegnlrpeatesmssid"))
(seq (make-array 25 :displaced-to matrix)))
(every #'eq seq (progn (find-words matrix) seq)))
== T
But I make a destructive change to a a cell in MATRIX in GET-WORDS and
later undo that change (so it probably isn't thread-safe).
Here is GET-WORDS
(defun get-words (graph i j)
"Find all possible words starting from GRAPH position I J"
(labels ((rec (i j prefix acc)
(loop for (ni nj) in (adjacent graph i j)
as next = (aref graph ni nj)
as word = (concatenate 'string prefix next)
if (and (>= (length word) *minimum-length*) (wordp
word))
do (push word acc)
when (prefixp word)
do (let ((old (aref graph i j)))
(setf (aref graph i j) 'nil ; change cell
acc (rec ni nj word acc)
(aref graph i j) old)) ; restore change
finally (return acc))))
(rec i j (aref graph i j) '())))
> --
> __Pascal Bourguignon__ http://www.informatimago.com/
Thank you
Vijay
···········@gmail.com writes:
> Pascal Bourguignon wrote:
>> Now, what you seem to be doing in find-words, is just that:
>>
>> (defun find-words (graph)
>> "Given GRAPH find all possible words."
>> (let ((words (get-words graph 0 0)))
>> (if words
>> (copy-list words)
>> '())))
>
> I dont' understand, could you explain more clearly? I search for
> words from every position in the graph. Or did you mean that I create
> a list and throw it away immediately?
Let's start again from your function:
1 (defun find-words (graph)
2 "Given GRAPH find all possible words."
3 (destructuring-bind (m n) (array-dimensions graph)
4 (loop with result = (make-array 0 :adjustable t :fill-pointer 0)
5 as i from 0 to (1- m)
6 do (loop as j from 0 to (1- n)
7 do (loop as word in (get-words graph i j)
8 if (and (zerop i) (zerop j))
9 do (vector-push-extend word result)))
10 finally (return (coerce result '(or cons list))))))
On line 8,9 you test if (and (zerop i) (zerop j))
and push the word to the result only when both i and j are 0.
If get-words has no side effect, then the loops are useless, since i
and j will be 0 only once.
If we add some FORMAT expression to have a look at how your function work:
(defun get-words (graph i j)
(if (and (zerop i) (zerop j))
(list "target word")
(list "other word")))
(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)
initially (format t "~&~D: " i)
do (format t "~D " j)
(loop as word in (get-words graph i j)
if (and (zerop i) (zerop j))
do (assert (and (zerop i) (zerop j)))
(format t "~&[~D:~D] --> ~S~% " i j word)
(vector-push-extend word result)))
finally (return (coerce result '(or cons list))))))
Here is what we get:
[152]> (find-words (make-array (list 10 10)))
0: 0
[0:0] --> "target word"
1 2 3 4 5 6 7 8 9
1: 0 1 2 3 4 5 6 7 8 9
2: 0 1 2 3 4 5 6 7 8 9
3: 0 1 2 3 4 5 6 7 8 9
4: 0 1 2 3 4 5 6 7 8 9
5: 0 1 2 3 4 5 6 7 8 9
6: 0 1 2 3 4 5 6 7 8 9
7: 0 1 2 3 4 5 6 7 8 9
8: 0 1 2 3 4 5 6 7 8 9
9: 0 1 2 3 4 5 6 7 8 9
("target word")
Only when i=0 and j=0 do we push a word to the result.
Why then should we scan the array?
>> Unless get-words is not a pure function. Do you have any side effect
>> in get-words?
>
> I don't know if I can say GET-WORDS is a pure function.
>
> These properties of GET-WORDS are definitely true:
>
> (eq matrix (progn (get-words matrix) matrix)) == T
This is always true (as long as get-words hasn't matrix in its lexical
scope to modify its binding).
What may be more interesting is whether:
(equalp (copy-array matrix) (progn (get-words matrix) matrix))
> and
>
> (let* ((matrix (make-graph "rstcsdeiaegnlrpeatesmssid"))
> (seq (make-array 25 :displaced-to matrix)))
> (every #'eq seq (progn (find-words matrix) seq)))
>
> == T
You cannot ensure that, since EQ for characters may return true or
false randomly.
> But I make a destructive change to a a cell in MATRIX in GET-WORDS and
> later undo that change (so it probably isn't thread-safe).
Ok, so it's essentially side-effect-free, and you don't earn anything
by calling it a hundred times when you keep only the result of
(get-words graph 0 0).
--
__Pascal Bourguignon__ http://www.informatimago.com/
Until real software engineering is developed, the next best practice
is to develop with a dynamic system that has extreme late binding in
all aspects. The first system to really do this in an important way
is Lisp. -- Alan Kay
Pascal Bourguignon wrote:
> ···········@gmail.com writes:
> 8 if (and (zerop i) (zerop j))
Just to cut short this subthread in case you didn't notice, elsewhere in
the thread Vijay mentioned that the above line of code was accidentally
left in when he ran the test and isn't supposed to be there. So his
questions are based on different code, which he has posted in other
messages in the thread.
--
Sidney Markowitz
http://www.sidney.com
···········@gmail.com writes:
> ···········@gmail.com 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.
Alexander Schmolck wrote:
> ···········@gmail.com writes:
>
> > ···········@gmail.com 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 <······@world.std.com> in comp.lang.lisp
···········@gmail.com wrote:
> Any other suggestions? What am I doing wrong?
Maybe nothing, but ever since you found that timing mistake that caused
one Lisp version to only seem to go blazingly fast I keep wondering if
you had the same bug in the Python timing. :)
Do you have a full standalone example others could run? Toss in the
Python version as well. Maybe the ACL profiler will reveal something,
though to be honest I have a wicked hard time understanding its output
(hint to Franz <g>).
I would also be interested in the counts, shy of a full reproducible.
What are the dimensions, how many words found, etc, etc.
kenny
--
Cells: http://common-lisp.net/project/cells/
"I'll say I'm losing my grip, and it feels terrific."
-- Smiling husband to scowling wife, New Yorker cartoon
Ken Tilton wrote:
> ···········@gmail.com wrote:
>
> > Any other suggestions? What am I doing wrong?
>
> Maybe nothing, but ever since you found that timing mistake that caused
> one Lisp version to only seem to go blazingly fast I keep wondering if
> you had the same bug in the Python timing. :)
>
> Do you have a full standalone example others could run? Toss in the
> Python version as well. Maybe the ACL profiler will reveal something,
> though to be honest I have a wicked hard time understanding its output
> (hint to Franz <g>).
I too had a hard time with SBCL's profiler, though, admittedly, I
didn't spend too much time reading the SBCL manual.
> I would also be interested in the counts, shy of a full reproducible.
> What are the dimensions, how many words found, etc, etc.
>
> kenny
>
Here is the lisp I wrote when I fisrt came with my questions.
(defpackage :vijay.boggle
(:use :cl)
(:export :boggle :read-dictionary-file)
(:nicknames :boggle))
(in-package :boggle)
(defvar *words* (make-hash-table :test #'equal)
"The actual dictionary of words.")
(defvar *prefixes* (make-hash-table :test #'equal)
"The prefixes of all the words.")
(defparameter *minimum-length* 3 "The minimum length for any word.")
(defun read-dictionary-file (filename)
"Reads the dictionary in FILENAME and stores it."
(with-open-file (file filename) (read-dictionary file)))
(defun read-dictionary (stream)
"Reads in STREAM and stores its words in the dictionary."
(loop as line = (read-line stream nil nil)
while line
as word = (string-downcase (string-trim #(#\Space #\Tab) line))
if (> (length word) 2) do (add-word word)))
(defun add-word (word)
"Add WORD to the dictionary."
(setf (gethash word *words*) t)
(loop as i from 2 below (1- (length word)) ; prefix ends at
penultimate char
as prefix = (subseq word 0 i)
do (setf (gethash prefix *prefixes*) t)))
(defun sanitize (letters)
"Changes LETTERS into the more commonly used form for the boggle
puzzle, It returns a list of strings of each alphabet in LETTERS.
This is mainly because `q' is actually `qu' for the puzzle."
;; There is a bug in this function. If given `aqcd' it will
;; (correctly) make it `aqucd'. Likewise, `aqucd' will be taken as
;; `aqucd' itself. So if the board has `q' and `u' in adjacent
;; squares, then it MUST be specified as `quu'.
(loop as char across (substitute-substring "q" "qu" letters)
collect (if (char= char #\q) "qu" (string char))))
(defun make-graph (letters)
"Forms the boggle puzzle from LETTERS."
(let* ((chars (sanitize letters))
(side (isqrt (length letters))))
(make-array (list side side)
:displaced-to (make-array (* side side)
:initial-contents chars))))
(defun boggle (letters &optional (*minimum-length* 3))
"Find all possible words in LETTERS."
(delete-duplicates (find-words (make-graph (string-downcase
letters)))
:test #'equal))
(defun find-words (graph)
"Given GRAPH find all possible words."
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = ()
as i from 0 below m
do (loop as j from 0 below n
do (setq result (nconc result (get-words graph i
j))))
finally (return result))))
(defun get-words (graph i j)
"Find all possible words starting from GRAPH position I J"
(labels ((rec (i j prefix acc)
(loop for (ni nj) in (adjacent graph i j)
as next = (aref graph ni nj)
as word = (concatenate 'string prefix next)
if (and (>= (length word) *minimum-length*) (wordp
word))
do (push word acc)
when (prefixp word)
do (let ((old (aref graph i j)))
(setf (aref graph i j) 'nil
acc (rec ni nj word acc)
(aref graph i j) old))
finally (return acc))))
(rec i j (aref graph i j) '())))
(defun wordp (word)
"Is WORD a dictionary word?"
(gethash word *words*))
(defun prefixp (word)
"Are there dictionary words beginning with WORD ?"
(gethash word *prefixes*))
(defun adjacent (graph i j)
"Returns a pair (ai aj) of adjacent positions to GRAPH[i j]"
(let ((side (array-dimension graph 0))
(adjacent '()))
(labels ((legalp (i) (and (>= i 0) (< i side)))
(add (i j)
(if (and (legalp i) (legalp j) (aref graph i j))
(push (list i j) adjacent))))
(let ((i-1 (1- i)) (i+1 (1+ i)) (j-1 (1- j)) (j+1 (1+ j)))
(add i-1 j-1) (add i j-1) (add i+1 j-1)
(add i-1 j) (add i+1 j)
(add i-1 j+1) (add i j+1) (add i+1 j+1))
adjacent)))
(defun substitute-substring (new old string &key (test #'string=))
"Substitutes OLD by NEW in STRING."
(let ((pos (search old string :test test)))
(if pos
(concatenate 'string
(subseq string 0 pos)
new
(substitute-substring new
old
(subseq string (+ pos
(length old)))
:test test))
string)))
;;; *eof*
;;;;;; Python code follows
from math import sqrt
WORDS = {}
def read_dictionary(stream):
'Read the file for words for the dictionary.'
for line in stream.readlines():
word = line.lower().strip()
if len(word) > 2: add_word(word)
def add_word(word):
'Add a word to the dictionary.'
global WORDS
WORDS[word] = True
for i in range(2,len(word)):
prefix = word[:i]
if not is_prefix(prefix):
WORDS[prefix] = 0
def make_graph(letters):
"Form the boggle puzzle given LETTERS."
letters.replace('qu', 'q')
side = int(sqrt(len(letters)))
graph = [[] for i in range(side)]
for i in range(side):
graph[i] = [[] for j in range(side)]
k = 0
for i in range(side):
for j in range(side):
graph[i][j] = letters[k].replace('q', 'qu')
k += 1
return graph
def boggle (letters):
'Solve the boggle puzzle for the given letters'
return list(set(find_words(make_graph(letters.lower()))))
def find_words(graph):
m, n = len(graph), len(graph[0])
results = []
for i in range(m):
for j in range(n):
results.extend(get_words(graph, i, j))
return results
def get_words(graph, i, j):
def rec(i, j, prefix, acc):
for ni, nj in adjacent(graph, i, j):
next = graph[ni][nj]
word = prefix + next
if len(word) > 3 and is_word(word):
acc.append(word)
if is_prefix(word):
old_val = graph[i][j]
graph[i][j] = ''
acc = rec(ni, nj, word, acc)
graph[i][j] = old_val
return acc
return rec(i, j, graph[i][j], [])
def is_word(word):
global WORDS
return is_prefix(word) and WORDS[word]
def is_prefix(word):
global WORDS
return WORDS.has_key(word)
def adjacent(graph, i, j):
m = len(graph)
adjacent = []
is_legal = lambda i: i >= 0 and i < m
def add(i, j):
if is_legal(i) and is_legal(j) and graph[i][j]:
adjacent.append((i, j))
add(i-1, j-1); add(i, j-1); add(i+1, j-1)
add(i-1, j); add(i+1, j)
add(i-1, j+1); add(i, j+1); add(i+1, j+1)
return adjacent
### eof
As to my bug in the FIND-WORDS
(loop ... if (and (zerop i) (zerop j)) do (get-words graph i j) ...)
was because I had included the IF for debugging and I'm so used to C-k
killing sexp (because I use paredit.el) that I forgot that LOOP dealt
with lines. Hence the mistake. I corrected it in other posts. I
apologize for the confusion caused.
The python code is almost the exact same as the lisp code. I was
bored one day and translated lisp to python. Right now I am not very
concerned about efficiency or style in python (after this, I'll ask
the fine folks at comp.lang.python :-)
However, the python code runs faster (for this particular input) than
the lisp code. It is also shorter but not by much. The advantage in
python is that I can use (in find_words) results.extend to accumulate
the values.
About the input, I saw on Peter Norvig's site that
"rstcsdeiaegnlrpeatesmssid" gives the most number of words (2905) for
the same dictionary that Sidney Markowitz refers to
http://www.gtoal.com/wordgames/yawl/word.list This is the same
dictionary that I use and I get the same number of words. For this
input, the python code is faster by a factor of 2. When I discard the
results in both of them, lisp is faster by a factor of about 3. For
inputs which don't give many results like "abcdefghijklmnopqrstuvwxy"
the lisp code is faster by about 1.5 to 2. For "abcd...wxy" lisp
takes a mere 0.013 seconds.
Coming back to lisp, I don't believe that the bottleneck is in
GET-WORDS. The timings when I dont' accumulate the results from
GET-WORDS (as Sidney Markowitz asked) I get the best time of 0.15
seconds. So even if GET-WORDS can be further optimized (as noted by
Kaz Kylheku in several places), I believe the greatest time is taken
when so many results need to be stitched together.
I restarted my computer (it's been on for a few weeks now) and ran all
these tests again. Here are the new numbers with corresponding code.
BOGGLE>
(run
(defun find-words (graph)
"Original FIND-WORDS"
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = ()
as i from 0 below m
do (loop as j from 0 below n
do (setq result (nconc result (get-words graph i
j))))
finally (return result))))
(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)
"collect and flatten"
(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)
collecting (get-words graph i j) into results
finally (return (apply #'nconc results))))))
(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 'list)))))
(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 'list)))))
(defun find-words (graph)
"discard 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)))))
(defun find-words (graph)
"change order of nconc arguments"
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = '()
as i from 0 below m
do (loop as j from 0 below n
do (setf result (nconc (get-words graph i j)
result)))
finally (return result))))
(progn
(defvar *collect* nil)
(defun find-words (graph)
"collect with special variable"
(destructuring-bind (m n) (array-dimensions graph)
(loop with *collect* = '()
as i from 0 below m
do (loop as j from 0 below n
do (get-words graph i j))
finally (return *collect*))))
(defun get-words (graph i j)
"find all possible words starting from graph position i j"
(labels ((rec (i j prefix)
(loop for (ni nj) in (adjacent graph i j)
as next = (aref graph ni nj)
as word = (concatenate 'string prefix next)
if (and (>= (length word) *minimum-length*)
(wordp word))
do (push word *collect*)
when (prefixp word)
do (let ((old (aref graph i j)))
(setf (aref graph i j) 'nil)
(rec ni nj word)
(setf (aref graph i j) old)))))
(rec i j (aref graph i j))))
))
Original FIND-WORDS --> 0.79526
use tail pointer --> 0.77866
loop nconcs --> 0.7815
collect and flatten --> 0.77976
hash-table --> 0.5194
vector-push-extend --> 0.77916
concatenate --> 0.78652
discard results --> 0.1086
change order of nconc arguments --> 0.73612
collect with special variable --> 0.73658
I look forward to more of your insightful comments.
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 <······@world.std.com> in comp.lang.lisp
No way! It suggests that they have transcended ordinary existence to
dwell among the symbols. Moreover, it shows that we are actually
interested in /them/ and not merely in what they can evaluate for us.
-- Kaz Kylheku in comp.lang.lisp
···········@gmail.com wrote:
> Ken Tilton wrote:
>
>>···········@gmail.com wrote:
>>
>>
>>>Any other suggestions? What am I doing wrong?
>>
>>Maybe nothing, but ever since you found that timing mistake that caused
>>one Lisp version to only seem to go blazingly fast I keep wondering if
>>you had the same bug in the Python timing. :)
>>
>>Do you have a full standalone example others could run? Toss in the
>>Python version as well. Maybe the ACL profiler will reveal something,
>>though to be honest I have a wicked hard time understanding its output
>>(hint to Franz <g>).
>
>
> I too had a hard time with SBCL's profiler, though, admittedly, I
> didn't spend too much time reading the SBCL manual.
>
>
>>I would also be interested in the counts, shy of a full reproducible.
>>What are the dimensions, how many words found, etc, etc.
>>
>>kenny
>>
>
>
> Here is the lisp I wrote when I fisrt came with my questions.
Actually, now I wish I had just the counts. esp, how many words are
being stored and how many distinct prefixes, because...
>
> (defpackage :vijay.boggle
> (:use :cl)
> (:export :boggle :read-dictionary-file)
> (:nicknames :boggle))
>
> (in-package :boggle)
>
>
> (defvar *words* (make-hash-table :test #'equal)
> "The actual dictionary of words.")
> (defvar *prefixes* (make-hash-table :test #'equal)
> "The prefixes of all the words.")
> (defparameter *minimum-length* 3 "The minimum length for any word.")
>
> (defun read-dictionary-file (filename)
> "Reads the dictionary in FILENAME and stores it."
> (with-open-file (file filename) (read-dictionary file)))
>
> (defun read-dictionary (stream)
> "Reads in STREAM and stores its words in the dictionary."
> (loop as line = (read-line stream nil nil)
> while line
> as word = (string-downcase (string-trim #(#\Space #\Tab) line))
> if (> (length word) 2) do (add-word word)))
>
> (defun add-word (word)
> "Add WORD to the dictionary."
> (setf (gethash word *words*) t)
> (loop as i from 2 below (1- (length word)) ; prefix ends at
> penultimate char
> as prefix = (subseq word 0 i)
"subseq creates a sequence that is a copy of the subsequence of sequence
bounded by start and end. "
Ouch. Just to store a prefix we first cons up an entire copy of the
prefix? Hello performance hit. I be guessing Python, being a C
derivative, is just using a fixed pointer and length from the i
subscript and hashing off the intervening characters. The lisp
equivalent would be....? I don't know. I am no array wizard, but it
seems to me you need some costless way to take a full word and hand
increasingly long subsequences (not using SUBSEQ!) to gethash just by
incrementing a pointer (which is what I am guessing Python is doing).
I'll leave that as an exercise, but this is the classic Lisp newby
performance gotcha. Yeah, subseq is awesome for the 99 times out of 100
that you do not want to get killed by side effects (or is that 9999 out
of 10000?), but whenever a Lispnik is writing code they know will get
hit a kazillion times and they also need it to run close to the speed of
C, well, when they get tempted to use subseq or any other such chunking
form they know enough to look it up in the CLHS to see if it copies.
kt
--
Cells: http://common-lisp.net/project/cells/
"I'll say I'm losing my grip, and it feels terrific."
-- Smiling husband to scowling wife, New Yorker cartoon
Ken Tilton wrote:
> Ouch. Just to store a prefix we first cons up an entire copy of the
> prefix? Hello performance hit.
Ouch. I just played around with some tests and it's late and I might
have screwed things up, but Lisp (or ACL at least) may be smarter than I
thought, no apparent... well, like I said, I am no array guru, maybe my
hack was not the best.
kt
--
Cells: http://common-lisp.net/project/cells/
"I'll say I'm losing my grip, and it feels terrific."
-- Smiling husband to scowling wife, New Yorker cartoon
Ken Tilton <·········@gmail.com> wrote:
+---------------
| "subseq creates a sequence that is a copy of the subsequence of sequence
| bounded by start and end. "
|
| Ouch. Just to store a prefix we first cons up an entire copy of the
| prefix? Hello performance hit.
+---------------
Yes, but... If the "word" is coming from a mutable place, say,
a fixed buffer or an array with a fill pointer that's being
repeatedly written into, then you *must* cons copies of the
"word" or any portion of it that's being used as a hash table
key, else run the risk of snot monkeys:
18.1.2 Modifying Hash Table Keys
...
If an object O1 is used as a key in a hash table H and is then
visibly modified with regard to the equivalence test of H, then
the consequences are unspecified if O1, or any object O2 equivalent
to O1 under the equivalence test (either before or after the
modification), is used as a key in further operations on H.
One approach that *might* buy a little performance is to (after
copying the initial "word" *once*, if needed for immutability)
make the prefixes be 1-, 2-, and 3-element arrays displaced to
the "word". Though note that with *most* implementations'
representations of displaced arrays, consing up a simple 1-, 2-,
or 3-char string with SUBSEQ is likely to be *far* less expensive
than consing up a displaced arrays. (*sigh*)
-Rob
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
*Oops!* Some hours ago, I wrote:
+---------------
| One approach that *might* buy a little performance is to (after
| copying the initial "word" *once*, if needed for immutability)
| make the prefixes be 1-, 2-, and 3-element arrays displaced to
| the "word". Though note that with *most* implementations'
| representations of displaced arrays, consing up a simple 1-, 2-,
| or 3-char string with SUBSEQ is likely to be *far* less expensive
| than consing up a displaced arrays. (*sigh*)
+---------------
Looking back, I see I had misunderstood the problem: the *minimum*
abbreviation is 3 characters, right? In that case, modify what I said
above to be this:
One approach that *might* buy a little performance is to (after
copying the initial "word" *once*, if needed for immutability)
create prefixes above a certain size [which will depend on the
CL implementation you're using] by using arrays displaced to
"word", e.g.:
> (let ((word (copy-seq "abcdefghijklmnopqrstuvwxyz"))
(copy-vs-displace-threshold 10))
(loop for i from 3 to (1- (length word)) collect
(if (> i copy-vs-displace-threshold)
(make-array i :element-type 'base-char :displaced-to word)
(subseq word 0 i))))
("abc" "abcd" "abcde" "abcdef" "abcdefg" "abcdefgh" "abcdefghi"
"abcdefghij" "abcdefghijk" "abcdefghijkl" "abcdefghijklm"
"abcdefghijklmn" "abcdefghijklmno" "abcdefghijklmnop"
"abcdefghijklmnopq" "abcdefghijklmnopqr" "abcdefghijklmnopqrs"
"abcdefghijklmnopqrst" "abcdefghijklmnopqrstu"
"abcdefghijklmnopqrstuv" "abcdefghijklmnopqrstuvw"
"abcdefghijklmnopqrstuvwx" "abcdefghijklmnopqrstuvwxy")
> (mapcar 'type-of *)
((SIMPLE-BASE-STRING 3) (SIMPLE-BASE-STRING 4) (SIMPLE-BASE-STRING 5)
(SIMPLE-BASE-STRING 6) (SIMPLE-BASE-STRING 7) (SIMPLE-BASE-STRING 8)
(SIMPLE-BASE-STRING 9) (SIMPLE-BASE-STRING 10) (BASE-STRING 11)
(BASE-STRING 12) (BASE-STRING 13) (BASE-STRING 14) (BASE-STRING 15)
(BASE-STRING 16) (BASE-STRING 17) (BASE-STRING 18) (BASE-STRING 19)
(BASE-STRING 20) (BASE-STRING 21) (BASE-STRING 22) (BASE-STRING 23)
(BASE-STRING 24) (BASE-STRING 25))
> (mapcar 'array-displacement **)
(NIL NIL NIL NIL NIL NIL NIL NIL "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz")
> (mapcar (lambda (x) (eq x (nth 8 *))) *)
(NIL NIL NIL NIL NIL NIL NIL NIL T T T T T T T T T T T T T T T)
>
If you set COPY-VS-DISPLACE-THRESHOLD more-or-less correctly,
this will use much less space for *large* words than using
SUBSEQ for all the prefixes.
-Rob
p.s. Hmmm... Doing a little peeking under the covers of CMUCL,
it seems like an appropriate value for COPY-VS-DISPLACE-THRESHOLD
there would be 21-24 characters. For lengths smaller than 21, a
SIMPLE-STRING will take less space that a displaced-array header.
Other implementations will vary, of course...
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
Ken Tilton wrote:
> ···········@gmail.com wrote:
> > Ken Tilton wrote:
> >
[snip]
>
> Actually, now I wish I had just the counts. esp, how many words are
> being stored and how many distinct prefixes, because...
>
> >
> > (defpackage :vijay.boggle
> > (:use :cl)
> > (:export :boggle :read-dictionary-file)
> > (:nicknames :boggle))
> >
> > (in-package :boggle)
> >
> >
> > (defvar *words* (make-hash-table :test #'equal)
> > "The actual dictionary of words.")
> > (defvar *prefixes* (make-hash-table :test #'equal)
> > "The prefixes of all the words.")
> > (defparameter *minimum-length* 3 "The minimum length for any word.")
> >
> > (defun read-dictionary-file (filename)
> > "Reads the dictionary in FILENAME and stores it."
> > (with-open-file (file filename) (read-dictionary file)))
> >
> > (defun read-dictionary (stream)
> > "Reads in STREAM and stores its words in the dictionary."
> > (loop as line = (read-line stream nil nil)
> > while line
> > as word = (string-downcase (string-trim #(#\Space #\Tab) line))
> > if (> (length word) 2) do (add-word word)))
> >
> > (defun add-word (word)
> > "Add WORD to the dictionary."
> > (setf (gethash word *words*) t)
> > (loop as i from 2 below (1- (length word)) ; prefix ends at
> > penultimate char
> > as prefix = (subseq word 0 i)
>
> "subseq creates a sequence that is a copy of the subsequence of sequence
> bounded by start and end. "
>
> Ouch. Just to store a prefix we first cons up an entire copy of the
> prefix? Hello performance hit. I be guessing Python, being a C
> derivative, is just using a fixed pointer and length from the i
> subscript and hashing off the intervening characters. The lisp
> equivalent would be....? I don't know. I am no array wizard, but it
> seems to me you need some costless way to take a full word and hand
> increasingly long subsequences (not using SUBSEQ!) to gethash just by
> incrementing a pointer (which is what I am guessing Python is doing).
Does this do the trick?
CL-USER>
(defun subarray (array start &optional end)
(setq end (or end (length array)))
(let* ((type (type-of array))
(element-type (if (null (third type)) t (second type))))
(make-array (- end start) :displaced-to array
:displaced-index-offset start
:element-type element-type)))
SUBARRAY
CL-USER> (let* ((string "abcdefghijklm")
(array (make-array (length string)
:element-type 'character
:initial-contents string))
(subarray (subarray array 3 6)))
(setf (aref array 4) #\x)
(values array subarray))
"abcdxfghijklm"
"dxf"
> I'll leave that as an exercise, but this is the classic Lisp newby
> performance gotcha. Yeah, subseq is awesome for the 99 times out of 100
> that you do not want to get killed by side effects (or is that 9999 out
> of 10000?), but whenever a Lispnik is writing code they know will get
> hit a kazillion times and they also need it to run close to the speed of
> C, well, when they get tempted to use subseq or any other such chunking
> form they know enough to look it up in the CLHS to see if it copies.
>
> kt
However, using SUBARRAY does not seem to improve performance.
BOGGLE>
(loop with count = 10
with start and stop
repeat count
initially (defun add-word (word)
"Add WORD to the dictionary."
(setf (gethash word *words*) t)
(loop as i from 2 below (1- (length word))
as prefix = (subseq word 0 i)
do (setf (gethash prefix *prefixes*) t)))
(sb-profile:profile add-word)
do (clrhash *words*)
(clrhash *prefixes*)
(setq start (get-internal-real-time))
(read-dictionary-file "word.list")
(setq stop (get-internal-real-time))
summing (- stop start) into sum
finally (return (float (/ sum count 1000))))
STYLE-WARNING: redefining ADD-WORD in DEFUN
4.4092
BOGGLE> (sb-profile:report)
seconds | consed | calls | sec/call | name
-------------------------------------------------------------
24.452 | 722,756,760 | 2,639,380 | 0.000009 | ADD-WORD
-------------------------------------------------------------
24.452 | 722,756,760 | 2,639,380 | | Total
estimated total profiling overhead: 7.33 seconds
overhead estimation parameters:
4.e-8s/call, 2.776e-6s total profiling, 1.1440001e-6s internal
profiling
; No value
BOGGLE> (sb-profile:unprofile)
NIL
BOGGLE>
(loop with count = 10
with start and stop
repeat count
initially (defun add-word (word)
"Add WORD to the dictionary."
(setf (gethash word *words*) t)
(loop as i from 2 below (1- (length word))
as prefix = (subarray word 0 i)
do (setf (gethash prefix *prefixes*) t)))
(sb-profile:profile add-word)
do (clrhash *words*)
(clrhash *prefixes*)
(setq start (get-internal-real-time))
(read-dictionary-file "word.list")
(setq stop (get-internal-real-time))
summing (- stop start) into sum
finally (return (float (/ sum count 1000))))
STYLE-WARNING: redefining ADD-WORD in DEFUN
6.0693
BOGGLE> (sb-profile:report)
seconds | consed | calls | sec/call | name
---------------------------------------------------------------
39.296 | 1,398,909,056 | 2,639,380 | 0.000015 | ADD-WORD
---------------------------------------------------------------
39.296 | 1,398,909,056 | 2,639,380 | | Total
estimated total profiling overhead: 7.33 seconds
overhead estimation parameters:
4.e-8s/call, 2.776e-6s total profiling, 1.1440001e-6s internal
profiling
; No value
to ease comparision:
seconds | consed | calls | sec/call | name
---------------------------------------------------------------
24.452 | 722,756,760 | 2,639,380 | 0.000009 | ADD-WORD (subseq)
39.296 | 1,398,909,056 | 2,639,380 | 0.000015 | ADD-WORD
(subarray)
---------------------------------------------------------------
I don't understand why this happens. Or I am making a mistake?
Please advise.
Cheers
Vijay
···········@gmail.com <···········@gmail.com> wrote:
> I too had a hard time with SBCL's profiler,
Could you elaborate on that?
> though, admittedly, I
> didn't spend too much time reading the SBCL manual.
In that case you might not have noticed that SBCL includes two
profilers. You might find SB-SPROF to be more useful than SB-PROFILE
for this particular case.
--
Juho Snellman
Juho Snellman wrote:
> ···········@gmail.com <···········@gmail.com> wrote:
> > I too had a hard time with SBCL's profiler,
>
> Could you elaborate on that?
It was again my own mistake with SB-PROFILE. It turns out that it
gave me the right execution time for FIND-WORDS the first time. But I
thought something was wrong because it didn't fit my beliefs. Also it
surprised me that the profiler showed FIND-WORDS taking more time when
I discarded the results. This is possibly true even now and that
FIND-WORDS takes more time when discarding but it didn't seem to match
up because the overall time taken in such a case was very less (since
DELETE-DUPLICATES had an empty list).
Confused, I tried the following function, and I still don't understand
why the profiler's behaviour in this case. It was this that led me to
give up on SB-PROFILE.
CL-USER> (defun one-sec () (sleep 1))
ONE-SEC
CL-USER> (sb-profile:profile one-sec)
; No value
CL-USER> (loop repeat 5 do (one-sec))
NIL
CL-USER> (sb-profile:report)
seconds | consed | calls | sec/call | name
----------------------------------------------------
0.000 | 0 | 5 | 0.000000 | ONE-SEC
----------------------------------------------------
0.000 | 0 | 5 | | Total
estimated total profiling overhead: .000 seconds
overhead estimation parameters:
4.e-8s/call, 2.8240001e-6s total profiling, 1.256e-6s internal
profiling
; No value
Why doesn't it take into consideration the sleep time?
The only reason I didn't elaborate right here was because I planned to
come to the SBCL mailing list with this question later.
If it helps, I'm using SBCL 0.9.8 on Ubuntu 6.06 I just apt-get'ed the
packaged version.
> > though, admittedly, I
> > didn't spend too much time reading the SBCL manual.
>
> In that case you might not have noticed that SBCL includes two
> profilers. You might find SB-SPROF to be more useful than SB-PROFILE
> for this particular case.
And yes, I did see there are two profilers. I went for the first
because it seemed simpler and similar to TRACE/UNTRACE.
Cheers,
Vijay
···········@gmail.com wrote:
> Juho Snellman wrote:
>> ···········@gmail.com <···········@gmail.com> wrote:
>> > I too had a hard time with SBCL's profiler,
>>
>> Could you elaborate on that?
>
> It was again my own mistake with SB-PROFILE. It turns out that it
> gave me the right execution time for FIND-WORDS the first time. But I
> thought something was wrong because it didn't fit my beliefs. Also it
> surprised me that the profiler showed FIND-WORDS taking more time when
> I discarded the results. This is possibly true even now and that
> FIND-WORDS takes more time when discarding but it didn't seem to match
> up because the overall time taken in such a case was very less (since
> DELETE-DUPLICATES had an empty list).
>
> Confused, I tried the following function, and I still don't understand
> why the profiler's behaviour in this case. It was this that led me to
> give up on SB-PROFILE.
>
> CL-USER> (defun one-sec () (sleep 1))
>
> ONE-SEC
> CL-USER> (sb-profile:profile one-sec)
> ; No value
> CL-USER> (loop repeat 5 do (one-sec))
> NIL
> CL-USER> (sb-profile:report)
> seconds | consed | calls | sec/call | name
> ----------------------------------------------------
> 0.000 | 0 | 5 | 0.000000 | ONE-SEC
> ----------------------------------------------------
> 0.000 | 0 | 5 | | Total
>
> estimated total profiling overhead: .000 seconds
> overhead estimation parameters:
> 4.e-8s/call, 2.8240001e-6s total profiling, 1.256e-6s internal
> profiling
> ; No value
>
> Why doesn't it take into consideration the sleep time?
>
> The only reason I didn't elaborate right here was because I planned to
> come to the SBCL mailing list with this question later.
>
> If it helps, I'm using SBCL 0.9.8 on Ubuntu 6.06 I just apt-get'ed the
> packaged version.
>
>> > though, admittedly, I
>> > didn't spend too much time reading the SBCL manual.
>>
>> In that case you might not have noticed that SBCL includes two
>> profilers. You might find SB-SPROF to be more useful than SB-PROFILE
>> for this particular case.
>
> And yes, I did see there are two profilers. I went for the first
> because it seemed simpler and similar to TRACE/UNTRACE.
>
> Cheers,
> Vijay
Let me guess. You use a threaded sbcl (like I do, thus I was able to
reproduce the effect). I suppose the reason is the context switch
most operating systems and computer languages do in sleep and the
fact that profile measures time spent *in* the thread, not the process time.
I couldn't explain it otherwise. But in other cases sb-profile in pretty
stable and you can rely on it.
Leonid Slobodov
Leonid Slobodov wrote:
> ···········@gmail.com wrote:
>
> > Juho Snellman wrote:
> >> ···········@gmail.com <···········@gmail.com> wrote:
> >> > I too had a hard time with SBCL's profiler,
> >>
> >> Could you elaborate on that?
> >
> > It was again my own mistake with SB-PROFILE. It turns out that it
> > gave me the right execution time for FIND-WORDS the first time. But I
> > thought something was wrong because it didn't fit my beliefs. Also it
> > surprised me that the profiler showed FIND-WORDS taking more time when
> > I discarded the results. This is possibly true even now and that
> > FIND-WORDS takes more time when discarding but it didn't seem to match
> > up because the overall time taken in such a case was very less (since
> > DELETE-DUPLICATES had an empty list).
> >
> > Confused, I tried the following function, and I still don't understand
> > why the profiler's behaviour in this case. It was this that led me to
> > give up on SB-PROFILE.
> >
> > CL-USER> (defun one-sec () (sleep 1))
> >
> > ONE-SEC
> > CL-USER> (sb-profile:profile one-sec)
> > ; No value
> > CL-USER> (loop repeat 5 do (one-sec))
> > NIL
> > CL-USER> (sb-profile:report)
> > seconds | consed | calls | sec/call | name
> > ----------------------------------------------------
> > 0.000 | 0 | 5 | 0.000000 | ONE-SEC
> > ----------------------------------------------------
> > 0.000 | 0 | 5 | | Total
> >
> > estimated total profiling overhead: .000 seconds
> > overhead estimation parameters:
> > 4.e-8s/call, 2.8240001e-6s total profiling, 1.256e-6s internal
> > profiling
> > ; No value
> >
> > Why doesn't it take into consideration the sleep time?
> >
> > The only reason I didn't elaborate right here was because I planned to
> > come to the SBCL mailing list with this question later.
> >
> > If it helps, I'm using SBCL 0.9.8 on Ubuntu 6.06 I just apt-get'ed the
> > packaged version.
> >
> >> > though, admittedly, I
> >> > didn't spend too much time reading the SBCL manual.
> >>
> >> In that case you might not have noticed that SBCL includes two
> >> profilers. You might find SB-SPROF to be more useful than SB-PROFILE
> >> for this particular case.
> >
> > And yes, I did see there are two profilers. I went for the first
> > because it seemed simpler and similar to TRACE/UNTRACE.
> >
> > Cheers,
> > Vijay
>
> Let me guess. You use a threaded sbcl (like I do, thus I was able to
> reproduce the effect). I suppose the reason is the context switch
> most operating systems and computer languages do in sleep and the
> fact that profile measures time spent *in* the thread, not the process time.
> I couldn't explain it otherwise. But in other cases sb-profile in pretty
> stable and you can rely on it.
Actually, it is a little stranger that that:
CL-USER> (defun take-time () (loop as i from 0 to
most-positive-fixnum))
TAKE-TIME
CL-USER> (defun call-take-time () (take-time))
CALL-TAKE-TIME
CL-USER> (sb-profile:profile take-time call-take-time)
; No value
CL-USER> (call-take-time)
NIL
CL-USER> (sb-profile:report)
seconds | consed | calls | sec/call | name
----------------------------------------------------
1.397 | 0 | 1 | 1.396999 | TAKE-TIME
0.000 | 0 | 1 | 0.000000 | CALL-TAKE-TIME
----------------------------------------------------
1.397 | 0 | 2 | | Total
estimated total profiling overhead: .000 seconds
overhead estimation parameters:
4.e-8s/call, 2.776e-6s total profiling, 1.1440001e-6s internal
profiling
; No value
CL-USER> (loop repeat 49 do (call-take-time))
NIL
CL-USER> (sb-profile:report)
seconds | consed | calls | sec/call | name
----------------------------------------------------
34.087 | 33,112 | 50 | 0.681739 | TAKE-TIME
0.000 | 0 | 50 | 0.000000 | CALL-TAKE-TIME
----------------------------------------------------
34.087 | 33,112 | 100 | | Total
estimated total profiling overhead: .000 seconds
overhead estimation parameters:
4.e-8s/call, 2.776e-6s total profiling, 1.1440001e-6s internal
profiling
; No value
I think it only calculates the time taken by code within the function,
excluding other function calls. But to me that isn't what I expect.
I would expect that
time(CALL-TAKE-TIME) = time(TAKE-TIME) + X
where X = time spent in CALL-TAKE-TIME
Cheers
Vijay
···········@gmail.com <···········@gmail.com> wrote:
[... SB-PROFILE ...]
> I think it only calculates the time taken by code within the function,
> excluding other function calls.
Not quite. It measures time spent in that function, or non-profiled
functions called from it. So if you don't profile TAKE-TIME in your
example, the time will be accounted to CALL-TAKE-TIME.
> But to me that isn't what I expect.
> I would expect that
>
> time(CALL-TAKE-TIME) = time(TAKE-TIME) + X
> where X = time spent in CALL-TAKE-TIME
That doesn't seem very useful when TAKE-TIME is also profiled, since
the time spent in TAKE-TIME will get double-counted as being spent in
both functions.
--
Juho Snellman
···········@gmail.com <···········@gmail.com> wrote:
> CL-USER> (defun one-sec () (sleep 1))
[...]
> CL-USER> (loop repeat 5 do (one-sec))
[...]
> 0.000 | 0 | 5 | 0.000000 | ONE-SEC
[...]
> Why doesn't it take into consideration the sleep time?
The profiler measures the amount of time that the CPU spent executing
the program instead of using the amount of "real" or "wall-clock" time
that was spent [*]. The CPU resources required for sleeping are
minute, so while executing your ONE-SEC function takes a second of
real time, the amount of CPU time spent is smaller then the profiler's
resolution.
To see why this is desireable, consider the following case. You make a
profiling run, note the results, and make some improvements to the
program based on those. While doing a second profiling run, some other
program starts consuming CPU resources (maybe a new process started by
crond, or you browsed to a web site that has a bunch of animated flash
ads, or whatever). If you measure "real" time, this second run would
show worse performance since part of the time was spent running the
other programs.
[*] The CPU time being the sum of Unix "system" and "user" times in
this case. See also: GET-INTERNAL-RUN-TIME and GET-INTERNAL-REAL-TIME
--
Juho Snellman
···········@gmail.com wrote:
> Here is the lisp I wrote when I fisrt came with my questions.
I see the problem now. Our machines are of similar speed and we are both
using sbcl, so I get results quite close to yours on your code.
The problem is that you are timing the entire boggle function, and
almost all the time is being spent in the final delete-duplicates of the
return value from find-words. Without the delete-duplicates, you see the
tenth of a second run time that you have in the "discarding results"
case. Since our run times are so similar I can say with confidence that
almost all of that tenth of a second is spent in get-words, mostly in
the hash table lookups in the calls to wordp and prefixp. find-words
itself is very fast, so when you try out variations you are only seeing
speed variations on the order of one or two hundredths of a second.
The odd fast timing in the hash-table version is because the hash-table
based find-words does not produce any duplicates. The call to
delete-duplicates still takes a long time in that case, but it is being
passed a much shorter list and is therefore faster than in the other
cases. You can experiment with variations that also have that property
such as adding a word to the accumulated list using pushnew, or using
nunion instead of nconc to see if the overall savings makes up for the
extra operations each time you add words to the accumulated results. Or
perhaps you could have some extra slot in the dictionary items to record
when a word has been used in a particular run, skipping it if it is
encountered again in that run.
In any case, with the bulk of your time being spent eliminating
duplicates, your biggest immediate savings are to be had avoiding adding
duplicates in the first place.
When I was timing I was doing the equivalent of
(setf *testgraph* (make-graph (string-downcase letters)))
(time (find-words *testgraph*)
which avoided including the setup time for the graph or the
delete-duplicates that I did not know about until you posted the boggle
function.
That reveals the next biggest candidate for optimization, which is the
get-hash calls in get-word. That's where using a trie might help.
--
Sidney Markowitz
http://www.sidney.com
Sidney Markowitz wrote:
> ···········@gmail.com wrote:
> > Here is the lisp I wrote when I fisrt came with my questions.
>
> I see the problem now. Our machines are of similar speed and we are both
> using sbcl, so I get results quite close to yours on your code.
>
> The problem is that you are timing the entire boggle function, and
> almost all the time is being spent in the final delete-duplicates of the
> return value from find-words. Without the delete-duplicates, you see the
> tenth of a second run time that you have in the "discarding results"
> case. Since our run times are so similar I can say with confidence that
> almost all of that tenth of a second is spent in get-words, mostly in
> the hash table lookups in the calls to wordp and prefixp. find-words
> itself is very fast, so when you try out variations you are only seeing
> speed variations on the order of one or two hundredths of a second.
>
> The odd fast timing in the hash-table version is because the hash-table
> based find-words does not produce any duplicates. The call to
> delete-duplicates still takes a long time in that case, but it is being
> passed a much shorter list and is therefore faster than in the other
> cases. You can experiment with variations that also have that property
> such as adding a word to the accumulated list using pushnew, or using
> nunion instead of nconc to see if the overall savings makes up for the
> extra operations each time you add words to the accumulated results. Or
> perhaps you could have some extra slot in the dictionary items to record
> when a word has been used in a particular run, skipping it if it is
> encountered again in that run.
>
> In any case, with the bulk of your time being spent eliminating
> duplicates, your biggest immediate savings are to be had avoiding adding
> duplicates in the first place.
>
> When I was timing I was doing the equivalent of
>
> (setf *testgraph* (make-graph (string-downcase letters)))
> (time (find-words *testgraph*)
>
> which avoided including the setup time for the graph or the
> delete-duplicates that I did not know about until you posted the boggle
> function.
>
> That reveals the next biggest candidate for optimization, which is the
> get-hash calls in get-word. That's where using a trie might help.
>
First, I apologize to everyone for my blunder. It never occured to me
that the DELETE-DUPLICATES would be the bottle-neck I was actually
looking for. Now that you have pointed it out, it is obvious to me
because it is an O(n^2) operation on a very long list.
Next time, I shall post the code up front so you can see the problem
right away rather than several posts and a few days later.
Sidney, your suggestions do work much better than my previous
implementation. Here are my results using NUNION in FIND-WORDS:
CL-USER> (sb-profile:profile boggle::find-words boggle::get-words)
; No value
CL-USER> (loop with count = 50
with start and stop
repeat count
do (setq start (get-internal-real-time))
(boggle:boggle "rstcsdeiaegnlrpeatesmssid")
(setq stop (get-internal-real-time))
summing (- stop start) into sum
finally (return (float (/ sum count 1000))))
0.2355
CL-USER> (sb-profile:report)
seconds | consed | calls | sec/call | name
---------------------------------------------------------
6.231 | 208,681,400 | 1,250 | 0.004984 | VIJAY.BOGGLE::GET-WORDS
5.454 | 69,632 | 50 | 0.109078 |
VIJAY.BOGGLE::FIND-WORDS
---------------------------------------------------------
11.684 | 208,751,032 | 1,300 | | Total
estimated total profiling overhead: .004 seconds
overhead estimation parameters:
4.e-8s/call, 2.776e-6s total profiling, 1.1440001e-6s internal
profiling
; No value
I shall work on the others and get back to you soon.
Once again, my apologies and many thanks to all.
Cheers
Vijay
···········@gmail.com wrote:
> Any other suggestions? What am I doing wrong?
Vijay, I'm not sure what is going on, but something seems wrong about
the numbers you are getting.
I coded up something for the functions that you haven't posted yet,
because it did not make sense to me that get-words good be so fast
compared to the find-words code.
I did a quick and dirty implementation using two hash tables, one to
store all the 262149 words of length between 4 and 25 characters in the
word game dictionary at http://www.gtoal.com/wordgames/yawl/word.list,
and another to store the 416439 prefixes of those words. That made wordp
and prefixp be simple hash lookups, probably not quite as efficient as
using tries, but good enough for this test.
I also did not put effort into optimizing the adjacent function or
avoiding concatenating new strings in get-words.
I did find a bug in your code, which I don't see how you avoided, as it
caused infinite recursion and a crash when I tried to run.
The bug is in the loop in get-words, that you never check if the return
value from (aref matrix ni nj) is nil, which indicates that position (ni
nj) has already been used. Here is how it can cause an infinite loop:
Let's say position (0 0) is "r", (1 1) is "e" and (1 0) is "s". When you
have checked those three and are now in a call to (rec 1 0 "res" acc),
when you then check the adjacent sell (0 0) the variable next is set to
(concatenate 'string "res" nil) which is "res". That is not a word and
is a prefix, resulting in a call to (rec 0 0 "res" acc). When that
checks position (1 0) it also finds a nil value, resulting in the prefix
remaining "res" and another cal to (rec 1 0 "res" acc). And you have an
infinite loop.
Oh, I guess if you check the contents of (aref matrix x y) and if it is
nil don't add (list x y) to the return value in the call to (adjacent
matrix i j) then that would also avoid the bug, but that seems like it
would be more expensive than testing for next being null in get-words.
So maybe you don't have this bug. I can't tell without seeing your
adjacent function.
Another bug is that the hash-table version has different results than
the others. Try looking at the length of the return values from
find-word. The hash-table implementation removes duplicates, which may
give you some speedup. That's probably more correct for a Boggle game
application. The other methods will return a word multiple times if it
can be found in different paths in the matrix.
Anyway, the numbers I got showed little variation between the different
find-word functions, with the loop nconcing one being a bit faster than
the hash-table or vector-push-extend ones. The throw the data away one
was not significantly faster, unlike your result.
I then tried the following implementation of get-words:
I renamed your get-words to get-words-orig, then
(defparameter *graph*)
(defparameter *words*
(make-array '(5 5)))
(defun setgraph ()
(setf *graph*
(make-array '(5 5)
:initial-contents
'(("r" "s" "t" "c" "s")
("d" "e" "i" "a" "e")
("g" "n" "l" "r" "p")
("e" "a" "t" "e" "s")
("m" "s" "s" "i" "d")))))
(defun setwords ()
(setgraph)
(dotimes (i 5)
(dotimes (j 5)
(setf (aref *words* i j) (get-words-orig *graph* i j)))))
(defun get-words (matrix i j)
"Find all possible words starting from MATRIX position I J"
(declare (ignore matrix))
(copy-list (aref *words* i j)))
With this test version of get-words, I get the same results as the
original get-words but much faster. The copy-list is necessary because
nconc is destructive
The original get-words gave me a time result for the nconcing version
using your time function of 0.142 seconds running sbcl on a 2GHz MacBook
(Intel cpu).
With that faked get-words, the same run took 0.0001 seconds.
That indicates that get-words is the bottleneck, not find-words
Could you post a full example showing all of your code and telling us
what you are using as a dictionary and how many words find-word is
returning?
--
Sidney Markowitz
http://www.sidney.com
···········@gmail.com wrote:
> Hi,
>
> I have a small lisp program to solve the boggle puzzle
> (http://weboggle.shackworks.com/) and it generates a lot of lists.
>
> This is the main part of the solving code:
>
> (defun find-words (matrix)
> "Given MATRIX find all possible words."
> (destructuring-bind (m n) (array-dimensions matrix)
> ;; Find words starting at every position in the matrix
> (loop with result = ()
> as i from 0 to (1- m)
> do (loop as j from 0 to (1- n)
> do (setq result (nconc result ; <-- major consing
> (get-words matrix i j))))
> finally (return result))))
Consing? Where? All I can see is that NCONC needs to read down to the
end of the list each time before it can splice.
I suggest you keep also a "tail" variable, initialized to nil.
Then (untested):
(if result
(rplacd tail gotten-words)
(setf result gotten-words))
(setf tail (last1 gotten-words))
I hear LOOP is pretty clever. Maybe it does that for you if you use the
NCONCING accumulation clause (nested in this case)(untested also):
(loop for i below m
nconcing (loop for j below n
nconcing (get-words matrix i j)))
kenny
--
Cells: http://common-lisp.net/project/cells/
"I'll say I'm losing my grip, and it feels terrific."
-- Smiling husband to scowling wife, New Yorker cartoon
Ken Tilton wrote:
> ···········@gmail.com wrote:
> > Hi,
> >
> > I have a small lisp program to solve the boggle puzzle
> > (http://weboggle.shackworks.com/) and it generates a lot of lists.
> >
> > This is the main part of the solving code:
> >
> > (defun find-words (matrix)
> > "Given MATRIX find all possible words."
> > (destructuring-bind (m n) (array-dimensions matrix)
> > ;; Find words starting at every position in the matrix
> > (loop with result = ()
> > as i from 0 to (1- m)
> > do (loop as j from 0 to (1- n)
> > do (setq result (nconc result ; <-- major consing
> > (get-words matrix i j))))
> > finally (return result))))
>
> Consing? Where? All I can see is that NCONC needs to read down to the
> end of the list each time before it can splice.
Sorry, wrong term. I was under the impression NCONCing was consing
also. I guess only APPENDing is (correct me if I'm wrong).
> I suggest you keep also a "tail" variable, initialized to nil.
> Then (untested):
>
> (if result
> (rplacd tail gotten-words)
> (setf result gotten-words))
> (setf tail (last1 gotten-words))
>
> I hear LOOP is pretty clever. Maybe it does that for you if you use the
> NCONCING accumulation clause (nested in this case)(untested also):
>
> (loop for i below m
> nconcing (loop for j below n
> nconcing (get-words matrix i j)))
Thanks for both these suggestions. The first one:
(defun find-words (graph)
"Given GRAPH find all possible words."
(destructuring-bind (m n) (array-dimensions graph)
(loop with result = () and tail = ()
as i from 0 to (1- m)
do (loop as j from 0 to (1- 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))) ; you meant
LAST, right?
finally (return result))))
takes 2.10 seconds and letting LOOP nconc
(defun find-words (graph)
"Given GRAPH find all possible words."
(destructuring-bind (m n) (array-dimensions graph)
(loop as i from 0 to (1- m)
nconcing (loop as j from 0 to (1- n)
nconcing (get-words graph i j)))))
is slightly faster at 2.08 seconds and significantly cleaner.
P.S. Please disregard my previous post where I said using
PUSH-VECTOR-EXTEND is much faster, I had kept an IF for debugging
which I'd forgotten to remove. PUSH-VECTOR-EXTEND takes approximately
the same time as my old NCONCing version. (Nonetheless, many thanks
for the book, Peter).
> kenny
Thank you Kenny
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 <······@world.std.com> in comp.lang.lisp
···········@gmail.com writes:
> Ken Tilton wrote:
>> ···········@gmail.com wrote:
>> > (defun find-words (matrix)
>> > "Given MATRIX find all possible words."
>> > (destructuring-bind (m n) (array-dimensions matrix)
>> > ;; Find words starting at every position in the matrix
>> > (loop with result = ()
>> > as i from 0 to (1- m)
>> > do (loop as j from 0 to (1- n)
>> > do (setq result (nconc result ; <-- major consing
>> > (get-words matrix i j))))
>> > finally (return result))))
>>
>> Consing? Where? All I can see is that NCONC needs to read down to the
>> end of the list each time before it can splice.
>
> Sorry, wrong term. I was under the impression NCONCing was consing
> also. I guess only APPENDing is (correct me if I'm wrong).
The initial N in some CL function names means Non-consing.
NCONC is a Non-consing Concatenate. Here is how it could be implemented:
(defun nconc (&rest args)
(cond ((null args) '())
((null (car args)) (apply (function nconc) (cdr args)))
((atom (car args)) (if (null (cdr args))
(car args)
(error "~S: ~A is not a list" 'nconc (car args))))
(t (setf (cdr (last (car args))) (apply (function nconc) (cdr args)))
(car args))))
The performance problem with your loop is that it's O(n^2) instead of
O(n), since NCONC is O(n). And since you've got two loops, that gives
O(m*n^2) instead of O(m*n).
--
__Pascal Bourguignon__ http://www.informatimago.com/
HEALTH WARNING: Care should be taken when lifting this product,
since its mass, and thus its weight, is dependent on its velocity
relative to the user.
···········@gmail.com wrote:
> (defun find-words (graph)
> "Given GRAPH find all possible words."
> (destructuring-bind (m n) (array-dimensions graph)
> (loop as i from 0 to (1- m)
> nconcing (loop as j from 0 to (1- n)
> nconcing (get-words graph i j)))))
>
> is slightly faster at 2.08 seconds and significantly cleaner.
How long does it take if you simply
(dotimes (i m) (dotimes (j n) (get-words graph i j)))
In other words, how much of the time is used in get-words? With all the
concatenation of strings that it's doing, I would expect it to be the
bottleneck, not find-words.
--
Sidney Markowitz
http://www.sidney.com
On Thu, 06 Jul 2006 02:37:47 -0400, Ken Tilton <·········@gmail.com> wrote:
> ···········@gmail.com wrote:
>> I have a small lisp program to solve the boggle puzzle
>> (http://weboggle.shackworks.com/) and it generates a lot of lists.
>>
>> This is the main part of the solving code:
>>
>> (defun find-words (matrix)
>> "Given MATRIX find all possible words."
>> (destructuring-bind (m n) (array-dimensions matrix)
>> ;; Find words starting at every position in the matrix
>> (loop with result = ()
>> as i from 0 to (1- m)
>> do (loop as j from 0 to (1- n)
>> do (setq result (nconc result ; <-- major consing
>> (get-words matrix i j))))
>> finally (return result))))
>
> I suggest you keep also a "tail" variable, initialized to nil.
> Then (untested):
>
> (if result
> (rplacd tail gotten-words)
> (setf result gotten-words))
> (setf tail (last1 gotten-words))
That's a very good way without LOOP :)
> I hear LOOP is pretty clever. Maybe it does that for you if you use the
> NCONCING accumulation clause (nested in this case)(untested also):
>
> (loop for i below m
> nconcing (loop for j below n
> nconcing (get-words matrix i j)))
LOOP is clever enough to do this in a simpler way:
CL-USER> (defun foo (num)
(* num 10))
FOO
CL-USER> (loop for k below 10
collect (foo k))
(0 10 20 30 40 50 60 70 80 90)
CL-USER>
The expression after `collect' can be as complex as you want it to be :)
···········@gmail.com wrote:
> Hi,
>
> I have a small lisp program to solve the boggle puzzle
> (http://weboggle.shackworks.com/) and it generates a lot of lists.
>
> This is the main part of the solving code:
>
> (defun find-words (matrix)
> "Given MATRIX find all possible words."
> (destructuring-bind (m n) (array-dimensions matrix)
> ;; Find words starting at every position in the matrix
> (loop with result = ()
> as i from 0 to (1- m)
> do (loop as j from 0 to (1- n)
> do (setq result (nconc result ; <-- major consing
> (get-words matrix i j))))
>
> finally (return result))))
Obviously, the arrow here is pointing to the wrong place. All of the
consing is done inside GET-WORDS, which searches for Boggle (tm)
solutions from a given row-column position in the letter grid.
What's going on in the NCONC is that it has to repeatedly search for
the end of the list from the beginning to find the tail where the
NCONC'ing is done.
If you don't care about the order of the words, it would be somewhat
cheaper to do the NCONC'ing in reverse order of the lists, that is:
(setq result (nconc (get-words matrix i j) result))
because then you're scanning only to the end of each new list. You are
not scanning over the items over and over again.
Also, a Boggle matrix isn't that large. You could just PUSH up a list
of lists, and then stitch all the lists together in one fell swoop, and
then have them in the original order:
collecting (get-words matrix i j) into word-list-collection
finally (return apply #'nconc word-list-collection)
So if the Boggle board is 4x4, the APPLY here calls NCONC with at most
16 arguments: each one of the lists collected from each of the 16
starting positions.
Also, here is an idea. How about using a big, fat, special variable to
accumulate the data? The innermost code just pushes onto that variable
directly, and when you call it on all the positions, there it is. The
top level wrapper function, of course, rebinds the variable with a LET
and returns the value.
If you want to be a master hacker, you must liberate your sense of
shame.
> (defun get-words (matrix i j)
> "Find all possible words starting from MATRIX position I J"
> (labels ((rec (i j prefix acc)
> (loop for (ni nj) in (adjacent matrix i j)
> as next = (aref matrix ni nj)
> as word = (concatenate 'string prefix next)
> if (and (>= (length word) *minimum-length*)
> (wordp word))
> do (push word acc)
> when (prefixp word)
> do (let ((old (aref matrix i j)))
> (setf (aref matrix i j) 'nil
> acc (rec ni nj word acc)
> (aref matrix i j) old))
> finally (return acc))))
> (rec i j (aref matrix i j) '())))
Here,
(concatenate 'string prefix next)
will allocate a new string just to add a letter. What you might want
to do is to use adjustable vectors of characters instead and use
vector-push-extend. It's uglier code but it can be faster.
Another thing:
( loop for (ni nj) in (adjacent matrix i j) ...)
generates a list of the positions adjacent to i j. It's nice to put it
that way, but it's a lot of consing: several conses for each character
visited. And not all characters visited result in the discovery of
words, obviously.
You could cut some of that consing with a trivial change, namely have
ADJACENT return a list of dotted pairs, so it becomes (loop for (ni .
nj) in (adjacent ....)) . It could return a vector also, in which case
you could loop ACROSS It and destructure the pairs yourself.
This could be a good application for the ITERATE macro instead, which
has some generator capabilities: you'd generate the adjacent positions.
Also, perhaps because I'm tired, I do not see where in your program is
an important Boggle constraint implemented: namely that the search must
not visit a square more than once! It seems that when the local
function REC is invoked on a square adjacent to i j, it will compute
the adjacency for that square, and that adjacency will include i j, and
so REC will be recursively invoked on i j again.
> ;;;;;;;;
>
> Running the problem as it is, takes 2.713 seconds. Throwing away the
> results obtained takes only 0.176 seconds. I changed find-words to
The word prefix check could be done with a lookup in a trie dictionary.
You could traverse the trie in parallel as you scan through the board
positions rather than calling wordp and prefixp predicate functions, so
you could terminate a search as soon as the trie bottoms out.
For instance, suppose you visited T and H. So you are at the trie node
where all of the TH words are rooted. But the next character is Z.
Right away, the trie tells you that this is junk, and your recursion
should bail out one level to try a different letter instead of the Z.
That might be an E and so now you have THE. You can collect that and
keep going.
I would eliminate the character accumulation entirely. When a word is
detected, you simply pull it out of the dictionary, which, if suitably
designed, gives you a pointer to the entire word: a prefix tree that a
list of all the words in their entirety, plus a bunch of nodes that
allow for prefix searches. So as you recurse through the board
positions, you are not building up a string, but keeping track of where
you are in the prefix tree.
> 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 <······@world.std.com> in comp.lang.lisp
No way! It suggests that they have transcended ordinary existence to
dwell among the symbols. Moreover, it shows that we are actually
interested in /them/ and not merely in what they can evaluate for us.