Advent of Code 2024 Day 06 Solutions (Ocaml, F#)

aoc.fsx

(*aoc.fsx : excerpt, Day 06*)
exception BreakI of int

let problem_06 () =
 let inputs =
  System.IO.File.ReadLines("06.txt") |>
  Seq.toArray in
 let ascii = new System.Text.ASCIIEncoding () in
 (* Guard psuedo module startA *)
 (* Guard type t = int (y) * int (x) * int (dir_flag) *)
 let flag_n = 0x01 in
 let flag_e = 0x02 in
 let flag_s = 0x04 in
 let flag_w = 0x08 in
 let turn dir = if dir <<< 1 > flag_w then flag_n else dir <<< 1 in
 (* Guard psuedo module endA *)
 let map_h = Array.length inputs in
 let map_w = String.length inputs.[0] in
 let history = Array.create (map_h * map_w) 0 in
 let map =
  inputs |>
  Array.map (ascii.GetBytes) in
 let guard0 =
  Seq.zip (seq { 0 .. map_h-1 }) map |>
  Seq.fold
   (fun a (y,line) ->
    Seq.zip (seq { 0 .. map_w-1 }) line |>
    Seq.fold (fun a (x,b) -> if b = '^'B then Option.defaultValue (y,x,flag_n) a |> Some else a) a)
   None |>
  Option.get in
 (* Guard psuedo module startB *)
 (* capture environment and simply use guard tuple as input *)
 (* reuse BreakI exception from Day 01 *)
 let move (y,x,d) =
  if history.[y*map_h+x] &&& d <> 0 then raise (BreakI 0) ;
  history.[y*map_h+x] <- history.[y*map_h+x] ||| d ;
  try
   if d = flag_n then (if map.[y-1].[x] = '#'B then (y,x, turn d) else (y-1,x,d)) else
   if d = flag_e then (if map.[y].[x+1] = '#'B then (y,x, turn d) else (y,x+1,d)) else
   if d = flag_s then (if map.[y+1].[x] = '#'B then (y,x, turn d) else (y+1,x,d)) else
   if d = flag_w then (if map.[y].[x-1] = '#'B then (y,x, turn d) else (y,x-1,d)) else
   failwith "Invalid Direction!"
  with _ -> raise (BreakI 1) in
 (* Guard psuedo module endB *)
 let count_visited () = Array.fold (fun a loc -> if loc <> 0 then a + 1 else a) 0 history in
 let mutable guard = guard0 in
 let res1 =
  try
   while true do guard <- move guard done
  with BreakI _ -> () ;
  count_visited () in
 let res2 =
  let mutable count = 0 in
  for y = 0 to map_h - 1 do
   for x = 0 to map_w - 1 do
    if map.[y].[x] = '.'B then
     map.[y].[x] <- '#'B ;
     guard <- guard0 ; 
     Array.fill history 0 (history.Length) 0 ;
     try
      while true do guard <- move guard done
     with BreakI code -> if code = 0 then count <- count + 1 else () ;
     map.[y].[x] <- '.'B
   done
  done ;
  count in
 res1, res2

aoc.ml

(* aoc.ml : excerpt, Day 06b *)
(* time: ~12s unopt ; 1s opt *)
let problem_06b2 () =
 let exception BreakB of bool in
 let (.%[]<-) = Bytes.set in
 let (.%[]) = Bytes.get in
 let module Guard = struct
  type dir = N | E | S | W
  type t = {y : int ; x : int ; d : dir}
  type hist = {arr : int array ; h : int ; w : int}
  let turn = function N -> E | E -> S | S -> W | W -> N
  let flag_of_dir = function N -> 1 | E -> 2 | S -> 4 | W -> 8
  (* use 1D state arrays (type hist(ory)) intead of hashtbls for efficiency! *)
  let hist_create h w = {arr = Array.make (h*w) 0; h ; w}
  let hist_clear hist = Array.fill hist.arr 0 (hist.h * hist.w) 0 
  let hist_set hist g = try hist.arr.(g.y * hist.w + g.x) <- hist.arr.(g.y * hist.w + g.x) lor (flag_of_dir g.d) with _ -> ()
  let hist_mem hist g = try (hist.arr.(g.y * hist.w + g.x) land flag_of_dir g.d) <> 0 with _ -> false
  (* if we hit an invalid arg, we would be stepping out, so we reraise our breakpoint *)
  let move hist map g =
   if hist_mem hist g then raise_notrace (BreakB false) ;
   try
    hist_set hist g;
    match g.d with
    | N when map.(g.y - 1).%[g.x] = '#' -> {g with d = turn (g.d)}
    | N -> {g with y = g.y - 1}
    | E when map.(g.y).%[g.x + 1] = '#' -> {g with d = turn (g.d)}
    | E -> {g with x = g.x + 1}
    | S when map.(g.y + 1).%[g.x] = '#' -> {g with d = turn (g.d)}
    | S -> {g with y = g.y + 1}
    | W when map.(g.y).%[g.x - 1] = '#' -> {g with d = turn (g.d)}
    | W -> {g with x = g.x - 1}
   with _ -> raise_notrace (BreakB true)
 end in
 let example = false in
 let inputs = 
  In_channel.(with_open_bin (if example then "06e.txt" else "06.txt") input_lines) |>
  List.map (Bytes.unsafe_of_string) |> Array.of_list in
 let guard0 =
  inputs |>
  Array.to_seq |>
  Seq.fold_lefti
   (fun a y xs ->
    match a with
    | None -> Option.bind (Bytes.index_opt xs '^') (fun x -> Some Guard.{y; x; d = Guard.N})
    | Some _ -> a) None |>
  Option.get in
 let guard = ref guard0 in
 let count = ref 0 in
 let history = Guard.hist_create (Array.length inputs) (Bytes.length inputs.(0)) in
 for y = 0 to Array.length inputs - 1 do
  for x = 0 to Bytes.length inputs.(y) - 1 do
   if inputs.(y).%[x] = '.' then (
    inputs.(y).%[x] <- '#' ;
    try
     while true do guard := Guard.move history inputs !guard done
    with BreakB oob -> if not oob then incr count else () ;
    (* clean up *)
    Guard.hist_clear history ;
    guard := guard0 ;
    inputs.(y).%[x] <- '.' ;
   ) else ()
  done
 done ;
 !count