Skip to content

Instantly share code, notes, and snippets.

@nojima
Created July 28, 2014 11:58
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save nojima/0353e33d19d466597eb0 to your computer and use it in GitHub Desktop.
ICFPC 2014 の Lambda man の AI
(define rnd 123456)
(define (flatten xs)
(if (null? xs)
()
(append (car xs) (flatten (cdr xs)))))
(define (field-ref field w y x)
(vector-ref field (+ (* y w) x)))
(define (field-set field w y x value)
(vector-set field (+ (* y w) x) value))
(define (wall? field w y x)
(= (field-ref field w y x) map-wall))
(define (filter-neighbors y x path pred)
(filter pred
(list (cons (cons (- y 1) x) (cons direction-up path))
(cons (cons y (- x 1)) (cons direction-left path))
(cons (cons (+ y 1) x) (cons direction-down path))
(cons (cons y (+ x 1)) (cons direction-right path)))))
(define (bfs-step field h w queue rest-steps goal? rest-results results) ; => [[Direction]]
(define (push-next-states new-queue y x path)
(fold queue-push new-queue
(filter-neighbors y x path
(lambda (state) (not (wall? field w (caar state) (cdar state)))))))
(if (or (<= rest-steps 0) (<= rest-results 0) (queue-empty? queue))
(reverse (map reverse results))
(let* ([state-and-queue (queue-pop queue)]
[state (car state-and-queue)]
[y (caar state)]
[x (cdar state)]
[path (cdr state)]
[new-queue (cdr state-and-queue)])
(if (wall? field w y x) ; visited?
(bfs-step field h w new-queue rest-steps goal? rest-results results) ; continue
(let ([new-field (field-set field w y x map-wall)]) ; update visited
(if (goal? field y x)
(bfs-step new-field h w new-queue (- rest-steps 1) goal? (- rest-results 1) (cons path results))
(bfs-step new-field h w (push-next-states new-queue y x path) (- rest-steps 1) goal? rest-results results)))))))
(define (pill-score dir pill-paths)
(let ([first-path (find (lambda (path) (= (car path) dir)) pill-paths)])
(if (null? first-path)
0
(+ 1 (div 1000 (+ 1 (length first-path)))))))
(define (ghost-score dir ghost-paths lambda-man)
(let ([first-path (find (lambda (path) (= (car path) dir)) ghost-paths)])
(if (null? first-path)
0
(let ([base-score (* (+ 1 (div 1000000 (+ 1 (length first-path)))))]
[vitality (get-lambda-man-vitality lambda-man)])
(if (> vitality 300)
(div base-score 100)
(* base-score -1))))))
(define wall-penalty -300000)
(define (wall-score dir field w y x)
(if (= dir direction-up)
(if (wall? field w (- y 1) x) wall-penalty 0)
(if (= dir direction-right)
(if (wall? field w y (+ x 1)) wall-penalty 0)
(if (= dir direction-down)
(if (wall? field w (+ y 1) x) wall-penalty 0)
(if (wall? field w y (- x 1)) wall-penalty 0)))))
(define (fruit-score dir fruit-paths)
(if (any (lambda (path) (and (not (null? path)) (= (car path) dir))) fruit-paths) 3000 0))
(define (power-pill-score dir power-pill-paths)
(let ([first-path (find (lambda (path) (= (car path) dir)) power-pill-paths)])
(if (null? first-path)
0
(* (+ 1 (div 900000 (+ 1 (length first-path))))))))
(define (direction-scores dir pill-paths ghost-paths fruit-paths power-pill-paths lambda-man field w y x)
(+ (pill-score dir pill-paths)
(ghost-score dir ghost-paths lambda-man)
(fruit-score dir fruit-paths)
(power-pill-score dir power-pill-paths)
(wall-score dir field w y x)))
(define (calculate-scores pill-paths ghost-paths fruit-paths power-pill-paths lambda-man field w y x)
(map (lambda (dir) (direction-scores dir pill-paths ghost-paths fruit-paths power-pill-paths lambda-man field w y x)) direction-list))
(define (find-indices value xs)
(define (iter xs index result)
(if (null? xs)
result
(iter (cdr xs) (+ index 1)
(if (= (car xs) value) (cons index result) result))))
(iter xs 0 ()))
(define (calculate-next-direction field h w y x lambda-man ghosts fruit-status)
(set! rnd (remainder (* 48271 rnd) 2147483647))
(let* ([initial-state (cons (cons y x) ())]
[ghost-find-steps (if (> (get-lambda-man-vitality lambda-man) 300) 64 32)]
[pill-find-steps (if (> fruit-status 0) 100 600)]
[fruit-find-steps (if (> fruit-status 0) 500 0)]
[power-pill-find-steps 8]
[queue (queue-push (make-queue) initial-state)]
[goal? (lambda (field y x)
(let ([cell (field-ref field w y x)])
(or (= cell map-pill) (= cell map-power-pill))))]
[power-pill? (lambda (field y x) (= (field-ref field w y x) map-power-pill))]
[pill-paths (bfs-step field h w queue pill-find-steps goal? 10 ())]
[power-pill-paths (bfs-step field h w queue power-pill-find-steps power-pill? 1 ())]
[visible-ghosts (filter (lambda (g) (not (= (get-ghost-vitality g) ghost-vitality-invisible))) ghosts)]
[ghost-locations (map get-ghost-location visible-ghosts)]
[ghost? (lambda (field y x) (any (lambda (g) (and (= y (cdr g)) (= x (car g)))) ghost-locations))]
[ghost-paths (bfs-step field h w queue ghost-find-steps ghost? 10 ())]
[fruit? (lambda (field y x) (and (= y fruit-y) (= x fruit-x)))]
[fruit-paths (bfs-step field h w queue fruit-find-steps fruit? 1 ())]
[scores (calculate-scores pill-paths ghost-paths fruit-paths power-pill-paths lambda-man field w y x)]
[max-score (fold max -10000000 scores)]
[best-directions (find-indices max-score scores)])
(if (null? best-directions)
(remainder (div rnd 65536) 4) ; random direction
(car best-directions))))
(define (step ai-state world-state) ; => (ai-state . direction)
(let* ([current-map (get-current-map world-state)]
[h (length current-map)]
[w (length (car current-map))]
[lambda-man (get-lambda-man-status world-state)]
[location (get-lambda-man-location lambda-man)]
[y (position-y location)]
[x (position-x location)]
[field (vector-set (car ai-state) (+ (* y w) x) map-empty)]
[ghosts (get-all-ghosts-status world-state)]
[fruit-status (get-fruit-status world-state)]
[next-direction (calculate-next-direction field h w y x lambda-man ghosts fruit-status)])
(cons (list field) next-direction)))
(define initial-map (get-current-map $1))
(define initial-field (list->vector (flatten initial-map)))
(define initial-ai-state (list initial-field))
(define (find-fruit-position current-map)
(define (iter-row row x)
(if (null? row)
-1
(if (= (car row) map-fruit)
x
(iter-row (cdr row) (+ x 1)))))
(define (iter rows y)
(if (null? rows)
(cons 0 0) ;; fruit not found ;-p
(let ((x (iter-row (car rows) 0)))
(if (>= x 0)
(cons y x)
(iter (cdr rows) (+ y 1))))))
(iter current-map 0))
(define fruit-position (find-fruit-position initial-map))
(define fruit-y (car fruit-position))
(define fruit-x (cdr fruit-position))
(cons initial-ai-state step)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment