Lisp - simple testcase to dissect

Author

simple testcase to dissect

Jack

2005-05-30, 3:58 pm

I'm learning CL (yes I bought a copy of PCL and am glad I did). One of my little exercises is to
implement an L-System evaluator. See

http://en.wikipedia.org/wiki/L-system

My naive attempt is as follows:

(defun run-l-system (rules state count)
(declare (optimize (speed 3) (safety 0)))
(let ((rule-table (make-hash-table)))
(dolist (rule rules)
(setf (gethash (car rule) rule-table) (cdr rule)))
(dotimes (i count)
(let (new-state)
(dolist (a-symbol state)
(setf new-state (append new-state (gethash a-symbol rule-table))))
(setf state new-state)))
state))

This obviously doesn't specifically handle constants, do any error checking,
yadda yadda, it's just an experiment. An example invocation (using the Algae rule set):

CL-USER 9 > (run-l-system (list (cons 'A '(A B)) (cons 'B '(A))) '(A) 3)
(A B A A B)

All well and good, but obviously could be better. What I'm particularly interested
in is how to speed this up (and learn some better CL idioms). I've loaded and compiled
this function on three different implementations, and gotten the following (time) results
when running the same rule set with a count of 20 instead of 3:

LispWorks Personal Edition 4.3.7
user time = 57.875
system time = 0.000
Elapsed time = 0:00:57
Allocation = 1800 bytes standard / 1725022871 bytes conses
0 Page faults
Calls to %EVAL 42

Allegro Trial Edition 6.2 Release 25
; cpu time (non-gc) 816 msec user, 0 msec system
; cpu time (gc) 8,419 msec user, 0 msec system
; cpu time (total) 9,235 msec user, 0 msec system
; real time 9,235 msec
; space allocation:
; 156,820,003 cons cells, 9,488 other bytes, 0 static bytes

GCL 2.6.6
real time : 3.560 secs
run-gbc time : 2.250 secs
child run time : 0.000 secs
gbc time : 1.310 secs

These are all from the same WinXP SP2 P4 3.4GHz 1Gig PC. BTW this is not meant
as a benchmark to compare Lisp vendors, I'm just trying to learn how to write better
code and so I'm trying different implementations.

The big obvious red flag is the ungodly amount of cons'ing. Any suggestions you
might have would be appreciated.

--
Jack

Peter Lewerin

2005-05-30, 3:58 pm

Jack <no.spam@example.org> wrote

> One of my little exercises is to
> implement an L-System evaluator.

The most obvious way for expressing the list processing that I can
think of is this:

(loop repeat count
for s = state then (proc s)
finally (return (proc s))))))

Where proc is the processing function, which looks like this:

(defun proc (list)
(apply #'append
(loop for elem in list
collect (gethash elem rule-table))))

My variant of run-l-system would look like this:

(defun f2b (rules state count)
(declare (optimize (speed 3) (safety 0)))
(let ((rule-table (make-hash-table)))
(dolist (rule rules)
(setf (gethash (car rule) rule-table) (cdr rule)))
(flet ((proc (list)
(apply #'append
(loop for elem in list
collect (gethash elem rule-table)))))
(loop repeat count
for s = state then (proc s)
finally (return (proc s))))))

On my system, your run-l-system times like this:

; cpu time (non-gc) 10,409 msec user, 270 msec system
; cpu time (gc) 23,069 msec user, 521 msec system
; cpu time (total) 33,478 msec user, 791 msec system
; real time 34,559 msec
; space allocation:
; 157,652,788 cons cells, 3,441,152 other bytes, 3,576 static bytes

and f2b above times like this:

; cpu time (non-gc) 1,121 msec user, 0 msec system
; cpu time (gc) 301 msec user, 0 msec system
; cpu time (total) 1,422 msec user, 0 msec system
; real time 1,432 msec
; space allocation:
; 1,054,469 cons cells, 5,058,304 other bytes, 0 static bytes

Still it can be improved. If the processing loop is rewritten as a
mapping instead;

(defun f2c (rules state count)
(declare (optimize (speed 3) (safety 0)))
(let ((rule-table (make-hash-table)))
(dolist (rule rules)
(setf (gethash (car rule) rule-table) (cdr rule)))
(flet ((proc (list)
(apply #'append
(mapcar (lambda (elem)
(gethash elem rule-table)) list))))
(loop repeat count
for s = state then (proc s)
finally (return (proc s))))))

It times like:

; cpu time (non-gc) 451 msec user, 10 msec system
; cpu time (gc) 150 msec user, 0 msec system
; cpu time (total) 601 msec user, 10 msec system
; real time 611 msec
; space allocation:
; 391,743 cons cells, 2,323,112 other bytes, 0 static bytes

That's better. But is the hash table really necessary? The code can
be simplified without it:

(defun f3b (rules state count)
(declare (optimize (speed 3) (safety 0)))
(flet ((proc (list)
(apply #'append
(mapcar (lambda (elem)
(rest (assoc elem rules))) list))))
(loop repeat count
for s = state then (proc s)
finally (return (proc s)))))

Times like this:

; cpu time (non-gc) 461 msec user, 0 msec system
; cpu time (gc) 170 msec user, 0 msec system
; cpu time (total) 631 msec user, 0 msec system
; real time 641 msec
; space allocation:
; 420,219 cons cells, 2,321,392 other bytes, 0 static bytes

OK, it's slightly simpler, but somewhat slower and conses some more.
I'd still prefer it to the other variants.

Wade Humeniuk

2005-05-30, 3:58 pm

Jack wrote:
> I'm learning CL (yes I bought a copy of PCL and am glad I did). One of my little exercises is to
> implement an L-System evaluator. See
>
> http://en.wikipedia.org/wiki/L-system
>
> My naive attempt is as follows:
>
> (defun run-l-system (rules state count)
> (declare (optimize (speed 3) (safety 0)))
> (let ((rule-table (make-hash-table)))
> (dolist (rule rules)
> (setf (gethash (car rule) rule-table) (cdr rule)))
> (dotimes (i count)
> (let (new-state)
> (dolist (a-symbol state)
> (setf new-state (append new-state (gethash a-symbol rule-table))))
> (setf state new-state)))
> state))
>
>

(defun run-l-system (rules state count)
(loop repeat count do
(setf state
(loop for rule in state
appending (cdr (assoc rule rules))))
finally (return state)))

ON LW 4.3.7. Using the appending collection method in loop
is as efficient as it comes.

CL-USER 7 > (time (run-l-system '((a a b) (b a)) '(a) 20))
Timing the evaluation of (RUN-L-SYSTEM (QUOTE ((A A B) (B A))) (QUOTE (A)) 20)

user time = 0.030
system time = 0.000
Elapsed time = 0:00:00
Allocation = 0 bytes standard / 510235 bytes conses
0 Page faults
Calls to %EVAL 36
(A B A A B A B A A B A A B A B A A B

Sponsored Links