https://gist.github.com/mattsan/07674b095908fda117a0

hoshimeguri.ml

(*
瞬き星 〜 第2回 ESM オフラインどう書くの問題を OCaml で解いてみたやつ
記事: http://emattsan.hatenablog.com/entry/20151230/1451449205
問題: https://gist.github.com/mattsan/07674b095908fda117a0
*)

open Core

type color_t = W | R

let flip = function W -> R | R -> W

let to_char = function W -> 'W' | R -> 'R'

let initial_map = Char.Map.of_alist_exn [('A', W); ('B', W); ('C', W); ('D', W); ('E', W); ('F', R); ('G', R); ('H', R); ('I', R); ('J', R)]

let routes = ["AFGD"; "AJIC"; "BIHD"; "BJFE"; "CHGE"]

let to_list m  = String.to_list "ABCDEFGHIJ" |> List.map ~f:(Char.Map.find_exn m)

let flip_at k m = Char.Map.update m k (function (Some x) -> flip x | None -> W)

let next_keys c route =
  match String.index route c with
  | Some 0 -> String.drop_prefix route 1 |> String.to_list
  | Some 1 -> String.drop_prefix route 2 |> String.to_list
  | Some 2 -> String.rev route |> (Fn.flip String.drop_prefix) 2 |> String.to_list
  | Some 3 -> String.rev route |> (Fn.flip String.drop_prefix) 1 |> String.to_list
  | _ -> []

let process m c =
  let iter m keys =
    match List.take_while ~f:(fun k -> not (phys_equal (Char.Map.find_exn m k) (Char.Map.find_exn m c))) keys with
    | [] -> m
    | xs when List.length xs = List.length keys -> m
    | xs -> List.fold_left ~init:m ~f:(Fn.flip flip_at) xs
  in
  List.filter ~f:((Fn.flip String.contains) c) routes
  |> List.map ~f:(next_keys c)
  |> List.fold_left ~init:(flip_at c m) ~f:iter

let solve input =
  String.to_list input
  |> List.fold_left ~init:initial_map ~f:process
  |> to_list
  |> List.map ~f:to_char
  |> String.of_char_list

let test input output =
  assert ((solve input) = output)

let () =
  test "A" "RWWWWRRRRR";;
  test "F" "WWWWWWWRRW";;
  test "J" "WWWWWWRRWW";;
  test "AA" "WWWWWWWRWW";;
  test "IC" "WWRWWRRRWW";;
  test "FC" "WWRWWWWRRW";;
  test "AE" "RWWWRRRRRR";;
  test "GJ" "WWWWWWWWWW";;
  test "CCB" "WRWWWRWWWR";;
  test "BEF" "WRWWRWWRRR";;
  test "JGD" "WWWRWWWWWW";;
  test "IHCC" "WWWWWRWWWW";;
  test "AIDD" "RWWWWRRWWR";;
  test "IJFA" "RWWWWWWWWW";;
  test "ABCDE" "RRRRRRRRRR";;
  test "ICEBA" "RRRWRRRRRR";;
  test "DAHHD" "RWWWWRWWWR";;
  test "GJIJC" "WWRWWWWWRR";;
  test "FGHIJ" "WWWWWWWWRR";;
  test "HJICGA" "RWRWWRRRRR";;
  test "IBCIGC" "WRWWWWWWWW";;
  test "BIJJJB" "WWWWWWRWWW";;
  test "DCBCHGD" "WRWWWWWRRW";;
  test "JEABDHD" "RRWWRRRWRR";;
  test "JHFADHE" "RWWRRRRRWW";;
  test "HDGGDBIB" "WWWWWWWWWW";;
  test "IIDIHCCG" "WWWRWRRWWW";;
  test "BBFBICIE" "WRRWRRRWWW";;
  test "HJHCFBJGG" "WRRWWWWRRW";;
  test "AJJIEAAII" "RWWWRWWWWR";;
  test "AIDHJFGAE" "WWWRRWWWWW";;
  test "FGBGHCBHJJ" "WWRWWWWRRW";;
  test "EFIGIGGHHJ" "WWWWRRRWWR";;
  test "HGAFDIFFFF" "RWWRWRRRRW";;
  test "AABBCCDDEE" "WWWWWWWWWW";;
  test "ABCDEFGHIJ" "RRRRRWWWWW";;
  test "FGHIJABCDE" "RRRRRRRRRR";;