Skip to content

Instantly share code, notes, and snippets.

@arnar

arnar/agents2.lisp

Created Jan 26, 2009
Embed
What would you like to do?
;; 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: ***
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment