module common

open heap

#nowarn "25"

//////// position manipulation
let inline abs x = if x >= 0 then x else -x

let inline get_r pos = pos / 80
let inline get_c pos = (pos >>> 2) % 20
let inline get_d pos = pos &&& 3
let inline get_rc pos = pos >>> 2

let inline gen_rc r c = r*20+c
let inline set_pos r c d = (r * 80) + (c <<< 2) ||| d
let inline set_d d pos = (pos &&& ~~~3) ||| d

let goal_pos board =
  let pos = Array.findIndex ((=) '$') board
  (pos / 20, pos % 20)

//////// moving lerak on the board
let move (board:char[]) r_inc c_inc pos =
  let r, c, d = get_r pos, get_c pos, get_d pos
  let nr, nc = r+r_inc, c+c_inc
  match board.[get_rc pos] with
  | '$' -> pos
  | _ when nr < 0 || nr >= 20 || nc < 0 || nc >= 20 -> -1
  | _ when board.[gen_rc nr nc] = '#' -> -1
  | _ when board.[gen_rc nr nc] = 'X' -> pos
  | _ -> set_pos nr nc d

let pasy (board:char[]) = function
  | pos when pos < 0 -> -1
  | pos ->
      match board.[get_rc pos] with
      | '^' -> move board -1  0 pos
      | '>' -> move board  0  1 pos
      | 'v' -> move board  1  0 pos
      | '<' -> move board  0 -1 pos
      | _ -> pos

let forward board dir = function
  | pos when pos < 0 -> -1
  | pos ->
      match dir with
      | 0 -> move board -1  0 pos
      | 1 -> move board  0  1 pos
      | 2 -> move board  1  0 pos
      | 3 -> move board  0 -1 pos

let move_lerak board pos move =
  let dir = get_d pos
  match move with
  | '1' -> pos |> forward board dir |> pasy board
  | '2' -> pos |> forward board dir |> forward board dir |> pasy board
  | '3' -> pos |> forward board dir |> forward board dir |> forward board dir |> pasy board
  | 'Z' -> pos |> forward board ((dir+2) &&& 3) |> pasy board
  | 'L' -> pos |> set_d ((dir+3) &&& 3) |> pasy board
  | 'R' -> pos |> set_d ((dir+1) &&& 3) |> pasy board

let possible_moves (board:char[]) pos offer len =
  let labels = [|'1'; '2'; '3'; 'Z'; 'L'; 'R'|]
  let moves = Array.init 6 (fun i -> offer |> Seq.filter ((=) labels.[i]) |> Seq.length)
  let used = Array.zeroCreate 1600
  let result = new ResizeArray<int>(32)
  let add_result what = if what < 0 then
                          if result.Count = 0 || result.[0] > what then begin result.Clear(); result.Add what end
                        else
                          if not used.[what] then begin used.[what] <- true; result.Add what end
  if board.[get_rc pos] = '$' then add_result -6

  let rec gen pos = function
    | i when i >= len -> add_result pos
    | i -> for j = 0 to 5 do
             if moves.[j]>0 then
               match move_lerak board pos labels.[j] with
               | where when where < 0 -> ()
               | where when board.[get_rc where] = '$' -> add_result ((i+1)-6)
               | where -> moves.[j] <- moves.[j] - 1
                          gen where (i+1)
                          moves.[j] <- moves.[j] + 1

  if board.[get_rc pos] <> 'X' && board.[get_rc pos] <> '#' then gen pos 0
  result.ToArray()

let find_move board pos offer goal =
  let labels = [|'1'; '2'; '3'; 'Z'; 'L'; 'R'|]
  let moves = Array.init 6 (fun i -> offer |> Seq.filter ((=) labels.[i]) |> Seq.length)
  let result = ref null

  let rec gen pos path = function
    | i when i >= 5 -> if pos = goal then result := new System.String(List.rev path |> Array.ofList)
    | i -> for j = 0 to 5 do
             if !result = null && moves.[j]>0 then
               match move_lerak board pos labels.[j] with
               | where when where < 0 -> ()
               | where when board.[get_rc where] = '$' -> if ((i+1)-6) = goal then result := new System.String(List.rev (labels.[j]::path) |> Array.ofList)
               | where -> moves.[j] <- moves.[j] - 1
                          gen where (labels.[j] :: path) (i+1)
                          moves.[j] <- moves.[j] + 1

  gen pos [] 0
  !result

