changeset 65:f2fb41098579

Day 12: refactor memoization
author Lewin Bormann <lbo@spheniscida.de>
date Sat, 23 Dec 2023 17:29:13 +0100
parents c9010e9a5257
children 2746741a49f6
files 2023/day12.ml
diffstat 1 files changed, 33 insertions(+), 35 deletions(-) [+]
line wrap: on
line diff
--- a/2023/day12.ml	Sat Dec 23 15:13:15 2023 +0100
+++ b/2023/day12.ml	Sat Dec 23 17:29:13 2023 +0100
@@ -107,46 +107,44 @@
 module Part2 = struct
   open Part1
 
-  module Memo_key = struct
-    type t = { ix : int; head : group; groupsleft : int }
-    [@@deriving compare, eq, sexp]
+  module Memoize = struct
+    module Memo_key = struct
+      type t = { ix : int; head : group; groupsleft : int }
+      [@@deriving compare, eq, sexp]
 
-    let hash t =
-      let open Int in
-      (t.ix * 31) + match t.head with Whole c -> c | Entered c -> c
-  end
+      let hash t =
+        let open Int in
+        (t.ix * 31) + match t.head with Whole c -> c | Entered c -> c
+    end
 
-  let create_memo () : (Memo_key.t, int) Hashtbl.t =
-    Hashtbl.create (module Memo_key)
+    type t = (Memo_key.t, int) Hashtbl.t
+
+    let create () : t = Hashtbl.create (module Memo_key)
 
-  let check_memo memo ix = function
-    | head :: groups ->
-        Hashtbl.mem memo
-          Memo_key.{ ix; head; groupsleft = 1 + List.length groups }
-    | [] -> false
+    let get memo ix = function
+      | head :: groups ->
+          Hashtbl.find memo
+            Memo_key.{ ix; head; groupsleft = 1 + List.length groups }
+      | [] -> None
 
-  let get_memo memo ix = function
-    | head :: groups ->
-        Hashtbl.find_exn memo
-          Memo_key.{ ix; head; groupsleft = 1 + List.length groups }
-    | [] -> assert false
-
-  let set_memo memo ix groups value =
-    match groups with
-    | head :: groups ->
-        Hashtbl.set memo
-          ~key:Memo_key.{ ix; head; groupsleft = 1 + List.length groups }
-          ~data:value
-    | [] -> ()
+    let set memo ix groups value =
+      match groups with
+      | head :: groups ->
+          Hashtbl.set memo
+            ~key:Memo_key.{ ix; head; groupsleft = 1 + List.length groups }
+            ~data:value
+      | [] -> ()
+  end
 
   (* a crude memoization scheme: the key is (index, head group, number of groups left to process)
      and identifies the state enough to reliably cache the outcome. *)
-  let rec count_memo memo row ix groups : int =
-    if check_memo memo ix groups then get_memo memo ix groups
-    else
-      let r = count (count_memo memo) row ix groups in
-      set_memo memo ix groups r;
-      r
+  let rec memoized_count memo row ix groups : int =
+    match Memoize.get memo ix groups with
+    | Some r -> r
+    | None ->
+        let r = count (memoized_count memo) row ix groups in
+        Memoize.set memo ix groups r;
+        r
 
   (* count combinations for a single record: row is the array of springs, ix is the current index,
      and groups is the current list of groups.
@@ -211,9 +209,9 @@
     { row = row'; damaged_groups = damaged_groups' }
 
   let count_combinations { row; damaged_groups } =
-    let memo = create_memo () in
+    let memo = Memoize.create () in
     let groups = List.map ~f:(fun c -> Whole c) damaged_groups in
-    count_memo memo row 0 groups
+    memoized_count memo row 0 groups
 
   (* a list of counts of combinations per record. *)
   (* count combinations for a single record: row is the array of springs, ix is the current index,