--- Fred Gilham <[EMAIL PROTECTED]> wrote:
> 
> > Your manual is out-of-date (or the manual itself
> is).  The following
> > types are also good array types:
> 
> 
> OK, so it turns out that fixnum is a good
> specialized array type.
> 
> What really makes the difference is declaring all
> the arrays.
> 
> Here's my final version, runs in slightly under 1
> second.
> 
> ----------------------------------------
> 
> (declaim (optimize (speed 3) (safety 1) (space 0)))
> 
> (declaim (fixnum *sides* *num*))
> (defconstant *sides* 10)
> (defconstant *num* 6)
> 
> (declaim (type (simple-array fixnum (#.*sides*)) r))
> (defvar r (make-array *sides* :element-type
> 'fixnum)) 
> 
> (defun check (dice num succ fail botch)
>   (declare (fixnum num))
>   (declare (type (simple-array fixnum (#.*num*))
> dice)
>          (type (simple-array fixnum (#.*sides*)) succ
> fail botch))
>   ;; reset counters
>   (dotimes (i *sides*)
>     (setf (aref r i) 0))
>   ;; scan dices
>   (let ((ones 0))
>     (declare (fixnum ones))
>     (dotimes (i num)
>       (if (= (aref dice i) 0)
>       (incf ones)
>       (progn
>         (loop for j fixnum from (aref dice i) downto 1
>               do (incf (aref r j))))))
>     ;; record results
>     (dotimes (i *sides*)
>       (cond
>       ((> (aref r i) ones) (incf (aref succ i)))
>       ((and (> ones 0) (= (aref r i) 0)) (incf (aref
> botch i)))
>       (t (incf (aref fail i)))))))
> 
> (defun increment (dice num)
>   (declare (fixnum num))
>   (declare (type (simple-array fixnum (#.*num*))
> dice))
>   (loop for i fixnum from 0 below num
>       do (incf (aref dice i))
>       when (>= (aref dice i) *sides*) do (setf (aref dice
> i) 0)
>       else do (return-from increment nil)
>       finally (return-from increment t)))
> 
> 
> (defun test-it ()
>   (let* ((num *num*)
>        (dice  (make-array num :initial-element 0
> :element-type 'fixnum))
>        (succ  (make-array *sides* :initial-element 0
> :element-type 'fixnum))
>        (fail  (make-array *sides* :initial-element 0
> :element-type 'fixnum))
>        (botch (make-array *sides* :initial-element 0
> :element-type 'fixnum)))
>     (declare (fixnum num))
>     (declare (type (simple-array fixnum (#.*num*))
> dice)
>            (type (simple-array fixnum (#.*sides*)) succ
> fail botch))
>     (format t "Start...~%")
>     (loop
>      do (check dice num succ fail botch)
>      until (increment dice num))
>     (print succ)
>     (print fail)
>     (print botch)
>     (values)
>     ))
> 
> ----------------------------------------
> 
> -- 
> Fred Gilham                                   
> [EMAIL PROTECTED]
> The TMI accident was unique: it was the only
> multi-billion dollar
> accident in history in which nobody was harmed.
>                  -Howard C. Hayden, Professor
> Emeritus, U of Conn.
> 


__________________________________________________
Do you Yahoo!?
Y! Web Hosting - Let the expert host your web site
http://webhosting.yahoo.com/

Reply via email to