Mercurial > lbo > hg > aoc22
view 2023/day05.ml @ 44:070e01565b16
Day 06 Part 1
author | Lewin Bormann <lbo@spheniscida.de> |
---|---|
date | Wed, 06 Dec 2023 20:13:48 +0100 |
parents | 865325736c6f |
children | ec052bcd3e40 |
line wrap: on
line source
open Angstrom open Base open Core module Hashtbl = Base.Hashtbl type rangemap = { dst_start : int; src_start : int; length : int } [@@deriving sexp] type input = { seeds : int list; maps : (string, rangemap list) Hashtbl.t } let sexp_of_input { seeds; maps } = Sexp.List [ Sexp.List [ Sexp.Atom "seeds"; List.sexp_of_t Int.sexp_of_t seeds ]; Sexp.List [ Sexp.Atom "maps"; Hashtbl.sexp_of_t String.sexp_of_t (List.sexp_of_t sexp_of_rangemap) maps; ]; ] module Parse = struct let maybe p = option () (p >>= fun _ -> return ()) let intP = take_while1 (function '0' .. '9' -> true | _ -> false) >>| Int.of_string let int_listP = skip_many (char ' ') *> sep_by1 (skip_many1 (char ' ')) intP let rangeP = int_listP >>= function | dst_start :: src_start :: length :: _rest -> return { dst_start; src_start; length } | _ -> assert false let map_nameP = take_while1 (fun c -> not (Char.is_whitespace c)) let map_headerP = map_nameP <* string " map:\n" let rangesP = many1 (rangeP <* char '\n') <* maybe (char '\n') let mapP = let open Angstrom.Let_syntax in let%bind mapname = map_headerP in let%bind ranges = rangesP in return (mapname, ranges) let seedsP = string "seeds: " *> int_listP <* string "\n\n" let inputP = let open Angstrom.Let_syntax in let%bind seeds = seedsP in let%bind maps = many1 mapP in return (seeds, maps) exception Parse_exn of string let parse input = match parse_string ~consume:All inputP input with | Ok (seeds, maps) -> let maps = Hashtbl.of_alist_exn (module String) maps in { seeds; maps } | Error e -> raise (Parse_exn e) let _test_parse input = let inp = parse input in Out_channel.print_endline (Sexp.to_string_hum (sexp_of_input inp)) end module Part1 = struct let steps_names = [ "seed-to-soil"; "soil-to-fertilizer"; "fertilizer-to-water"; "water-to-light"; "light-to-temperature"; "temperature-to-humidity"; "humidity-to-location"; ] (* for a single step, resolve the number using the provided range maps. Return None if no mapping was found. *) let resolve_step_maybe { dst_start; src_start; length } number = if src_start <= number && number <= src_start + length then Some (dst_start + (number - src_start)) else None (* For all maps in a step, determine the final next number. *) let rec resolve_step maps number = match maps with | map :: maps' -> ( match resolve_step_maybe map number with | Some ok -> ok | None -> resolve_step maps' number) | [] -> number (* Traverse steps for one seed *) let rec traverse_for_seed seed = function | step :: steps -> let next = resolve_step step seed in traverse_for_seed next steps | [] -> seed (* optain list of steps from hashmap *) let maps_list maps_hm = let f = Hashtbl.find_exn maps_hm in List.map steps_names ~f (* For all seeds, find resulting location (end number). *) let traverse_all { seeds; maps } = let maps = maps_list maps in let results = List.map seeds ~f:(fun seed -> traverse_for_seed seed maps) in results (* Read, parse, and process input from channel. *) let process ch = let input = In_channel.input_all ch in let input' = Parse.parse input in let result = traverse_all input' in Out_channel.print_endline (Sexp.to_string_hum (List.sexp_of_t Int.sexp_of_t result)); Out_channel.printf "Result is %d\n" (List.fold ~init:Int.max_value ~f:Int.min result) end let () = Part1.process In_channel.stdin