upscheme/femtolisp/torus.lsp

48 lines
1.1 KiB
Common Lisp

(defun maplist (f l)
(if (null l) ()
(cons (f l) (maplist f (cdr l)))))
; produce a beautiful, toroidal cons structure
; make m copies of a CDR-circular list of length n, and connect corresponding
; conses in CAR-circular loops
; replace maplist 'identity' with 'copy-tree' for rapdily exploding memory use
(defun torus (m n)
(let* ((l (map-int identity n))
(g l)
(prev g))
(dotimes (i (- m 1))
(setq prev g)
(setq g (maplist identity g))
(rplacd (last prev) prev))
(rplacd (last g) g)
(let ((a l)
(b g))
(dotimes (i n)
(rplaca a b)
(setq a (cdr a))
(setq b (cdr b))))
l))
(defun cyl (m n)
(let* ((l (map-int identity n))
(g l))
(dotimes (i (- m 1))
(setq g (maplist identity g)))
(let ((a l)
(b g))
(dotimes (i n)
(rplaca a b)
(setq a (cdr a))
(setq b (cdr b))))
l))
(time (progn (print (torus 100 100)) nil))
;(time (dotimes (i 1) (load "100x100.lsp")))
; with ltable
; printing time: 0.415sec
; reading time: 0.165sec
; with ptrhash
; printing time: 0.081sec
; reading time: 0.0264sec