ocamlの同一キーの合成

Question

###やりたいこと
[("apple", 1); ("grape", 1) ; ("apple", 2); ("grape", 3); ("melon", 3); ("banana", 3)]
(=List)

というリストをキーが同じものをまとめて

[("apple", [1;2]) ; ("grape", [1;3]) ; ("melon", [3]) ; ("banana", [3])]
というリストにしたい

以下に思考の殴り書きのような形で，思いついたことを書かせていただきます．

###考えた方法

# let synthe pair1 pair2 =
    if (fst (pair1)) = (fst (pair2)) then (fst (pair1), [snd (pair1) ; snd (pair2)])
    else (fst (pair1), [snd (pair1)]);;
val trya : 'a * 'b -> 'a * 'b -> 'a * 'b list = <fun>
# synthe ("app",1) ("app", 2);;
- : string * int list = ("app", [1; 2])
# synthe ("app",1) ("apple", 2);;
- : string * int list = ("app", [1])

h::restでListの先頭を取ってrest中の全要素について上記のsyntheを行い，
再帰でrestについてh::restとし，同様に行う
つまり

match List with 
  |[] -> []
  | h::rest -> (syntheで作ったもの)::(この関数名)　(restなどの引数)

を改善したようにする．

###問題点
このままでは合成したものの残りかすが出現してしまう．
例えば
上の例では("apple", [1;2]) と　("apple", [2])の二つが出来てしまう
また，「h::restでListの先頭を取ってrest中の全要素について上記のsyntheを行い」の部分の具体的な実装が分からない

###考えた方法2
Listを辞書順にソートし，となり合ったものの第一項を見て一緒ならまとめる，異なるならば注目する組を移す

[("apple", 1); ("grape", 1) ; ("apple", 2); ("grape", 3); ("melon", 3); ("banana", 3)]
→[●("apple", 1); ("apple", 2)　;("grape", 1) ; ("grape", 3); ("melon", 3); ("banana", 3)]
→[●("apple", [1;2]) ;("grape", 1) ; ("grape", 3); ("melon", 3); ("banana", 3)]
→[("apple", [1;2]) ; ●("grape", [1]) ; ("grape", 3); ("melon", 3); ("banana", 3)]
...
→[("apple", [1;2]) ; ("grape", [1]) ; ("grape", [3]); ("melon", [3]); ●("banana", [3])]

のような動き(●は注目してる組)

###問題点2
シンプルなリストのソートは出来るが，組のリストのソートはList.sortでは無理だった．

###お聞きしたいこと
・上記の考え方の補強となる考え方
・同じことができる他のアルゴリズム

宜しくお願いいたします．

Answer 1

「考えた方法2」で進めるのが良さそうに思いました。

シンプルなリストのソートは出来るが，組のリストのソートはList.sortでは無理だった．

手元で試してみたところList.sortでソートできました。compare関数を使います。

(* string * int型は比較できる *)
# ("apple", 1) <= ("apple", 2);;
- : bool = true

# compare;;
- : 'a -> 'a -> int = <fun>

(* 左 < 右のときはマイナス値、左 = 右のときは0、左 > 右のときはプラス値を返す *)
# compare ("apple", 1) ("apple", 2);;
- : int = -1

# compare ("apple", 1) ("banana", 1);;
- : int = -1

# let l = [("apple", 1); ("grape", 1) ; ("apple", 2); ("grape", 3); ("melon", 3); ("banana", 3)];;

# List.sort compare l;;
- : (string * int) list =
[("apple", 1); ("apple", 2); ("banana", 3); ("grape", 1); ("grape", 3); ("melon", 3)]

---

となり合ったものの第一項を見て一緒ならまとめる，異なるならば注目する組を移す

こういう集計っぽいものが入っている処理は、多くの場合foldで処理できます。

たとえば以下のようにfold_leftで処理する場合、

List.fold_left (fun acc item -> ...) [] [("apple", 1); ("apple", 2); ("banana", 3); ...]

以下のように結果のリストを作り上げていきます。（accとitemはfold_leftに渡す匿名関数の引数。->はその関数からの戻り値で、次のaccになります）

