https://gist.github.com/mattsan/2ec7888056c6d02c3cc398d1279e5708

calcula-machine.ml

(*
カリキュラマシーン 〜 第3回 ESM オフラインどう書くの問題を OCaml で解いてみたやつ
記事: http://emattsan.hatenablog.com/entry/20170528/1495976693
問題: https://gist.github.com/mattsan/2ec7888056c6d02c3cc398d1279e5708
*)

open Core

type exp_t =
  | Num of Big_int.big_int
  | Add of exp_t * exp_t
  | Sub of exp_t * exp_t
  | Mul of exp_t * exp_t
  | Div of exp_t * exp_t
  | Pow of exp_t * exp_t
  | Mod of exp_t * exp_t

let to_tuple xs = (Int.of_string (List.nth_exn xs 0)), List.nth_exn xs 1

let to_bin_str n =
  let rec iter digits n =
    match n with
    | 0 | 1 -> Printf.sprintf "%04d" (Int.of_string ((Int.to_string n) ^ digits))
    | _     -> iter ((Int.to_string (n % 2)) ^ digits) (n / 2)
  in iter "" (Int.of_string ("0x" ^ n))

let to_char = function
    "00"      -> '0'
  | "01"      -> '1'
  | "100"     -> '2'
  | "1010"    -> '3'
  | "1011"    -> '4'
  | "1100"    -> '5'
  | "11010"   -> '6'
  | "11011"   -> '7'
  | "111000"  -> '8'
  | "111001"  -> '9'
  | "1110100" -> '+'
  | "1110101" -> '-'
  | "1110110" -> '*'
  | "1110111" -> '/'
  | _         -> '?'

let to_bin = function
    '0' -> "00"
  | '1' -> "01"
  | '2' -> "100"
  | '3' -> "1010"
  | '4' -> "1011"
  | '5' -> "1100"
  | '6' -> "11010"
  | '7' -> "11011"
  | '8' -> "111000"
  | '9' -> "111001"
  | '+' -> "1110100"
  | '-' -> "1110101"
  | '*' -> "1110110"
  | '/' -> "1110111"
  | _    -> "?"

let rec zero_pad bin_str =
  if (String.length bin_str = 4) then
    bin_str
  else
    zero_pad (bin_str ^ "0")

let prepare input =
  let (bit_length, hex) = String.split ~on:':' input |> to_tuple in
  String.to_list hex
  |> List.map ~f:Char.to_string
  |> List.map ~f:to_bin_str
  |> String.concat
  |> String.to_list
  |> (Fn.flip List.take) bit_length
  |> String.of_char_list

let decode bin_str =
  let bins = String.to_list bin_str in
  let rec loop acc part_of_bins n =
    if (List.is_empty part_of_bins || List.length bins = n) then
      acc
    else
      match List.take part_of_bins n |> String.of_char_list |> to_char with
      | '?' -> loop acc part_of_bins (n + 1)
      | c   -> loop (acc ^ String.of_char c) (List.drop part_of_bins n) 2
  in
  loop "" bins 2

let tokenize str =
  let rec loop tokens rest_chars = match rest_chars with
    | [] -> tokens
    | '0' :: _ | '1' :: _ | '2' :: _ | '3' :: _ | '4' :: _
    | '5' :: _ | '6' :: _ | '7' :: _ | '8' :: _ | '9' :: _ ->
       loop
         (tokens @ [List.take_while ~f:Char.is_digit rest_chars |> String.of_char_list])
         (List.drop_while ~f:Char.is_digit rest_chars)
    | ('*' as c) :: _ | ('/' as c) :: _ ->
       loop
         (tokens @ [List.take_while ~f:((=) c) rest_chars |> String.of_char_list])
         (List.drop_while ~f:((=) c) rest_chars)
    | x :: xs -> loop (tokens @ [String.of_char x]) xs
  in
  loop [] (String.to_list str)

