Mercurial > lbo > hg > aoc22
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,