Cellular Automata

Cellular Stomata is an famous algorithm witch is use for spread out function patterns through a large scale population. This algorithm is mostly use in AI field to do the simulations. Following lisp program is show the basics of this algorithm.

    

(defun initial-lst(elements start_pointer);;initiate new element list (one diamentional)
  (let ((core_list '()))
    (loop while (< (length core_list) elements) do 
      (push 1 core_list))
    (setf (nth (- start_pointer 1) core_list) 0)
    core_list))

(defun find-zeros (list);;list the elements which has 0 as value it self
    (let ((zero_list '()))
      (loop for i from 0 below (length list) do
        (when (= (nth i list) 0) (push i zero_list)))
      zero_list))

(defun set-nabours (zero_list core_list);;identify the nabours of the zero value elements 
;this can be change according to our need(eg: we can consider random element indexes as nabours) 
  (let ((lower_bound 0) (uper_bound (- (length core_list) 1)) (nabour_list '()));set boundries and boundri avoiding function
    (loop for x from 0 below (length zero_list) do
      (cond ((= (nth x zero_list) uper_bound) 
                (pushnew (- (nth x zero_list) 1) nabour_list) (pushnew lower_bound nabour_list)) 
          ((= (nth x zero_list) lower_bound) 
                (pushnew uper_bound nabour_list) (pushnew (+ (nth x zero_list) 1) nabour_list))
          (t(pushnew (+ (nth x zero_list) 1) nabour_list) 
                (pushnew (- (nth x zero_list) 1) nabour_list))))nabour_list))
  
(defun automart (core_list nabour_list);;set new nabours to 0 according to the nabour list
  (loop for y from 0 below (length core_list) do
    (if (= (nth y core_list) 0) (setf (nth y core_list) 1)
      (when (eq (find y nabour_list) y) (setf (nth y core_list) 0))))
  core_list)



(defun main (number_of_elements start_pointer iterations);;main function to run all the above functions
  (setq initial (initial-lst number_of_elements start_pointer))
    (loop for k from 0 to iterations do
      (print (automart initial (set-nabours (find-zeros initial) initial)))
          (setq initial (automart initial (set-nabours (find-zeros initial) initial)))))



(main 1000 100 1000);;call to the main function