49 lines
1.2 KiB
Scheme
49 lines
1.2 KiB
Scheme
; -*- scheme -*-
|
|
(define (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
|
|
(define (torus m n)
|
|
(let* ((l (map-int identity n))
|
|
(g l)
|
|
(prev g))
|
|
(dotimes (i (- m 1))
|
|
(set! prev g)
|
|
(set! g (maplist identity g))
|
|
(set-cdr! (last-pair prev) prev))
|
|
(set-cdr! (last-pair g) g)
|
|
(let ((a l)
|
|
(b g))
|
|
(dotimes (i n)
|
|
(set-car! a b)
|
|
(set! a (cdr a))
|
|
(set! b (cdr b))))
|
|
l))
|
|
|
|
(define (cyl m n)
|
|
(let* ((l (map-int identity n))
|
|
(g l))
|
|
(dotimes (i (- m 1))
|
|
(set! g (maplist identity g)))
|
|
(let ((a l)
|
|
(b g))
|
|
(dotimes (i n)
|
|
(set-car! a b)
|
|
(set! a (cdr a))
|
|
(set! b (cdr b))))
|
|
l))
|
|
|
|
(time (begin (print (torus 100 100)) ()))
|
|
;(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
|