--- a/2023/day07.ml	Thu Dec 07 21:16:16 2023 +0100
+++ b/2023/day07.ml	Thu Dec 07 22:30:39 2023 +0100
@@ -46,30 +46,37 @@
     | Error e -> raise (Parse_exn e)
 end
 
-module Part1 = struct
-  type typ =
-    | FiveOf
-    | FourOf
-    | FullHouse
-    | ThreeOf
-    | TwoPair
-    | OnePair
-    | High
-    | NoType
-  [@@deriving sexp]
+type typ =
+  | FiveOf
+  | FourOf
+  | FullHouse
+  | ThreeOf
+  | TwoPair
+  | OnePair
+  | High
+  | NoType
+[@@deriving sexp]
 
-  let int_of_typ = function
-    | FiveOf -> 8
-    | FourOf -> 7
-    | FullHouse -> 6
-    | ThreeOf -> 5
-    | TwoPair -> 4
-    | OnePair -> 3
-    | High -> 2
-    | NoType -> 0
+let int_of_typ = function
+  | FiveOf -> 8
+  | FourOf -> 7
+  | FullHouse -> 6
+  | ThreeOf -> 5
+  | TwoPair -> 4
+  | OnePair -> 3
+  | High -> 2
+  | NoType -> 0
 
-  let compare_typ a b = Int.compare (int_of_typ a) (int_of_typ b)
+let compare_typ a b = Int.compare (int_of_typ a) (int_of_typ b)
 
+let _string_of_typ_bids bids =
+  Sexp.to_string_hum
+  @@ Sexp.List
+       (List.map
+          ~f:(fun (typ, bid) -> Sexp.List [ sexp_of_typ typ; sexp_of_bid bid ])
+          bids)
+
+module Part1 = struct
   let count_cards cards =
     let counts = Array.create ~len:(max_card + 1) 0 in
     let count c = counts.(c) <- counts.(c) + 1 in
@@ -103,13 +110,117 @@
   let compare_bids { hand = a; _ } { hand = b; _ } = compare_hands a b
   let sort_bids = List.sort ~compare:(fun a b -> compare_bids a b)
 
-  let winnings bids =
+  let _winnings bids =
     let sorted = sort_bids bids in
     let f ix ac bid = ac + ((ix + 1) * bid.win) in
     List.foldi ~f ~init:0 sorted
 end
 
+module Part2 = struct
+  let convert_part1_hand { hand; win } =
+    let f = function 11 -> 1 | x -> x in
+    { hand = List.map ~f hand; win }
+
+  type cardcount = { card : int; count : int } [@@deriving sexp]
+
+  let compare_cardcount { count = count1; _ } { count = count2; _ } =
+    Int.compare count1 count2
+
+  let count_cards cards =
+    let cardcounts =
+      Sequence.unfold ~init:0 ~f:(fun s ->
+          if s <= max_card + 1 then Some ({ card = s; count = 0 }, s + 1)
+          else None)
+    in
+    let counts = Sequence.to_array cardcounts in
+    let count c =
+      counts.(c) <- { (counts.(c)) with count = counts.(c).count + 1 }
+    in
+    List.iter ~f:count cards;
+    counts
+
+  let wildcard = 1
+
+  let wildcards =
+    List.fold ~init:0 ~f:(fun a { card; count } ->
+        if Int.equal card wildcard then a + count else a)
+
+  let typ_of counts =
+    Array.sort ~compare:(fun a b -> compare_cardcount b a) counts;
+    let countsl = Array.to_list counts in
+    let nwild = wildcards countsl in
+    let countsl =
+      List.filter ~f:(fun { card; _ } -> not (Int.equal card wildcard)) countsl
+    in
+    (*Out_channel.printf "counts %s\n" (Sexp.to_string_hum (List.sexp_of_t sexp_of_cardcount countsl));
+    *)
+    match countsl with
+    | { count = x; _ } :: _ when Int.(nwild + x = 5) -> FiveOf
+    | { count = x; _ } :: { count = y; _ } :: _
+      when Int.(nwild + x = 4 || (x = 4 && nwild + y = 1)) ->
+        FourOf
+    | { count = x; _ } :: { count = y; _ } :: _
+      when Int.((nwild + x = 3 && y = 2) || (nwild + y = 2 && x = 3)) ->
+        FullHouse
+    | { count = x; _ } :: { count = 1; _ } :: { count = z; _ } :: _
+      when Int.((nwild + x = 3 && z = 1) || (x = 3 && nwild + z = 1)) ->
+        ThreeOf
+    | { count = 2; _ } :: { count = y; _ } :: { count = z; _ } :: _
+      when Int.((nwild + y = 2 && z = 1) || (y = 2 && nwild + z = 1)) ->
+        TwoPair
+    | { count = x; _ }
+      :: { count = y; _ }
+      :: { count = z; _ }
+      :: { count = a; _ }
+      :: { count = b; _ }
+      :: _
+      when Int.(
+             (x + nwild = 2 && y = 1 && z = 1 && a = 1 && b = 0)
+             || (x = 2 && y = 1 && z = 1 && a + nwild = 1)) ->
+        OnePair
+    | { count = 1; _ }
+      :: { count = 1; _ }
+      :: { count = 1; _ }
+      :: { count = 1; _ }
+      :: { count = x; _ }
+      :: _
+      when Int.(nwild + x = 1) ->
+        High
+    | _ -> assert false
+
+  let typ_of_hand h =
+    (*Out_channel.printf "hand %s -> " (Sexp.to_string_hum (List.sexp_of_t Int.sexp_of_t h));
+    *)
+    let typ = typ_of (count_cards h) in
+    (*Out_channel.printf "%s -> %s\n"
+      (Sexp.to_string_hum (sexp_of_typ typ))
+      (Sexp.to_string_hum @@ List.sexp_of_t Int.sexp_of_t h);
+    *)
+    typ
+
+  let compare_hands a b =
+    let ta, tb = (typ_of_hand a, typ_of_hand b) in
+    match compare_typ ta tb with
+    | -1 -> -1
+    | 1 -> 1
+    | 0 -> List.compare compare_card a b
+    | _ -> assert false
+
+  let sort_bids bids =
+    let f bid = (typ_of_hand bid.hand, bid) in
+    let typ_hands = List.map ~f bids in
+    List.sort
+      ~compare:(fun (_, a) (_, b) -> compare_hands a.hand b.hand)
+      typ_hands
+
+  let winnings bids =
+    let sorted = sort_bids @@ List.map ~f:convert_part1_hand bids in
+    Out_channel.print_endline (_string_of_typ_bids sorted);
+    let f ix ac (_, bid) = ac + ((ix + 1) * bid.win) in
+    List.foldi ~f ~init:0 sorted
+end
+
 let () =
   let inp = In_channel.input_all In_channel.stdin in
   let bids = Parse.parse_input inp in
-  Out_channel.printf "Total winnings: %d\n" (Part1.winnings bids)
+  Out_channel.printf "Total winnings: %d\n" (Part2.winnings bids)