SchemeでLifeGame v3
7月 7th, 2008 at 11:15pm |
SCHEME:
-
(use srfi-1)
-
(use srfi-27)
-
-
(define width 14)
-
(define height 10)
-
-
(define population 0.3)
-
-
(define birth '(3))
-
(define keep '(2 3))
-
-
(define element-x car)
-
(define element-y cadr)
-
(define element-value caddr)
-
(define (make-element x y v) (list x y v))
-
-
(define (make-field)
-
(define (flatten x) (fold-right append '() x))
-
(map
-
(lambda (e) (make-element (car e) (cadr e) #f))
-
(zip
-
(apply circular-list (iota width 0))
-
(flatten
-
(map
-
(lambda (x) (iota width x 0))
-
(iota height 0))))))
-
-
(define (randomize-field field)
-
(random-source-randomize! default-random-source)
-
(map
-
(lambda (e)
-
(if (<(random-real) population)
-
(make-element (element-x e) (element-y e) #t)
-
(make-element (element-x e) (element-y e) #f)))
-
field))
-
-
(define (print-field field)
-
(define (print-cell e)
-
(if (element-value e)
-
(display "[*]")
-
(display "[ ]")))
-
(let loop ((left field))
-
(if (not (null? left))
-
(begin
-
(print-cell (car left))
-
(if (= (element-x (car left)) (- width 1))
-
(newline))
-
(loop (cdr left))))))
-
-
(define (game-next field)
-
(define (count field) (length (filter (lambda (e) (element-value e)) field)))
-
(define (get-neighbors x y)
-
(let
-
((x-1 (remainder (+ x width -1) width))
-
(x+1 (remainder (+ x width +1) width))
-
(y-1 (remainder (+ y height -1) height))
-
(y+1 (remainder (+ y height +1) height)))
-
(filter
-
(lambda (e)
-
(let
-
((cx (element-x e))
-
(cy (element-y e)))
-
(or
-
(and (= x-1 cx) (= y-1 cy)) (and (= x cx) (= y-1 cy)) (and (= x+1 cx) (= y-1 cy))
-
(and (= x-1 cx) (= y cy)) (and (= x+1 cx) (= y cy))
-
(and (= x-1 cx) (= y+1 cy)) (and (= x cx) (= y+1 cy)) (and (= x+1 cx) (= y+1 cy)))))
-
field)))
-
(define (next-state e)
-
(define neighbors (count (get-neighbors (element-x e) (element-y e))))
-
(define live? element-value)
-
(define (live->next)
-
(if (fold (lambda (x y) (or x y)) #f (map (cut = neighbors <>) keep))
-
e
-
(make-element (element-x e) (element-y e) #f)))
-
(define (dead->next)
-
(if (fold (lambda (x y) (or x y)) #f (map (cut = neighbors <>) birth))
-
(make-element (element-x e) (element-y e) #t)
-
e))
-
(if (live? e)
-
(live->next)
-
(dead->next)))
-
(map
-
next-state
-
field))
-
-
(define (play)
-
(define (field-chain field)
-
(cons
-
field
-
(delay (field-chain (game-next field)))))
-
(define field-list (field-chain (randomize-field (make-field))))
-
(define count ((lambda ()
-
(define counter 0)
-
(define (inc)
-
(set! counter (+ counter 1))
-
counter)
-
inc)))
-
(define (iter)
-
(display (count))
-
(newline)
-
(print-field (car field-list))
-
(display "if you want to exit. press e.")
-
(newline)
-
(if (char=? #\e (read-char)) (exit 0))
-
(set! field-list (force (cdr field-list)))
-
(iter))
-
(iter))
-
-
(play)
・CPSっぽいやり方じゃなくなった
・無限ストリームっぽいものになった
play内部のcountの作り方に1〜2分悩んだ(おばか
SCHEME:
-
(define (play)
-
(define (field-chain field)
-
(cons
-
field
-
(delay (field-chain (game-next field)))))
-
(define field-list (field-chain (randomize-field (make-field))))
-
(define (iter count)
-
(display count)
-
(newline)
-
(print-field (car field-list))
-
(display "if you want to exit. press e.")
-
(newline)
-
(if (char=? #\e (read-char)) (exit 0))
-
(set! field-list (force (cdr field-list)))
-
(iter (+ count 1)))
-
(iter 1))
playの定義はこっちのが綺麗ですよねーってなるよねぇ…
Posted in Scheme