advent-of-code-2020/day16.ml

(* Common util. Should probably put this in a module or something.. *)
let get_one_line file =
  try Some (input_line file) with
    End_of_file -> None

let get_lines file =
  let rec input lines =
    match get_one_line file with
      Some line -> input (line :: lines)
    | None -> List.rev lines
  in input []

let read_file file =
  let channel = open_in(file) in
  get_lines channel

let explode s = (* convert a string to a list of chars *)
  let rec exp i l =
   if i < 0 then l else exp (i - 1) (s.[i] :: l) in
  exp (String.length s - 1) []

let implode l = String.of_seq (List.to_seq l)

let (<<) f g x = f(g(x))
let (>>) f g x = g(f(x))

let rec find_idx nth x = function (* find nth index of x in a list *)
  | [] -> raise (Failure "Not Found")
  | h :: t ->
      if x = h
      then if nth = 0 then 0 else 1 + find_idx (nth-1) x t
      else 1 + find_idx nth x t

let rec take n l = (* take the first n elements *)
  match n with
  | 0 -> []
  | n ->
      match l with
      | [] -> []
      | x :: xs -> x :: (take (n-1) xs)

let rec drop n l = (* drop the first n elemnts *)
  match n with
  | 0 -> l
  | n -> drop (n-1) @@ List.tl l

let sub_list start length = (* sub list from start *)
  drop start >> take length

let range start len = (* makes a new list from start with length len *)
  List.init len (fun x -> x + 0) |> List.map (fun x -> x + start)

(* --- *)

type rule = { name: string; ranges: (int * int) list }

(* type ordering = string * (int list) (* rule name and it's possible positinos *) *)

let parse_range r =
  let [l; r] = String.split_on_char '-' r in
  (int_of_string l, int_of_string r)

let parse_rules line = (* from "class: 1-6 or 5-7" to a rule *)
  let [name; range_strings] = String.split_on_char ':' line in
  let [rs1; _; rs2] = String.split_on_char ' ' (String.trim range_strings) in
  { name; ranges = [parse_range rs1; parse_range rs2] }

let read_chunks lines =
  let blank1 = find_idx 0 "" lines in
  let blank2 = find_idx 1 "" lines in
  let rule_lines = sub_list 0 blank1 lines in
  let rules = List.map parse_rules rule_lines in
  let your_ticket = List.nth lines (blank2 - 1)
    |> String.split_on_char ','
    |> List.map int_of_string
  in
  let nearby_tickets = sub_list (blank2 + 2) (List.length lines - blank2 - 2) lines
    |> List.map @@ String.split_on_char ','
    |> List.map @@ List.map int_of_string
  in
  (rules, your_ticket, nearby_tickets)


(* Part 1 stuff *)

let is_value_valid rules value = (* given a list of rules and a value, is this value good *)
  List.exists (fun { name; ranges } ->
    List.exists (fun (l, r) ->
      (value >= l) && (value <= r)
    ) ranges
  ) rules

let find_invalid_values rules tickets = (* given a list of rules and a list of tickets, find all invalid values within the tickets *)
  List.map (fun ticket ->
    List.filter (fun value -> not @@ is_value_valid rules value) ticket
  ) tickets
  |> List.concat


(* Part 2 stuff *)

let find_valid_tickets rules =
  List.filter (fun ticket ->
    List.for_all (fun value -> is_value_valid rules value) ticket
  )

let is_position_valid rule tickets position =
  let values = List.map (fun t -> List.nth t position) tickets in
  List.for_all (fun value ->
    is_value_valid [rule] value
  ) values

let find_positions rule tickets =
  let len = List.length (List.nth tickets 0) in
  let all_positions = range 0 len in
  let good_positions = List.filter (is_position_valid rule tickets) all_positions in
  Printf.printf "Found good positions for rule %s: " rule.name;
  List.iter (Printf.printf "%i ") good_positions;
  print_newline ();
  good_positions

let find_all_orderings rules tickets =
  List.map (fun rule ->
    let positions = find_positions rule tickets in
    (rule.name, positions)
  ) rules

let remove_found_from_ordering found (name, positions) =
  let new_pos_list = List.filter (fun p -> not @@ List.mem_assoc p found) positions in
  (name, new_pos_list)

let find_ordering orderings =
  print_newline ();
  let rec go ords found =
    if List.length orderings = List.length found
    then found
    else
      let ords' = List.map (remove_found_from_ordering found) ords in
      (* any of these only have 1 possibility? *)
      let has_one = List.find (fun o -> List.length (snd o) = 1) ords' in
      let uniq_pos = List.nth (snd has_one) 0 in
      Printf.printf "found %s position: %i \n" (fst has_one) uniq_pos;
      go ords' ((uniq_pos, fst has_one) :: found)
  in
  go orderings []

let find_departure_positions ords =
  List.filter (fun (pos, name) ->
    try String.sub name 0 9 = "departure"
    with Invalid_argument _ -> false
  ) ords
  |> List.map (fun (pos, name) -> (name, pos))

let values_at_positions positions ticket =
  List.map (fun (name, pos) -> List.nth ticket pos) positions

let () =
  let (rules, my_ticket, nearby) = read_file "day16.txt" |> read_chunks in

  (* Part 1 *)
  let invalid_nums = find_invalid_values rules nearby in
  let invalid_sum = List.fold_left (+) 0 invalid_nums in
  Printf.printf "invalid sum: %i\n" invalid_sum;

  (* Part 2 *)
  let valid_tickets = find_valid_tickets rules nearby in
  let all_orderings = find_all_orderings rules valid_tickets in
  let ordering = find_ordering all_orderings in
  let departure_positions = find_departure_positions ordering in

  print_newline ();
  List.iter (fun (a, b) -> Printf.printf "%s %i\n" a b) departure_positions;

  let departure_values = values_at_positions departure_positions my_ticket in

  print_newline ();
  List.iter (fun x -> Printf.printf "departure value %i\n" x) departure_values;

  let prod = List.fold_left ( * ) 1 departure_values in
  Printf.printf "\nproduct: %i" prod;