お気楽 Go 言語プログラミング入門

電卓プログラムの改良 (連結リスト編その２)

電卓プログラムの使用例として簡単なライブラリを作ってみました。

数値演算

isEven(n), isOdd(n)
n が偶数ならば isEven は 1 を isOdd は 0 を、奇数ならば isEven は 0 を isOdd は 1 を返す。
isPositive(n)
n が正の値ならば 1 を返す。
isNegative(n)
n が負の値ならば 1 を返す。
isZero(n)
n が 0 ならば 1 を返す。
abs(n)
n の絶対値を返す。
sign(n)
n の符号 (-1, 0, 1) を返す。
max(a, b), min(a, b)
max は引数 a, b の大きいほうを、min は小さいほうを返す。
gcd(a, b)
整数値 a, b の最大公約数を求める。
lcm(a, b)
整数値 a, b の最小公倍数を求める。
combNum(n, r)
組み合わせの数 _nＣ_r を求める。
fact(n)
n の階乗を求める。
expt(a, b)
a の b 乗を求める。(ただし、b は整数)
fibo(n)
フィボナッチ数を求める。
sieve(n)
整数 n 以下の素数を求める。
factorization(n)
整数 n を素因数分解する。返り値はコンスセル (p . q) を格納したリストで、コンスセルは p^q を表す。

Calc> isEven(2);
1
Calc> isEven(3);
0
Calc> isOdd(4);
0
Calc> isOdd(5);
1
Calc> isPositive(10);
1
Calc> isPositive(-10);
0
Calc> isNegative(10);
0
Calc> isNegative(-10);
1
Calc> isZero(0);
1
Calc> isZero(-1);
0
Calc> abs(-10);
10
Calc> abs(10);
10
Calc> max(1, 10);
10
Calc> min(1, 10);
1
Calc> gcd(24, 32);
8
Calc> lcm(24, 32);
96
Calc> combNum(10, 5);
252
Calc> combNum(30,15);
155117520
Calc> fact(10);
3628800
Calc> fact(20);
2432902008176640000
Calc> expt(2,32);
4294967296
Calc> expt(2,62);
4611686018427387904
Calc> fibo(0);
1
Calc> fibo(1);
1
Calc> fibo(2);
2
Calc> fibo(10);
89
Calc> fibo(50);
20365011074
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)
Calc> factorization(1234567890);
((2 . 1) (3 . 2) (5 . 1) (3607 . 1) (3803 . 1))
Calc> factorization(1111111111);
((11 . 1) (41 . 1) (271 . 1) (9091 . 1))

述語

pair(xs) [組み込み関数]
xs がリストならば真を返す。
null(xs) [組み込み関数]
xs が空リストならば真を返す。
isList(xs)
xs がリストか空リストならば真を返す。
eql(x, y) [組み込み関数]
x と y が等しい場合は真を返す。等値の定義は、x と y が同じデータ型で値が等しいこと。リストの場合は、同一のリストであれば真を返す。ベクタと関数値の場合は無条件に偽を返す。
equal(xs, ys)
xs と ys が等しい場合は真を返す。等値の定義は、xs と ys が同じデータ型で値が等しいこと。リストとベクタの場合は要素に対して equal を再帰的に適用する。
any(pred, xs)
リスト xs の要素がひとつでも述語 pred を満たせば真を返す。
every(pred, xs)
リスト xs のすべての要素が述語 pred を満たせば真を返す。

Calc> pair(cons(1, 2));
1
Calc> pair(nil);
0
Calc> null(nil);
1
Calc> null(cons(1, 2));
0
Calc> any(isEven, list(1,3,5,7,9));
0
Calc> any(isEven, list(1,3,4,5,7,9));
1
Calc> any(isOdd, [2,4,6,8,10]);
0
Calc> any(isOdd, [2,4,5,6,8,10]);
1
Calc> every(isEven, list(2,4,6,8));
1
Calc> every(isEven, list(2,4,5,6,8));
0
Calc> every(isEven, [2,4,6,8,10]);
1
Calc> every(isEven, [2,4,6,8,10,11]);
0
Calc> eql(1, 1);
1
Calc> eql(1, 1.0);
0
Calc> eql("abc", "abc");
1
Calc> eql("abc", "def");
0
Calc> eql("abc", 2);
0
Calc> eql(nil, nil);
1
Calc> equal(1, 1);
1
Calc> equal(1, 1.0);
0
Calc> equal("abc", "abc");
1
Calc> equal("abc", "def");
0
Calc> equal("abc", 2);
0
Calc> equal(list(1,2,3), list(1,2,3));
1
Calc> equal(list(1,2,3), list(1,2,3.0));
0
Calc> equal([[1,2],[3,4]], [[1,2],[3,4]]);
1
Calc> equal([[1,2],[3,4]], [[1,2],[3.0,4]]);
0

リストのアクセス

