sutton-barto-reinforcement-learning/gridworld/source.lisp at main · davidelettieri/sutton-barto-reinforcement-learning · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
;;ref: http://incompleteideas.net/book/code/gridworld5x5.lisp
;; to execute in SBCL:
;; (load "source.lisp")
;; (setup)
;; (compute-V)  for policy evaluation
;; OR
;; (compute-V*) for finding optimal value function

(defvar V)
(defvar VV)
(defvar rows)
(defvar columns)
(defvar states)
(defvar AA)
(defvar BB)
(defvar AAprime)
(defvar BBprime)
(defvar gamma 0.9)


(defun setup ()
  (setq rows 5)
  (setq columns 5)
  (setq states 25)
  (setq AA (state-from-xy 1 0))
  (setq BB (state-from-xy 3 0))
  (setq AAprime (state-from-xy 1 4))
  (setq BBprime (state-from-xy 3 2))
  (setq V (make-array states :initial-element 0.0))
  (setq VV (make-array (list rows columns)))
)

(defun compute-V ()
  (loop for delta = (loop for x below states
                          for old-V = (aref V x)
                          do (setf (aref V x)
                                   (mean (loop for a below 4 collect
                                               (full-backup x a))))
                          sum (abs (- old-V (aref V x))))
        until (< delta 0.000001))
  (loop for state below states do
        (multiple-value-bind (x y) (xy-from-state state)
          (setf (aref VV y x) (aref V state))))
  (sfa VV))

(defun compute-V* ()
  (loop for delta = (loop for x below states
                          for old-V = (aref V x)
                          do (setf (aref V x)
                                   (loop for a below 4 maximize
                                               (full-backup x a)))
                          sum (abs (- old-V (aref V x))))
        until (< delta 0.000001))
  (loop for state below states do
        (multiple-value-bind (x y) (xy-from-state state)
          (setf (aref VV y x) (aref V state))))
  (sfa VV))

(defun sfa (array)
  "Show Floating-Point Array"
  (cond ((= 1 (array-rank array))
         (loop for e across array do (format t "~5,1F" e)))
        (t (loop for i below (array-dimension array 0) do
                 (format t "~%")
                 (loop for j below (array-dimension array 1) do
                       (format t "~5,1F" (aref array i j)))))))

(defun full-backup (x a)
  (let (r y)
    (cond ((= x AA)
           (setq r +10)
           (setq y AAprime))
          ((= x BB)
           (setq r +5)
           (setq y BBprime))
          ((off-grid x a)
           (setq r -1)
           (setq y x))
          (t
           (setq r 0)
           (setq y (next-state x a))))
    (+ r (* gamma (aref V y)))))

(defun off-grid (state a)
  (multiple-value-bind (x y) (xy-from-state state)
    (case a
      (0 (incf y) (>= y rows))
      (1 (incf x) (>= x columns))
      (2 (decf y) (< y 0))
      (3 (decf x) (< x 0)))))

(defun next-state (state a)
  (multiple-value-bind (x y) (xy-from-state state)
    (case a
      (0 (incf y))
      (1 (incf x))
      (2 (decf y))
      (3 (decf x)))
    (state-from-xy x y)))

(defun state-from-xy (x y)
      (+ y (* x columns)))

(defun xy-from-state (state)
  (truncate state columns))

;; using SBCL and loading the original code, it gives an error that mean is undefined. So adding this definition of mean here.
(defun mean (numbers)
  "Return the arithmetic mean of a list of numbers."
  (if (null numbers)
      0
      (/ (reduce #'+ numbers) (length numbers))))