ICFP Programming Contest 2014

game

ICFPコンテストに参加していた。今年はLightning Divisionのみで、一人チームでの参加。

Lightning Divisionの課題は、あるゲーム*1をプレイするAIを書くというもので、最初はよくある問題のように思ったのだが、結果的にはかなり楽しめた。というのも、提出するAIは決められた言語で書かなければならないのだが、その言語が機械語のようなものであって、複雑なコードを書こうと思うとまずコンパイラを書くことになる。このコンパイラのソース言語はもちろん自由なのだが、機械語の設計からして露骨にLISP系言語が優遇されている。したがって、数時間ででっちあげた自家製の糞LISP方言*2を使って、ひーひー言いながらAIを書くことになる。これがなかなか面白かった。

時系列

+0時間
問題文を読む。
+1時間
問題文を読み終わって方針を考える。一人チームなのでシミュレータは自作せずに公式のものを使い、コンパイラだけ書くことにする。制御構造としてgotoとwhileを持った手続き型言語を書くことも検討したが、まともな手続き型言語の処理系を書いた経験がないので見送り、誘導された通りにLISP風言語を作ることにする。
+3.5時間
とりあえず動くコンパイラができる。コード生成の面倒な部分(レジスタ割り付け、クロージャ変換、タグビットなどなど)は全てCPUがやってくれる仕様なのであっさりできた。パーサは既存プロジェクトの物を流用。これのおかげでインデント構文を持つLISPにり、モチベーションの向上に寄与した。就寝。
+9.5時間
二度寝。
+13時間ごろ
AI作成にとりかかる。方針としては、αβ法みたいに数ステップ先読みして、敵やアイテムからの距離をもとに局面評価すれば、のようなことを漠然と考えていた。いずれにしても最短経路探索は必要だろうと考えそれを当面の目標にする。機械語の仕様上配列が使えないが、リストを毎回書き換えるのはさすがに遅いと思われたのでconsセルを使って完全二分木を作ることにした。
+14時間ごろ
公式のJavaScriptシミュレータ上で完全二分木のコードが動いているらしいことを確認。小さい関数を一つ書くたびにシミュレータにコピペしてテストしていたので時間が掛かる。

ここからはひたすら実装で、時間の記憶があやふやになっている。skew heap*3、キュー、幅優先探索を実装し、その過程で必要になったlength,mapといった標準関数を実装した。コンパイラにも随時手を加え、トレース命令やlist,andといった特殊形式を実装した。

+20時間ごろ
AIの最初のバージョンができる。公式シミュレータで動かしてみたところいつまでたっても初期化が終わらない。初期化時に全点対間の最短経路を計算しているのが重いらしい。計算量を概算したところ制限には間に合っているようにしか思えなかったので、単にJavaScript製であろうシミュレータが遅すぎるのだと信じることにする。以降テストは3x4などの小さいマップで行なった。
+21時間ごろ
AIがクラッシュするのをデバッグするには、ゲームのシミュレータよりもCPUシミュレータを使った法がエラーメッセージが詳しいので、AIをCPUシミュレータで動く形式にコンパイルできるように手を加える。
+23時間ごろ
この時点でのAIの挙動は、最も近い敵からの距離を稼ぎつつ最も近い錠剤を目指すもの。ここから一時間で実装できる改善として、果物の出現位置を目指す項を評価関数に入れるか、敵から逃げるにあたって敵が方向転換できない事実を利用できるようにするかを考えた。迷った挙句後者を選択。
+23.9時間ごろ
結局間に合わなかったので古い版を提出。敵の方向を理解するものができたのは締め切りを90秒ほど過ぎてからだった。

まとめ

コンパイラが動くまでは良いペースだったが、その後のAI実装が遅すぎた。提出したAIは一手読みしかしておらず、未来予測らしいことが何もできていないので、非常に弱いと思う。

提出したもの

提出物。