//////// finding shortest path
let max_int = System.Int32.MaxValue

let shortest_path board gen_moves move_len =
  let goal_r, goal_c = goal_pos board
  let distances, visited, neighbors = Array.create 1600 max_int, Array.create 1600 false, Array.create 1600 []

  let process_move pos = function
    | move when move < 0 -> distances.[pos] <- min distances.[pos] (move+6)
    | move -> neighbors.[move] <- pos :: neighbors.[move]
  {0..1599} |> Seq.iter (fun pos -> gen_moves pos |> Seq.iter (process_move pos))

  let mutable heap = empty
  for i=0 to 1599 do if distances.[i] < max_int then heap <- insert distances.[i] i heap
  while not (isEmpty heap) do
    let pos = findMin heap
    heap <- deleteMin heap

    if not visited.[pos] then
      visited.[pos] <- true

      for n in neighbors.[pos] do
        if distances.[pos] + move_len < distances.[n] then
          distances.[n] <- distances.[pos] + move_len
          heap <- insert distances.[n] n heap

  distances

//////// navigating using measures
let measure_value measure = function
  | move when move < 0 -> move+1
  | move -> Array.get measure move

let fmeasure_value fmeasure = function
  | move when move < 0 -> float32 move + 6.f
  | move -> Array.get fmeasure move + 5.f

let best_move get_move_value = function
  | [||] -> None
  | moves -> Some (Array.minBy get_move_value moves)

//////// computing measures
let show_measure (measure:int[]) =
  let get_measure r c d = min 99 measure.[r*80 + c*4 + d]

  for r=0 to 19 do
    for d1=0 to 1 do
      for c=0 to 19 do
        printf "%3d%3d " (get_measure r c (3*d1)) (get_measure r c (d1+1))
      printf "\n"

let show_fmeasure (measure:float32[]) =
  let get_measure r c d = min 99.9f measure.[r*80 + c*4 + d]

  for r=0 to 19 do
    for d1=0 to 1 do
      for c=0 to 19 do
        printf "%5.1f%5.1f " (get_measure r c (3*d1)) (get_measure r c (d1+1))
      printf "\n"

let metric_measure board =
  let goal_r, goal_c = goal_pos board
  Array.init 1600 (fun pos -> abs (get_r pos - goal_r) + abs (get_c pos - goal_c))

let metricdir_measure board =
  let goal_r, goal_c = goal_pos board
  let distance pos =
    let pos_r, pos_c, pos_d = get_r pos, get_c pos, get_d pos
    let dir_r = if pos_r < goal_r then 2 else if pos_r > goal_r then 0 else -1
    let dir_c = if pos_c < goal_c then 1 else if pos_c > goal_c then 3 else -1
    let dir_price = match pos_d with
                    | _ when dir_r <> -1 && dir_c <> -1 -> if pos_d=dir_r || pos_d=dir_c then 1 else 2
                    | _ when dir_r <> -1 -> if pos_d=dir_r then 0 else if pos_d=((dir_r+2)%4) then 2 else 1
                    | _ when dir_c <> -1 -> if pos_d=dir_c then 0 else if pos_d=((dir_c+2)%4) then 2 else 1
                    | _ -> 0

    abs (pos_r - goal_r) + abs (pos_c - goal_c) + dir_price
  Array.init 1600 distance

let moves_measure moves board =
  shortest_path board (fun pos -> possible_moves board pos moves 1) 1

let rounds_measure moves board =
  shortest_path board (fun pos -> possible_moves board pos moves 5) 5