car(xs) [組み込み関数]
リスト xs の先頭要素を返す。xs が空リストの場合は空リストを返す。
cdr(xs) [組み込み関数]
リスト xs の先頭要素を取り除く。xs が空リストの場合は空リストを返す。
caar(xs), cadr(xs), cdar(xs), cddr(xs)
cXYr(xs) は cXr(cYr(xs)) と同じ。
first(xs), second(xs), third(xs), fourth(xs), fifth(xs)
first はリスト xs の先頭の要素、second は 2 番目の要素、 third は 3 番目の要素、fourth は 4 番目の要素、fifth は 5 番目の要素を取り出す。
nth(xs, n)
リスト xs の n 番目の要素を取り出す。ただし、要素の順番は 0 から数える。

Calc> a = list(1,2,3,4,5);
(1 2 3 4 5)
Calc> first(a);
1
Calc> second(a);
2
Calc> third(a);
3
Calc> fourth(a);
4
Calc> fifth(a);
5
Calc> nth(a, 0);
1
Calc> nth(a, 4);
5

リストの生成

cons(x, y) [組み込み関数]
CAR 部に x を、CDR 部に y を格納したコンスセルを返す。
makelist(n, x)
要素が x で長さが n のリストを生成する。
iota(n, m)
整数 n から m までの数列を格納したリストを生成する。
tabulate(f, n, m)
整数 n から m までの数列の要素に関数 f を適用した結果をリストに格納して返す。

Calc> cons(1, 2);
(1 . 2)
Calc> cons(2, cons(1, nil));
(2 1)
Calc> makelist(10, 0);
(0 0 0 0 0 0 0 0 0 0)
Calc> iota(1, 10);
(1 2 3 4 5 6 7 8 9 10)
Calc> tabulate(fn(x) x * x end, 1, 10);
(1 4 9 16 25 36 49 64 81 100)

簡単なリスト操作

append(xs, ys)
リスト xs と ys を連結する。
length(xs)
リスト xs の長さを求める。
reverse(xs)
リスト xs を反転する。
revAppend(xs, ys)
リスト xs を反転してリスト ys と連結する。
take(xs, n)
リスト xs の先頭から n 個の要素を取り出す。
drop(xs, n)
リスト xs の先頭から n 個の要素を取り除く。
last(xs, n)
リスト xs の末尾から n 個の要素を取り出す。
butlast(xs, n)
リスト xs の末尾から n 個の要素を取り除く。
partition(pred, xs)
リスト xs を述語 pred が真を返す要素とそうでないものの 2 つに分ける。

Calc> a = iota(1, 4);
(1 2 3 4)
Calc> b = iota(5, 8);
(5 6 7 8)
Calc> append(a, b);
(1 2 3 4 5 6 7 8)
Calc> c = append(a, b);
(1 2 3 4 5 6 7 8)
Calc> revAppend(a, b);
(4 3 2 1 5 6 7 8)
Calc> length(c);
8
Calc> reverse(c);
(8 7 6 5 4 3 2 1)
Calc> c;
(1 2 3 4 5 6 7 8)
Calc> c = iota(1, 9);
(1 2 3 4 5 6 7 8 9)
Calc> drop(c, 3);
(4 5 6 7 8 9)
Calc> take(c, 3);
(1 2 3)
Calc> last(c, 3);
(7 8 9)
Calc> butlast(c, 3);
(1 2 3 4 5 6)
Calc> partition(isEven, c);
((2 4 6 8) 1 3 5 7 9)
Calc> partition(isOdd, c);
((1 3 5 7 9) 2 4 6 8)

簡単なリストとベクタの操作

sum(xs)
リストまたはベクタ xs の合計値を求める。
maximum(xs)
リストまたはベクタ xs の中から最大値を求める。
minimum(xs)
リストまたはベクタ xs の中から最小を求める。
toVector(xs)
リスト xs をベクタに変換する。リストの要素がリストの場合、そのリストもベクタに変換する。
toList(xs)
ベクタ xs をリストに変換する。ベクタの要素がベクタの場合、そのベクタもリストに変換する。
foreach(f, xs)
リストまたはベクタ xs の要素に関数 f を適用する。関数 f の副作用が目的で、返り値は捨てられる。
copy(xs)
リストまたはベクタ xs のコピーを返す。コピーされるのはトップレベルのみで、いわゆる深いコピーは行われない。

Calc> a = list(5,6,4,7,3,8,2,9,1);
(5 6 4 7 3 8 2 9 1)
Calc> b = [5,6,4,7,3,8,2,9,1];
[5, 6, 4, 7, 3, 8, 2, 9, 1]
Calc> sum(a);
45
Calc> sum(b);
45
Calc> maximum(a);
9
Calc> maximum(b);
9
Calc> minimum(b);
1
Calc> minimum(a);
1
Calc> a = toList([1,2,3,4,5]);
(1 2 3 4 5)
Calc> toVector(a);
[1, 2, 3, 4, 5]
Calc> b = toList([1,[2,[3],4],5]);
(1 (2 (3) 4) 5)
Calc> toVector(b);
[1, [2, [3], 4], 5]
Calc> foreach(print, a);
12345678
Calc> foreach(print, [1,2,3,4,5,6,7,8]);
12345678
Calc> copy(list(1,2,3,4,5));
(1 2 3 4 5)
Calc> copy([1,2,3,4,5]);
[1, 2, 3, 4, 5]

