Chicken McNuggets Monoid

Chicken_McNuggets_Monoid.ml

(* See https://www.johndcook.com/blog/2022/10/10/mcnugget-monoid/ *)

(* Stage 1 - provide mask *)

let rec make_mask = function
  | 0 -> []
  | 1 -> [ true ]
  | i -> false :: make_mask (i - 1)

let rec mix_masks l1 l2 =
  match (l1, l2) with
  | [], l2 -> l2
  | l1, [] -> l1
  | i :: l1, j :: l2 -> (i || j) :: mix_masks l1 l2

let rec make_masks = function
  | [] -> []
  | a :: l -> mix_masks (make_mask a) (make_masks l)

(* Stage 2 - stream for decision *)

let apply_masks l =
  let open Preface.Stream in
  let masks = make_masks l in
  let rec apply_masks d = function
    | [] -> stream (d, false) (lazy (apply_masks (d + 1) []))
    | true :: l -> stream (d, true) (lazy (apply_masks (d + 1) (mix_masks masks l)))
    | false :: l -> stream (d, false) (lazy (apply_masks (d + 1) l))
  in
  apply_masks 0 [ true ]

(* Stage 3 - use it *)

let l = 
  let open Preface.Stream in
  let open Preface.List.Monad_plus in
  let open Preface.Try.Functor in
  let values = apply_masks [6;9;20] in
  take 48 values <&> ( =<< ) (fun (i, b) -> if b then [] else [ i ])
  (* Ok ([1; 2; 3; 4; 5; 7; 8; 10; 11; 13; 14; 16; 17; 19; 22; 23; 25; 28; 31; 34; 37; 43]) *)