Last active
August 29, 2015 13:55
-
-
Save chris-taylor/8699351 to your computer and use it in GitHub Desktop.
Revisions
-
chris-taylor revised this gist
Jan 30, 2014 . 1 changed file with 26 additions and 7 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,4 +1,13 @@ (* Define monadic operations for a list *) let return x = [x] let (>>=) lst f = List.concat (List.map f lst) (* Generate the combinations of k distinct objects from a list *) (* Simple version let rec combnk k lst = if k = 0 then [[]] @@ -7,28 +16,38 @@ let rec combnk k lst = | [] -> [] | x :: xs -> List.map (fun z -> x :: z) (combnk (k - 1) xs) :: inner xs in List.concat (inner lst) *) let rec combnk k lst = if k = 0 then [[]] else match lst with | [] -> [] | x :: xs -> (combnk (k - 1) xs >>= fun comb -> return (x :: comb)) @ combnk k xs (* Set difference for lists *) let rec set_diff xs ys = match xs with | [] -> [] | h :: t -> if List.mem h ys then set_diff t ys else h :: set_diff t ys (* Sort a list into subgroups of specific sizes. For example, # group ["a";"b";"c";"d"] [2;1];; - : string list list list = [[["a"; "b"]; ["c"]]; [["a"; "c"]; ["b"]]; [["b"; "c"]; ["a"]]; [["a"; "b"]; ["d"]]; [["a"; "c"]; ["d"]]; [["b"; "c"]; ["d"]]; [["a"; "d"]; ["b"]]; [["b"; "d"]; ["a"]]; [["a"; "d"]; ["c"]]; [["b"; "d"]; ["c"]]; [["c"; "d"]; ["a"]]; [["c"; "d"]; ["b"]]] *) let rec group lst sizes = match sizes with | [] -> [[]] | h :: t -> combnk h lst >>= fun grp -> -
Jan 29, 2014 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,48 @@ (* Generate the combinations of k distinct objects from a list *) let rec combnk k lst = if k = 0 then [[]] else let rec inner = function | [] -> [] | x :: xs -> List.map (fun z -> x :: z) (combnk (k - 1) xs) :: inner xs in List.concat (inner lst) (* Define monadic operations for a list *) let return x = [x] let (>>=) lst f = List.concat (List.map f lst) (* Set difference for lists *) let rec set_diff xs ys = match xs with | [] -> [] | h :: t -> if List.mem h ys then set_diff t ys else h :: set_diff t ys (* Sort a list into subgroups of specific sizes. For example, # group ["a";"b";"c";"d"] [2;1];; - : string list list list = [[["a"; "b"]; ["c"]]; [["a"; "c"]; ["b"]]; [["b"; "c"]; ["a"]]; [["a"; "b"]; ["d"]]; [["a"; "c"]; ["d"]]; [["b"; "c"]; ["d"]]; [["a"; "d"]; ["b"]]; [["b"; "d"]; ["a"]]; [["a"; "d"]; ["c"]]; [["b"; "d"]; ["c"]]; [["c"; "d"]; ["a"]]; [["c"; "d"]; ["b"]]] *) let rec group lst sizes = match sizes with | [] -> [[]] | h :: t -> combnk h lst >>= fun grp -> group (set_diff lst grp) t >>= fun grps -> return (grp :: grps) (* I belive that the non-monadic code looks something like this: let rec group (lst : 'a list) (sizes : int list) : 'a list list list = match sizes with | [] -> [[]] | h :: t -> let f gr = List.map (fun z -> gr :: z) (group (set_diff lst gr) t) in let grps = combnk h lst in List.concat (List.map f grps) *)