リストとベクタの探索

member(x, xs), memberIf(pred, xs)
リスト xs の中から x と等しい要素を探す。比較は述語 eql で行われる。見つけた場合、その要素以降のリストを返す。見つからない場合は nil を返す。memberIf は述語 pred が真を返す要素を探す。
find(x, xs), findIf(pred, xs)
リストまたはベクタ xs の中から x と等しい要素を探す。見つけた場合は真 (1) を返す。findIf はリストまたはベクタ xs の中から述語 pred を満たす最初の要素を返す。見つからない場合は nil を返す。
position(x, xs), positionIf(pred, xs)
リストまたはベクタ xs の中から x と等しい要素の位置を返す。見つからない場合は -1 を返す。positionIf は述語 pred を満たす最初の要素の位置を返す。
count(x, xs), countIf(pred, xs)
リストまたはベクタ xs の中から x と等しい要素の個数を返す。countIf は述語 pred を満たす要素の個数を返す。

Calc> a;
(1 2 3 4 5 6 7 8 9)
Calc> b;
[1, 2, 3, 4, 5, 6, 7, 8, 9]
Calc> findIf(isEven, a);
2
Calc> findIf(isEven, b);
2
Calc> findIf(fn(x) x == 10 end, a);
()
Calc> positionIf(isEven, b);
1
Calc> positionIf(isEven, a);
1
Calc> positionIf(fn(x) x == 10 end, a);
-1
Calc> countIf(isEven, a);
4
Calc> countIf(isEven, b);
4
Calc> member(5, a);
(5 6 7 8 9)
Calc> member(10, a);
()

マッピング、フィルター、畳み込み

map(f, xs)
リスト xs の要素に関数 f を適用した結果をリストに格納して返す。
filter(pred, xs)
filter はリスト xs から述語 pred を満たす要素を取り出す。
remove(x, xs), removeIf(pred, xs)
remove はリスト xs から x と等しい要素を削除する。removeIf は pred を満たす要素を削除する。
foldl(f, a, xs), foldr(f, a, xs)
リスト xs の要素 x と累積変数 a に関数 f(x, a) を適用して畳み込みを行う。foldl は先頭から順番に要素を取り出し、foldr は逆に末尾から順番に要素を取り出す。

Calc> a = iota(1, 8);
(1 2 3 4 5 6 7 8)
Calc> map(fn(x) x * 2 end, a);
(2 4 6 8 10 12 14 16)
Calc> filter(isEven, a);
(2 4 6 8)
Calc> removeIf(isEven, a);
(1 3 5 7)
Calc> foldl(fn(x, a) cons(x, a) end, nil, iota(1, 8));
(8 7 6 5 4 3 2 1)
Calc> foldr(fn(x, a) cons(x, a) end, nil, iota(1, 8));
(1 2 3 4 5 6 7 8)

連想リスト

zip(xs, ys)
xs の要素がキー、ys の要素が値となる連想リストを生成する。
assoc(key, xs)
連想リスト xs から key を探す。返り値はコンスセル (key . value) で、見つからない場合は nil を返す。
assocIf(pred, xs)
連想リスト xs から述語 pred を満たす key を探す。返り値はコンスセル (key . value) で、見つからない場合は nil を返す。

Calc> a = zip(iota(1, 5), iota(11, 15));
((1 . 11) (2 . 12) (3 . 13) (4 . 14) (5 . 15))
Calc> assoc(1, a);
(1 . 11)
Calc> assoc(5, a);
(5 . 15)
Calc> assoc(6, a);
()
Calc> assocIf(fn(x) x % 3 == 0 end, a);
(3 . 13)

集合

リストを集合として扱う関数で、リストには重複要素がないものとする。

removeDup(xs)
リスト xs から重複した要素を削除する。等値の判定には述語 eql を用いる。
union(xs, ys)
リスト xs, ys の和集合を求める。
intersection(xs, ys)
リスト xs, ys の積集合を求める。
difference(xs, ys)
リスト xs, ys の差集合を求める。
product(xs, ys)
リスト xs, ys の直積集合を求める。
powerSet(xs)
リスト xs のべき集合を求める。

Calc> a = removeDup(list(1,1,2,1,2,3,1,2,3,4,1,2,3,4));
(1 2 3 4)
Calc> b = list(3,4,5,6);
(3 4 5 6)
Calc> union(a, b);
(1 2 3 4 5 6)
Calc> intersection(a, b);
(3 4)
Calc> difference(a, b);
(1 2)
Calc> difference(b, a);
(5 6)
Calc> product(list(1,2,3), list(4,5));
((1 . 4) (1 . 5) (2 . 4) (2 . 5) (3 . 4) (3 . 5))
Calc> powerSet(list(1,2,3,4));
(() (4) (3) (3 4) (2) (2 4) (2 3) (2 3 4) (1) (1 4) (1 3) (1 3 4) (1 2) (1 2 4) (1 2 3) (1 2 3 4))

マージとソート

mergeList(xs, ys)
リスト xs, ys をひとつのリストに併合する。xs, ys は演算子 < を満たすように整列しておくこと。
insertSortList(xs)
リスト xs を昇順に整列 (単純挿入ソート) する。
mergeSortList(pred, n, xs)
リスト xs を昇順に整列 (マージソート) する。
insertSort(xs)
ベクタ xs を昇順に整列 (単純挿入ソート) する。
quickSort(xs)
ベクタ xs を昇順に整列 (クイックソート) する。

Calc> mergeList(list(1,3,5,7), list(2,4,6,8));
(1 2 3 4 5 6 7 8)
Calc> insertSortList(list(1,3,5,7,2,4,6,8));
(1 2 3 4 5 6 7 8)
Calc> mergeSortList(list(1,3,5,7,2,4,6,8));
(1 2 3 4 5 6 7 8)
Calc> insertSort([1,3,5,7,2,4,6,8]);
[1, 2, 3, 4, 5, 6, 7, 8]
Calc> quickSort([1,3,5,7,2,4,6,8]);
[1, 2, 3, 4, 5, 6, 7, 8]

順列と組み合わせ

permutation(f, n, xs)
リスト xs から n 個を選ぶ順列を生成し、それを関数 f に渡して評価する。
combination(f, n, xs)
リスト xs から n 個を選ぶ組み合わせを生成し、それを関数 f に渡して評価する。

Calc> permutation(print, 3, list(1,2,3));
(1 2 3)(1 3 2)(2 1 3)(2 3 1)(3 1 2)(3 2 1)
Calc> combination(print, 3, list(1,2,3,4,5));
(1 2 3)(1 2 4)(1 2 5)(1 3 4)(1 3 5)(1 4 5)(2 3 4)(2 3 5)(2 4 5)(3 4 5)

スタックとキュー

makeStack()
スタックを生成する。スタックを表すリスト s を返す。
push(s, x)
スタック s に x をプッシュする。
pop(s)
スタックからデータをポップする。
top(s)
スタックトップにあるデータを返す。
isEmptyStack(s)
スタック s が空であれば真を返す。
makeQueue()
キューを生成する。キューを表すリスト q を返す。
enqueue(q, x)
キュー q にデータ x を挿入する。
dequeue(q)
キュー q からデータを取り出す。
front(q)
キュー q の先頭データを返す。
isEmptyQueue(q)
キュー q が空であれば真を返す。

Calc> s = makeStack();
(())
Calc> push(s, 1);
(1)
Calc> push(s, 2);
(2 1)
Calc> push(s, 3);
(3 2 1)
Calc> isEmptyStack(s);
0
Calc> top(s);
3
Calc> pop(s);
3
Calc> pop(s);
2
Calc> pop(s);
1
Calc> isEmptyStack(s);
1
Calc> q = makeQueue();
(())
Calc> enqueue(q, 1);
(1)
Calc> enqueue(q, 2);
(2)
Calc> enqueue(q, 3);
(3)
Calc> isEmptyQueue(q);
0
Calc> front(q);
1
Calc> dequeue(q);
1
Calc> dequeue(q);
2
Calc> dequeue(q);
3
Calc> isEmptyQueue(q);
1

乱数の生成

乱数生成のアルゴリズムは線形合同法なので、乱数の品質はあまりよくない。

seed(n)
乱数のシードを設定する。
rand()
0 以上 RandMax (0x100000000) 未満の乱数 (整数) を生成する。
random()
0 以上 1.0 未満の乱数 (実数) を生成する。

Calc> srand(clock());
3979656540
Calc> let i = 0 in while i < 8 do println(rand()), i = i + 1 end end;
1580551853
1952172426
2688968067
1359605992
1461301705
3210973942
3827903743
4181785396
0
Calc> let i = 0 in while i < 8 do println(random()), i = i + 1 end end;
0.8788879301864654
0.9104500492103398
0.8744489091914147
0.3117089420557022
0.4249188455287367
0.7197418245486915
0.8480797538068146
0.020515683107078075
0

おまけ (数当てゲーム)

マスターマインド (数当てゲーム) です。lib.cal のあとに mastermind.cal をロードしてください。

C>calc8 lib.cal mastermind.cal
Calc> mastermind();
[a,b,c,d]>>> [0,1,2,3];
1 : [0, 1, 2, 3], Bulls; 0, Cows: 2
[a,b,c,d]>>> [4,5,6,7];
2 : [4, 5, 6, 7], Bulls; 2, Cows: 0
[a,b,c,d]>>> [3,5,6,0];
3 : [3, 5, 6, 0], Bulls; 1, Cows: 1
[a,b,c,d]>>> [1,3,6,7];
4 : [1, 3, 6, 7], Bulls; 0, Cows: 0
[a,b,c,d]>>> [4,5,0,2];
Good Job!

●プログラムリスト

//
// lib.cal : 電卓プログラム用ライブラリ
//
//           Copyright (C) 2014 Makoto Hiroi

//
// 数値計算
//

// 述語
def isOdd(x) x % 2 != 0 end
def isEven(x) x % 2 == 0 end
def isPositive(x) x > 0 end
def isNegative(x) x < 0 end
def isZero(x) x == 0 end

// 絶対値
def abs(x)
  if x < 0 then -x else x end
end

// 符号
def sign(x)
  if x > 0 then
    1
  else
    if x < 0 then -1 end
  end
end

// 最大値と最小値
def max(a, b)
  if a > b then a else b end
end

def min(a, b)
  if a < b then a else b end
end

// 最大公約数
def gcd(a, b)
  if b == 0 then
    a
  else
    gcd(b, a % b)
  end
end

// 最小公倍数
def lcm(a, b)
  a * b / gcd(a, b)
end

// 累乗 x ** y (y is Int)
def expt(x, y)
  if y == 0 then
    1
  else
    if y == 1 then
      x
    else
      let z = expt(x, y / 2) in
        if isOdd(y) then
          z * z * x
        else
          z * z
        end
      end
    end
  end
end

// 階乗
def fact(n)
  let
    a = 1
  in
    while n > 0 do
      a = a * n,
      n = n - 1
    end,
    a
  end
end

// フィボナッチ関数
def fibo(n)
  let
    a = 1,
    b = 0,
    c = 0
  in
    while n > 0 do
      c = a,
      a = a + b,
      b = c,
      n = n - 1
    end,
    a
  end
end

// 組み合わせの数
def combNum(n, r)
  if n == 0 or r == 0 then
    1
  else
    combNum(n, r - 1) * (n - r + 1) / r
  end
end

//
// 連結リスト
//

def caar(xs) car(car(xs)) end
def cadr(xs) car(cdr(xs)) end
def cdar(xs) cdr(car(xs)) end
def cddr(xs) cdr(cdr(xs)) end

// 述語
def isList(xs)
  pair(xs) or null(xs)
end

def equal(xs, ys)
  if isVec(xs) then
    if isVec(ys) and len(xs) == len(ys) then
      let r = 1, i = 0 in
        while i < len(xs) and r do
          if !equal(xs[i], ys[i]) then
            r = 0
          else
            i = i + 1
          end
        end,
        r
      end
    end
  else
    let r = 1 in
      while pair(xs) and pair(ys) and r do
        if !equal(car(xs), car(ys)) then
          r = 0
        else
          begin xs = cdr(xs), ys = cdr(ys) end
        end
      end,
      if r then
        if !pair(xs) and !pair(ys) then
          eql(xs, ys)
        end
      end
    end
  end
end

// 高階関数
def map(f, xs)
  if null(xs) then
    nil
  else 
    cons(f(car(xs)), map(f, cdr(xs)))
  end
end

def filter(f, xs)
  if null(xs) then
    nil
  else
    if f(car(xs)) then
      cons(car(xs), filter(f, cdr(xs)))
    else
      filter(f, cdr(xs))
    end
  end
end

def foldl(f, a, xs)
  while !null(xs) do
    a = f(car(xs), a),
    xs = cdr(xs)
  end,
  a
end

def foldr(f, a, xs)
  if null(xs) then
    a
  else
    f(car(xs), foldr(f, a, cdr(xs)))
  end
end

def every(f, xs)
  let r = 1 in
    while pair(xs) and r do
      if !f(car(xs)) then r = 0 end,
      xs = cdr(xs)
    end,
    r
  end
end

def any(f, xs)
  let r = 0 in
    while pair(xs) and !r do
      if f(car(xs)) then r = 1 end,
      xs = cdr(xs)
    end,
    r
  end
end

// リストの参照
def nth(xs, n)
  while !null(xs) and n > 0 do
    xs = cdr(xs),
    n = n - 1
  end,
  car(xs)
end

def first(xs) car(xs) end
def second(xs) cadr(xs) end
def third(xs) car(cddr(xs)) end
def fourth(xs) nth(xs, 3) end
def fifth(xs) nth(xs, 4) end

// 長さ
def length(xs)
  foldl(fn(x, a) a + 1 end, 0, xs)
end

// 反転
def reverse(xs)
  foldl(fn(x, a) cons(x, a) end, nil, xs)
end

// 連結
def append(xs, ys)
  if null(xs) then
    ys
  else
    cons(car(xs), append(cdr(xs), ys))
  end
end

def revAppend(xs, ys)
  while !null(xs) do
    ys = cons(car(xs), ys),
    xs = cdr(xs)
  end,
  ys
end

// 削除
def remove(x, xs)
  foldr(fn(y, a) if eql(x, y) then a else cons(y, a) end end, nil, xs)
end

def removeIf(f, xs)
  foldr(fn(x, a) if f(x) then a else cons(x, a) end end, nil, xs)
end

// 先頭から n 個の要素を取り出す
def take(xs, n)
  if n == 0 or null(xs) then
    nil
  else
    cons(car(xs), take(cdr(xs), n - 1))
  end
end

// 先頭から n 個の要素を取り除く
def drop(xs, n)
  while !null(xs) and n > 0 do
    xs = cdr(xs),
    n = n - 1
  end,
  xs
end

// 末尾から n 個の要素を取り出す
def last(xs, n)
  drop(xs, length(xs) - n)
end

// 末尾から n 個の要素を取り除く
def butlast(xs, n)
  take(xs, length(xs) - n)
end

// リストの生成
def makelist(n, x)
  let
    xs = nil
  in
    while n > 0 do
      xs = cons(x, xs),
      n = n - 1
    end,
    xs
  end
end

def iota(n, m)
  let
    xs = nil
  in
    while m >= n do
      xs = cons(m, xs),
      m = m - 1
    end,
    xs
  end
end

def tabulate(f, n, m)
  let
    xs = nil
  in
    while m >= n do
      xs = cons(f(m), xs),
      m = m - 1
    end,
    xs
  end
end

// リストの分割
def partition(f, xs)
  if null(xs) then
    list(nil)
  else
    let ys = partition(f, cdr(xs)) in
      if f(car(xs)) then
        cons(cons(car(xs), car(ys)), cdr(ys))
      else
        cons(car(ys), cons(car(xs), cdr(ys)))
      end
    end
  end
end


// 探索
def member(x, ls)
  while !null(ls) and !eql(car(ls), x) do
    ls = cdr(ls)
  end,
  ls
end

def memberIf(f, ls)
  while !null(ls) and !f(car(ls)) do
    ls = cdr(ls)
  end,
  ls
end

// 連想リスト
def zip(xs, ys)
  if null(xs) or null(ys) then
    nil
  else
    cons(cons(car(xs), car(ys)), zip(cdr(xs), cdr(ys)))
  end
end

def assoc(x, xs)
  while !null(xs) and !eql(caar(xs), x) do
    xs = cdr(xs)
  end,
  car(xs)
end

def assocIf(f, xs)
  while !null(xs) and !f(caar(xs)) do
    xs = cdr(xs)
  end,
  car(xs)
end

//
// 集合演算
//

// 重複要素を取り除く
def removeDup(xs)
  foldr(fn(x, a) if member(x, a) then a else cons(x, a) end end, nil, xs)
end

// 集合の和
def union(xs, ys)
  foldr(fn(x, a) if member(x, ys) then a else cons(x, a) end end, ys, xs)
end

// 集合の積
def intersection(xs, ys)
  foldr(fn(x, a) if member(x, ys) then cons(x, a) else a end end, nil, xs)
end

// 集合の差
def difference(xs, ys)
  foldr(fn(x, a) if member(x, ys) then a else cons(x, a) end end, nil, xs)
end

// 直積集合
def product(xs, ys)
  foldr(fn(x, a) append(map(fn(y) cons(x, y) end, ys), a) end, nil, xs)
end

// べき集合
def powerSet(xs)
  if null(xs) then
    list(nil)
  else
    append(powerSet(cdr(xs)),
           map(fn(ys) cons(car(xs), ys) end, powerSet(cdr(xs))))
  end
end

//
// ベクタ
//

// 高階関数
def vectorFold(f, a, xs)
  let i = 0 in
    while i < len(xs) do
      a = f(xs[i], a),
      i = i + 1
    end,
    a
  end
end

//
// 列関数
//

def selectFold(xs)
  if isList(xs) then
    foldl
  else
    if isVec(xs) then
      vectorFold
    else
      error("list or vector required")
    end
  end
end

def sum(xs)
  let
    f = selectFold(xs)
  in
    f(fn(x, y) x + y end, 0, xs)
  end
end

def maximum(xs)
  if pair(xs) then
    foldl(fn(x, a) max(x, a) end, car(xs), cdr(xs))
  else
    if isVec(xs) then
      vectorFold(fn(x, a) max(x, a) end, xs[0], xs)
    else
      error("list or vector required")
    end
  end
end

def minimum(xs)
  if pair(xs) then
    foldl(fn(x, a) min(x, a) end, car(xs), cdr(xs))
  else
    if isVec(xs) then
      vectorFold(fn(x, a) min(x, a) end, xs[0], xs)
    else
      error("list or vector required")
    end
  end
end

def positionIf(f, xs)
  let i = 0, r = 0 in
    if isList(xs) then
      while !null(xs) and !r do
        if f(car(xs)) then
          r = 1
        else
          begin i = i + 1, xs = cdr(xs) end
        end
      end
    else
      if isVec(xs) then
        while i < len(xs) and !r do
          if f(xs[i]) then
            r = 1
          else
            i = i + 1
          end
        end
      else
        error("list or vector required")
      end
    end,
    if r then i else -1 end
  end
end

def position(x, xs)
  positionIf(fn(y) eql(x, y) end, xs)
end

def findIf(f, xs)
  if isList(xs) then
    car(memberIf(f, xs))
  else
    if isVec(xs) then
      let i = positionIf(f, xs) in
        if i >= 0 then xs[i] else nil end
      end
    else
      error("list or vector required")
    end
  end
end

def find(x, xs)
  !null(findIf(fn(y) eql(x, y) end, xs))
end

def countIf(f, xs)
  let
    g = selectFold(xs)
  in
    g(fn(x, a) if f(x) then a + 1 else a end end, 0, xs)
  end
end

def count(x, xs)
  countIf(fn(y) eql(x, y) end, xs)
end

//
// リストとベクタの変換
//
def toList(xs)
  let ys = nil, i = len(xs) - 1 in
    while i >= 0 do
      if isVec(xs[i]) then
        ys = cons(toList(xs[i]), ys)
      else
        ys = cons(xs[i], ys)
      end,
      i = i - 1
    end,
    ys
  end
end

def toVector(xs)
  let ys = vector(length(xs), 0), i = 0 in
    while pair(xs) do
      if pair(car(xs)) then
        ys[i] = toVector(car(xs))
      else
        ys[i] = car(xs)
      end,
      xs = cdr(xs),
      i = i + 1
    end,
    ys
  end
end

// foreach と copy
def foreach(f, xs)
  let
    g = selectFold(xs)
  in
    g(fn(x, a) f(x) end, 0, xs)
  end
end

def copy(xs)
  if isList(xs) then
    foldr(cons, nil, xs)
  else
    if isVec(xs) then
      let i = 0, ys = vector(len(xs), 0) in
        while i < len(xs) do
          ys[i] = xs[i],
          i = i + 1
        end,
        ys
      end
    else
      error("list or vector required")
    end
  end
end

//
// 順列と組み合わせ
//
def permSub(f, n, xs, a)
  if n == 0 then
    f(reverse(a))
  else
    foreach(fn(x) permSub(f, n - 1, remove(x, xs), cons(x, a)) end, xs)
  end
end

def permutation(f, n, xs)
  permSub(f, n, xs, nil)
end

def combSub(f, n, xs, a)
  if n == 0 then
    f(reverse(a))
  else
    if length(xs) == n then
      f(append(reverse(a), xs))
    else
      begin
        combSub(f, n - 1, cdr(xs), cons(car(xs), a)),
        combSub(f, n, cdr(xs), a)
      end
    end
  end
end

def combination(f, n, xs)
  combSub(f, n, xs, nil)
end

//
// 素数
//
def sieve(n)
  let
     xs = iota(2, n), ys = nil
  in
    while car(xs) <= sqrt(n) do
      ys = cons(car(xs), ys),
      xs = removeIf(fn(x) x % car(xs) == 0 end, xs)
    end,
    revAppend(ys, xs)
  end
end

// 素因数分解
def factorSub(n, m)
  let c = 0 in
    while n % m == 0 do
      c = c + 1,
      n = n / m
    end,
    cons(c, n)
  end
end

def factorization(n)
  let
    xs = factorSub(n, 2),
    ys = if car(xs) != 0 then list(cons(2, car(xs))) else nil end,
    i = 3
  in
    n = cdr(xs),
    while n >= i * i and n != 1 do
      xs = factorSub(n, i),
      if car(xs) != 0 then
        ys = cons(cons(i, car(xs)), ys)
      end,
      n = cdr(xs),
      i = i + 2
    end,
    if n != 1 then ys = cons(cons(n, 1), ys) end,
    reverse(ys)
  end
end

//
// 線形合同法による乱数の生成
//
Seed = 1;
Mask = 0x100000000;
RandMax = Mask - 1;

def srand(n)
  Seed = n % Mask
end

def rand()
  Seed = (69069 * Seed + 1) % Mask,
  Seed
end

def random()
  (1.0 / (RandMax + 1.0)) * rand()
end

//
// マージとソート
//
def insertElement(x, xs)
  if null(xs) then
    list(x)
  else
    if x <= car(xs) then
      cons(x, xs)
    else
      cons(car(xs), insertElement(x, cdr(xs)))
    end
  end
end

def insertSortList(xs)
  let ys = nil in
    while !null(xs) do
      ys = insertElement(car(xs), ys),
      xs = cdr(xs)
    end,
    ys
  end
end

def mergeList(xs, ys)
  if null(xs) then
    ys
  else
    if null(ys) then
      xs
    else
      if car(xs) <= car(ys) then
        cons(car(xs), mergeList(cdr(xs), ys))
      else
        cons(car(ys), mergeList(xs, cdr(ys)))
      end
    end
  end
end

//
def mergeSortSub(n, xs)
  if n < 16 then
    insertSortList(take(xs, n))
  else
    let m = n / 2 in
      mergeList(mergeSortSub(m, xs),
                mergeSortSub(n - m, drop(xs, m)))
    end
  end
end 

def mergeSortList(xs)
  mergeSortSub(length(xs), xs)
end

//
// ベクタのソート
//

// 単純挿入ソート
def insertSort(v)
  let
    i = 1, k = len(v), j = 0, tmp = 0
  in
    while i < k do
      j = i,
      tmp = v[i],
      while j > 0 and v[j - 1] >= tmp do
        v[j] = v[j - 1],
        j = j - 1
      end,
      v[j] = tmp,
      i = i + 1
    end
  end,
  v
end

// クイックソート
def qsort(v, low, high)
  if high - low > 16 then
    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,
      qsort(v, low, i - 1),
      qsort(v, j + 1, high)
    end
  end
end

def quickSort(v)
  qsort(v, 0, len(v) - 1),
  insertSort(v)
end

//
// スタックとキュー
//
def makeStack() list(nil) end

def push(s, x) setCar(s, cons(x, car(s))) end

def pop(s)
  if null(car(s)) then
    error("Stack is empty")
  else
    let x = caar(s) in
      setCar(s, cdar(s)),
      x
    end
  end
end

def top(s)
  if null(car(s)) then
    error("Stack is empty")
  else
    caar(s)
  end
end

def isEmptyStack(s) null(car(s)) end

// キュー
def makeQueue() cons(nil, nil) end

def enqueue(q, x)
  let
    newCell = list(x)
  in
    if null(car(q)) then
      begin setCar(q, newCell), setCdr(q, newCell) end
    else
      begin setCdr(cdr(q), newCell), setCdr(q, newCell) end
    end
  end
end

def dequeue(q)
  if null(car(q)) then
    error("Queue is empty")
  else
    let x = car(q) in
      setCar(q, cdr(x)),
      if null(cdr(x)) then setCdr(q, nil) end,
      car(x)
    end
  end
end

def front(q)
  if null(car(q)) then
    error("Queue is empty")
  else
    caar(q)
  end
end

def isEmptyQueue(q) null(car(q)) end

●プログラムリスト２

//
// mastermind.cal : 数当てゲーム
//
//                  Copyright (C) 2014 Makoto Hiroi
//

def makeQuestion()
  let
    xs = vector(4, -1),
    x = 0, n = 0
  in
    while n < 4 do
      x = (rand() / 0x10000) % 10,
      if !find(x, xs) then
        begin xs[n] = x, n = n + 1 end
      end
    end,
    xs
  end
end

def countBulls(xs, ys)
  let c = 0, i = 0 in
    while i < 4 do
      if xs[i] == ys[i] then c = c + 1 end,
      i = i + 1
    end,
    c
  end
end

def countSameNumber(xs, ys)
  let c = 0, i = 0 in
    while i < 4 do
      if find(xs[i], ys) then c = c + 1 end,
      i = i + 1
    end,
    c
  end
end

def check(xs)
  if isVec(xs) and len(xs) == 4 then
    let i = 0, r = 1 in
      while i < 4 and r do
        if count(xs[i], xs) != 1 then
          r = 0
        else
          i = i + 1
        end
      end,
      r
    end
  end
end

def initRand(n)
  while n > 0 do rand(), n = n - 1 end
end

def mastermind()
  initRand(clock() % 0x100),
  let xs = makeQuestion(),
      ys = 0, r = 1
  in
    while r do
      ys = input("[a,b,c,d]>>> "),
      if eql(ys, 0) then
        begin print("oops! : "), error(xs) end
      end,
      if !check(ys) then
        println("input error")
      else
        let bulls = countBulls(xs, ys),
            cows = countSameNumber(xs, ys) - bulls
        in
          if bulls == 4 then
            r = 0
          else
            begin
              print(r), print(" : "), print(ys),
              print(", Bulls; "), print(bulls),
              print(", Cows: "), println(cows),
              r = r + 1
            end
          end
        end
      end
    end,
    "Good Job!"
  end
end

Go Language Programming

お気楽 Go 言語プログラミング入門

電卓プログラムの改良 (連結リスト編その２)

数値演算

述語

リストのアクセス

リストの生成

簡単なリスト操作

簡単なリストとベクタの操作

リストとベクタの探索

マッピング、フィルター、畳み込み

連想リスト

集合

マージとソート

順列と組み合わせ

スタックとキュー

乱数の生成

おまけ (数当てゲーム)

●プログラムリスト

●プログラムリスト２