acc:  []
item: ("apple", 1)
   -> [("apple", [1])]

acc:  [("apple", [1])]
item: ("apple", 2) 
   -> [("apple", [2; 1])]

acc:  [("apple", [2; 1])]
item: ("banana", 3)
   -> [("banana", [3]); ("apple", [2; 1])]

匿名関数ではaccのheadとitemについてそれぞれの第一項を比較して、まとめるかどうかを判断します。

なお、上の例のようにfold_leftを使うと結果のリストの順番が逆転してしまいます。fold_rightを使うと逆転しないのですが、巨大なリストを処理しようとすると、再帰呼び出しの積み重なりが多すぎてスタックオーバーフローエラーになることがあります。事前にリストの長さが短いとわかっていない限りはfold_leftを使うのが無難です。

このfold_leftの逆転問題は、入力となるリストを逆順にソートしておくことで解決できます。以下のようにcompareの返す値の正負を逆転すると逆順にソートできます。

# List.sort (fun x y -> ~- (compare x y)) l;;
- : (string * int) list =
[("melon", 3); ("grape", 3); ("grape", 1); ("banana", 3); ("apple", 2); ("apple", 1)]

---

追記

コメント欄でLists.fold_leftを使わない方法で完成したとの連絡を受けました。完成してよかったです！

参考までにLists.fold_leftを使った方法を追記します。

# let l = [("apple", 1); ("grape", 1) ; ("apple", 2); ("grape", 3); ("melon", 3); ("banana", 3)];;
val l : (string * int) list =
  [("apple", 1); ("grape", 1); ("apple", 2); ("grape", 3); ("melon", 3); ("banana", 3)]

# let l' = List.sort (fun x y -> ~- (compare x y)) l;;
val l' : (string * int) list =
  [("melon", 3); ("grape", 3); ("grape", 1); ("banana", 3); ("apple", 2); ("apple", 1)]

# let f = fun acc item ->
      match (item, acc) with
      (* 第一項が一緒なのでまとめる *)
      | ((x, y), (x', ys)::rest) when x = x' -> (x, y::ys)::rest
      (* 第一項が異なる。（accが[]のときも含む） *)
      | ((x, y), _) -> (x, [y])::acc;;
val f : ('a * 'b list) list -> 'a * 'b -> ('a * 'b list) list = <fun>

# List.fold_left f [] l';;
- : (string * int list) list =
[("apple", [1; 2]); ("banana", [3]); ("grape", [1; 3]); ("melon", [3])]

Comments

[grape_ll]

丁寧な解説ありがとうございます．
実装の点で1つ解決できない問題に直面したため，質問させていただきます．
fold_leftを用いた実装が具体的に思い浮かばなかったので次の代案で処理しようと考えたのですが，エラーに対処することが出来ない状態です．修正箇所を教えていただけますでしょうか．
#let listing list =
List.map (fun (x,y) -> (x,[y])) list;;
# let rec synthe list ans front =
match list with
| [] -> front::ans
| h::rest -> if (snd (front)) = [0] then synthe rest ans h
else if (fst (front) = fst (h)) then synthe rest ans (fst (h), (snd (h))@(snd(front)))
else synthe rest front::ans h;;
Error: This expression has type 'a * int list
but an expression was expected of type ('a * int list) list
The type variable 'a * int list occurs inside ('a * int list) list

ソートした後にこれを行おうと思っています．
下線部は最後のfrontにひかれていました．
宜しくお願いいたします．

[tatsuya6502]

最後の行ですが、エラーになっていた front::ans のところを () で囲んで、 synthe rest (front::ans) h としたところコンパイルできました。

[grape_ll]

結びつきが弱いのを忘れていました，初歩的なミスですね，気を付けます．
完成しました．ありがとうございます．

[tatsuya6502]

完成してよかったです！　回答にLists.fold_leftを使った例を追記しましたので、よかったら参考にしてください。

[grape_ll]

ありがとうございます．そちらの方法も参照させていただきます．