今回はベクタを使って fncalc の簡単なサンプルプログラムを作ってみましょう。
最初はデータの探索処理を作ります。ベクタの中からデータを「線形探索」する処理は次のようになります。
リスト : データの探索
def find(x, v)
let i = 0,
k = length(v) in
while i < k and v[i] != x do
i = i + 1;
end
i < k;
end
end
def find1(x, v)
let iter = 0,
k = length(v) in
iter = fn(i)
if i == k then
0;
else
if v[i] == x then
1;
else
iter(i + 1);
end
end
end;
iter(0);
end
end
関数 find はベクタ v の中から引数 x と等しいデータを探します。while 文でリストの要素を一つずつ順番に取り出して x と比較します。等しい場合は繰り返しを中断します。そして、最後に i < k をチェックします。i と k が等しい場合、ベクタの中に x と等しい要素はないので偽 (0) を返します。そうでなければ真 (1) を返します。
関数 find1 は末尾再帰でデータを探索しています。実際の処理は局所関数 iter で行います。i が k と等しい場合、ベクタの中に x と等しい要素は見つからなかったので偽 (0) を返します。i < k の場合、v[i] と x が等しければ真 (1) を返します。そうでなければ、i を +1 して iter を再帰呼び出しします。
簡単な実行例を示します。
Calc> find(1, [1, 2, 3, 4, 5, 6, 7, 8]); => 1 Calc> find(8, [1, 2, 3, 4, 5, 6, 7, 8]); => 1 Calc> find(0, [1, 2, 3, 4, 5, 6, 7, 8]); => 0 Calc> find(10, [1, 2, 3, 4, 5, 6, 7, 8]); => 0 Calc> find(5, [1, 2, 3, 4, 5, 6, 7, 8]); => 1 Calc> find1(1, [1, 2, 3, 4, 5, 6, 7, 8]); => 1 Calc> find1(5, [1, 2, 3, 4, 5, 6, 7, 8]); => 1 Calc> find1(8, [1, 2, 3, 4, 5, 6, 7, 8]); => 1 Calc> find1(0, [1, 2, 3, 4, 5, 6, 7, 8]); => 0 Calc> find1(10, [1, 2, 3, 4, 5, 6, 7, 8]); => 0
関数 position は見つけた要素の位置を返します。次のリストを見てください。
リスト : 位置を返す
def position(x, v)
let i = 0,
k = length(v) in
while i < k and v[i] != x do
i = i + 1;
end
if i < k then
i;
else
-1;
end
end
end
def position1(x, v)
let iter = 0,
k = length(v) in
iter = fn(i)
if i == k then
-1;
else
if v[i] == x then
i;
else
iter(i + 1);
end
end
end;
iter(0);
end
end
position の処理は find とほぼ同じです。while 文のあとで i < k をチェックします。真であれば位置 i を返し、そうでなければ -1 を返します。関数 postion1 は末尾再帰でプログラムしたものです。
簡単な実行例を示します。
Calc> position(1, [1, 2, 3, 4, 5, 6, 7, 8]); => 0 Calc> position(5, [1, 2, 3, 4, 5, 6, 7, 8]); => 4 Calc> position(8, [1, 2, 3, 4, 5, 6, 7, 8]); => 7 Calc> position(0, [1, 2, 3, 4, 5, 6, 7, 8]); => -1 Calc> position(10, [1, 2, 3, 4, 5, 6, 7, 8]); => -1 Calc> position1(1, [1, 2, 3, 4, 5, 6, 7, 8]); => 0 Calc> position1(5, [1, 2, 3, 4, 5, 6, 7, 8]); => 4 Calc> position1(8, [1, 2, 3, 4, 5, 6, 7, 8]); => 7 Calc> position1(0, [1, 2, 3, 4, 5, 6, 7, 8]); => -1 Calc> position1(10, [1, 2, 3, 4, 5, 6, 7, 8]); => -1
position は最初に見つけた要素の位置を返しますが、同じ要素がベクタに複数個あるかもしれません。そこで、要素の個数を数える関数を作ってみましょう。次のリストを見てください。
リスト : 個数を返す
def count(x, v)
let i = 0,
c = 0,
k = length(v) in
while i < k do
if v[i] == x then
c = c + 1;
end
i = i + 1;
end
c;
end
end
def count1(x, v)
let iter = 0,
k = length(v) in
iter = fn(i, c)
if i == k then
c;
else
if v[i] == x then
iter(i + 1, c + 1);
else
iter(i + 1, c);
end
end
end;
iter(0, 0);
end
end
局所変数 c を 0 に初期化し、x と等しい要素を見つけたら c の値を +1 します。最後に c を返します。count1 は末尾再帰でプログラムしたもので、引数 c を累積変数として使っています。
簡単な実行例を示します。
Calc> count(1, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 4 Calc> count(2, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 3 Calc> count(3, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 2 Calc> count(4, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 1 Calc> count(5, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 0 Calc> count1(1, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 4 Calc> count1(2, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 3 Calc> count1(3, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 2 Calc> count1(4, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 1 Calc> count1(5, [1, 1, 2, 1, 2, 3, 1, 2, 3, 4]); => 0
このように、線形探索は簡単にプログラムできますが、大きな欠点があります。データ数が多くなると処理に時間がかかります。近年、パソコンの性能は著しく向上しているので、線形探索でどうにかなる場合もありますが、データ数が多くて時間かかかるのであれば、次に取り上げる「二分探索」や他の高速な探索アルゴリズム [*1] を使ってみてください。
次は、高速なデータ探索アルゴリズムである「二分探索（バイナリサーチ：binary searching）」を作りましょう。線形探索の実行時間は要素数 N に比例するので、数が多くなると時間がかかるようになります。これに対し二分探索は log2 N に比例する時間でデータを探すことができます。ただし、探索するデータはあらかじめ昇順に並べておく必要があります。このため、二分探索は線形探索に比べて準備に時間がかかります。
二分探索の動作を下図に示します。
[11 22 33 44 55 66 77 88 99] key は 66
↑ 66 > 55 後半を探す
11 22 33 44 55 [66 77 88 99] 88 > 66 前半を探す
↑
11 22 33 44 55 [66 77] 88 99 77 > 66 前半を探す
↑
11 22 33 44 55 [66] 77 88 99 66 = 66 発見
↑
図 : 二分探索
二分探索は探索する区間を半分に分割しながら調べていきます。キーが 66 の場合を考えてみましょう。まず区間の中央値 55 とキーを比較します。データが昇順にソートされている場合、66 は中央値 55 より大きいので区間の前半を調べる必要はありません。したがって、後半部分だけを探索すればいいのです。
あとは、これと同じことを後半部分に対して行います。最後には区間の要素が一つしかなくなり、それとキーが一致すれば探索は成功、そうでなければ探索は失敗です。ようするに、探索するデータ数が 1 / 2 ずつ減少していくわけです。
上図の場合、線形探索ではデータの比較が 6 回必要になりますが、二分探索であれば 4 回で済みます。また、データ数が 1,000,000 個になったとしても、二分探索を使えば高々 20 回程度の比較で探索を完了することができます。
それでは、リストからデータを二分探索するプログラムを作ってみましょう。二分探索は簡単にプログラムできます。次のリストを見てください。
リスト : 二分探索
def bsearch(x, v, low, high)
let result = 0 in
while low <= high do
let mid = (low + high) // 2 in
if v[mid] == x then
begin
result = 1;
high = -1;
end
else
if v[mid] < x then
low = mid + 1;
else
high = mid - 1;
end
end
end
end
result;
end
end
def binary_search(x, v)
bsearch(x, v, 0, length(v) - 1);
end
実際の処理は関数 bsearch で行います。引数 low と high は探索する区間を表します。そして、while ループで探索区間を半分ずつに狭めていきます。まず、区間の中央値を求めて mid にセットします。演算子 // は Scheme の quotient と同じで、整数同士で割り算した商を求めます。if 文で v[mid] と x を比較し、等しい場合は探索成功です。result に 1 をセットして high を -1 に書き換えます。これで while ループを脱出することができます。
x が大きい場合は区間の後半を調べます。変数 low に mid + 1 をセットします。逆に、x が小さい場合は前半を調べるため、変数 high に mid - 1 をセットします。これを二分割できる間繰り返します。low が high より大きくなったら分割できないので繰り返しを終了し、最後に reuslt を返します。
Calc> binary_search(50, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 1 Calc> binary_search(10, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 1 Calc> binary_search(100, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 1 Calc> binary_search(0, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 0 Calc> binary_search(110, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 0 Calc> binary_search(55, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 0
bsearch を末尾再帰でプログラムすると次のようになります。
リスト : 二分探索 (末尾再帰)
def bsearch1(x, v, low, high)
if low > high then
0;
else
let mid = (low + high) // 2 in
if v[mid] == x then
1;
else
if v[mid] < x then
bsearch1(x, v, mid + 1, high);
else
bsearch1(x, v, low, mid - 1);
end
end
end
end
end
def binary_search1(x, v)
bsearch1(x, v, 0, length(v) - 1);
end
繰り返しが末尾再帰に変わっただけなので、とくに難しいところはないと思います。
簡単な実行例を示します。
Calc> binary_search1(50, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 1 Calc> binary_search1(10, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 1 Calc> binary_search1(100, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 1 Calc> binary_search1(0, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 0 Calc> binary_search1(110, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 0 Calc> binary_search1(55, [10, 20, 30, 40, 50, 60, 70, 80, 90, 100]); => 0
二分探索はデータを高速に探索することができますが、あらかじめデータをソートしておく必要があります。このため、途中でデータを追加するには、データを挿入する位置を求め、それ以降のデータを後ろへ移動する処理が必要になります。つまり、データの登録には時間がかかるのです。
したがって、二分探索はプログラムの実行中にデータを登録し、同時に探索も行うという使い方には向いていません。途中でデータを追加して探索も行う場合は、他の高速な探索アルゴリズムを検討してみてください。
次は簡単なソートプログラムを作ってみましょう。「バブルソート (buble sort) 」は泡がぶくぶくと浮いてくるように、いちばん小さいデータが後ろから前に浮かび上がってくるアルゴリズムです。
隣接する 2 つのデータを比較して、順序が逆であれば入れ換えます。これを順番に後ろから前に行っていけば、いちばん小さなデータは頂上に浮かび上がっているというわけです。先頭が決まったならば、残りのデータに対して同じことを行えば、2 番目には残りのデータの中でいちばん小さいものが浮かび上がってきます。これをデータ数だけ繰り返せばソートが完了します。
9 5 3 7 6 4 8 交換しない
~~~
9 5 3 7 6 4 8 交換する
~~~
9 5 3 7 4 6 8 交換する
~~~
9 5 3 4 7 6 8 交換しない
~~~
9 5 3 4 7 6 8 交換する
~~~
9 3 5 4 7 6 8 交換する
~~~
3 9 5 4 7 6 8 いちばん小さいデータが決定する
+ 残りのデータに対して同様な操作を行う
図 : バブルソート
これをそのままプログラムすると次のようになります。
リスト : バブルソート
def buble_sort(v)
let i = 0,
k = length(v) - 1 in
while i < k do
let j = k in
while i < j do
if v[j - 1] > v[j] then
let tmp = v[j] in
v[j] = v[j - 1];
v[j - 1] = tmp;
end
end
j = j - 1;
end
end
i = i + 1;
end
end
v;
end
最初のループで k 回 (データの個数 - 1) だけ繰り返します。2 番目のループで v の後ろから前に向かって、確定していないデータを比較していき、もしも順番が逆になっていたら交換します。とても簡単ですね。
簡単な実行例を示しましょう。
Calc> buble_sort([5, 6, 4, 7, 3, 8, 2, 9, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> buble_sort([9, 8, 7, 6, 5, 4, 3, 2, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> buble_sort([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
選択ソート (selection sort) は、ソートしていないデータの中から最小値（または最大値）を見つけ、それを先頭のデータと交換する、という手順を繰り返すことでソートを行います。最初は、すべてのデータの中から最小値を探し、それを配列の先頭 buff[0] と交換します。次は、buff[1] 以降のデータの中から最小値を探し、それを buff[1] と交換します。これを繰り返すことでソートすることができます。
[9 5 3 7 6 4 8] 3 と 9 を交換する
+ +
3 [5 9 7 6 4 8] 5 と 4 を交換する
+ +
3 4 [9 7 6 5 8] 9 と 5 を交換する
+ +
3 4 5 [7 6 9 8] 7 と 6 を交換する
+ +
3 4 5 6 [7 9 8] 7 と 7 を交換する
+
3 4 5 6 7 [9 8] 9 と 8 を交換してソート終了
+ +
図 : 選択ソート
このように、選択ソートは単純でわかりやすいアルゴリズムです。
プログラムは次のようになります。
リスト : 選択ソート
def min_vector(v, x)
let min = v[x], pos = x, i = x + 1,
k = length(v) in
while i < k do
if min > v[i] then
begin
min = v[i];
pos = i;
end
end
i = i + 1;
end
pos;
end
end
def select_sort(v)
let i = 0,
k = length(v) - 1 in
while i < k do
let j = min_vector(v, i) in
let tmp = v[j] in
v[j] = v[i];
v[i] = tmp;
end
end
i = i + 1;
end
end
v;
end
関数 min_vector はベクタ v の x 番目以降の中から最小値を求め、その位置を返します。min_vector を用意すると、選択ソートのプログラムは簡単です。ベクタの i 番目から末尾までの中から min_vector で最小の要素を選び、それと i 番目の要素を交換するだけです。
簡単な実行例を示します。
Calc> select_sort([5, 6, 4, 7, 3, 8, 2, 9, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> select_sort([9, 8, 7, 6, 5, 4, 3, 2, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> select_sort([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
次は単純挿入ソートを作ります。基本的な考え方はとても簡単です。ソート済みのベクタに新しいデータを挿入していくことでソートを行います。次の図を見てください。
[9] 5 3 7 6 4 8 5 を取り出す
[9] * 3 7 6 4 8 5 を[9]の中に挿入する
[5 9] 3 7 6 4 8 9 をひとつずらして先頭に 5 を挿入
[5 9] * 7 6 4 8 3 を取り出して[5 9]の中に挿入する
[3 5 9] 7 6 4 8 先頭に 3 を挿入
[3 5 9] * 6 4 8 7 を取り出して[3 5 9] に挿入
[3 5 7 9] 6 4 8 9 を動かして 7 を挿入
残りの要素も同様に行う
図 : 挿入ソート
最初は先頭のデータひとつがソート済みと考えて、2 番目のデータをそこに挿入することからスタートします。データを挿入するので、そこにあるデータをどかさないといけません。そこで、挿入位置を決めるため後ろから順番に比較するとき、いっしょにデータの移動も行うことにします。
プログラムは次のようになります。
リスト : 挿入ソート
def insert_sort(v)
let i = 1,
k = length(v) in
while i < k do
let j = i, tmp = v[i] in
while j > 0 and v[j - 1] >= tmp do
v[j] = v[j - 1];
j = j - 1;
end
v[j] = tmp;
end
i = i + 1;
end
end
v;
end
length(v) でベクタの長さを求めて変数 k にセットします。最初のループで挿入するデータを選びます。ソート開始時は先頭のデータひとつがソート済みと考えるるので、2 番目のデータ（添字では 1）を取り出して挿入していきます。2 番目のループで挿入する位置を探しています。探索は後ろから前に向かって行っていて、このときデータの移動も同時に行っています。
それでは実行してみましょう。
Calc> insert_sort([5, 6, 4, 7, 3, 8, 2, 9, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> insert_sort([9, 8, 7, 6, 5, 4, 3, 2, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> insert_sort([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
バブルソート、選択ソート、挿入ソートはデータ数が多くなると実行時間がかかります。データ数を N とすると、実行時間は N の 2 乗に比例します。これらのソートは簡単ですが遅いアルゴリズムなのです。
次は高速なソートアルゴリズムとして有名な「クイックソート (quick sort) 」を作ります。クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 2 つに分割していくことでソートを行います。2 つに分けた各々の区間を同様に分割して 2 つの区間に分けます。最後は区間の要素がひとつになってソートが完了します。
9 5 3 7 6 4 2 8 最初の状態
9 5 3 7 6 4 2 8 7 を枢軸にして左側から 7 以上の値を探し、
L R 右側から 7 以下の値を探す。
2 5 3 7 6 4 9 8 交換する
L R
2 5 3 7 6 4 9 8 検索する
L R
2 5 3 4 6 7 9 8 交換する
L R
2 5 3 4 6 7 9 8 検索する。R と L が交差したら分割終了。
R L
[2 5 3 4 6] [7 9 8] この 2 つの区間について再び同様な分割を行う
図 : クイックソート
基準になる値のことを「枢軸 (pivot) 」といいます。枢軸は要素の中から適当な値を選びます。今回は中央にある要素を選ぶことにしましょう。上図を見てください。左側から枢軸 7 以上の要素を探し、左側から 7 以下の要素を探します。探索のときは枢軸が番兵の役割を果たすので、ソート範囲外の要素を探索することはありません。見つけたらお互いの要素を交換します。探索位置が交差したら分割は終了です。
あとは同じ手順を分割した 2 つの区間に適用します。これは再帰定義を使えば簡単に実現できます。分割した区間の要素数が 1 になったときが再帰の停止条件になります。
これをそのままプログラムすると次のようになります。
リスト : クイックソート
def qsort(v, low, high)
let pivot = v[(low + high) // 2],
flag = 1,
i = low,
j = high in
while flag do
while v[i] < pivot do i = i + 1; end
while pivot < v[j] do j = j - 1; end
if i < j then
let tmp = v[i] in
v[i] = v[j];
v[j] = tmp;
i = i + 1;
j = j - 1;
end
else
flag = 0;
end
end
if low < i - 1 then qsort(v, low, i - 1); end
if j + 1 < high then qsort(v, j + 1, high); end
end
end
def quick_sort(v)
qsort(v, 0, length(v) - 1);
v;
end
関数 qsort の引数 v がソートするベクタ、low が区間の下限値、high が区間の上限値です。qsort は v の low から high までの区間をソートします。まず最初に、区間の中央にあるデータを枢軸 pivot として選び、pivot を基準にして区間を 2 つに分けます。
while ループの中の最初の while ループで、左側から枢軸以上の要素を探しています。ここでは枢軸以上という条件を、枢軸より小さい間は探索位置を進める、というように置き換えています。同様に次の while ループで右側から枢軸以下の要素を探します。お互いの探索位置 i, j が交差したら分割は終了です。flag を 0 に書き換えて while ループを終了します。そうでなければお互いの要素を交換します。
次に、分割した区間に対して qsort を再帰呼び出しします。このとき要素数をチェックして、2 個以上ある場合に再帰呼び出しを行います。この停止条件を忘れると正常に動作しません。ご注意ください。
簡単な実行例を示します。
Calc> quick_sort([5, 6, 4, 7, 3, 8, 2, 9, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> quick_sort([9, 8, 7, 6, 5, 4, 3, 2, 1, 0]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> quick_sort([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
次は素数を求めるプログラムを作りましょう。最初に、2 から N までの整数列を生成します。先頭の 2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。2 で割り切れる整数が取り除かれたので、残った要素の先頭が素数になります。先頭要素は 3 になるので、今度は 3 で割り切れる整数を取り除けばいいのです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩 (ふるい) 」といいます。
プログラムは次のようになります。
リスト : エラトステネスの篩
def sieve_sub(n, m, buff)
let i = n + n in
while i <= m do
buff[i] = 1;
i = i + n;
end
end
end
def print_prime(n)
display(n);
display(" ");
end
def sieve(n)
let hurui = make_vector(n + 1, 0),
i = 3 in
sieve_sub(2, n, hurui);
while i * i < n do
if hurui[i] == 0 then
sieve_sub(i, n, hurui);
end
i = i + 2;
end
print_prime(2);
i = 3;
while i <= n do
if hurui[i] == 0 then
print_prime(i);
end
i = i + 2;
end
end
end
関数 sieve の変数 hurui で整数列を表します。make_vector で大きさ n + 1 のベクタを生成し、それを hurui にセットします。0 で素数を表し、素数でない場合は 1 をセットします。make_vector で初期値に 0 を指定しているので、最初はすべての数が素数ということになります。
次に、関数 sieve_sub を呼び出して 2 の倍数を削除します。sieve_sub の引数 n が素数、m がベクタの大きさ、buff がベクタです。最初に、局所変数 i を n + n に初期化します。そして、while ループで buff[i] を 1 に書き換えて i に n を加算していけば、n の倍数を削除することができます。
あとは 3 から始まる奇数列を while ループで生成し、hurui[i] が 0 ならば sieve_sub で i の倍数を削除します。最後の while ループで、hurui の中に残った素数を表示します。
簡単な実行例を示します。
Calc> sieve(100); 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 => 0
エラトステネスの篩と同じ考え方で素因数分解を行うことができます。素因数分解とは、素数でない整数 (合成数) を素数の積の形に書き表すことです。たとえば、12 は 2 * 2 * 3 と素因数分解することができます。プログラムは次のようになります。
リスト : 素因数分解
def factorization(n)
while n % 2 == 0 do
display(2);
display(" ");
n = n / 2;
end
let i = 3 in
while i * i <= n do
while n % i == 0 do
display(i);
display(" ");
n = n / i;
end
i = i + 2;
end
if n > 1 then print(n); end
end
end
最初に 2 で割り算してから、奇数で割り算していきます。割り算するときは、その数で割り切れるあいだは割り算を続けることに注意してください。たとえば、27 を素因数分解すると 3 * 3 * 3 になりますが、3 を一回だけしか割り算しないと、結果は 3 * 9 のように素数ではない数が含まれてしまいます。
実行結果は次のようになります。
Calc> factorization(12); 2 2 3 => 3 Calc> factorization(12345678); 2 3 3 47 14593 => 14593 Calc> factorization(1234567890); 2 3 3 5 3607 3803 => 3803
どの数も素数で、2 * 3 * 3 * 5 * 3607 * 3803 を計算すると 1234567890 になります。なお、これはとても単純なアルゴリズムなので、大きな整数の素因数分解には適していません。巨大な合成数の素因数分解はとても難しい問題です。興味のある方は素因数分解について調べてみてください。
次はベクタを木とみなして、x と等しい要素 (葉) を探す関数 member_tree を作りましょう。
リスト : 木の探索
def member_tree(x, tree)
let iter = 0 in
iter = fn(tree, cont)
let i = 0,
k = length(tree) in
while i < k do
if vector(tree[i]) then
iter(tree[i], cont);
else
if tree[i] == x then
cont(1);
end
end
i = i + 1;
end
end
end;
callcc(fn(cont) iter(tree, cont); end);
end
end
探索は局所関数 iter で行います。探索の途中で値を返すため、脱出用の継続を引数 cont に受け取ります。while ループでベクタの要素を順番に調べていき、要素 v[i] がベクタならば iter を再帰呼び出しします。そうでなければ、v[i] が x と等しいかチェックします。そうであれば、継続 cont(1) を評価して探索処理から脱出します。x が見つからない場合、while ループの値が返されるので、返り値は 0 になります。
簡単な実行例を示します。
Calc> member_tree(1, [1, [2, [3, [4, [5], 6], 7], 8], 9]); => 1 Calc> member_tree(5, [1, [2, [3, [4, [5], 6], 7], 8], 9]); => 1 Calc> member_tree(9, [1, [2, [3, [4, [5], 6], 7], 8], 9]); => 1 Calc> member_tree(10, [1, [2, [3, [4, [5], 6], 7], 8], 9]); => 0 Calc> member_tree(0, [1, [2, [3, [4, [5], 6], 7], 8], 9]); => 0
次はベクタを木とみなして、要素 (葉) を数える関数 count_leaf を作ります。
リスト : 要素 (葉) の個数を求める
def count_leaf(v)
let c = 0,
i = 0,
k = length(v) in
while i < k do
if vector(v[i]) then
c = c + count_leaf(v[i]);
else
c = c + 1;
end
i = i + 1;
end
c;
end
end
count_leaf も簡単です。局所変数 c に要素の個数を格納します。v[i] がベクタならば count_leaf を再帰呼び出しし、その返り値を c に加算します。そうでなければ、c を +1 します。
簡単な実行例を示します。
Calc> count_leaf([1, 2, 3, 4, 5]); => 5 Calc> count_leaf([1, [2, 3, 4], 5]); => 5 Calc> count_leaf([1, [2, [3], 4], 5]); => 5 Calc> count_leaf([1, [2, [3, 3, 3], 4], 5]); => 7
最後に、ベクタを木とみなして、木を平坦化する関数 flattern を作ります。
リスト : 平坦化
def flatten(v)
let i = 0,
iter = 0,
flat = make_vector(count_leaf(v), 0) in
iter = fn(v)
let j = 0,
k = length(v) in
while j < k do
if vector(v[j]) then
iter(v[j]);
else
begin
flat[i] = v[j];
i = i + 1;
end
end
j = j + 1;
end
end
end;
iter(v);
flat;
end
end
fncalc のベクタは「可変長配列」ではないので、あらかじめ count_leaf で要素数を数え、その大きさのベクタを make_vector で生成して局所変数 flat にセットします。局所変数 i は flat に書き込む位置を表します。あとは、局所関数 iter で木を巡回して、要素 v[j] を flat[i] に書き込みます。最後に flat を返します。
簡単な実行例を示します。
Calc> flatten([1, 2, 3, 4, 5]); => [1, 2, 3, 4, 5] Calc> flatten([1, [2, 3, 4], 5]); => [1, 2, 3, 4, 5] Calc> flatten([1, [2, [3], 4], 5]); => [1, 2, 3, 4, 5] Calc> flatten([1, [2, [3, 4, 5], 4], 5]); => [1, 2, 3, 4, 5, 4, 5]
リスト : ベクタのサンプルプログラム (sample.cal)
# 線形探索
def find(x, v)
let i = 0,
k = length(v) in
while i < k and v[i] != x do
i = i + 1;
end
i < k;
end
end
def find1(x, v)
let iter = 0,
k = length(v) in
iter = fn(i)
if i == k then
0;
else
if v[i] == x then
1;
else
iter(i + 1);
end
end
end;
iter(0);
end
end
# 位置を返す
def position(x, v)
let i = 0,
k = length(v) in
while i < k and v[i] != x do
i = i + 1;
end
if i < k then
i;
else
-1;
end
end
end
def position1(x, v)
let iter = 0,
k = length(v) in
iter = fn(i)
if i == k then
-1;
else
if v[i] == x then
i;
else
iter(i + 1);
end
end
end;
iter(0);
end
end
# 個数を求める
def count(x, v)
let i = 0,
c = 0,
k = length(v) in
while i < k do
if v[i] == x then
c = c + 1;
end
i = i + 1;
end
c;
end
end
def count1(x, v)
let iter = 0,
k = length(v) in
iter = fn(i, c)
if i == k then
c;
else
if v[i] == x then
iter(i + 1, c + 1);
else
iter(i + 1, c);
end
end
end;
iter(0, 0);
end
end
# 二分探索
def bsearch(x, v, low, high)
let result = 0 in
while low <= high do
let mid = (low + high) // 2 in
if v[mid] == x then
begin
result = 1;
high = -1;
end
else
if v[mid] < x then
low = mid + 1;
else
high = mid - 1;
end
end
end
end
result;
end
end
def binary_search(x, v)
bsearch(x, v, 0, length(v) - 1);
end
def bsearch1(x, v, low, high)
if low > high then
0;
else
let mid = (low + high) // 2 in
if v[mid] == x then
1;
else
if v[mid] < x then
bsearch1(x, v, mid + 1, high);
else
bsearch1(x, v, low, mid - 1);
end
end
end
end
end
def binary_search1(x, v)
bsearch1(x, v, 0, length(v) - 1);
end
# バブルソート
def buble_sort(v)
let i = 0,
k = length(v) - 1 in
while i < k do
let j = k in
while i < j do
if v[j - 1] > v[j] then
let tmp = v[j] in
v[j] = v[j - 1];
v[j - 1] = tmp;
end
end
j = j - 1;
end
end
i = i + 1;
end
end
v;
end
# 選択ソート
def min_vector(v, x)
let min = v[x], pos = x, i = x + 1,
k = length(v) in
while i < k do
if min > v[i] then
begin
min = v[i];
pos = i;
end
end
i = i + 1;
end
pos;
end
end
def select_sort(v)
let i = 0,
k = length(v) - 1 in
while i < k do
let j = min_vector(v, i) in
let tmp = v[j] in
v[j] = v[i];
v[i] = tmp;
end
end
i = i + 1;
end
end
v;
end
# 単純挿入ソート
def insert_sort(v)
let i = 1,
k = length(v) in
while i < k do
let j = i, tmp = v[i] in
while j > 0 and v[j - 1] >= tmp do
v[j] = v[j - 1];
j = j - 1;
end
v[j] = tmp;
end
i = i + 1;
end
end
v;
end
# クイックソート
def qsort(v, low, high)
let pivot = v[(low + high) // 2],
flag = 1,
i = low,
j = high in
while flag do
while v[i] < pivot do i = i + 1; end
while pivot < v[j] do j = j - 1; end
if i < j then
let tmp = v[i] in
v[i] = v[j];
v[j] = tmp;
i = i + 1;
j = j - 1;
end
else
flag = 0;
end
end
if low < i - 1 then qsort(v, low, i - 1); end
if j + 1 < high then qsort(v, j + 1, high); end
end
end
def quick_sort(v)
qsort(v, 0, length(v) - 1);
v;
end
# エラトステネスの篩
def sieve_sub(n, m, buff)
let i = n + n in
while i <= m do
buff[i] = 1;
i = i + n;
end
end
end
def print_prime(n)
display(n);
display(" ");
end
def sieve(n)
let hurui = make_vector(n + 1, 0),
i = 3 in
sieve_sub(2, n, hurui);
while i * i < n do
if hurui[i] == 0 then
sieve_sub(i, n, hurui);
end
i = i + 2;
end
print_prime(2);
i = 3;
while i <= n do
if hurui[i] == 0 then
print_prime(i);
end
i = i + 2;
end
end
end
# 素因数分解
def factorization(n)
while n % 2 == 0 do
display(2);
display(" ");
n = n / 2;
end
let i = 3 in
while i * i <= n do
while n % i == 0 do
display(i);
display(" ");
n = n / i;
end
i = i + 2;
end
if n > 1 then print(n); end
end
end
# 木の探索
def member_tree(x, tree)
let iter = 0 in
iter = fn(tree, cont)
let i = 0,
k = length(tree) in
while i < k do
if vector(tree[i]) then
iter(tree[i], cont);
else
if tree[i] == x then
cont(1);
end
end
i = i + 1;
end
end
end;
callcc(fn(cont) iter(tree, cont); end);
end
end
# 葉の個数を求める
def count_leaf(v)
let c = 0,
i = 0,
k = length(v) in
while i < k do
if vector(v[i]) then
c = c + count_leaf(v[i]);
else
c = c + 1;
end
i = i + 1;
end
c;
end
end
# 平坦化
def flatten(v)
let i = 0,
iter = 0,
flat = make_vector(count_leaf(v), 0) in
iter = fn(v)
let j = 0,
k = length(v) in
while j < k do
if vector(v[j]) then
iter(v[j]);
else
begin
flat[i] = v[j];
i = i + 1;
end
end
j = j + 1;
end
end
end;
iter(v);
flat;
end
end