agents2.lisp

;; agents2.lisp

(defstruct env
  (width 2)
  (height 1)
  (x-pos 0)
  (y-pos 0)
  (dirt-vector (make-array 2))
  (moves-so-far 0))

(defstruct agent
  (name "A")
  (program nil)   ;; a function of percept -> action
  (state nil)
)

(defvar *env*)

(defun env-dirt (x y env)
  (aref (env-dirt-vector env)
        (+ x (* y (env-width env)))))

(defun set-env-dirt (x y env dirty)
  (setf (aref (env-dirt-vector env)
              (+ x (* y (env-width env))))
        dirty))

;; Draws a picture of an environment
(defun print-env (env)
  (let ((w (env-width env))
        (h (env-height env))
        (x (env-x-pos env))
        (y (env-y-pos env)))
    (format t "      ")
    (dotimes (j w) (format t "~a~0,4:@t" j))
    (format t "~%")
    (dotimes (i h)
      (format t "    ")
      (dotimes (j w) (format t "+---"))
      (format t "+~%")
      (format t "~a~4t" i)
      (dotimes (j w)
        (format t "| ")
        (if (and (= j x) (= i y))
            (format t "A")
            (format t " "))
        (if (env-dirt j i env)
            (format t ";")
            (format t " ")))
      (format t "|~%")
    )
    (format t "    ")
    (dotimes (j w) (format t "+---"))
    (format t "+~%")
  )
)

;; Constructs the perception for an environment
(defun get-percept (env)
  (list :x (env-x-pos env)
        :y (env-y-pos env)
	:width (env-width env)
	:height (env-height env)
        :dirty (env-dirt (env-x-pos env)
                         (env-y-pos env)
                         env)))

;; Applies an action to an enviornment, updating all relevant fields
(defun update-env (action env)
  (cond ((eq action 'suck) (set-env-dirt (env-x-pos env)
                                          (env-y-pos env)
                                          env
                                          NIL
                           )
        )
        ((eq action 'left)  (setf (env-x-pos env)
                                  (max (1- (env-x-pos env)) 0))
                            (setf (env-moves-so-far env) (1+ (env-moves-so-far env))))
        ((eq action 'right) (setf (env-x-pos env)
                                  (min (1+ (env-x-pos env))
                                       (1- (env-width env))))
                            (setf (env-moves-so-far env) (1+ (env-moves-so-far env))))
        ((eq action 'up)    (setf (env-y-pos env)
                                  (max (1- (env-y-pos env)) 0))
                            (setf (env-moves-so-far env) (1+ (env-moves-so-far env))))
        ((eq action 'down) (setf (env-y-pos env)
                                  (min (1+ (env-y-pos env))
                                       (1- (env-height env))))
                           (setf (env-moves-so-far env) (1+ (env-moves-so-far env))))
  ))

;; Initializes global environment
(defun init-env (width height dirt-probability)
  (setf *env* (make-env :width width
                        :height height
                        :dirt-vector (make-array (* width height))))
  (dotimes (i (* width height))
    (setf (aref (env-dirt-vector *env*) i)
          (< (random 1.0) dirt-probability))))

;; Simulates a step of an agent on the global environment
(defun simulate-step (agent performance-measure)
  (let ((action (funcall (agent-program agent) agent (get-percept *env*))))
    (update-env action *env*)
    (format t "Agent ~a just performed action: ~a~%" (agent-name agent) action)
    (print-env *env*)
    (format t "Performance evaluation: ~a~%" (funcall performance-measure *env* agent))
  ))

;; Simulates while user asks to keep going, prints every step
(defun simulate (agent performance-measure)
  (loop (simulate-step agent performance-measure)
     (if (not (y-or-n-p "Perform another step? [y/n]: ")) (return))))

;; Simulates a given number of steps and prints the resulting performance value
;; as well as returning it
(defun simulate-quiet (agent performance-measure steps)
  (dotimes (i steps)
    (update-env (funcall (agent-program agent) agent (get-percept *env*)) *env*))
  (format t "Performed ~a steps of simulation, performance value: ~a~%" 
          steps (funcall performance-measure *env* agent)))

