--- a/2023/day04.ml	Mon Dec 04 22:31:00 2023 +0100
+++ b/2023/day04.ml	Mon Dec 04 23:02:33 2023 +0100
@@ -19,7 +19,7 @@
     take_while1 (function '0' .. '9' -> true | _ -> false) >>| Int.of_string
 
   let int_listP = skip_many (char ' ') *> sep_by1 (skip_many1 (char ' ')) intP
-  let card_headP = (string "Card" *> skip_many1 (char ' ')) *> intP <* string ": "
+  let card_headP = string "Card" *> skip_many1 (char ' ') *> intP <* string ": "
   let sepP = string " | "
 
   let card =
@@ -39,20 +39,15 @@
 end
 
 module Part1 = struct
-  let to_set ilist =
-    Set.of_list
-      (module Int : Comparator.S
-        with type t = Int.t
-         and type comparator_witness = Int.comparator_witness)
-      ilist
+  let to_set ilist = Set.of_list (module Int) ilist
 
   let list_intersect a b =
     let sa = to_set a in
     let sb = to_set b in
     Set.inter sa sb
 
-  let card_value c =
-    Int.pow 2 (Set.length (list_intersect c.winning c.have)) / 2
+  let winning_numbers card = Set.length (list_intersect card.winning card.have)
+  let card_value card = Int.pow 2 (winning_numbers card) / 2
 
   let _test_parse ch =
     let process l =
@@ -64,7 +59,7 @@
     let f l = Out_channel.print_endline (process l) in
     In_channel.iter_lines ch ~f
 
-  let solve ch =
+  let _solve ch =
     let f acc line =
       let card = Parse.parse_card line in
       acc + card_value card
@@ -73,4 +68,58 @@
     Out_channel.printf "Total value is %d\n" result
 end
 
-let () = Part1.solve In_channel.stdin
+module Part2 = struct
+  let make_int_hashmap () : (int, int) Hashtbl.t = Hashtbl.create (module Int)
+
+  (* format int/int hashmap *)
+  let _hm_to_string hm =
+    Sexp.to_string_hum (Hashtbl.sexp_of_t Int.sexp_of_t Int.sexp_of_t hm)
+
+  (* create a counting sequence *)
+  let count_seq (from : int) (upto : int) : int Sequence.t =
+    let f c =
+      if Int.equal c upto then None
+      else Some (c, if upto > from then c + 1 else c - 1)
+    in
+    Sequence.unfold ~init:from ~f
+
+  (* for a card, account for all won cards. *)
+  let process_card hm card =
+    (* create default entry for card *)
+    Hashtbl.update hm card.id ~f:(function None -> 1 | Some x -> x);
+    (* how many points have we won? *)
+    let winning = Part1.winning_numbers card in
+    (* how many copies does the current card have? *)
+    let copies_won = Option.value ~default:1 (Hashtbl.find hm card.id) in
+    (* updater function adding `copies_won` to each successive card *)
+    let updater card_id =
+      Hashtbl.update hm card_id ~f:(function
+        | None -> 1 + copies_won
+        | Some x -> x + copies_won)
+    in
+    (* sequence of cards to update *)
+    let copied_cards = count_seq (card.id + 1) (card.id + winning + 1) in
+    Sequence.iter copied_cards ~f:updater
+
+  (* sequentially process available cards. *)
+  let process_cards ch =
+    let hm = make_int_hashmap () in
+    let f count line =
+      process_card hm (Parse.parse_card line);
+      count + 1
+    in
+    let count = In_channel.fold_lines ch ~init:0 ~f in
+    (count, hm)
+
+  (* count all scratchcards, up to the number of available cards. *)
+  let total_scratchcards hm cardcount =
+    let f ~key ~data sum = if key <= cardcount then sum + data else sum in
+    Hashtbl.fold hm ~init:0 ~f
+
+  (* print solution *)
+  let _solve_process_cards ch =
+    let count, hm = process_cards ch in
+    Out_channel.printf "%d\n" (total_scratchcards hm count)
+end
+
+let () = Part2._solve_process_cards In_channel.stdin