subsets for reference

Every now and then I need to write a simple combinatorial algorithm. Using monads this is fairly easy and concise, but probably not the fastest way to do it. We start with the definition of a few functions in terms of the List module. The function themselves are kinda of self explanatory. I write this mostly for reference then for real added value.

let return a = [a]
let bind m f = List.flatten (List.map f m)
let mzero = []
let guard b = if b then return () else mzero
let mplus = List.append

let card l = (List.length l)

let rec subsets = function
  |[] -> return []
  |h :: t ->
      bind (subsets t) (fun t1 ->
        mplus (
          bind (return t1) (fun t2 -> return (h :: t2))
        ) (return t1)
      )

(* all subsets with cardinality less then k *)
(* [ x | x <- (subsets X) ; |x| <= k ] *)
let subsets_k k l =
  bind (subsets l) (fun x ->
    bind (guard (card(x) <= k)) (fun _ ->
      return x
    )
  )

(* cartesian product *)
let cartesian l1 l2 =
  bind l1 (fun x ->
    bind l2 (fun y ->
      return (x,y)
    )
  )

let rec permutation = function
  |[] -> return []
  |h::t ->
      bind (permutation t) (fun t1 ->
        List.map (fun h1 -> h1 :: t1) h
      )

The previous version of the code uses the List module. If we want a more space efficient implementation of the same functions, we can use a lazy data structure and substitute the functions in the preamble. In this case, instead of writing a lazy list module from scratch, we simply use the Enum module of ExtLib.

open ExtLib
let return a = let e = Enum.empty () in Enum.push e a ; e
let bind m f = Enum.concat (Enum.map f m)
let mzero = Enum.empty ()
let guard b = if b then return () else mzero
let mplus = Enum.append

In action :

# subsets_k 1 [1;2];;                      
- : int list list = [[2]; [1]; []]
# cartesian [1;2;3] [3;4];;
- : (int * int) list = [(1, 3); (1, 4); (2, 3); (2, 4); (3, 3); (3, 4)]
permutation [[1;2;3;4];[5;6];[7;8;9]];;
- : int list list =
[[1; 5; 7]; [2; 5; 7]; [3; 5; 7]; [4; 5; 7]; [1; 6; 7]; [2; 6; 7]; [3; 6; 7];
 [4; 6; 7]; [1; 5; 8]; [2; 5; 8]; [3; 5; 8]; [4; 5; 8]; [1; 6; 8]; [2; 6; 8];
 [3; 6; 8]; [4; 6; 8]; [1; 5; 9]; [2; 5; 9]; [3; 5; 9]; [4; 5; 9]; [1; 6; 9];
 [2; 6; 9]; [3; 6; 9]; [4; 6; 9]]