第8章
貪欲アルゴリズムをほどく
（やさしい版）
Pearls of Functional Algorithm Design（関数プログラミングによるアルゴリズム設計の真珠）
どんな問題？
ある文字の並び（列）が与えられたとき、それをいくつかの「昇順に並んだ部分列」に分解したいとします。しかも、分解のしかたはできるだけ少ない本数にしたい――これが今回のテーマです。
「ほどく」ってどういうこと？
たとえば "accompany" という文字列を考えてみましょう。これを、順番を混ぜ合わせれば元に戻せるような、いくつかの部分列にバラすことを、unravel（ほどき）と呼びます。
"accompany" を "acm", "an", "copy" の3本にほどける。- 順番は問わないが、重複は数える。たとえば
"peptet" は "pet" を2本、というほどき方ができる。
upravel（上昇するほどき方）
そのなかでも、どの部分列も昇順（弱増加）になっているほどき方を upravel と呼びます。
"acm", "an", "copy" はすべて昇順なので、"accompany" の upravel。"aany", "ccmp", "o" も別の upravel。- 1文字ずつバラバラにすれば必ず upravel になるので、upravel は必ず1つは存在する。
目標
すべての upravel のなかから、本数（サイズ）が最も少ないものを1つ求めたい。これを「最短 upravel（shortest upravel）」と呼び、これを求める関数を supravel と書く。
仕様
最短 upravel を求める関数 supravel は、日本語で書けば「すべての unravel を作る → 昇順のものだけ残す → その中で長さ最小のものを選ぶ」という3段構えです。
supravel :: Ord a ⇒ [a] → [[a]]
supravel = minBy length · filter (all up) · unravels
Dart
// 仕様: 全 unravel を作り、昇順のものだけ残し、その中で最短のもの
// (計算量は爆発するが仕様として)
List<List<T>> supravelSpec<T extends Comparable<T>>(List<T> xs) {
final all = unravelsSpec(xs).where((ur) => ur.every(isUp)).toList();
all.sort((a, b) => a.length.compareTo(b.length));
return all.first;
}
bool isUp<T extends Comparable<T>>(List<T> xs) {
for (var i = 1; i < xs.length; i++) {
if (xs[i - 1].compareTo(xs[i]) > 0) return false;
}
return true;
}
- minBy f は「f を最小にする要素を(どれか1つ)返す」という非決定的な関数（前章で登場）。
- up は「引数が昇順かどうか」を判定する述語。
- unravels は「与えられた列のあらゆる unravel を全部列挙する」関数。
unravels は、先頭から1文字ずつ処理していくかたちで、次のように帰納的に書けます。
unravels :: [a] → [[[a]]]
unravels = foldr (concatMap · prefixes) [[ ]]
prefixes x [ ] = [[[x]]]
prefixes x (xs : xss) = [(x : xs) : xss] ++ map (xs :) (prefixes x xss)
Dart
// prefixes x ur: x を ur のどれかの列の先頭に付ける全パターン
List<List<List<T>>> prefixes<T>(T x, List<List<T>> ur) {
if (ur.isEmpty) {
return [
[
[x]
]
];
}
final xs = ur.first;
final xss = ur.sublist(1);
final head = [
[x, ...xs],
...xss,
];
final rest = prefixes(x, xss).map((yss) => [xs, ...yss]).toList();
return [head, ...rest];
}
// unravels xs: xs のあらゆる unravel を列挙
List<List<List<T>>> unravelsSpec<T>(List<T> xs) {
List<List<List<T>>> acc = [[]];
for (final x in xs.reversed) {
acc = [for (final ur in acc) ...prefixes(x, ur)];
}
return acc;
}
prefixes x は「新しい文字 x を、いまある unravel のどこかの列の先頭にくっつける」処理を、あらゆる可能性で行います。
導出
1. まず「昇順のみを残す」条件を融合する
いきなり全 unravel を作ってから昇順のものだけ残す、というのは無駄が多いです。そこで foldr の融合則を使って、「作る段階で最初から昇順になるものだけを作る」ように書き直します。
upravels = filter (all up) · unravels
融合すると、次の upravels が得られます。
upravels :: Ord a ⇒ [a] → [[[a]]]
upravels = foldr (concatMap · uprefixes) [[ ]]
uprefixes x [ ] = [[[x]]]
uprefixes x (xs : xss) = if x ≤ head xs then
[(x : xs) : xss] ++ map (xs :) (uprefixes x xss)
else map (xs :) (uprefixes x xss)
Dart
// uprefixes: x ≤ head xs のときだけ x を先頭付加する (昇順が保たれる)
List<List<List<T>>> uprefixes<T extends Comparable<T>>(T x, List<List<T>> ur) {
if (ur.isEmpty) {
return [
[
[x]
]
];
}
final xs = ur.first;
final xss = ur.sublist(1);
final rest = uprefixes(x, xss).map((yss) => [xs, ...yss]).toList();
if (x.compareTo(xs.first) <= 0) {
final head = [
[x, ...xs],
...xss,
];
return [head, ...rest];
} else {
return rest;
}
}
List<List<List<T>>> upravels<T extends Comparable<T>>(List<T> xs) {
List<List<List<T>>> acc = [[]];
for (final x in xs.reversed) {
acc = [for (final ur in acc) ...uprefixes(x, ur)];
}
return acc;
}
ポイントは、uprefixes x が「先頭が x 以上である列にのみ x を先頭付加する」ようになっている点です。これで昇順性が最初から保たれます。
2. 次に「最短を選ぶ」処理も融合したい
ここが本題です。minBy length と upravels を融合し、以下のように書きたいのです。
minBy length · upravels ⇝ foldr insert [ ]
ここで ⇝（精緻化）は「右辺の答えが左辺の可能な答えのひとつになっている」という関係です。この insert x の仕様は「upravel ur に x を挿入して最短の upravel を作るような操作」です。
minBy length · uprefixes x ⇝ insert x
この融合がうまくいく条件は、次の単調性です。
length ur ≤ length vr
⇒ length (insert x ur) ≤ length (insert x vr) (8.1)
3. しかし (8.1) は成り立たない
反例
"ada" の upravel を2つ考えます。どちらも長さ2で同じです。
["ad", "a"] に "c" を挿入すると、最善は ["ad", "a", "c"]（3本）になる。["aa", "d"] に "c" を挿入すると ["aa", "cd"]（2本）でOK。
同じ長さでも、挿入後は差がついてしまいます。だから length だけで比べる作戦は失敗です。
4. コスト関数を強くする
失敗の原因は、「単なる長さ」よりも「各列の先頭が何か」の方が挿入結果に効く、という点にあります。そこで、各列の先頭だけを取ってソートした列を返す heads を用意します。
heads :: Ord a ⇒ [[a]] → [a]
heads = sort · map head
Dart
// heads ur: 各列の先頭を集めてソートした列
List<T> heads<T extends Comparable<T>>(List<List<T>> ur) {
final hs = ur.map((xs) => xs.first).toList();
hs.sort((a, b) => a.compareTo(b));
return hs;
}
直感的には、heads ur が「大きい」ほど、x をどこかの列の先頭にくっつけやすくなり、本数が増えにくくなります。ところが、単に辞書式順序で heads を比較しても length の大小と一致しないため、これも直接には使えません。
5. 半順序 ⪯ を導入する
そこで、次のような半順序前順序（partial preorder） ⪯ を定義します。
ur ⪯ vr = heads ur ⊴ heads vr
ここで [x1, …, xm] ⊴ [y1, …, yn] とは、次の2つが両方成り立つことを意味します。
- m ≤ n（heads ur のほうが短い、つまり ur のほうが本数が少ない）
- 1 ≤ j ≤ n の各 j について xj ≥ yj（先頭たちが要素ごとに大きい）
この ⪯ は、length を尊重する（ur ⪯ vr なら本数は ur のほうが少ない）ので、minBy length を minWith (⪯) に置き換えても、最短性は失われません。そして、この順序に対して以下の単調性が成り立てば融合できます。
ur ⪯ vr ⇒ insert x ur ⪯ insert x vr (8.2)
これが成り立てば、目的の融合が得られます。
minWith (⪯) · upravels ⇝ foldr insert [ ]
半順序の注意
半順序では、「最小（minimum）」と「極小（minimal）」は違います。最小は「他のすべてより小さい」もの、極小は「それより小さいものが無い」だけのもの。たとえば {{a, b}, {a, c}, {a, b, c}} は ⊆ の下で最小元を持たず、極小元が2つ（{a, b} と {a, c}）あります。今回は minWith(⪯) がちゃんと存在することを、帰納法で確かめる必要があります。
6. insert x を構成する
heads ur = [x1, x2, …, xm] とし（昇順）、xk < x ≤ xk+1 となる k を取ります（xm+1 = ∞ とみなす）。すると、x を各列の先頭に付けたときにできる新しい heads の候補は、以下のようなリスト群となります。
[xk+2, xk+3, …, xm]
[xk+1, xk+3, …, xm]
…
[xk+1, xk+2, …, xm−1]
[xk+1, xk+2, …, xm−1, xm]
このなかで1行目が要素ごとに最大となり、⊴ の下で最小（つまり ⪯ で最小）になります。
結論（貪欲な選び方）
x を挿入するときは、「x 以上である先頭のうち、最も短い（辞書式の意味で、次に小さい）先頭を持つ列の先頭にくっつける」のがベスト。
これを Haskell で書くと、次のようにシンプルに表せます。
insert x [ ] = [[x]]
insert x (xs : xss) = if x ≤ head xs then (x : xs) : xss
else xs : insert x xss
Dart
// 貪欲な挿入: 初めて x 以上になった列の先頭に x を付ける
List<List<T>> insert<T extends Comparable<T>>(T x, List<List<T>> ur) {
if (ur.isEmpty) {
return [
[x]
];
}
final xs = ur.first;
final xss = ur.sublist(1);
if (x.compareTo(xs.first) <= 0) {
return [
[x, ...xs],
...xss,
];
} else {
return [xs, ...insert(x, xss)];
}
}
// supravel: foldr insert [] で最短 upravel を求める
List<List<T>> supravel<T extends Comparable<T>>(List<T> xs) {
List<List<T>> ur = [];
for (final x in xs.reversed) {
ur = insert(x, ur);
}
return ur;
}
insert x ur のあとも、各列の先頭を並べた map head ur は狭義増加のまま保たれます。だから、先頭から順に「初めて x 以上になった列」に x をくっつければよいわけです。
7. 計算量
- 素直に書くと insert x ur は ur の長さに比例した時間（線形）。
- upravel をリストの配列で表して二分探索を使うか、平衡木を使えば、対数時間まで速くできる。
- 結果として、全体は O(n log n) ステップで動作する。
8. 単調性 (8.2) の確認
heads ur = [x1, …, xm] と heads vr = [y1, …, yn] とし、m ≤ n かつ yi ≤ xi とします。挿入後の heads は次のようになります。
heads (insert x ur) = [x1, x2, …, xk, x, xk+2, xk+3, …, xm]
heads (insert x vr) = [y1, y2, …, yℓ, x, xℓ+2, xℓ+3, …, yn]
ここで xk < x ≤ xk+1、yℓ < x ≤ yℓ+1 です。yk ≤ xk なので k ≤ ℓ が言えます。両者を位置合わせして並べれば、yk+1 ≤ x かつ x ≤ xℓ+1 なので、1行目のリストは2行目のリストより要素ごとに大きいと分かります。よって (8.2) が成り立ちます。
まとめ
与えられたリストの最短 upravel は、O(n log n) の貪欲アルゴリズムで求められる。「⪯ に対して単調な insert」を foldr で回すのがコツ。
結びに
最短 upravel の問題は、1984年9月にフランスの Pont-à-Mousson で開かれた IFIP Working Group 2.1 の会合で Lambert Meertens が初めて提起し、解いたものです（Meertens, 1984）。その後、Kaldewaij (1985) がまったく別の解法を発表しました。
Kaldewaij の別解
Kaldewaij の（たった1ページの！）解は、Dilworth の定理の特別な場合を構成的に証明することに基づきます。すなわち、
重要な事実
xs の最短 upravel の大きさは、xs の最長減少部分列（longest decreasing subsequence）の長さに等しい。
最長減少部分列の長さは O(n log n) で求まる有名なアルゴリズムがあるので、同じ計算量で最短 upravel も求まる、ということです。
もう1つの貪欲アルゴリズム
本章は Bird (1992) に基づいており、そこでは次のような unravels の定義から出発する別の貪欲アルゴリズムも紹介されています。
unravels [ ] = [[ ]]
unravels xs = [ys : yss | ys ← subseqs xs, not (null ys),
yss ← unravels (xs \\ ys)]
Dart
// 別定義: 非空部分列 ys と、残り (xs \\ ys) の unravel yss を組み合わせる
List<List<List<T>>> unravelsAlt<T>(List<T> xs) {
if (xs.isEmpty) return [[]];
final result = <List<List<T>>>[];
for (final ys in subseqs(xs)) {
if (ys.isEmpty) continue;
final rest = diff(xs, ys); // xs から ys の要素を順に取り除く
for (final yss in unravelsAlt(rest)) {
result.add([ys, ...yss]);
}
}
return result;
}
// 全ての部分列 (空を含む)
List<List<T>> subseqs<T>(List<T> xs) {
if (xs.isEmpty) return [[]];
final rest = subseqs(xs.sublist(1));
return [...rest, for (final r in rest) [xs.first, ...r]];
}
// Haskell の \\ : xs から ys の各要素を1つずつ削除
List<T> diff<T>(List<T> xs, List<T> ys) {
final result = [...xs];
for (final y in ys) {
final i = result.indexOf(y);
if (i >= 0) result.removeAt(i);
}
return result;
}
この場合、各段階で右端の極大上昇部分列（rightmost maximal upsequence）を取り出せば最短 upravel が得られます。この取り出しは rmu = foldr op [ ]（op は下記）で計算できます。
op x [ ] = [x]
op x (y : ys) = if x ≤ y then x : y : ys else y : ys
Dart
// op x acc: x ≤ 現在の先頭 y なら x を追加、そうでなければ acc をそのまま返す
List<T> op<T extends Comparable<T>>(T x, List<T> acc) {
if (acc.isEmpty) return [x];
final y = acc.first;
if (x.compareTo(y) <= 0) return [x, ...acc];
return acc;
}
// rmu = foldr op [] : 右端の極大上昇部分列を取り出す
List<T> rmu<T extends Comparable<T>>(List<T> xs) {
List<T> acc = [];
for (final x in xs.reversed) {
acc = op(x, acc);
}
return acc;
}
この別解の導出は、原著では演習として残されています。
Dart
// 動作確認
void main() {
final xs = 'accompany'.split('');
final ur = supravel(xs);
print(ur.map((s) => s.join()).toList());
// 例: [ac, a, c, o, mp, an, y] のような最短 upravel (要素数が最小)
// 別解の rmu: 右端の極大上昇部分列
print(rmu(xs).join());
// 例: acopy (accompany の右端極大上昇部分列)
}
参考文献
Bird, R. S. (1992). The smallest upravel. Science of Computer Programming 18, 281–92.
Kaldewaij, A. (1985). On the decomposition of sequences into ascending subsequences. Information Processing Letters 21, 69.
Meertens, L. G. L. T. (1984). Some more examples of algorithmic developments. IFIP WG2.1 Working Paper, Pont-à-Mousson, France. See also An Abstracto Reader prepared for IFIP WG 2.1. Technical Report CWI Note CS-N8702, Centrum voor Wiskunde en Informatica, April 1987.