Source

icfp2014 / code / lml / ai_1.lml

  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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
;; For reference:
;;  * 0: Wall (`#`)
;;  * 1: Empty (`<space>`)
;;  * 2: Pill
;;  * 3: Power pill
;;  * 4: Fruit location
;;  * 5: Lambda-Man starting position
;;  * 6: Ghost starting position
(letrec (init modulo random opposite map lman lmanvit lmanpos lmandir anyfruit mhdist abs ghostpos ghostdist reverse search flee moves sort transform sortedmoves filterdir filterobj findpills sameasfirst shuffle step mapobj findx nextstep)
  (
   ;; init: returns the seed for the PRG, and the step function
   (lambda (ws unused) (tuple (tuple 42 0) step))
   ;; modulo: is a % b
   (lambda (a b) (- a  (* b (div a b))))
   ;; random: is a pseudo random generator
   (lambda (seed) (modulo (* 75 seed) 65537)) ; same as ZX Spectrum
   ;; opposite: returns the opposite direction
   (lambda (dir)
     (modulo (+ dir 2) 4))
   ;; map: given world state, returns the map
   (lambda (ws) (car ws))
   ;; lman: given world state returns the lambda-man's state
   (lambda (ws) (car (cdr ws)))
   ;; lmanvit: given world state returns the vitality of lambda-man
   (lambda (ws) (car (lman ws)))
   ;; lmanpos: given world state returns the position of lambda-man
   (lambda (ws) (car (cdr (lman ws))))
   ;; lmandir: given world state returns the position of lambda-man
   (lambda (ws) (car (cdr (cdr (lman ws)))))
   ;; anyfruit: given world state returns the fruit status
   (lambda (ws) (cdr (cdr (cdr ws))))
   ;; mhdist: given two positions, return manhattan distance
   (lambda (p1 p2)
     (let (x1 y1 x2 y2) ((car p1) (cdr p1) (car p2) (cdr p2))
          (if (> x1 x2)
              (if (> y1 y2)
                  (+ (- x1 x2) (- y1 y2))
                  (+ (- x1 x2) (- y2 y1)))
              (if (> y1 y2)
                  (+ (- x2 x1) (- y1 y2))
                  (+ (- x2 x1) (- y2 y1))))))
   ;; abs: returns absolute value
   (lambda (x)
     (if (< x 0) (* x -1) x))
   ;; ghostpos: given world state, returns list of ghosts' positions
   (lambda (ws)
     (letrec (ghosts getpos)
       ((car (cdr (cdr ws)))
        (lambda (g)
          (if (atom g)
              g
            (if (eq (car (car g)) 0) ;; standard ghost
                (cons (car (cdr (car g))) ;; The position of the first ghost in the list
                      (getpos (cdr g)))
              (getpos (cdr g))))))
       (getpos ghosts)))
   ;; ghostdist: given list of ghost statuses and a position, return list of (manhattandistance, position) tuples
   (lambda (gl pos)
     (letrec (getmdd)
       ((lambda (g)
          (if (atom g)
              g
            (cons (tuple (mhdist (car g) pos) (car g))
                  (getmdd (cdr g) pos)))))
       (getmdd gl pos)))
   ;; reverse: reverse a list
   (lambda (lst)
     (letrec (dorev)
       ((lambda (l a)
          (if (atom l)
              a
            (dorev (cdr l) (cons (car l) a)))))
       (dorev lst 0)))
   ;; search: do a breadth-first search for pos2 from pos1, and limit after limit moves. Returns a list of path lengths.
   (lambda (ws pos1 pos2 max)
     (letrec (dosearch expand lte fixuppaths)
       ((lambda (p1 p2 depth limit sofar path)
          (if (eq depth limit)
              sofar
            (if (eq (mapobj (map ws) p1) 0) ; wall
                sofar
              (if (eq (car p1) (car p2))
                  (if (eq (cdr p1) (cdr p2))
                      (cons (cons depth path) sofar)
                    (expand p1 p2 (+ depth 1) limit sofar path))
                (expand p1 p2 (+ depth 1) limit sofar path)))))
        (lambda (pp1 pp2 d l sf pth)
          (let (nsf0) ((dosearch (nextstep pp1 0) pp2 d l sf (cons 0 pth)))
               (let (nsf1) ((dosearch (nextstep pp1 1) pp2 d l nsf0 (cons 1 pth)))
                    (let (nsf2) ((dosearch (nextstep pp1 2) pp2 d l nsf1 (cons 2 pth)))
                         (dosearch (nextstep pp1 3) pp2 d l nsf2 (cons 3 pth))))))
        (lambda (a b)
          (<= (car a) (car b)))
        (lambda (plist)
          (letrec (doit)
            ((lambda (pl)
               (if (atom pl)
                   pl
                 (cons (cons (car (car pl)) (reverse (cdr (car pl))))
                       (doit (cdr pl))))))
            (doit plist))))
       (sort (fixuppaths (dosearch pos1 pos2 0 max 0 0)) lte)))
   ;; flee: given the world state, returns the forbidden dir or -1 if there is no need to flee
   (lambda (ws)
     (letrec (getdir)
       ((lambda (g)
          (if (atom g)
              -1
            (let (mh pos)
              ((car (car g))
               (cdr (car g)))
                 (if (< mh 5) ;; maybe flee if ghost is closer than this
                     ;; do an exhaustive search with max depth mh
                     (let (paths) ((search ws (lmanpos ws) pos (+ mh 1)))
                          (if (atom paths)
                              ;; no path found, we're safe
                              (getdir (cdr g))
                            ;; aagh, flee!
                            (car (cdr (car paths)))))
                   (getdir (cdr g)))))))
       (getdir (ghostdist (ghostpos ws) (lmanpos ws)))))
   ;; moves: given world state, returns a list of map objects and their directions (walls are excluded)
   (lambda (ws)
     (letrec (getobjs checkghost)
       ((lambda (dirs)
          (if (atom dirs)
              dirs
            (let (newpos) ((nextstep (lmanpos ws) (car dirs)))
                 (let (obj) ((mapobj (map ws) newpos))
                      (if (eq obj 0)
                          (getobjs (cdr dirs))
                        (if (eq (checkghost newpos) 1) ; moving to ghost position is invalid
                            (getobjs (cdr dirs))
                          (cons (tuple obj (car dirs))
                                (getobjs (cdr dirs)))))))))
        (lambda (pos)
          (letrec (docheck)
            ((lambda (lst)
               (if (atom lst)
                   0
                 (if (eq (car pos) (car (car lst)))
                     (if (eq (cdr pos) (cdr (car lst)))
                         1
                       (docheck (cdr lst)))
                   (docheck (cdr lst))))))
            (docheck (ghostpos ws)))))
       (getobjs (list 0 1 2 3))))
   ;; sort: bubble-sorts a list using the supplied predicate
   ;;       adapted from: http://www.cs.toronto.edu/~dianaz/Example_LispPart1.html
   (lambda (unsorted predicate)
     (letrec (dosort checkagain)
       ((lambda (lst pred)
          ; Boundary case, if the input is an nil list
          (if (atom lst)
              lst
            ; Base case, if the list contains 1 number
            (if (atom (cdr lst))
                lst
              ; Recursive case, check the first bubble -- the first two numbers in the list
              ; If the first number <= second number, sort the list starting at the second number
              ; Beware that the recursive call to sort can return a list with the first number smaller
              ; than the current first number in the list. Hence, call a function 'check-again' to ensure
              ; the list is correctly sorted. This is what the bubble sort do when flipping the numbers among 
              ; bubbles.
              (if (pred (car lst) (car (cdr lst)))
                  (checkagain
                   (cons (car lst)
                         (dosort (cdr lst) pred))
                   pred)
                ; If the first number > second number, swap the first two numbers and sort the list
                ; starting at the current second number
                (checkagain
                 (cons (car (cdr lst))
                       (dosort (cons (car lst) (cdr (cdr lst))) pred))
                 pred)))))
        (lambda (lst pred)
          (if (pred (car lst) (car (cdr lst)))
              lst
            (dosort lst pred))))
       (dosort unsorted predicate)))
   ;; transform: transforms list of (obj dir) to a list of (desirability dir)
   (lambda (movelist fruit)
     (letrec (dotrans transform)
       ((lambda (lst)
          (if (atom lst)
              lst
            (cons (transform (car lst)) (dotrans (cdr lst)))))
        (lambda (a)
          (let (obj dir) ((car a) (cdr a))
               (if (eq obj 4)
                   (if (eq fruit 0)
                       (cons 40 dir)  ; if no fruit, treat as empty
                     (cons 10 dir))
                 (if (eq obj 3)
                     (cons 20 dir)
                   (if (eq obj 2)
                       (cons 30 dir)
                     (if (eq obj 1)
                         (cons 40 dir)
                       (if (eq obj 5)
                           (cons 40 dir) ; treat as empty
                         (if (eq obj 6)
                             (cons 40 dir) ; treat as empty
                           (cons 70 dir))))))))))
        (dotrans movelist)))
   ;; sortedmoves: given list of moves, sort them in (fruit, power pill, pill, (empty, lambda-man-start, ghost-start), wall) order
   (lambda (movelist fruit)
     (letrec (pred)
       ((lambda (a b)
          (<= (car a) (car b))))
       (sort (transform movelist fruit) pred)))
   ;; filterdir: given list of moves and a dir, return list without it
   (lambda (movelist dir)
     (letrec (dofilter)
       ((lambda (lst)
          (if (atom lst)
              lst
            (if (eq (cdr (car lst)) dir)
                (dofilter (cdr lst))
              (cons (car lst) (dofilter (cdr lst)))))))
       (dofilter movelist)))
   ;; filterobj: given list of moves and an obj, return list without it
   (lambda (movelist obj)
     (letrec (dofilter)
       ((lambda (lst)
          (if (atom lst)
              lst
            (if (eq (car (car lst)) obj)
                (dofilter (cdr lst))
              (cons (car lst) (dofilter (cdr lst)))))))
       (dofilter movelist)))
   ;; findpills: given ws, returns how many there are in each direction
   (lambda (ws)
     (letrec (sumdir getdists getposandmh getpills)
       ((lambda (pills dir)
          (letrec (dosumdir)
            ((lambda (lst c)
               (if (atom lst)
                   c
                 (if (eq dir 0) ;; up
                     (if (> (cdr (car lst)) 0)
                         (dosumdir (cdr lst) (+ c 1))
                       (dosumdir (cdr lst) c))
                   (if (eq dir 1) ;; right
                       (if (< (car (car lst)) 0)
                           (dosumdir (cdr lst) (+ c 1))
                         (dosumdir (cdr lst) c))
                     (if (eq dir 3) ;; down
                         (if (< (cdr (car lst)) 0)
                             (dosumdir (cdr lst) (+ c 1))
                           (dosumdir (cdr lst) c))
                       (if (eq dir 0) ;; left
                           (if (> (cdr (car lst)) 0)
                               (dosumdir (cdr lst) (+ c 1))
                             (dosumdir (cdr lst) c))
                         ;; this should never happen!
                         c)))))))
            (dosumdir pills 0)))
        (lambda (p)
          (letrec (lmp dodist)
            ((lmanpos ws)
             (lambda (lst)
               (if (atom lst)
                   lst
                 (cons (cons (- (car lmp) (car (car lst)))
                             (- (cdr lmp) (cdr (car lst))))
                       (dodist (cdr lst))))))
            (dodist p)))
        ;; getposandmh returns pill positions sorted on mh
        (lambda (p)
          (letrec (lmp dodist pred)
            ((lmanpos ws)
             (lambda (lst)
               (if (atom lst)
                   lst
                 (cons (cons (car lst) (mhdist (car lst) lmp))
                       (dodist (cdr lst)))))
             (lambda (a b)
               (<= (cdr a) (cdr b))))
            (sort (dodist p) pred)))
        (lambda (m startx starty)
          (letrec (walky walkx)
            ((lambda (rows y pills sx sy)
               (if (atom rows)
                   pills
                 (if (>= y sy)
                     (if (< (- y sy) 20)
                         (let (newpills) ((walkx (car rows) 0 y pills sx))
                              (walky (cdr rows) (+ y 1) newpills sx sy))
                       pills) ; outside area, return what we have
                   (walky (cdr rows) (+ y 1) pills sx sy))))
             (lambda (row x y pills sx)
               (if (atom row)
                   pills
                 (if (>= x sx)
                     (if (< (- x sx) 20)
                         (if (eq (car row) 2)
                             (cons (cons x y) (walkx (cdr row) (+ x 1) y pills sx))
                           (walkx (cdr row) (+ x 1) y pills sx))
                       pills) ; outside area, return what we have
                   (walkx (cdr row) (+ x 1) y pills sx)))))
            (walky m 0 0 startx starty))))
       (let (pills) ((getpills (map ws) (- (car (lmanpos ws)) 10) (- (cdr (lmanpos ws)) 10)))
          (let (dists posandmh) ((getdists pills) (getposandmh pills))
               (tuple posandmh
                      (list (cons 0 (sumdir dists 0))
                            (cons 1 (sumdir dists 1))
                            (cons 2 (sumdir dists 2))
                            (cons 3 (sumdir dists 3))))))))
   ;; sameasfirst: takes a list of moves, then returns the list of moves which has the same map object as the first and the length of it
   (lambda (movelist)
     (if (atom movelist)
         movelist
       (let (first) ((car (car movelist)))
            (letrec (filter)
              ((lambda (lst)
                 (if (atom lst)
                     lst
                   (if (eq (car (car lst)) first)
                       (cons (car lst) (filter (cdr lst)))
                     (filter (cdr lst))))))
              (filter movelist)))))
   ;; shuffle: takes a moves list, and returns a list randomized according to the weights
   (lambda (lst1 weights rndseed)
     (if (atom lst1)
         lst1
       (if (atom (cdr lst1)) ;; only one element, pointless to do anything
           lst1
         (letrec (doshuffle applyrandomizedweights getweight)
           ((lambda (movelist)
              (letrec (pred)
                ((lambda (a b)
                   (>= (car a) (car b))))
                (sort movelist pred)))
            (lambda (lst seed)
              (if (atom lst)
                  lst
                (let (w rnd) ((getweight weights (cdr (car lst))) (random seed))
                     (cons (cons (modulo rnd (+ w 5)) (cdr (car lst))) ; Add some to w, to avoid divzerro and to give low values a bit higher chance
                           (applyrandomizedweights (cdr lst) rnd)))))
            (lambda (lst dir)
              (if (atom lst)
                  lst
                (if (eq (car (car lst)) dir)
                    (cdr (car lst))
                  (getweight (cdr lst) dir)))))
           (doshuffle (applyrandomizedweights lst1 rndseed))))))
   ;; step: this is the main ai function, it takes the current ai state and the world state,
   ;; and returns the new ai state and the new direction for lambda-man
   (lambda (ai ws)
     (let (res)
       ((letrec (forbiddenfleedir movelist currdir rnd cp std)
          ((flee ws) (sortedmoves (moves ws) (anyfruit ws)) (lmandir ws) (modulo (car ai) 2) (cdr ai)
           (lambda (unused)
             (let (validmoves)
               ((if (eq forbiddenfleedir -1)
                    ;; No need to flee. Use the whole movelist
                    movelist
                  ;; filter the list to only contain good flee directions
                  (let (fleemoves) ((filterdir movelist forbiddenfleedir))
                       (if (atom fleemoves)
                           ;; wth, use any valid move!
                           movelist
                         ;; list not empty, use it
                         fleemoves))))
               (if (atom validmoves)
                   ;; OH NOES
                   (cons currdir 0)
                 (if (<= (car (car validmoves)) 30) ; lower values are more desirable, if the top move is a pill or fruit, go for it!
                     (cons (cdr (car validmoves)) 0)
                   (let (filteredinit) ((sameasfirst (filterdir validmoves (opposite currdir))))
                        (if (atom filteredinit)
                            ;; No choice but to go back on ourselves
                            (cons (opposite currdir) 0)
                          (let (filtered) ((if (eq (lmanvit ws) 0) (filterobj filteredinit 3) filteredinit))
                               (if (atom filtered)
                                   ;; Ok, then eat the power..
                                   (cons (cdr (car filteredinit)) 0)
                                 (if (atom (cdr filtered))
                                     ;; only one way to go!
                                     (cons (cdr (car filtered)) 0)
                                   ;; Multiple choices, figure out where it's best to go!
                                   (let (pills) ((findpills ws))
                                        (let (mh) ((if (atom (car pills)) 9999 (cdr (car (car pills)))))
                                             (if (< mh 6) ; pills are close
                                                 (let (paths) ((search ws (lmanpos ws) (car (car (car pills))) (+ mh 1)))
                                                      (if (atom paths)
                                        ; no path found, use weighted random
                                                          (let (randomized) ((shuffle filtered (cdr pills) (car ai)))
                                                               (cons (cdr (car randomized)) 0))
                                        ; follow the path
                                                        (cons (car (cdr (car paths))) (cdr (cdr (car paths))))))
                                        ; no pills close, use weighted random
                                               (let (randomized) ((shuffle filtered (cdr pills) (car ai)))
                                                    (cons (cdr (car randomized)) 0)))))))))))))))
             (if (atom cp)
                 (std 0)
               (if (eq forbiddenfleedir -1)
                                        ; just follow the path
                   cp
                 ;; don't follow path when fleeing!
                 (std 0)))))
       (tuple (tuple (random (car ai)) (cdr res)) (car res))))
   ;; mapobj: access the map at a certain position
   (lambda (map pos)
     (let (x y) ((car pos) (cdr pos))
          (if (eq y 0)
              (findx (car map) x)
            (mapobj (cdr map) (tuple x (- y 1))))))
   ;; findx: helper for mapobj (could probably be local to mapobj)
   (lambda (row x)
     (if (eq x 0)
         (car row)
       (findx (cdr row) (- x 1))))
   ;; nextstep: given a position and a direction, it returns the new position
   (lambda (pos dir)
     (let (x y) ((car pos) (cdr pos))
          (if (eq dir 0)
              (tuple x (- y 1))
            (if (eq dir 1)
                (tuple (+ x 1) y)
              (if (eq dir 2)
                  (tuple x (+ y 1))
                (tuple (- x 1) y)))))))
  (init)
  )