Commit b2e947fd authored by Adrian Kosmaczewski's avatar Adrian Kosmaczewski

First working version of the evolve algorithm

parent c08c1578
......@@ -4,10 +4,9 @@
(:documentation "A lattice of cells referenced by coord values."))
(defun find-in-list (object list)
(block nested-loops
(loop for a in list do
(if (equalp a object)
(return-from nested-loops t)))))
(loop named outer for a in list do
(if (equalp a object)
(return-from outer t))))
(defun make-world (size alive-cells)
(defvar cells (make-hash-table :test #'equalp))
......@@ -19,13 +18,45 @@
(setf (gethash c cells) 'dead)))))
(make-instance 'world :size size :cells cells))
(defmethod evolve ((object world))
(with-slots (size cells) object
(defvar alive-cells)
(setq alive-cells (list nil))
(loop for key being the hash-keys of cells using (hash-value value) do
(let ((count 0))
(loop for a from -1 to 1 do
(loop for b from -1 to 1 do
(let ((current-coord (make-coord :x (+ a (coord-x key)) :y (+ b (coord-y key)))))
(if (not (equalp current-coord key))
(if (gethash current-coord cells)
(let ((cell (gethash current-coord cells)))
(if (equalp cell 'alive)
(progn
(setq count (+ 1 count))))))))))
(if (equalp value 'alive)
(if (or (= 2 count) (= 3 count))
(setq alive-cells (append (list key) alive-cells)))
(if (= 3 count)
(setq alive-cells (append (list key) alive-cells))))))
(make-world size alive-cells)))
(defmethod print-world ((object world))
(with-slots (size cells) object
(loop for a from 0 to size do
(loop for b from 0 to size do
(let ((c (make-coord :x b :y a)))
(format t "~A" (print-cell (gethash c cells)))))
(format t "~%"))))
(loop for a from 0 to size do
;; First line with coordinates
(if (= a 0)
(progn
(format t " ")
(loop for b from 0 to size do
(format t "~3d|" b))
(format t "~%")))
(format t "~3d|" a)
(loop for b from 0 to size do
(let ((c (make-coord :x b :y a)))
(format t "~A" (print-cell (gethash c cells)))))
(format t "~%"))))
(defmethod evolve ((object world))
(make-instance 'world :size (size object)))
(defun make-blinker (origin)
(list (make-coord :x (coord-x origin) :y (coord-y origin))
(make-coord :x (+ 1 (coord-x origin)) :y (coord-y origin))
(make-coord :x (+ 2 (coord-x origin)) :y (coord-y origin))))
(require "asdf")
(asdf:operate 'asdf:load-op 'conway)
(defparameter *my-hash* (make-hash-table :test #'equalp))
(defparameter *coord1* (make-coord :x 45 :y 64))
(defparameter *coord2* (make-coord :x 356 :y 65))
(defun clear ()
;; https://rosettacode.org/wiki/Terminal_control/Clear_the_screen#Common_Lisp
(format t "~C[2J" #\Esc))
(setf (gethash *coord1* *my-hash*) 'alive)
(format t "~A~%" (print-cell (gethash *coord1* *my-hash*)))
(format t "~A~%" (print-cell (gethash (make-coord :x 45 :y 64) *my-hash*)))
;; ALIVE
(format t "~A~%" (gethash *coord2* *my-hash*))
;; NIL
(setf (gethash *coord2* *my-hash*) 'dead)
(format t "~A~%" (print-cell (gethash *coord2* *my-hash*)))
;; DEAD
(defvar alive-cells (make-blinker (make-coord :x 0 :y 1)))
(defvar world (make-world 5 alive-cells))
(defvar generation 1)
(defun fa ()
(list *coord1* *coord2* (make-coord :x 1 :y 2)))
(loop
(clear)
(print-world world)
(format t "~%Generation ~d~%" generation)
(setq generation (+ 1 generation))
(setq world (evolve world))
(sleep 0.5))
(sleep 0.5)
(defvar alive-cells (fa))
(defparameter *w1* (make-world 5 alive-cells))
(print-world *w1*)
;;(defparameter *w2* (evolve *w1*))
;;(format t "~A~%" (size *w2*))
......@@ -3,6 +3,10 @@ FreeBASIC/src/coord.bas
FreeBASIC/src/world.bas
FreeBASIC/main.bas
FreeBASIC/tests.bas
CommonLisp/main.lisp
CommonLisp/conway/cell.lisp
CommonLisp/conway/coord.lisp
CommonLisp/conway/world.lisp
C#/Conway/Program.cs
C#/ConwayLib/Cell.cs
C#/ConwayLib/Coord.cs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment