[Shootout-list] Mandelbrot Set for CMUCL and SBCL 2nd try
Yannick Gingras
ygingras@ygingras.net
Sun, 27 Mar 2005 13:22:13 -0500
--nextPart2497443.vGPu0YfsS4
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline
Hi, I saw that my previous submission generated an error. I don't
know why and the output seems to be right but I was using
single-floats and that could have produced an output slightly
divergent from the implementations using double floats.
Here is a version using double-floats and doing the complex mult by
hand like in C.
;;; The Great Computer Language Shootout
;;; http://shootout.alioth.debian.org/
;;; contributed by Yannick Gingras <ygingras@ygingras.net>
;;; for a colorful web zoomer for the Mandelbrot Set by the same
;;; author see http://fract.ygingras.net/
(declaim (optimize speed (debug 0) (safety 0)))
=20
(defun render (size &optional (stream *standard-output*))
(declare (type fixnum size)
(type stream stream))
(let* ((inc (/ 2.0d0 size))
(code 0)
(mask 128)
(zi 0.0d0)
(zr 0.0d0)
(tr 0.0d0)
(base-imag -1.0d0)
(base-real -1.5d0)
(str (make-string (ceiling (* size size) 8)))
(cur-char -1))
(declare (type (unsigned-byte 8) code mask)
(type double-float zr zi tr base-real base-imag inc)
(type fixnum cur-char))
(format stream "P4~%~d ~d~%" size size)
(dotimes (y size)
(declare (type fixnum y))
(dotimes (x size)
(declare (type fixnum x))
(setf zr 0.0d0)
(setf zi 0.0d0)
(when (not (dotimes (n 50)
(when (< 4.0d0 (+ (* zr zr) (* zi zi)))
(return t))
(setf tr (+ (* zr zr) (- (* zi zi)) base-real))
(setf zi (+ (* 2.0d0 zr zi) base-imag))
(setf zr tr)))
(setf code (logior mask code)))
(setf mask (ash mask -1))
(when (zerop mask)
(setf mask 128)
(setf (elt str (incf cur-char)) (code-char code))
(setf code 0))
(incf base-real inc))
(setf base-real -1.5d0)
(incf base-imag inc))
(when (/=3D 128 mask)
(setf (elt str (incf cur-char)) (code-char code)))
(write-sequence str stream))
t)
(defun main ()
(let* ((args #+sbcl sb-ext:*posix-argv*
#+cmu extensions:*command-line-strings*
#+gcl si::*command-args*)
(n (parse-integer (car (last args)))))
(render n)))
=2D-=20
Yannick Gingras Math Student, UQAM
Join FSF as an Associate Member at:
http://member.fsf.org/join?referrer=3D2327
--nextPart2497443.vGPu0YfsS4
Content-Type: application/pgp-signature
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.5 (GNU/Linux)
iD8DBQBCRvnaX5grbfhLwA4RAmHUAJwOWysLwwnhOcJ1jisjZBJkiz13HgCfTte9
9svWUL2D7rCYjvj2yZOvURY=
=O/mH
-----END PGP SIGNATURE-----
--nextPart2497443.vGPu0YfsS4--