Combine Lists with Same Heads in a 2D List (OCaml)

I'm working with a list of lists in OCaml, and I'm trying to write a function that combine开发者_运维技巧s all of the lists that share the same head. This is what I have so far, and I make use of the List.hd built-in function, but not surprisingly, I'm getting the failure "hd" error:

let rec combineSameHead list nlist = match list with
 | [] -> []@nlist
 | h::t -> if List.hd h = List.hd (List.hd t)
    then combineSameHead t nlist@uniq(h@(List.hd t))
    else combineSameHead t nlist@h;;

So for example, if I have this list:

[[Sentence; Quiet]; [Sentence; Grunt]; [Sentence; Shout]]

I want to combine it into:

[[Sentence; Quiet; Grunt; Shout]]

The function uniq I wrote just removes all duplicates within a list. Please let me know how I would go about completing this. Thanks in advance!

---

For one thing, I generally avoid functions like List.hd, as pattern maching is usually clearer and less error-prone. In this case, your if can be replaced with guarded patterns (a when clause after the pattern). I think what is happening to cause your error is that your code fails when t is []; guarded patterns help avoid this by making the cases more explicit. So, you can do (x::xs)::(y::ys)::t when x = y as a clause in your match expression to check that the heads of the first two elements of the list are the same. It's not uncommon in OCaml to have several successive patterns which are identical except for guards.

Further things: you don't need []@nlist - it's the same as just writing nlist.

Also, it looks like your nlist@h and similar expressions are trying to concatenate lists before passing them to the recursive call; in OCaml, however, function application binds more tightly than any operator, so it actually appends the result of the recursive call to h.

I don't, off-hand, have a correct version of the function. But I would start by writing it with guarded patterns, and then see how far that gets you in working it out.

---

Your intended operation has a simple recursive description: recursively process the tail of your list, then perform an "insert" operation with the head which looks for a list that begins with the same head and, if found, inserts all elements but the head, and otherwise appends it at the end. You can then reverse the result to get your intended list of list.

In OCaml, this algorithm would look like this:

let process list = 
  let rec insert (head,tail) = function
    | [] -> head :: tail 
    | h :: t -> 
      match h with 
      | hh :: tt when hh = head -> (hh :: (tail @ t)) :: t 
      | _ -> h :: insert (head,tail) t
  in
  let rec aux = function 
    | [] -> []
    | [] :: t -> aux t
    | (head :: tail) :: t -> insert (head,tail) (aux t) 
  in
  List.rev (aux list)

---

Consider using a Map or a hash table to keep track of the heads and the elements found for each head. The nlist auxiliary list isn't very helpful if lists with the same heads aren't adjacent, as in this example:

# combineSameHead [["A"; "a0"; "a1"]; ["B"; "b0"]; ["A"; "a2"]]
- : list (list string) = [["A"; "a0"; "a1"; "a2"]; ["B"; "b0"]]

---

I probably would have done something along the lines of what antonakos suggested. It would totally avoid the O(n) cost of searching in a list. You may also find that using a StringSet.t StringMap.t be easier on further processing. Of course, readability is paramount, and I still find this hold under that criteria.

module OrderedString =
    struct
        type t = string
        let compare = Pervasives.compare
    end

module StringMap = Map.Make (OrderedString)
module StringSet = Set.Make (OrderedString)

let merge_same_heads lsts =
    let add_single map = function
        | hd::tl when StringMap.mem hd map ->
            let set = StringMap.find hd map in
            let set = List.fold_right StringSet.add tl set in
            StringMap.add hd set map
        | hd::tl ->
            let set = List.fold_right StringSet.add tl StringSet.empty in
            StringMap.add hd set map
        | []     ->
            map
    in
    let map = List.fold_left add_single StringMap.empty lsts in
    StringMap.fold (fun k v acc-> (k::(StringSet.elements v))::acc) map []

---

You can do a lot just using the standard library:

(* compares the head of a list to a supplied value.  Used to partition a lists of lists *)
let partPred x = function h::_ -> h = x
  | _ -> false

let rec combineHeads = function [] -> []
  | []::t -> combineHeads t (* skip empty lists *)
  | (hh::_ as h)::t -> let r, l = List.partition (partPred hh) t in (* split into lists with the same head as the first, and lists with different heads *)
  (List.fold_left (fun x y -> x @ (List.tl y)) h r)::(combineHeads l) (* combine all the lists with the same head, then recurse on the remaining lists *)

combineHeads [[1;2;3];[1;4;5;];[2;3;4];[1];[1;5;7];[2;5];[3;4;6]];;
- : int list list = [[1; 2; 3; 4; 5; 5; 7]; [2; 3; 4; 5]; [3; 4; 6]]

This won't be fast (partition, fold_left and concat are all O(n)) however.