let rec parse tokens =
  match (List.rev_filter_mapi ~f:(fun i t -> if (t = "+" || t = "-") then Some i else None) tokens) with
  | i :: _ ->
     (
     match (List.nth_exn tokens i) with
     | "+" -> Add (parse (List.take tokens i), parse (List.drop tokens (i + 1)))
     | _   -> Sub (parse (List.take tokens i), parse (List.drop tokens (i + 1)))
     )
  | [] ->
     match (List.rev_filter_mapi ~f:(fun i t -> if (t = "*" || t = "/" || t = "//") then Some i else None) tokens) with
     | i :: _ ->
        (
        match (List.nth_exn tokens i) with
        | "*" -> Mul (parse (List.take tokens i), parse (List.drop tokens (i + 1)))
        | "/" -> Div (parse (List.take tokens i), parse (List.drop tokens (i + 1)))
        | _   -> Mod (parse (List.take tokens i), parse (List.drop tokens (i + 1)))
        )
     | [] ->
        match (List.filter_mapi ~f:(fun i t -> if (t = "**") then Some i else None) tokens) with
        | i :: _ -> Pow (parse (List.take tokens i), parse (List.drop tokens (i + 1)))
        | []     -> Num (List.hd_exn tokens |> Big_int.big_int_of_string)

let rec eval = function
  | Num f ->
     f
  | Add (e1, e2) ->
     Big_int.add_big_int (eval e1) (eval e2)
  | Sub (e1, e2) ->
     Big_int.sub_big_int (eval e1) (eval e2)
  | Mul (e1, e2) ->
     Big_int.mult_big_int (eval e1) (eval e2)
  | Div (e1, e2) ->
     Big_int.div_big_int (eval e1) (eval e2)
  | Pow (e1, e2) ->
     Big_int.power_big_int_positive_big_int (eval e1) (eval e2)
  | Mod (e1, e2) ->
     Big_int.mod_big_int (eval e1) (eval e2)

let encode n =
   Big_int.string_of_big_int n
   |> String.to_list
   |> List.map ~f:to_bin
   |> String.concat

let disorganize bin_str =
  let rec loop result = function
    | [] ->
       List.map ~f:(fun s -> "0b" ^ s) result
       |> List.map ~f:Int.of_string
       |> List.map ~f:(Printf.sprintf "%X")
       |> String.concat
       |> Printf.sprintf "%d:%s" (String.length bin_str)
    | rest ->
       loop
         (List.append result [(zero_pad (String.of_char_list (List.take rest 4)))])
         (List.drop rest 4)
  in
  loop [] (String.to_list bin_str)

let solve input =
  input
  |> prepare
  |> decode
  |> tokenize
  |> parse
  |> eval
  |> encode
  |> disorganize

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

let () =
  test "27:675AED8" "11:EB4";;
  test "21:BCE8E0" "7:D0";;
  test "21:D1D760" "11:EA8";;
  test "22:E676A0" "15:9BD0";;
  test "22:E4EFB0" "2:4";;
  test "29:AE3B76D8" "44:5BB733899CC";;
  test "26:B7BF76C" "6:68";;
  test "34:D3D2E7490" "9:660";;
  test "41:E4EAF1D79D0" "14:EB2C";;
  test "45:BAED9AEDC720" "20:8DD30";;
  test "52:C33B769DFBEF9" "6:68";;
  test "54:64EDC671DFBAEC" "11:DF0";;
  test "49:D35D752FA66E0" "11:CD2";;
  test "51:ACD76A39EF354" "12:B78";;
  test "58:E2F3BDE73DB5BE4" "16:D6F9";;
  test "66:68EDC39D666BBBC6C" "24:4CE6F9";;
  test "63:ACB3AF172BBCE2B6" "18:ACAE0";;
  test "50:E6FB71C77DE84" "2:4";;
  test "94:A26BAEB9E6FAEB8D4EBC1BE0" "29:EAF1C9C0";;
  test "63:B9DBB5D77EF57CF0" "12:9A4";;
  test "49:6BB47AF13BE50" "11:9B8";;
  test "58:E5E9C6BB66FAF30" "14:BE44";;
  test "41:E3B76CEDDA0" "103:ADEF7C734F1A9CE6DD3B39CD70";;
  test "53:95ACEFDD3BF780" "4:C";;
  test "23:9DBB20" "116:66B7AC341271273637CEB65432B7A";;