第6章
100を作る
（やさしい版）
Pearls of Functional Algorithm Design（関数プログラミングによるアルゴリズム設計の真珠）
どんな問題？
数字を 1, 2, 3, 4, 5, 6, 7, 8, 9 の順に並べたまま、そのあいだに + と × を好きな場所に挿入して、合計を 100 にする方法をすべて挙げよという問題です。
たとえば、こんな組み合わせが答えになります。
100 = 12 + 34 + 5×6 + 7 + 8 + 9
100 = 1 + 2×3 + 4 + 5 + 67 + 8 + 9
ルールは 2 つだけです。
- 括弧は使えない。
- × は + よりも先に計算する（普通の四則演算のルール）。
この章のテーマ
素直に解こうとすると、可能な式をすべて調べる網羅探索（exhaustive search）しかありません。この章では、まず「網羅探索を速くするための一般的な理論」を作り、それを 100 を作る問題に当てはめて枝刈りによる大幅な高速化を導きます。
ちょっとした理論
登場人物：3 つの型と 3 つの関数
網羅探索を抽象化するために、次の 3 つの型と 3 つの関数を用意します。
candidates :: Data → [Candidate]
value :: Candidate → Value
good :: Value → Bool
Dart
// 抽象的な網羅探索の道具立て（型は任意なのでジェネリクスで表現）
typedef Candidates<D, C> = List<C> Function(D data);
typedef ValueFn<C, V> = V Function(C c);
typedef Good<V> = bool Function(V v);
- candidates は入力データからすべての候補を並べる関数。
- value は候補を評価してその値を出す関数。
- good は値が「合格」かどうか判定する関数（今回なら「100 と等しいか？」）。
これら 3 つを組み合わせて、探索本体 solutions は次のように定義できます。
solutions :: Data → [Candidate]
solutions = filter (good · value) · candidates
Dart
// solutions = 全候補を並べて value が good なものだけ残す
List<C> solutionsNaive<D, C, V>(
Candidates<D, C> candidates,
ValueFn<C, V> value,
Good<V> good,
D data,
) {
return candidates(data).where((c) => good(value(c))).toList();
}
意味は「全候補を並べて、値が合格なものだけを残す」という素直なものです。
遅延評価のメリット
Haskell は遅延評価なので、「1 つだけ解が欲しい」ときも、必要になった分だけ計算されます。全部並べてから絞る書き方でも無駄がありません。
仮定その1：候補は foldr で組み立てられる
Data はデータの列 [Datum] だと考え、candidates を次の形で作れると仮定します。
candidates = foldr extend [ ] (6.1)
ここで extend は「新しいデータを 1 つ受け取り、今までの候補リストを拡張する」関数です。foldr は「右から順に extend を適用していく」高階関数で、空リストから出発して候補をだんだん増やしていきます。
直観
100 を作る問題なら、extend は「今ある式の全パターンに、新しい数字 x を先頭に付け足す」役割になります。
仮定その2：good より緩い ok を用意する
枝刈りの鍵になる仮定です。good よりも判定が緩い述語 ok を用意し、次の 2 つを要求します。
- 合格するものは必ず ok でもある：good v ⇒ ok v。
- したがって最終フィルタは ok で先に絞ってから good を見ても同じ結果になる：
filter (good · value) = filter (good · value) · filter (ok · value) (6.2)
さらに強く、「ok な値をもつ候補は、ok な候補を拡張して作られる」ことも仮定します。
filter (ok · value) · extend x
= filter (ok · value) · extend x · filter (ok · value) (6.3)
言い換えると、拡張の途中で ok から外れたものは捨ててよいということです。ここが枝刈りの根本です。
100 を作るなら
途中まで作った式の値がすでに 100 を超えているなら、そこから + と × をどう足しても 100 ちょうどには戻れません（+ も × も値を減らさないため）。だから「値 ≤ 100」を ok にすれば安全に枝刈りできます。
foldr の融合則で書き換える
(6.1)〜(6.3) を組み合わせて計算してみます。
solutions
= {solutions の定義}
filter (good · value) · candidates
= {等式 (6.1)}
filter (good · value) · foldr extend [ ]
= {等式 (6.2)}
filter (good · value) · filter (ok · value) · foldr extend [ ]
= {extend′ x = filter (ok · value) · extend x とおく}
filter (good · value) · foldr extend′ [ ]
最後のステップで使ったのが foldr の融合則（fusion law）です。融合則は次のことを言います。
融合則（foldr fusion）
次の 3 つが満たされるとき、
f ·
foldr g a =
foldr h b と書き換えられる。
- (i) f が正格関数である（⊥ を ⊥ に写す）。
- (ii) f a = b。
- (iii) すべての x, y について f (g x y) = h x (f y)。
ざっくり言うと「後付けの処理
f を、
foldr のステップの中に取り込める」規則です。
これで次の書き換えができました。
solutions = filter (good · value) · foldr extend′ [ ]
新しい版のよさは、各段階で ok を満たすものだけしか候補リストに残さないため、リストが劇的に小さくなり得ることです。
残る問題
extend′ の中で value を毎回呼び直しているのが気になります。次はこの再計算をなくしにいきます。
仮定その3：値は「作り直せる」
拡張と同時に値も更新できるように、もう 1 つ仮定を置きます。
map value · extend x = modify x · map value (6.4)
これは「拡張後の候補の値は、元の候補の値だけから modify x で作れる」という主張です。これで value を毎回計算し直さずに済みます。
そこで候補生成を「候補と値のペア」を作るように書き換えます。
candidates = map (fork (id, value)) · foldr extend′ [ ]
ここで fork (f, g) x = (f x, g x) です。つまり fork (id, value) は「候補 x を (x, value x) のペアに変える」役です。
この形をもう一度 foldr の融合則にかけるために、以下を満たす関数 expand を探します。
map (fork (id, value)) · extend′ x
= expand x · map (fork (id, value))
これが見つかれば candidates = foldr expand [ ] になります。
配管用の 6 つの規則
expand を導くために、fork にまつわるおなじみの規則を集めておきます。
fst · fork (f, g) = f および snd · fork (f, g) = g (6.5)
fork (f, g) · h = fork (f · h, g · h) (6.6)
次は cross です。cross (f, g) (x, y) = (f x, g y) と定義すると、
fork (f · h, g · k) = cross (f, g) · fork (h, k) (6.7)
次の 2 つの規則は zip と unzip を fork でとらえるためのものです。
unzip :: [(a, b)] → ([a], [b])
unzip = fork (map fst, map snd)
zip :: ([a], [b]) → [(a, b)] は zip · unzip = id で規定されます。1
用語の直観
- fork (f, g): 同じ入力を 2 つの関数に通し、結果をペアに束ねる。
- cross (f, g): ペアの左右をそれぞれ別の関数で処理する。
- zip: 2 つのリストを対応させてペアのリストにする。
- unzip: ペアのリストを、左だけ／右だけのリスト 2 本に分ける。
順に計算すると、次の 2 つの重要な等式が得られます。
fork (map f, map g) = unzip · map (fork (f, g)) (6.8)
map (fork (f, g)) = zip · fork (map f, map g) (6.9)
そして fork と filter をつなぐ最後の規則：
map (fork (f, g)) · filter (p · g)
= filter (p · snd) · map (fork (f, g)) (6.10)
(6.10) がなぜうれしいか
左辺は「フィルタで残った各要素にもう一度 g を計算する」動きですが、右辺は「先にペアを作っておいてから snd（＝計算済みの g の値）を見る」ので、g は各要素につき 1 回で済みます。
最終形の導出
いよいよ最終計算に入ります。まず extend′ の定義と (6.10) から、
map (fork (id, value)) · extend′ x
= {extend′ の定義}
map (fork (id, value)) · filter (ok · value) · extend x
= {(6.10)}
filter (ok · snd) · map (fork (id, value)) · extend x
後ろの 2 項をさらに書き換えます。
map (fork (id, value)) · extend x
= {(6.9) と map id = id}
zip · fork (id, map value) · extend x
= {(6.6)}
zip · fork (extend x, map value · extend x)
= {(6.4)}
zip · fork (extend x, modify x · map value)
= {(6.7)}
zip · cross (extend x, modify x) · fork (id, map value)
= {(6.8)}
zip · cross (extend x, modify x) · unzip · map (fork (id, value))
ふたつの計算を合わせると、solutions の最終版が得られます。
solutions = map fst · filter (good · snd) · foldr expand [ ]
expand x = filter (ok · snd) · zip · cross (extend x, modify x) · unzip
まとめ（最終版のレシピ）
- foldr expand [ ] が「候補 + 値」のペアのリストを作る。
- expand x は、拡張と modify による値の更新をペアのままセットで行い、ok を満たさないペアは捨てる。
- 最後に good で仕上げのフィルタをかけ、値を落として候補だけ取り出す。
必要なのは
good、
ok、
extend、
modify の 4 つを与えることだけです。
100を作る
式・項・因子の型
ここから本題に戻ります。候補となる式は「項の和」で、各項は「因子の積」、各因子は「数字の列」です。型シノニムで表すと、次のようになります。
type Expression = [Term]
type Term = [Factor]
type Factor = [Digit]
type Digit = Int
Dart
// 三重リスト：式 = 項のリスト、項 = 因子のリスト、因子 = 数字のリスト
typedef Digit = int;
typedef Factor = List<Digit>;
typedef Term = List<Factor>;
typedef Expression = List<Term>;
つまり Expression は本質的に [[[Int]]] です。三重リストのイメージは「〔項〔因子〔数字…〕…〕…〕」です。
値を計算する関数
valExpr :: Expression → Int
valExpr = sum · map valTerm
valTerm :: Term → Int
valTerm = product · map valFact
valFact :: Factor → Int
valFact = foldl1 (λ n d → 10 ∗ n + d)
Dart
// 式の値 = 各項の和
int valExpr(Expression e) =>
e.map(valTerm).fold(0, (a, b) => a + b);
// 項の値 = 各因子の積
int valTerm(Term t) =>
t.map(valFact).fold(1, (a, b) => a * b);
// 因子の値 = 数字列を左から10進で連結（[1,2,3] -> 123）
int valFact(Factor f) =>
f.reduce((n, d) => 10 * n + d);
valFact は数字のリストを整数にする関数です。たとえば [1, 2, 3] を渡すと ((1·10+2)·10+3) = 123 になります。
「良い」式は値が 100 のものです。
good :: Int → Bool
good v = (v == 100)
Dart
bool good(int v) => v == 100;
式をすべて生成する
expressions は与えられた数字リストから作れる式をすべて列挙する関数です。2 通りの作り方があります。
方法1：リストをあらゆる方法で連続した部分リストに分割する標準関数 partitions（型 [a] → [[[a]]]）を 2 回重ねる。
expressions :: [Digit] → [Expression]
expressions = concatMap partitions · partitions
Dart
// リストを「連続した部分リストの列」に分割する全パターン
// partitions [1,2,3] = [[[1,2,3]], [[1],[2,3]], [[1,2],[3]], [[1],[2],[3]]]
List<List<List<T>>> partitions<T>(List<T> xs) {
if (xs.isEmpty) return [];
if (xs.length == 1) return [[[xs[0]]]];
final head = xs.first;
final rest = xs.sublist(1);
final result = <List<List<T>>>[];
for (final p in partitions(rest)) {
// head を先頭のブロックの頭にくっつける
result.add([[head, ...p.first], ...p.sublist(1)]);
// head を独立した新ブロックにする
result.add([[head], ...p]);
}
return result;
}
// 方法1：数字列 → 項への分割 → 各項を因子への分割
List<Expression> expressionsV1(List<Digit> ds) {
// 因子列 t : List<Digit> を「因子への全分割」= List<Term> に変える
List<Term> termChoices(List<Digit> t) =>
partitions(t).map((factors) => factors).toList();
return partitions(ds).expand((termParts) {
// 各項の因子分割の直積で式を組み立てる
List<Expression> acc = [<Term>[]];
for (final t in termParts) {
final choices = termChoices(t);
acc = [
for (final e in acc)
for (final term in choices) [...e, term],
];
}
return acc;
}).toList();
}
方法2：foldr で 1 桁ずつ足していく。
extend :: Digit → [Expression] → [Expression]
extend x [ ] = [[[[x]]]]
extend x es = concatMap (glue x) es
glue :: Digit → Expression → [Expression]
glue x ((xs : xss) : xsss) = [((x : xs) : xss) : xsss,
([x] : xs : xss) : xsss,
[[x]] : (xs : xss) : xsss]
Dart
// 1 桁 x を全ての式の左端に付け足す（3 通り）
List<Expression> extend(Digit x, List<Expression> es) {
if (es.isEmpty) {
return [[[[x]]]]; // 空なら [[[[x]]]]
}
return es.expand((e) => glue(x, e)).toList();
}
List<Expression> glue(Digit x, Expression e) {
// e = (xs : xss) : xsss を Dart で分解
final firstTerm = e.first; // (xs : xss)
final xs = firstTerm.first; // 先頭因子
final xss = firstTerm.sublist(1); // 残りの因子
final xsss = e.sublist(1); // 残りの項
return [
// 1) 先頭因子の頭に x をくっつける
[[[x, ...xs], ...xss], ...xsss],
// 2) × で新しい因子を始める
[[[x], xs, ...xss], ...xsss],
// 3) + で新しい項を始める
[[[x]], [xs, ...xss], ...xsss],
];
}
// foldr extend [] : 数字列から全ての式を生成（方法2）
List<Expression> expressionsV2(List<Digit> ds) {
List<Expression> acc = [];
for (final x in ds.reversed) {
acc = extend(x, acc);
}
return acc;
}
glue の 3 つの選択肢
1 桁の数字
x を式の左端に付け足す方法は、ちょうど 3 通りです。
- 先頭因子の頭に x をくっつける（例：34 の頭に 1 → 134）。
- 新しい因子として × でつなぐ（× で新しい因子を始める）。
- 新しい項として + でつなぐ（+ で新しい項を始める）。
だから
n 桁の数字列に対して式の総数は 3
n−1 通り。1〜9 なら 3
8 = 6561 通りになります。
素朴な探索の結果
filter (good · valExpr) · expressions を実行すると、答えは 7 通り見つかります。
100 = 1×2×3 + 4 + 5 + 6 + 7 + 8×9
100 = 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8×9
100 = 1×2×3×4 + 5 + 6 + 7×8 + 9
100 = 12 + 3×4 + 5 + 6 + 7×8 + 9
100 = 1 + 2×3 + 4 + 5 + 67 + 8 + 9
100 = 1×2 + 34 + 5 + 6×7 + 8 + 9
100 = 12 + 34 + 5×6 + 7 + 8 + 9
候補は 6561 通りしかないので、この探索はすぐ終わります。しかし別の目標値や、もっと多くの数字を扱う場面のことを考えて、高速化の余地を探ってみましょう。
ok の設計：値 ≤ 目標値
先ほどの理論を使うには、good より緩い ok が必要でした。目標値 c に対して good v = (v == c) なので、自然な ok は次のものです。
ok v = (v ≤ c)
+ も × も（正の数のあいだでは）値を減らさないので、途中で c を超えたら二度と戻ってきません。だから「値 ≤ c」で切ってよいのです。
modify を作るための工夫
次に modify を定義したいのですが、glue x e で作られる新しい式の値は、元の式の値 valExpr e だけからは決まりません。先頭因子の値と先頭項の値も必要です。そこで value を valExpr ではなく、次のような 4 つ組にします。
value ((xs : xss) : xsss) = (10n, valFact xs, valTerm xss, valExpr xsss)
where n = length xs
Dart
// 式から 4 つ組 (k, f, t, e) を作る
// k = 10^n（先頭因子の桁数から決まる係数）
// f = 先頭因子の値, t = 残り因子の積, e = 残り項の和
(int k, int f, int t, int e) value(Expression expr) {
final firstTerm = expr.first;
final xs = firstTerm.first;
final xss = firstTerm.sublist(1);
final xsss = expr.sublist(1);
final n = xs.length;
var k = 1;
for (var i = 0; i < n; i++) {
k *= 10;
}
return (k, valFact(xs), valTerm(xss), valExpr(xsss));
}
4 成分の意味は次のとおりです。
- k = 10n：先頭因子の桁数から決まる係数（valFact (x : xs) を高速に計算するため）。
- f = valFact xs：先頭因子の値。
- t = valTerm xss：先頭項（残りの因子の積）の値。
- e = valExpr xsss：残りの式（先頭項を除いた項の和）の値。
この 4 つ組があれば、modify は次のように書けます。
modify x (k, f, t, e)
= [(10∗k, k∗x + f, t, e), (10, x, f∗t, e), (10, x, 1, f∗t + e)]
Dart
// glue の 3 通りに対応する 4 つ組の更新
List<(int, int, int, int)> modify(
Digit x, (int, int, int, int) v) {
final (k, f, t, e) = v;
return [
(10 * k, k * x + f, t, e), // 1) 頭にくっつける
(10, x, f * t, e), // 2) × で新因子
(10, x, 1, f * t + e), // 3) + で新項
];
}
3 つの結果は、glue の 3 つの選択肢に対応しています。
- 先頭因子の頭に x をくっつける：桁が 1 増え、値は k·x + f。
- × で新しい因子を始める：先頭因子が x（1 桁）にリセットされ、直前の因子は「先頭項の積」に取り込まれて f·t。
- + で新しい項を始める：先頭因子・先頭項がリセットされ、直前の項 f·t が「残りの式の和」に取り込まれる。
これで good と ok も 4 つ組の上で書けます。
good c (k, f, t, e) = (f∗t + e == c)
ok c (k, f, t, e) = (f∗t + e ≤ c)
Dart
// f*t + e が式全体の値。目標値 c と比較する
bool goodC(int c, (int, int, int, int) v) {
final (_, f, t, e) = v;
return f * t + e == c;
}
bool okC(int c, (int, int, int, int) v) {
final (_, f, t, e) = v;
return f * t + e <= c;
}
f∗t + e が式全体の値
f·t は「先頭項の値」で、e は「残りの式の値」。だから f·t + e がその式全体の値になります。良い値は c、ok は c 以下、という単純な形です。
枝刈り付きの網羅探索
4 つ組の情報と modify を expand の枠組みに入れると、次のプログラムが得られます。
solutions c = map fst · filter (good c · snd) · foldr (expand c) [ ]
expand c x = filter (ok c · snd) · zip · cross (extend x, modify x) · unzip
さらに、expand は 4 つ組を候補と一緒に扱うので、次のように直接書き下せます。
expand c x [ ] = [([[[x]]], (10, x, 1, 0))]
expand c x evs = concat (map (filter (ok c · snd) · glue x) evs)
glue x ((xs : xss) : xsss, (k, f, t, e)) =
[(((x : xs) : xss) : xsss, (10∗k, k∗x + f, t, e)),
(([x] : xs : xss) : xsss, (10, x, f∗t, e)),
([[x]] : (xs : xss) : xsss, (10, x, 1, f∗t + e))]
Dart
// 式と 4 つ組を一緒に持つペア
typedef EV = (Expression expr, (int k, int f, int t, int e) v);
// glue の 3 通り（式と値をセットで作る）
List<EV> gluePaired(Digit x, EV ev) {
final (expr, v) = ev;
final (k, f, t, e) = v;
final firstTerm = expr.first;
final xs = firstTerm.first;
final xss = firstTerm.sublist(1);
final xsss = expr.sublist(1);
return [
([[[x, ...xs], ...xss], ...xsss], (10 * k, k * x + f, t, e)),
([[[x], xs, ...xss], ...xsss], (10, x, f * t, e)),
([[[x]], [xs, ...xss], ...xsss], (10, x, 1, f * t + e)),
];
}
// 枝刈り付き expand：ok を満たさない候補は即座に捨てる
List<EV> expandC(int c, Digit x, List<EV> evs) {
if (evs.isEmpty) {
return [([[[x]]], (10, x, 1, 0))];
}
return evs
.expand((ev) => gluePaired(x, ev).where((n) => okC(c, n.$2)))
.toList();
}
// solutions c = foldr (expand c) [] してから good で仕上げ
List<Expression> solutions(int c, List<Digit> ds) {
List<EV> acc = [];
for (final x in ds.reversed) {
acc = expandC(c, x, acc);
}
return acc.where((ev) => goodC(c, ev.$2)).map((ev) => ev.$1).toList();
}
実測結果
この solutions c は最初の版と比べて何倍も高速です。試しに c = 1000、入力を π の先頭 14 桁にすると、200 倍以上速く動いたとのことです。値を超えた候補を早い段階で捨てられるため、探索空間が一気に縮むのです。
Dart
// 式を "12 + 34 + 5×6 + 7 + 8 + 9" のような文字列に整形
String showExpr(Expression e) => e
.map((t) => t.map((f) => f.join()).join('×'))
.join(' + ');
void main() {
final digits = [1, 2, 3, 4, 5, 6, 7, 8, 9];
// 素朴版：全 6561 通りから value == 100 を抽出
final naive = expressionsV2(digits)
.where((e) => good(valExpr(e)))
.toList();
print('naive : ${naive.length} 通り');
for (final e in naive) {
print(' 100 = ${showExpr(e)}');
}
// 枝刈り版：4 つ組と ok(v <= c) で途中打ち切り
final pruned = solutions(100, digits);
print('pruned: ${pruned.length} 通り');
// 期待：どちらも 7 通り、内容も一致
}
最後に
100 を作る問題は Knuth (2006) の演習 122 でも扱われています。そちらでは、括弧を認めたり、割り算や引き算などの演算子を追加したりする変種も考えられています。本書の後半にある Countdown の pearl（Pearl 20）も同系統の問題です。
この章の 2 つの教訓
- 候補と値をペアで持ち歩く：ある基準を値が満たす候補を探したいとき、候補の生成と値の生成を組にすれば、値の再計算を避けられる。今回のように普通は「候補と値を一緒に管理すればよい」と直感で分かるが、そこには本章のようなきちんとしたレシピが存在する。
- good を ok に緩められないか考える：どの候補についても保たれる、より緩い判定 ok が作れれば、そこで枝刈りができて探索が小さくなる。今回は「合計が目標値 c ちょうど」を「合計 ≤ c」に緩めるのが決め手だった。
参考文献
Knuth, D. E. (2006). The Art of Computer Programming, Volume 4, Fascicle 4: Generating All Trees. Reading, MA: Addison-Wesley.