;; Simply count the number of clean squares
(defun example-measure (env agent)
  (count-if #'not (env-dirt-vector env)))

;; This agent assumes a 2x1 environment
(defun example-agent-program (agent percept)
  (if (getf percept :dirty)
      'suck
      (if (= 0 (getf percept :x))
          'right
          'left
      )
   )
)

;; To initialize the vacuum-cleaner environment, call
;; (init-env 10 20 .5)
;; where 10 and 20 are the width and height, respectively, and .5 is the probability
;; of a square containing dirt

;; To test an agent interactively, call
;; (simulate (make-agent :name "Simple" :program #'example-agent-program) #'example-measure)

;; To test an agent for a number of steps, call
;; (simulate-quiet (make-agent :name "Simple" :program #'example-agent-program) #'example-measure 100)
;;  where 100 is the number of steps to perform


;;;;;; STATEFUL AGENTS ;;;;;;;;

;; Helper function: Unique number pr. square
(defun square-id (x y w)
  (+ x (* y w)))

;; Helper function: Returns a list of the neighbour squares
;; returns a list of lists, each containing two elements,
;; the direction and the id of the corresponding square
(defun get-neighbours (x y w h)
  (append (if (> x 0) (list (list 'left (square-id (1- x) y w))) '())
          (if (> y 0) (list (list 'up   (square-id x (1- y) w))) '())
          (if (< x (1- w)) (list (list 'right (square-id (1+ x) y w))) '())
          (if (< y (1- h)) (list (list 'down (square-id x (1+ y) w))) '())
  ))

;; An agent program that behaves as follows:
;; The agent stores in the state a list of
;; squares that it has seen clean alrady. It
;; is useful to use a unique number for each square,
;; the function SQUARE-ID provides such a number.
;; This agent will wander about randomly, avoiding
;; squares that have already been clean. It's goal
;; is to clean all the squares and then turn off
;; (i.e. return :idle forever)
(defun random-walk-with-state (agent percept)
  (let ((x (getf percept :x))
        (y (getf percept :y))
        (w (getf percept :width))
	(h (getf percept :height))
        (clean-list (agent-state agent)))
    ;; Fill in the code for the agent here
  )
)


;;;; Code for running experiments ;;;;

;; Helper function: given a number, gets the next number
;; with equal number of bits set
;; From Hacker's Delight, page 14
;; http://www.hackersdelight.org/basics.pdf
(defun next-set (value)
  (let* ((smallest (logand value (- value)))
         (ripple (+ value smallest))
         (ones (logxor value ripple))
         (ones (floor (ash ones -2) smallest)))
    (logior ripple ones)))

;; Helper function: Creates a list of all possible boolean
;; vectors of length LENGTH with K elements set to T
(defun generate-choices (length k)
  (let ((xs '()))
    (loop for i = (1- (ash 1 k)) 
	  then (next-set i)
	  until (logbitp length i)
       do (let ((a (make-array length)))
	    (loop for j = 0 
	          then (1+ j) 
	          while (< j length)
	       do (setf (aref a j) (logbitp j i))
	    )
	    (setf xs (cons a xs))
	   )
   )
   xs
  )
)
    

;; Generates all possible environments of a given
;; size with a given number of dirty squares
(defun generate-environments (width height dirty-squares)
  (mapcar (lambda (dirt)
	    (make-env :width width
		      :height height
		      :dirt-vector dirt))
	  (generate-choices (* width height) dirty-squares)))


;; Helper function: Runs an agent on an environment
;; for a number of steps, and returns the evaluation
(defun run-experiment-step (env agent performance-measure max-steps)
  (dotimes (i max-steps)
    (update-env (funcall (agent-program agent) agent (get-percept env)) env))
  (funcall performance-measure env agent))

;; Runs an experiment, evaluates an agent on a set of
;; environments and returns average performance
(defun run-experiment (environments agent-factory performance-measure max-steps)
  (let ((sum 0)
	(count 0))
    (loop for env in environments
       do (setf sum (+ sum (run-experiment-step env
						(funcall agent-factory)
						performance-measure
						max-steps)))
	 (setf count (1+ count)))
    (format t "Ran ~a simulations, avg. performance: ~a~%" count (float (/ sum count)))
))

;; Example usage:
;; CL-USER> (run-experiment (generate-environments 3 3 2)
;; 			 (lambda () (make-agent :program #'example-agent-program))
;; 			 #'example-measure
;; 			 1000)
;; Ran 36 simulations, avg. performance: 7.4444447
;; NIL
;; CL-USER> (run-experiment (generate-environments 3 3 2)
;; 			 (lambda () (make-agent :program #'example-agent-program))
;; 			 #'perf-measure
;; 			 1000)
;; Ran 36 simulations, avg. performance: -850.6667
;; NIL
;; CL-USER> (run-experiment (generate-environments 3 3 2)
;; 			 (lambda () (make-agent :program #'random-walk))
;; 			 #'perf-measure
;; 			 1000)
;; Ran 36 simulations, avg. performance: -818.0
;; NIL
;; CL-USER> (run-experiment (generate-environments 3 3 2)
;; 			 (lambda () (make-agent :program #'random-walk-with-state))
;; 			 #'perf-measure
;; 			 1000)
;;; Ran 36 simulations, avg. performance: 167.13889



;;; Local Variables: ***
;;; indent-tabs-mode: NIL ***
;;; End: ***