(* 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;