Make a complete multipartite graph of N symbolic state spaces.

state_space.ml

module StateSpace :
sig
  val enumerate : 'a list list -> 'a list list

  val count : 'a list list -> int

  val tests : unit -> unit
end = struct
  open Printf

  module L = ListLabels
  module S = StringLabels

  module Stack :
  sig
    type 'a t

    val create : unit -> 'a t

    val push : 'a t -> 'a -> unit

    val dump : 'a t -> 'a list
  end = struct
    type 'a t =
      'a list ref

    let create () =
      ref []

    let push t e =
      t := e :: !t

    let dump t =
      !t
  end

  let enumerate sets =
    let paths = Stack.create () in
    let rec enum path sets =
      match sets with
      |        [] -> Stack.push paths (L.rev path)
      | s :: sets -> L.iter s ~f:(fun node -> enum (node :: path) sets)
    in
    enum [] sets;
    L.rev (Stack.dump paths)

  let count sets =
    match L.map sets ~f:L.length with
    |      [] -> 0
    | n :: [] -> n
    | n :: ns -> L.fold_left ns ~init:n ~f:( * )

  let tests () =
    let rec seq current last =
      if current > last then [] else current :: seq (current + 1) last
    in
    let str_seq n str =
      L.map (seq 1 n) ~f:(sprintf "%s%d" str)
    in
    let test_sets_print =
      [ str_seq 3 "a"
      ; str_seq 3 "b"
      ; str_seq 3 "c"
      ]
    in
    let paths = enumerate test_sets_print in
    L.iter paths ~f:(fun path -> print_endline (S.concat path ~sep:" -> "));
    printf "%s\nTOTAL: %d\n" (S.make 79 '-') (count test_sets_print);
    assert (count ([[1; 1; 1]; [2; 2; 2]; [3; 3; 3]]) = 27)
end


let () =
  StateSpace.tests ()