ソースは以下。コロンはインデントブロックを開始する。ドットは開き括弧と同じだが、対応する閉じ括弧は暗黙で、可能な限り右側で閉じられる。

. \ world0 undocumented -> . let:

  not = . \ x -> . - 1 x
  cadr = . \ x -> . car . cdr x
  cddr = . \ x -> . cdr . cdr x
  caar = . \ x -> . car . car x
  cdar = . \ x -> . cdr . car x
  caddr = . \ x -> . car . cdr . cdr x
  cdddr = . \ x -> . cdr . cdr . cdr x
  caaar = . \ x -> . car . car . car x
  cdaar = . \ x -> . cdr . car . car x
  cadar = . \ x -> . car . cdr . car x
  cddar = . \ x -> . cdr . cdr . car x
  cadddr = . \ x -> . car . cdr . cdr . cdr x
  caaaar = . \ x -> . car . car . car . car x
  cdaaar = . \ x -> . cdr . car . car . car x
  mod = . \ a b -> . - a . * b . / a b
  const = . \ x -> . \ y -> x

  ; create a list that contains @n@ copies of @a@.
  replicate = . \ n a -> .
    if n:
      cons a . replicate (- n 1) a
      0

  ; returns the input list reversed
  reverse = . \ list -> . reverse-go list 0
  reverse-go = . \ list acc -> .
    if (atom list):
      acc
      reverse-go (cdr list) (cons (car list) acc)
  
  ; transform each eleemnt in the list
  map = . \ f list -> . if (atom list):
    list
    cons (f (car list)) (map f . cdr list)

  ; return a list that contains integers m .. n
  enum-from-to = . \ m n -> . if (> m n):
    0
    cons m . enum-from-to (+ m 1) n

  ; length of the list
  length = . \ list -> . if (atom list):
    0
    + 1 . length . cdr list

  maximum-on = . \ default f list -> . if (atom list):
    default
    maximum-on-go f (car list) (f . car list) (cdr list)
  maximum-on-go = . \ f best bestval list -> . if (atom list):
    best
    let:
      val = . f . car list
      if (> val bestval):
        maximum-on-go f (car list) val (cdr list)
        maximum-on-go f best bestval (cdr list)

  minimum-on = . \ default f list -> . if (atom list):
    default
    minimum-on-go f (car list) (f . car list) (cdr list)
  minimum-on-go = . \ f best bestval list -> . if (atom list):
    best
    let:
      val = . f . car list
      if (> bestval val):
        minimum-on-go f (car list) val (cdr list)
        minimum-on-go f best bestval (cdr list)

  ; does the list have more than 1 element?
  list-long-p = . \ list -> .
    if (atom list):
      0
      not . atom . cdr list
  
  pair-list = . \ list -> .
    if (list-long-p list):
      cons (cons (car list) (cadr list)) (pair-list . cddr list)
      if (atom list):
        list
        cons list 0

  ; turn a non-empty list into a perfect binary tree with size
  list-to-bt = . \ list -> .
    list-to-bt-go list 1
  list-to-bt-go = . \ list s -> .
    if (list-long-p list):
      list-to-bt-go (pair-list list) (* s 2)
      cons (car list) s


  ; turn a list of lists into a tree of trees
  list-to-bt2 = . \ list -> . list-to-bt . map list-to-bt list
  list-to-bt3 = . \ list -> . list-to-bt . map list-to-bt2 list

  ; get an item from a binary tree
  index-bt = . \ k bt -> . index-bt-go (car bt) (cdr bt) k
  index-bt-go = . \ tree s k -> .
    if (> s 1):
      do:
        s1 = . / s 2
        if (>= k s1):
          index-bt-go (cdr tree) s1 (- k s1)
          index-bt-go (car tree) s1 k
      tree
  
  ; get an item from a nested binary tree
  index-bt2 = . \ x y bt -> . index-bt x . index-bt y bt

  index-bt3 = . \ x y z bt -> . index-bt z . index-bt2 x y bt

  ; turn a function into a binary tree
  tabulate-bt = . \ sz f -> .
    list-to-bt . map f . enum-from-to 0 (- sz 1)

  ; turn a function into a nested binary tree
  tabulate-bt2 = . \ width height f -> .
    tabulate-bt height . \ y -> .
      tabulate-bt width . \ x -> . f x y

  ; apply @f@ to the positino @k@ of the binary tree @bt@.
  modify-bt = . \ k f bt -> .
    cons (modify-bt-go (car bt) (cdr bt) k f) (cdr bt)
  modify-bt-go = . \ tree s k f -> .
    if (> s 1):
      do:
        s1 = . / s 2
        if (>= k s1):
          cons (car tree) (modify-bt-go (cdr tree) s1 (- k s1) f)
          cons (modify-bt-go (car tree) s1 k f) (cdr tree)
      f tree

  ; modify a nested binary tree
  modify-bt2 = . \ x y f bt -> .
    modify-bt y (\ row -> . modify-bt x f row) bt

  modify-bt3 = . \ x y z f bt -> .
    modify-bt2 x y (\ vs -> . modify-bt z f vs) bt

  ;; skew heap
  ;
  ; heap = 0 | (int, (a, (heap, heap)))

  ; singleton heap
  singleton-heap = . \ prio val -> .
    cons prio . cons val . cons 0 0

  merge-heap = . \ x y -> .
    if (atom x):
      y
      if (atom y):
        x
        if (> (car x) (car y)):
          cons (car y) . cons (cadr y) . cons (merge-heap x (cdddr y)) (caddr y)
          cons (car x) . cons (cadr x) . cons (merge-heap y (cdddr x)) (caddr x)

  insert-heap = . \ p x h -> . merge-heap h . singleton-heap p x

  heap-take-min = . \ h -> .
    cons:
      cons (car h) (cadr h)
      merge-heap (caddr h) (cdddr h)

  ;; queue
  ;
  ; queue = (list, list)

  empty-queue = . cons 0 0

  singleton-queue = . \ x -> . cons (cons x 0) 0

  enqueue = . \ x q -> . cons (car q) (cons x . cdr q)

  dequeue = . \ q -> .
    if (atom (car q)):
      do:
        rev = . reverse (cdr q)
        cons (car rev) (cons (cdr rev) 0)
      cons (caar q) . cons (cdar q) (cdr q)
  
  null-queue = . \ q -> .
    if (atom (car q)):
      atom (cdr q)
      0

  valid-location-p = . \ width height m x y -> . and:
    >= x 0
    > width x
    >= y 0
    > height y
    index-bt2 x y m

  opposite = . \ d -> .
    mod (+ 2 d) 4

  min-ghost-distance-from = . \ width height m start -> . 
    if (== 0 . index-bt2 (car start) (cdr start) m):
      list-to-bt3 . replicate height . replicate width . replicate 4 inf
      min-ghost-distance-from-go width height m:
        modify-bt3 (car start) (cdr start) 0 (const 0) .
          modify-bt3 (car start) (cdr start) 1 (const 0) .
          modify-bt3 (car start) (cdr start) 2 (const 0) .
          modify-bt3 (car start) (cdr start) 3 (const 0) .
          list-to-bt3 . replicate height . replicate width . replicate 4 inf
        enqueue (cons (cons start 1) 0) .
          enqueue (cons (cons start 2) 0) .
          enqueue (cons (cons start 3) 0) .
          singleton-queue (cons (cons start 0) 0)
  min-ghost-distance-from-go = . \ width height m dist q -> . if (null-queue q):
    dist
    do:
      qr = . dequeue q
      x = 0
      y = 0
      z = 0
      next-d = 0
      add = 0
      add-not-opposite = 0
      d1_q1 = 0
      has-way = 0
      
      <- x . caaaar qr
      <- y . cdaaar qr
      <- z . cdaar qr
      <- next-d . + 1 . cdar qr
      <- add . \ z1 dq -> . do:
        x1 = . move-x z1 x
        y1 = . move-y z1 y
        if (valid-location-p width height m x1 y1):
          do:
            <- has-way 1
            if (== inf . index-bt3 x1 y1 z1 dist):
              cons:
                modify-bt3 x1 y1 z1 (const next-d) . car dq
                enqueue (cons (cons (cons x1 y1) z1) next-d) . cdr dq
              dq
          dq
      <- add-not-opposite . \ z1 dq -> . if (== z1 . opposite z):
        dq
        add z1 dq
      <- d1_q1 .
        add-not-opposite 0 .
        add-not-opposite 1 .
        add-not-opposite 2 .
        add-not-opposite 3 .
        cons dist (cdr qr)
      <- d1_q1 . if has-way:
        d1_q1
        add (opposite z) d1_q1
      min-ghost-distance-from-go width height m (car d1_q1) (cdr d1_q1)

  ; calculate distances from a single starting point, @start@.
  min-distance-from = . \ width height m start -> . 
    if (== 0 . index-bt2 (car start) (cdr start) m):
      list-to-bt2 . replicate height . replicate width inf
      min-distance-from-go width height m
        (modify-bt2 (car start) (cdr start) (const 0) .
            list-to-bt2 . replicate height . replicate width inf)
        (singleton-queue (cons start 0))
  min-distance-from-go = . \ width height m dist q -> . if (null-queue q):
    dist
    do:
      qr = . dequeue q
      x = 0
      y = 0
      next-d = 0
      add = 0
      d1_q1 = 0
      
      <- x . caaar qr
      <- y . cdaar qr
      <- next-d . + 1 . cdar qr
      <- add . \ x1 y1 dq -> .
        if (and:
              valid-location-p width height m x1 y1
              == inf . index-bt2 x1 y1 dist):
          cons:
            modify-bt2 x1 y1 (const next-d) . car dq
            enqueue (cons (cons x1 y1) next-d) . cdr dq
          dq
      <- d1_q1 .
        add (- x 1) y .
        add (+ x 1) y .
        add x (- y 1) .
        add x (+ y 1) .
        cons dist (cdr qr)
      min-distance-from-go width height m (car d1_q1) (cdr d1_q1)

  ; minimum distance to the nearest pill
  min-distance-to-pill = . \ width height m start -> . 
    min-distance-to-pill-go width height m
      (modify-bt2 (car start) (cdr start) (const 0) .
          list-to-bt2 . replicate height . replicate width inf)
      (singleton-queue (cons start 0))
  min-distance-to-pill-go = . \ width height m dist q -> . if (null-queue q):
    (- 0 1000) ; no pill is reachable, we have won the game
    do:
      qr = . dequeue q
      x = 0
      y = 0
      next-d = 0
      add = 0
      d1_q1 = 0
      
      <- x . caaar qr
      <- y . cdaar qr
      <- next-d . + 1 . cdar qr
      <- add . \ x1 y1 dq -> .
        if (and:
              valid-location-p width height m x1 y1
              == inf . index-bt2 x1 y1 dist):
          cons:
            modify-bt2 x1 y1 (const next-d) . car dq
            enqueue (cons (cons x1 y1) next-d) . cdr dq
          dq
      <- d1_q1 .
        add (- x 1) y .
        add (+ x 1) y .
        add x (- y 1) .
        add x (+ y 1) .
        cons dist (cdr qr)
      if (== 2 . index-bt2 x y m):
        cdar qr
        min-distance-to-pill-go width height m (car d1_q1) (cdr d1_q1)

  ; minimum distance between each pair of points
  min-distances-among = . \ width height m -> .
    tabulate-bt2 width height . \ x y -> .
      min-distance-from width height m (cons x y)

  ; infinite distance
  inf = 100000

  make-sim-state = . \ width height m loc score -> .
    cons:
      cons:
        cons width height
        cons m loc
      score
  state-width = . \ state -> . caaar state
  state-height = . \ state -> . cdaar state
  state-map = . \ state -> . cadar state
  state-location = . \ state -> . cddar state
  state-score = . \ state -> . cdr state

  move-x = . \ dir x -> .
    if (== dir 1):
      (+ x 1)
      if (== dir 3):
        (- x 1)
        x

  move-y = . \ dir y -> .
    if (== dir 0):
      (- y 1)
      if (== dir 2):
        (+ y 1)
        y

  movable = . \ dir state -> .
    valid-location-p:
      state-width state
      state-height state
      state-map state
      move-x dir . car . state-location state
      move-y dir . cdr . state-location state

  simulate-move = . \ dir state -> . do:
    new-x = . move-x dir . car . state-location state
    new-y = . move-y dir . cdr . state-location state
    make-sim-state:
      state-width state
      state-height state
      modify-bt2 new-x new-y (const 1) . state-map state
      cons new-x new-y
      +:
        state-score state
        if (== 2 . index-bt2 new-x new-y . state-map state):
          10
          0

  test-map = 0
  current-map = 0
  map-width = 0
  map-height = 0
  
  map-distances = 0
  directions = . list 0 1 2 3

  distance-to = . \ from to -> .
    index-bt2 (car to) (cdr to) .
      index-bt2 (car from) (cdr from) map-distances

  think = . \ state world -> . let:
    man-state = . cadr world
    ghost-states = . caddr world
    enemy-distance-score = . \ state -> .
      minimum-on 0 (\ x -> x) .
        map (\ ghost -> . distance-to (state-location state) . cadr ghost)
        ghost-states
    score-state = . \ state -> . +:
      state-score state
      -:
        * 2 . enemy-distance-score state
        min-distance-to-pill:
          state-width state
          state-height state
          state-map state
          state-location state

    ;score-move = . \ dir -> . if (movable dir sim-state):
    ;  score-state . simulate-move dir sim-state
    ;  0
    score-move = . \ dir -> . do:
      score = . if (movable dir sim-state):
        score-state . simulate-move dir sim-state
        0
      trace (list 1 dir score) score
    man-location = 0
    sim-state = 0
    next-direction = 0

    do:
      trace (cons 5 ghost-states) .
        <- man-location . cadr man-state
      <- sim-state . make-sim-state map-width map-height current-map man-location 0
      <- next-direction . maximum-on 100 score-move directions
      <- current-map . state-map . simulate-move next-direction sim-state
      trace (cons 0 next-direction) .
        cons state next-direction

  do:
    <- current-map . list-to-bt2 . car world0
    <- map-width . length . car . car world0
    <- map-height . length . car world0
    <- map-distances .
      min-distances-among map-width map-height current-map

    <- test-map . list-to-bt2 . list:
      list 1 0 1
      list 1 1 1
    ; step = . \ state world -> . cons 0 1
    ; cons 0 step
    ;index-bt (list-to-bt . cons 100 . cons 1001 . cons 1002 0) 1
    ; heap-take-min . cdr . heap-take-min . insert-heap 1 100 . insert-heap 3 300 . insert-heap 2 200 . singleton-heap 9 900
    ; update-bt 3 8 (list-to-bt . replicate 10 4)
    ; dequeue . cdr . dequeue . enqueue 1 . enqueue 2 . enqueue 3 . singleton-queue 4
    ; modify-bt2 0 1 (\ x -> . + x 1) .
    ; modify-bt2 0 1 (\ x -> . + x 1) . cons (cons (cons (cons 0 1) 2) (cons (cons 2 3) 2)) 2
    ; min-distances-among 3 2 test-map
    ;trace (min-ghost-distance-from 3 2 test-map (cons 0 0)) 0

    cons 12345 think
    ;think 12345 world0

*1:パックマンらしい。未プレイ

*2:数時間で作るので必然的に糞言語になる

*3:ダイクストラ法を書くつもりだったが結局使わなかった