SchemeでLifeGame v2
7月 3rd, 2008 at 10:05pm |
他の人の投稿も見てみた結果こうなった
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 (step-exec value next proc)
-
(define (iter value cc)
-
(cc value
-
(lambda () (iter (next value) cc))))
-
(lambda ()
-
(iter
-
value
-
(lambda (value cc) (proc value) cc))))
-
-
(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 (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 (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 (count field)
-
(length (filter (lambda (e) (element-value e)) field)))
-
-
(define (game-next 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 next
-
(step-exec
-
(randomize-field (make-field))
-
game-next
-
(lambda (e) (print-field e))))
-
-
(let loop
-
((c (read-char))
-
(count 1))
-
(if (char=? #\e c)
-
(exit 0)
-
(begin
-
(display count)
-
(newline)
-
(set! next (next))
-
(display "next -> any keys.")
-
(newline)
-
(display "exit -> press e.")
-
(newline)
-
(loop (read-char) (+ count 1)))))
・のりしろがなくなった
・make-element やら element-* を使ってればセルの表現を気にしないでよくなった(相変わらず全体はセルのリストだ
毎回get-neighborsしてるのはバカらしい気もするけどまぁいいや
Posted in Scheme