(lambda (world undoc) (letrec ( (cadr (lambda (x) (car (cdr x)))) (cddr (lambda (x) (cdr (cdr x)))) (caar (lambda (x) (car (car x)))) (cdar (lambda (x) (cdr (car x)))) (caddr (lambda (x) (car (cdr (cdr x))))) (cdddr (lambda (x) (cdr (cdr (cdr x))))) (cadddr (lambda (x) (car (cdr (cdr (cdr x)))))) (cddddr (lambda (x) (cdr (cdr (cdr (cdr x)))))) (length (lambda (l) (if (atom? l) 0 (length (cdr l))))) (nth (lambda (i l) (if (= i 0) (car l) (nth (- i 1) (cdr l))))) (map (lambda (f xs) (if (atom? xs) 0 (cons (f (car xs)) (map f (cdr xs)))) )) (filter (lambda (pred xs) (if (atom? xs) 0 (if (pred (car xs)) (cons (car xs) (filter pred (cdr xs))) (filter pred (cdr xs)) ) ) )) (any (lambda (f xs) (if (atom? xs) 0 (or (f (car xs)) (any f (cdr xs)))))) (all (lambda (f xs) (if (atom? xs) 1 (and (f (car xs)) (all f (cdr xs)))))) (append (lambda (xs ys) (if (atom? xs) ys (cons (car xs) (append (cdr xs) ys)) ) )) (concat (lambda (xss) (if (atom? xss) 0 (if (atom? (car xss)) (concat (cdr xss)) (cons (car (car xss)) (concat (cons (cdr (car xss)) (cdr xss)))) ) ) )) (abs (lambda (x) (if (< x 0) (- 0 x) x))) (mod (lambda (x y) (- x (* (/ x y) y)))) (** (lambda (x y) (if (= 0 y) 1 (* x (** x (- y 1)) ) ) )) (bitfield-get (lambda (bf pos size) (mod (/ bf pos) size) )) (bitfield-set (lambda (bf pos size val) (+ bf (* pos (- val (bitfield-get bf pos size)))) )) (id (lambda (x) x)) (const (lambda (x) (lambda (y) x))) (do2 (lambda (x1 x2) x2)) (do3 (lambda (x1 x2 x3) x3)) (do4 (lambda (x1 x2 x3 x4) x4)) (do5 (lambda (x1 x2 x3 x4 x5) x5)) (randnext 1) (rand (lambda (limit) (mod (/ (set! randnext (mod (+ (* randnext 31337) 12345) 65536)) 64) limit ) )) (make-mutable (lambda (val) (let ((x val)) (lambda (f) (set! x (f x))) ) )) (mutable-get (lambda (m) (m id))) (mutable-set (lambda (m x) (m (const x)))) (mutable-map (lambda (m f) (m f))) ) (letrec ( (world-map car) (world-man cadr) (world-ghosts caddr) (world-fruit cdddr) (man-vitality car) (man-location cadr) (man-dir caddr) (man-lives cadddr) (man-score cddddr) (ghost-vitality car) (ghost-loc cadr) (ghost-dir cddr) (loc-x car) (loc-y cdr) (make-loc cons) (loc-move (lambda (loc dir) (if (< dir 2) (if (< dir 1) (cons (car loc) (- (cdr loc) 1)) (cons (+ (car loc) 1) (cdr loc)) ) (if (< dir 3) (cons (car loc) (+ (cdr loc) 1)) (cons (- (car loc) 1) (cdr loc)) ) ) )) (loc-eq? (lambda (a b) (and (= (car a) (car b)) (= (cdr a) (cdr b))) )) (loc-manhattan-dist (lambda (a b) (+ (abs (- (car a) (car b))) (abs (- (cdr a) (cdr b)))) )) (flipdir (lambda (dir) (if (< dir 2) (+ dir 2) (- dir 2)) )) (node-loc caar) (node-neighbors cdar) (node-neighbors-get (lambda (n) (mutable-get (cdar n)))) (node-neighbors-set (lambda (n x) (mutable-set (cdar n) x))) (node-state cadr) (node-state-get (lambda (n) (mutable-get (cadr n)))) (node-state-set (lambda (n x) (mutable-set (cadr n) x))) (node-visited caddr) (node-visited-get (lambda (n) (mutable-get (caddr n)))) (node-visited-set (lambda (n x) (mutable-set (caddr n) x))) (node-depth cdddr) (node-depth-get (lambda (n) (mutable-get (cdddr n)))) (node-depth-set (lambda (n x) (mutable-set (cdddr n) x))) (make-node (lambda (loc ns s v d) (cons (cons loc (make-mutable ns)) (cons (make-mutable s) (cons (make-mutable v) (make-mutable d)))))) (make-neighbors (lambda (u r d l) (cons u (cons r (cons d (cons l 0)))) )) (make-graph-row (lambda (x y n' r' r) (if (atom? r) 0 (let ((n (if (car r) (make-node (make-loc x y) (make-neighbors (if (atom? r') 0 (car r')) 0 0 n') (car r) 0 -1) 0) )) (do3 (if (atom? n') 0 (node-neighbors-set n' (make-neighbors (nth 0 (node-neighbors-get n')) n (nth 2 (node-neighbors-get n')) (nth 3 (node-neighbors-get n')) ) ) ) (if (or (atom? r') (atom? (car r'))) 0 (node-neighbors-set (car r') (make-neighbors (nth 0 (node-neighbors-get (car r'))) (nth 1 (node-neighbors-get (car r'))) n (nth 3 (node-neighbors-get (car r'))) ) ) ) (cons n (make-graph-row (+ x 1) y n (if (atom? r') 0 (cdr r')) (cdr r)) ) ) ) ) )) (make-graph (lambda (y m r') (if (atom? m) 0 (let ((r (make-graph-row 0 y 0 r' (car m)))) (cons r (make-graph (+ y 1) (cdr m) r) ) ) ) )) (graph-get (lambda (g loc) (nth (car loc) (nth (cdr loc) g)) )) (init-bfs-row (lambda (r) (if (atom? r) 0 (do2 (if (atom? (car r)) 0 (do2 (node-visited-set (car r) 0) (node-depth-set (car r) -1) ) ) (init-bfs-row (cdr r)) ) ) )) (init-bfs (lambda (g) (if (atom? g) 0 (do2 (init-bfs-row (car g)) (init-bfs (cdr g)) ) ) )) (count-good-nodes (lambda (c xs) (if (atom? xs) c (count-good-nodes (if (atom? (car xs)) c (+ 1 c)) (cdr xs)) ) )) (tag-neighbors-exclude' (lambda (dir neighbors exclude) (if (atom? neighbors) 0 (if (= dir exclude) (tag-neighbors-exclude' (+ 1 dir) (cdr neighbors) exclude) (cons (cons (car neighbors) dir) (tag-neighbors-exclude' (+ 1 dir) (cdr neighbors) exclude) ) ) ) )) (tag-neighbors-exclude (lambda (neighbors exclude) (tag-neighbors-exclude' 0 neighbors (if (< (count-good-nodes 0 neighbors) 2) -1 exclude) ) )) (tag-neighbors' (lambda (dir neighbors) (if (atom? neighbors) 0 (cons (cons (car neighbors) dir) (tag-neighbors' (+ 1 dir) (cdr neighbors)) ) ) )) (tag-neighbors (lambda (dir neighbors) (if (= dir -1) (tag-neighbors' 0 neighbors) (map (lambda (neighbor) (cons neighbor dir)) neighbors) ) )) (depth-ok? (lambda (mdepth gdepth) (or (< gdepth 0) (< mdepth gdepth)) )) (calc-score (lambda (dir state fruit mdepth gdepth) (if (< dir 0) -1000000 (let ( (gdist (if (< gdepth 0) (if (= gdepth -2) 0 300000) (if (= 3 state) (if (> 20 (- gdepth mdepth)) 20 (- gdepth mdepth) ) (- gdepth mdepth) ) ) ) (gobble (if (and (= gdepth -2) (< mdepth 8)) (- 7000010 mdepth) 0 ) ) ) (+ gobble (if (or (= 2 state) (= 3 state)) (+ (if (> gdist 1) 1000000 1) gdist) (if (and (= 4 state) (> fruit (* mdepth 127)) ) (+ (if (> gdist 1) 9000000 1) gdist) (+ (if (> gdist 1) mdepth (/ mdepth 2)) gdist) ) )) ) ) )) (bfs-ghosts (lambda (gnodes gnext fright depth ok?) (if (atom? gnodes) (if (atom? gnext) 0 (bfs-ghosts gnext 0 fright (+ 1 depth) ok?) ) (let ((gnode (car (car gnodes))) (dir (cdr (car gnodes)))) (if (and (not (atom? gnode)) (ok? gnode) (not (bitfield-get (node-visited-get gnode) (** 2 dir) 2)) ) (do3 (node-visited-set gnode (bitfield-set (node-visited-get gnode) (** 2 dir) 2 1)) (if (= (node-depth-get gnode) -1) (node-depth-set gnode (if (or (atom? fright) (not (car fright))) depth -2 ) ) 0) (bfs-ghosts (cdr gnodes) (append (tag-neighbors-exclude (node-neighbors-get gnode) (flipdir dir) ) gnext) (if (atom? fright) 0 (cdr fright)) depth ok?) ) (bfs-ghosts (cdr gnodes) gnext (if (atom? fright) 0 (cdr fright)) depth ok?) ) ) ) )) (bfs-man (lambda (mnodes mnext depth bestdir bestscore fruit ok? done?) (if (atom? mnodes) (if (atom? mnext) (do2 bestscore bestdir) (bfs-man mnext 0 (+ 1 depth) bestdir bestscore fruit ok? done?) ) (let ((mnode (car (car mnodes))) (dir (cdr (car mnodes)))) (if (and (not (atom? mnode)) (ok? mnode) (not (bitfield-get (node-visited-get mnode) 16 2)) (depth-ok? depth (node-depth-get mnode)) ) (do2 (node-visited-set mnode (bitfield-set (bitfield-get (node-visited-get mnode) 16 2) 16 2 1)) (if 0 dir (id (let ((score (calc-score dir (node-state-get mnode) fruit depth (node-depth-get mnode))) ) (bfs-man (cdr mnodes) (append (tag-neighbors dir (node-neighbors-get mnode)) mnext) depth (if (> score bestscore) dir bestdir) (if (> score bestscore) score bestscore) fruit ok? done?) )) ) ) (bfs-man (cdr mnodes) mnext depth bestdir bestscore fruit ok? done?) ) ) ) )) (bfs (lambda (g mnode gnodes fright fruit ok? done?) (do3 (init-bfs g) (bfs-ghosts gnodes 0 fright 0 ok?) (bfs-man (cons (cons mnode -1) 0) 0 0 -3 -1000000 fruit ok? done?) ) )) ) (letrec ( (graph 0) (step (lambda (state world) (letrec ( (manloc (man-location (world-man world))) (mannode (graph-get graph (man-location (world-man world)))) (ghostlocs (map ghost-loc (world-ghosts world))) (ghostnodes (map (lambda (g) (cons (graph-get graph (ghost-loc g)) (ghost-dir g))) (world-ghosts world))) (fright (map (lambda (g) (= 1 (ghost-vitality g))) (world-ghosts world))) (search-ok? node-state-get) ) (do2 (if (or (= 2 (node-state-get mannode)) (= 3 (node-state-get mannode))) (node-state-set mannode 1) 0 ) (let ((bfsdir (bfs graph mannode ghostnodes fright (world-fruit world) search-ok? (lambda (node) (let ((st (node-state-get node))) (or (= 2 st) (= 3 st)) )) ) )) (cons 0 (if (and (>= bfsdir 0) (<= bfsdir 3)) bfsdir (rand 4)) ) ) ) ) )) ) (do2 (set! graph (make-graph 0 (world-map world) 0)) (cons 0 step) ) ))))