A Racket library for (non-LLM) AI algorithms
1#lang racket/base
2
3
4(require racket/contract/base)
5
6
7(provide
8 (contract-out
9 [transition-system? (-> any/c boolean?)]
10 [make-transition-system
11 (->* (#:states (sequence/c any/c)
12 #:actions (sequence/c any/c)
13 #:transition-function (-> any/c any/c distribution?))
14 (#:applicable-action-selector (or/c (-> any/c set?) #false)
15 #:name (or/c symbol? #false))
16 transition-system?)]
17 [transition-system-states (-> transition-system? set?)]
18 [transition-system-actions (-> transition-system? set?)]
19 [transition-system-contains-state? (-> transition-system? any/c boolean?)]
20 [transition-system-contains-action? (-> transition-system? any/c boolean?)]
21 [transition-system-action-applicable? (-> transition-system? any/c any/c boolean?)]
22 [transition-system-applicable-actions (-> transition-system? any/c set?)]
23 [transition-system-outcomes (-> transition-system? any/c any/c distribution?)]
24 [transition-system-perform-action (-> transition-system? any/c any/c any/c)]))
25
26
27(require math/distributions
28 racket/match
29 racket/sequence
30 racket/set
31 rebellion/custom-write)
32
33
34(struct transition-system (states actions transition-function applicable-action-selector name)
35 #:omit-define-syntaxes
36 #:constructor-name constructor:transition-system
37 #:property prop:object-name (struct-field-index name)
38 #:property prop:custom-write (make-named-object-custom-write 'transition-system))
39
40
41(define (make-transition-system #:states states
42 #:actions actions
43 #:transition-function transition-function
44 #:applicable-action-selector [selector #false]
45 #:name [name #false])
46 (let* ([states (for/set ([s states]) s)]
47 [actions (for/set ([a actions]) a)]
48 [selector (or selector (λ (_) actions))])
49 (constructor:transition-system states actions transition-function selector name)))
50
51
52; Gridworld, from Reinforcement Learning: An Introduction Chapter 4.1:
53;
54; T 1 2 3
55; 4 5 6 7
56; 8 9 10 11
57; 12 13 14 T
58
59(define gridworld-states (set 'terminal 1 2 3 4 5 6 7 8 9 10 11 12 13 14))
60(define gridworld-actions (set 'left 'up 'right 'down))
61
62
63(define (gridworld-transition state action)
64 (define new-state
65 (match* (state action)
66 [(1 'left) 'terminal]
67 [(1 'up) 1]
68 [(1 'right) 2]
69 [(1 'down) 5]
70 [(2 'left) 1]
71 [(2 'up) 2]
72 [(2 'right) 3]
73 [(2 'down) 6]
74 [(3 'left) 2]
75 [(3 'up) 3]
76 [(3 'right) 3]
77 [(3 'down) 7]
78 [(4 'left) 4]
79 [(4 'up) 'terminal]
80 [(4 'right) 5]
81 [(4 'down) 8]
82 [(5 'left) 4]
83 [(5 'up) 1]
84 [(5 'right) 6]
85 [(5 'down) 9]
86 [(6 'left) 5]
87 [(6 'up) 2]
88 [(6 'right) 7]
89 [(6 'down) 10]
90 [(7 'left) 6]
91 [(7 'up) 3]
92 [(7 'right) 7]
93 [(7 'down) 11]
94 [(8 'left) 8]
95 [(8 'up) 4]
96 [(8 'right) 9]
97 [(8 'down) 12]
98 [(9 'left) 8]
99 [(9 'up) 5]
100 [(9 'right) 10]
101 [(9 'down) 13]
102 [(10 'left) 9]
103 [(10 'up) 6]
104 [(10 'right) 11]
105 [(10 'down) 14]
106 [(11 'left) 10]
107 [(11 'up) 7]
108 [(11 'right) 11]
109 [(11 'down) 'terminal]
110 [(12 'left) 12]
111 [(12 'up) 8]
112 [(12 'right) 13]
113 [(12 'down) 12]
114 [(13 'left) 12]
115 [(13 'up) 9]
116 [(13 'right) 14]
117 [(13 'down) 13]
118 [(14 'left) 13]
119 [(14 'up) 10]
120 [(14 'right) 'terminal]
121 [(14 'down) 14]
122 [('terminal _) 'terminal]))
123 (discrete-dist (list new-state)))
124
125
126(define gridworld
127 (make-transition-system
128 #:states gridworld-states
129 #:actions gridworld-actions
130 #:transition-function gridworld-transition
131 #:name 'gridworld))
132
133
134(define (transition-system-contains-state? system state)
135 (set-member? (transition-system-states system) state))
136
137
138(define (transition-system-contains-action? system action)
139 (set-member? (transition-system-actions system) action))
140
141
142(define (transition-system-action-applicable? system state action)
143 (set-member? (transition-system-applicable-actions system state) action))
144
145
146(define (transition-system-applicable-actions system state)
147 (check-transition-system-contains-state #:who 'transition-system-applicable-actions system state)
148 ((transition-system-applicable-action-selector system) state))
149
150
151(define (transition-system-outcomes system state action)
152 (check-transition-system-contains-state #:who 'transition-system-outcomes system state)
153 (check-transition-system-contains-action #:who 'transition-system-outcomes system action)
154 (check-transition-system-action-applicable #:who 'transition-system-outcomes system state action)
155 ((transition-system-transition-function system) state action))
156
157
158(define (transition-system-perform-action system state action)
159 (check-transition-system-contains-state #:who 'transition-system-perform-action system state)
160 (check-transition-system-contains-action #:who 'transition-system-perform-action system action)
161 (check-transition-system-action-applicable #:who 'transition-system-perform-action
162 system state action)
163 (sample ((transition-system-transition-function system) state action)))
164
165
166(define (check-transition-system-contains-state #:who who system state)
167 (unless (transition-system-contains-state? system state)
168 (raise-arguments-error who "transition system does not contain given state"
169 "state" state
170 "system" system)))
171
172
173(define (check-transition-system-contains-action #:who who system action)
174 (unless (transition-system-contains-action? system action)
175 (raise-arguments-error who "transition system does not contain given action"
176 "action" action
177 "system" system)))
178
179
180(define (check-transition-system-action-applicable #:who who system state action)
181 (unless (transition-system-action-applicable? system state action)
182 (raise-arguments-error who "action is not applicable in given state"
183 "action" action
184 "state" state
185 "system" system)))