; Arclife
; cra craas
;
; Artificial life build in Arc
; ARtificial Critters, CRA.
;

; makes a world matrix
;
(def makeworld (x)
   (= world (n-of x (n-of x nil))) ; world of nil
   nil)


; print out the world, overlay the creatures in the list
(def show ((o lst))
   ; create empty field
   (let display (n-of (len world) (n-of (len (world 0)) nil))

      ; plot list into it
      (each c lst
         (= ((display (cadr (c 'pos))) (car (c 'pos))) (c 'symbol)))

      ; plot static world into it, where there's no critter yet
      (for y 0 (- (len world) 1)
         (for x 0 (- (len (world 0)) 1)
            (if (no ((display y) x)) (= ((display y) x) ((world y) x)))))

      ; plot world
      (each row display
         (each pos row (if (is pos nil) (pr #\. #\space) (pr pos #\space)))
         (prn))))


; randomly seed N of char I in world
(def seed (i n)
   (repeat n
      (= 
         ((world (rand (len world))) (rand (len (world 0))))
      i)))



; flood empty space in world with character i
(def flood (i) 
   (for y 0 (- (len world) 1)
      (for x 0 (- (len (world 0)) 1)
         (if (no ((world y) x)) (= ((world y) x) i)))))


; function returns nil or content of a particular pos
; x = rows, y = columns. 0,0 is topleft
(def showpos (x y) 
   (if (>= x (len (world 0))) nil
       (< x 0) nil
       (>= y (len world)) nil 
       (< y 0) nil 
          ((world y) x)))


; observe, and returns list of lists of interesting positions
(def observe (x y r)
   (let b nil
      (for i (* r -1) r
      (for j (* r -1) r
         (if (showpos (+ x j) (+ y i))
         (= b (cons `(,(showpos (+ x j) (+ y i)) ,j ,i) b)))))
      b))


; associate: like seed, but drops near the thing to associate with.
; could make 'thing' a list of things to be nearby to, but then
; I could just as well use two different aseeds, and do an each on
; the items in the list
; y = what, x = how many, a = associated with what
(def aseed (y x a)
   (let counter 0
      (while (< counter x)
         (with (ypos (rand (len world)) xpos (rand (len (world 0))))
            (if (and (some a (map car (observe xpos ypos 1))) (no (showpos xpos ypos)))
                (do
                  (= ((world ypos) xpos) y)
                  (++ counter)))))))





; printout version of observe
; l = list of ypos, xpos ; r = radius of circle
(def showarea (l r)
      (for i (* r -1) r
         (for j (* r -1) r
         (if (> (+ (* i i) (* j j)) (+ (* r r) 1)) (pr #\space #\space)
            (pr (if (is (showpos (+ (car l) j) (+ (cadr l) i)) nil) #\. (showpos (+ (car l) j) (+ (cadr l) i))) #\space)))
      (pr #\newline)))




; Critter-specific functions
;
;
;


; The whole memory bit is sort of in here
; we can rewrite the stm as a queue some other time
; c = creature, o = new observation, s = to-be stored observation, a = association to be associated with s
(def add-observation (c o)

   ; add observation to end of stm
   (= c!stm (join c!stm (list o)))
   
   ; pop observation from beginning of stm, continue if this is not nil or an emotion
   (= s (pop c!stm))

   (if (and s (isnt s 'positive) (isnt s 'negative) (isnt s 'neutral))
      (do
         ; create a ltm of s if no ltm is present. !PS here may be an arc bug: I can't shorten (c 'ltm) to c!ltm
         (if (no (c!ltm s)) (= ((c 'ltm) s) (n-of c!ltmsize nil)))

         ; pick s2ltm number of observations from stm to associate with s
         (repeat c!s2ltm

            ; should we preprocess stm to remove references to i(tself)? Let's see what heppens if we don't
            ; possibly: preprocess to compact things into one two many?
            (let a (car (nthcdr (rand c!stmsize) c!stm))

               ; store emotions in eltm
               (if (or (is a 'positive) (is a 'negative) (is a 'neutral))

                  (do
                     ; create an eltm of s if we don't have one yet
                     (if (no (c!eltm s)) (= ((c 'eltm) s) (obj positive 0 negative 0 neutral 0)))

                     ; increase the positive or negative association with s
                     (++ (((c 'eltm) s) a)))

                  ; else store in ltm unless we're trying to associate a thing with itself, which is of dubious use
                  (if (no (is a s)) (= ((c!ltm s) (rand c!ltmsize)) a))
                  
                  )))))
   nil)



; Template of a creature
; extend this when needed
(deftem creature 
   symbol #\@
   dir '(1 1) 
   pos '(0 0)

   ;memory bits
   stm (n-of 7 nil)  ; hmmm. stmsize is this 7..
   stmsize 7
   ltm (table)
   ltmsize 50
   ; reason for separating ltm and emotional ltm is that passing by a poisonous plant  isn't the same as eating it, and experiencing
   ; the poison. Say a creature learned to associate negative with poisonous plants, and avoids eating them, or even avoids them
   ; after a while the association is lost by other observations coupled to poisonous plants (rocks for example)
   eltm (table)
   s2ltm 3

   ;list of behaviours/ actions
   action (list act_bite)
   )

; actions (destructive, I guess)
; would be nice if new actions can be created on the fly from simpler components
(def act_bite (creature)
   (= ((world (cadr creature!pos)) (car creature!pos)) nil)
   (prn "eating something!"))


;
; Movement
;
(def newdir ()
   `(,(- (rand 3) 1) ,(- (rand 3) 1)))

(def forward (creature)
   (map + (creature 'pos) (creature 'dir)))
   
(def placewithinbounds (creature)
   ; sort of wrongly assuming the world has the same height as it has width
   (map [min _ (- (len world) 1)] (map [max _ 0] (creature 'pos))))

(def directawayfrombounds (creature)
    (withs (range
              cons
            within
              (fn (range num)
                (let (min . max) range
                  (<= min num max)))
            awaydir
              (fn (pos dim dir)
                (if (within (range 0 (- dim 1)) (+ pos dir))
                    dir
                    (- dir)))
            (xpos ypos) creature!pos
            (xdir ydir) creature!dir)
      (list
        (awaydir xpos (len (world 0)) xdir)
        (awaydir ypos (len world) ydir))))


;turn left / right
(def left (dir)
   (let (x y) dir
      (if (is (+ (car dir) (cadr dir)) 0)
         (= x 0)
         (if (is x 0) (= x y)))
      (if (is (abs (+ (car dir) (cadr dir))) 2)
         (= y 0)
         (if (is y 0) (= y (* -1 x))))
      (list x y)))

(def right (dir)
   (let (x y) dir
      (if (is (+ (car dir) (cadr dir)) 0)
         (= y 0)
         (if (is y 0) (= y x)))
      (if (is (abs (+ (car dir) (cadr dir))) 2)
         (= x 0)
         (if (is x 0) (= x (* -1 y))))
      (list x y)))


; utility function, sort a list alphabetically
(def sort-abc (list) (sort (fn (a b) (< (tostring:write a) (tostring:write b))) list))
; utility function to print nicely
(def space (body spacing) (+ (newstring (- spacing (len (tostring:disp body))) #\space) (tostring:disp body)))
;
; Start of program
;

(makeworld 40)
(seed #\T 10)
(seed #\N 30)
(seed #\R 10)
(aseed #\f 10 #\T)
(aseed #\p 10 #\R)

(= craa (inst 'creature))


(show (list craa))
(prn)

; move is not functional, but desctructive (for now) 
; walk forward
; occasionally change direction
; don't try to walk through walls
; fix pos if it is outside the boundaries of the world

(repeat 10
   (repeat 100
      (do
         ; moving
         (= (craa 'pos) (forward craa))

         ; steering (randomly for now, we'll let the craa experience things first
         (if (> 1 (rand 10)) (= (craa 'dir) (newdir)))

         ; boundary collision algorithm
         (= (craa 'pos) (placewithinbounds craa))
         (= (craa 'dir) (directawayfrombounds craa))

          ; observe what you see in an area with radius 3
         (each x (observe (car (craa 'pos)) (cadr (craa 'pos)) 3)
            (add-observation craa (car x)))

         ; pick at random one of the interactions, and associate it with the item at the position of the craa
         ; will be nice, updates the status of the craa, which are observations that are also added to its observations
         ; like eating food generates a good feeling, craa associates food with good feeling ;).
         (let food (showpos (car craa!pos) (cadr craa!pos))
            (if (is food #\f) 
               (do 
                  ;(act_bite craa)
                  (add-observation craa (list 'bite #\f))
                  (add-observation craa 'positive)
                   ))
            (if (is food #\p) 
               (do 
                  ;(act_bite craa)
                  (add-observation craa #\p)
                  (add-observation craa (list 'bite #\p))
                  (add-observation craa 'negative)
                  )
               ;else not edible
               (if food 
                  (do
                     (add-observation craa (list 'bite food))
                     (add-observation craa 'neutral)
                     ))))

         ;(prn)
         ;(prn " stm: " craa!stm)
         ;(showarea craa!pos 3)
      )

   )
      
   (prn)
   (prn "short-term memory:")
   (prn (craa 'stm))
   (prn)
   (prn "associative longterm memory:") 

   ; iaw = is associated with
   (each x (sort-abc (keys craa!ltm))
      (pr (space x 8) "  iaw  ")
      (let categorized (counts (craa!ltm x))
         (each z (keys craa!ltm) (unless (categorized z) (= (categorized z) #\.)))
         ;(= (categorized x) #\.)
         (each y (sort-abc (keys categorized))
            (pr (space (categorized y) 3) " " y ", ")))
      (prn)
      )

   (prn)
   (prn "emotional longterm memory:") 
   (each x (sort-abc (keys craa!eltm))
            (prn (space x 8) "  iaw   " (space ((craa!eltm x) 'positive) 3) " pos,   " (space ((craa!eltm x) 'neutral) 3) " neu,   " (space ((craa!eltm x) 'negative) 3) " neg."))
   (prn)
)

(show (list craa))
(prn (craa 'pos))
(prn (craa 'dir))


; utility: sum
(def sum (list)
   (let s 0 
      (each i list (= s (+ s i))) 
   s))

(def vector2angle (dir)
   (withs (distance (sqrt (sum dir)) 
           pi (acos -1) 
           degree (/ pi 180)
           (x y) (map [/ _ distance] dir)
           angle (/ (acos x) degree))
      (if (< (/ (asin y) degree) 0) (= direction (+ angle 180)))
      (list (round angle) distance)))
      

; c = creature (for dir and pos) , pos = pos of point to check 
; width is deviation from direction angle of craa that is still in sight
(def insight (c pos width range)
   (withs  ((dx dy) (map - pos c!pos) 
            angle1 (car (vector2angle c!dir))
            (angle2 distance) (vector2angle (list dx dy)))
      (if (> distance range) nil
         (if (> width (abs (- angle1 angle2))) nil t))))