let prob_fmeasure board failure_cost =
  let labels = [|'1'; '2'; '3'; 'Z'; 'L'; 'R'|]
  let moves = Array.create 6 1
  let offers = Array.init 1600 (fun pos -> Array.create 56 null)
  let used = Array.init 1600 (fun pos -> Array.zeroCreate 56)

  // List of offers as tuple (index, sorted list of length three with elements 0..5
  let rec offers_list prefix next = function
    | 0 -> [prefix]
    | n when next <= 5 -> offers_list (prefix @ [next]) next (n-1) @ offers_list prefix (next+1) n
    | _ -> []
  let offers_list = List.zip [0..55] (offers_list [] 0 3)

  // Compute offers from the 'extra' parameter of the 'gen' function.
  let rec subset small big =
    match small, big with
    | [], _ -> true
    | _, [] -> false
    | s::ss, b::bs when s < b -> false
    | s::ss, b::bs when s = b -> subset ss bs
    | s::ss, b::bs when s > b -> subset small bs
  let extra2offer extra =
    let extra_list = [extra%7; (extra/7)%7; extra/49] |> List.map ((+) -1) |> List.filter ((<=) 0) |> List.sort
    [| for offer, offer_list in offers_list do if subset extra_list offer_list then yield offer |]
  let extra2offer = Array.init (7*7*7) extra2offer

  // Generate moves for all offers.
  let gen start =
    for pos=0 to 1599 do for offer=0 to 55 do used.[pos].[offer] <- false
    let local_offers = Array.init 56 (fun offer -> new ResizeArray<int>(8))

    let add_offers pos extra =
      for i=0 to extra2offer.[extra].Length-1 do
        let offer = extra2offer.[extra].[i]
        if pos < 0 then
          if local_offers.[offer].Count = 0 || local_offers.[offer].[0] > pos then
            local_offers.[offer].Clear()
            local_offers.[offer].Add pos
        else
          if not used.[pos].[offer] then
            used.[pos].[offer] <- true
            local_offers.[offer].Add pos

    let rec gen pos extra extra_len = function
      | i when i >= 5 -> add_offers pos extra
      | i -> for j = 0 to 5 do
               if moves.[j]>0 || extra_len < 3 then
                 match move_lerak board pos labels.[j] with
                 | where when where < 0 -> ()
                 | where when board.[get_rc where] = '$' -> add_offers ((i+1)-6) (if moves.[j] > 0 then extra else extra*7+j+1)
                 | where when moves.[j] > 0 -> moves.[j] <- moves.[j] - 1
                                               gen where extra extra_len (i+1)
                                               moves.[j] <- moves.[j] + 1
                 | where(*when extra_len<3*)-> gen where (extra*7+j+1) (extra_len+1) (i+1)
    if board.[get_rc start] = '$' then add_offers (-1) 0
    else if board.[get_rc start] <> 'X' && board.[get_rc start] <> '#' then gen start 0 0 0
    for offer=0 to 55 do offers.[start].[offer] <- local_offers.[offer].ToArray()

  for pos=0 to 1599 do gen pos

  // Generate initial measure
  let measure = shortest_path board (fun pos -> offers.[pos].[0]) 5
  let measure = Array.map (fun w -> float32 (if w = max_int then failure_cost else w)) measure
  let tmp = Array.copy measure

  let rec iterate n =
    for pos=0 to 1599 do
      tmp.[pos] <- 0.f
      for offer=0 to 55 do
        tmp.[pos] <- tmp.[pos] + match offers.[pos].[offer] with
                                 | [||] -> float32 failure_cost
                                 | moves -> moves |> Array.minBy (fmeasure_value measure) |> fmeasure_value measure
      tmp.[pos] <- tmp.[pos] / 56.f
    for pos=0 to 1599 do measure.[pos] <- tmp.[pos]

    if n > 1 then iterate (n-1) else measure
  iterate 21

//////// final decision
let move_or_anything move board pos (offer:string) =
  match move with
  | None -> offer.Substring(0, 5)
  | Some goal -> find_move board pos offer goal