関数型電卓プログラム fcalc の使用例として簡単なライブラリ (付録A) と、それを使ったパズルの解法プログラム (付録B) を示します。
Calc> evenp(2); 1 Calc> evenp(3); 0 Calc> oddp(4); 0 Calc> oddp(5); 1 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> comb(10, 5); 252 Calc> comb(100, 50); 100891344545564193334812497256 Calc> fact(10); 3628800 Calc> fact(20); 2432902008176640000 Calc> expt(2,32); 4294967296 Calc> expt(2,64); 18446744073709551616 Calc> fibo(0); 1 Calc> fibo(1); 1 Calc> fibo(2); 2 Calc> fibo(10); 89 Calc> fibo(100); 573147844013817084101
Calc> pair(cons(1, 2)); 1 Calc> pair(nil); 0 Calc> null(nil); 1 Calc> null(cons(1, 2)); 0 Calc> listp(cons(1, 2)); 1 Calc> listp(nil); 1 Calc> listp(10); 0 Calc> single(cons(1, nil)); 1 Calc> single(nil); 0 Calc> single(list(1,2,3)); 0 Calc> any(evenp, list(1,3,5,7,9)); 0 Calc> any(evenp, list(1,3,4,5,7,9)); 1 Calc> any(oddp, [2,4,6,8,10]); 0 Calc> any(oddp, [2,4,5,6,8,10]); 1 Calc> every(evenp, list(2,4,6,8)); 1 Calc> every(evenp, list(2,4,5,6,8)); 0 Calc> every(evenp, [2,4,6,8,10]); 1 Calc> every(evenp, [2,4,6,8,10,11]); 0 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
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
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)
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> 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> nreverse(c); (8 7 6 5 4 3 2 1) Calc> c; (1) 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> partition(evenp, c); ((2 4 6 8) 1 3 5 7 9) Calc> partition(oddp, c); ((1 3 5 7 9) 2 4 6 8)
Calc> a; (1 2 3 4 5 6 7 8 9) Calc> b; [1, 2, 3, 4, 5, 6, 7, 8, 9] Calc> find(evenp, a); 2 Calc> find(evenp, b); 2 Calc> find(fn(x) x == 10 end, a); Calc> position(evenp, b); 1 Calc> position(evenp, a); 1 Calc> position(fn(x) x == 10 end, a); ~1 Calc> count(evenp, a); 4 Calc> count(evenp, b); 4 Calc> member(5, a); (5 6 7 8 9) Calc> member(10, a);
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(evenp, a); (2 4 6 8) Calc> remove(evenp, 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) Calc> b = iota(11, 18); (11 12 13 14 15 16 17 18) Calc> foldl2(fn(x, y, a) cons(cons(x, y), a) end, nil, a, b); ((8 . 18) (7 . 17) (6 . 16) (5 . 15) (4 . 14) (3 . 13) (2 . 12) (1 . 11)) Calc> foldr2(fn(x, y, a) cons(cons(x, y), a) end, nil, a, b); ((1 . 11) (2 . 12) (3 . 13) (4 . 14) (5 . 15) (6 . 16) (7 . 17) (8 . 18))
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]
リストを集合として扱う関数で、リストには重複要素がないものとする。
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))
Calc> merge(fn(x, y) x < y end, list(1,3,5,7), list(2,4,6,8)); (1 2 3 4 5 6 7 8) Calc> insert_sort(fn(x, y) x < y end, list(1,3,5,7,2,4,6,8)); (1 2 3 4 5 6 7 8) Calc> quick_sort(fn(x, y) x < y end, list(1,3,5,7,2,4,6,8)); (1 2 3 4 5 6 7 8) Calc> merge_sort(fn(x, y) x < y end, 8, list(1,3,5,7,2,4,6,8)); (1 2 3 4 5 6 7 8)
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)
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
# # lib.cal : 関数型電卓ライブラリ (fcalc.sml 用) # # Copyright (C) 2012 Makoto Hiroi # # 数値計算 def evenp(n) n % 2 == 0 end def oddp(n) n % 2 != 0 end def abs(n) if n > 0 then n else - n 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 # 組み合わせの数 def comb(n, r) if n == 0 or r == 0 then 1 else comb(n, r - 1) * (n - r + 1) / r end end # 階乗 def fact(n) if n == 0 then 1 else n * fact(n - 1) end end # 整数の累乗 def expt(x, y) if y == 0 then 1 else let z = expt(x, y / 2) in if y % 2 == 0 then z * z else x * z * z end end end end # フィボナッチ数列 def fibo(n) let rec iter = fn(i, a, b) if i == 0 then a else iter(i - 1, a + b, a) end end in iter(n, 1, 0) end end # 基本的なリスト操作関数 def pair(xs) isPair(xs) end def null(xs) isNil(xs) end def listp(xs) isPair(xs) or isNil(xs) end def single(xs) isPair(xs) and null(cdr(xs)) 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 cdddr(xs) cdr(cdr(cdr(xs))) end def cddddr(xs) cdr(cdr(cdr(cdr(xs)))) end def first(xs) car(xs) end def second(xs) car(cdr(xs)) end def third(xs) car(cdr(cdr(xs))) end def fourth(xs) car(cdr(cdr(cdr(xs)))) end def fifth(xs) car(cdr(cdr(cdr(cdr(xs))))) end # リストの n 番目の要素を取得 def nth(xs, n) if null(xs) then nil else if n == 0 then car(xs) else nth(cdr(xs), n - 1) end end end # リストの生成 def makelist(n, x) let rec iter = fn(n, a) if n == 0 then a else iter(n - 1, cons(x, a)) end end in iter(n, nil) end end def iota(n, m) let rec iter = fn(m, a) if m < n then a else iter(m - 1, cons(m, a)) end end in iter(m, nil) end end def tabulate(f, n, m) let rec iter = fn(m, a) if m < n then a else iter(m - 1, cons(f(m), a)) end end in iter(m, nil) end end # 畳み込み def foldl(f, a, xs) let rec iterL, iterV = fn(a, xs) if null(xs) then a else iterL(f(car(xs), a), cdr(xs)) end end, fn() let k = len(xs), i = 0 in while i < k do a = f(xs[i], a), i = i + 1 end, a end end in if isVector(xs) then iterV() else iterL(a, xs) end end end def foldl2(f, a, xs, ys) if null(xs) or null(ys) then a else foldl2(f, f(car(xs), car(ys), a), cdr(xs), cdr(ys)) end end def foldr(f, a, xs) let rec iterL, iterV = fn(a, xs) if null(xs) then a else f(car(xs), iterL(a, cdr(xs))) end end, fn() let i = len(xs) - 1 in while i >= 0 do a = f(xs[i], a), i = i - 1 end, a end end in if isVector(xs) then iterV() else iterL(a, xs) end end end def foldr2(f, a, xs, ys) if null(xs) or null(ys) then a else f(car(xs), car(ys), foldr2(f, a, cdr(xs), cdr(ys))) end end # マッピング def map(f, xs) if isVector(xs) then let v = makeVector(len(xs), nil) in foldl(fn(x, a) v[a] = f(x), a + 1 end, 0, xs), v end else foldr(fn(x, a) cons(f(x), a) end, nil, xs) end end # フィルター def filter(pred, xs) foldr(fn(x, a) if pred(x) then cons(x, a) else a end end, nil, xs) end def remove(pred, xs) foldr(fn(x, a) if pred(x) then a else cons(x, a) end end, nil, xs) end # def foreach(f, xs) foldl(fn(x, a) f(x) end, nil, xs), nil end # コピー def copy(xs) if isVector(xs) then let v = makeVector(len(xs), nil), in foldl(fn(x, a) v[a] = x, a + 1 end, 0, xs), v end else foldr(fn(x, a) cons(x, a) end, nil, xs) end end # 述語 def every(pred, xs) callcc(fn(k) foldl(fn(x, a) if not pred(x) then k(0) end end, nil, xs), 1 end) end # def any(pred, xs) callcc(fn(k) foldl(fn(x, a) if pred(x) then k(1) end end, nil, xs), 0 end) end # 等値判定 def equal(xs, ys) if pair(xs) and pair(ys) then if equal(car(xs), car(ys)) then equal(cdr(xs), cdr(ys)) end else if isVector(xs) and isVector(ys) then let k = len(xs), i = 0 in if len(ys) == k then while i < k and equal(xs[i], ys[i]) do i = i + 1 end, i == k end end else if (isInteger(xs) and isInteger(ys)) or (isFloat(xs) and isFloat(ys)) then xs == ys else if (isString(xs) and isString(ys)) then strcmp(xs, ys) == 0 else null(xs) and null(ys) end end end end end # 線形探索 def member(x, xs) if null(xs) then nil else if car(xs) == x then xs else member(x, cdr(xs)) end end end def find(pred, xs) callcc(fn(k) foldl(fn(x, a) if pred(x) then k(x) end end, nil, xs), nil end) end def position(pred, xs) callcc(fn(k) foldl(fn(x, a) if pred(x) then k(a) else a + 1 end end, 0, xs), -1 end) end def count(pred, xs) foldl(fn(x, a) if pred(x) then a + 1 else a end end, 0, xs) end # リストの連結 def append(xs, ys) foldr(fn(x, a) cons(x, a) end, ys, xs) 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 nreverse(xs) let rec iter = fn(xs, a) if null(xs) then a else let ys = cdr(xs) in setCdr(xs, a), iter(ys, xs) end end end in iter(xs, nil) end 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) if n == 0 or null(xs) then xs else drop(cdr(xs), n - 1) end end # リストの分割 def partition(pred, xs) let rec iter = fn(xs, a, b) if null(xs) then cons(nreverse(a), nreverse(b)) else if pred(car(xs)) then iter(cdr(xs), cons(car(xs), a), b) else iter(cdr(xs), a, cons(car(xs), b)) end end end in iter(xs, nil, nil) end 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 insert_sort(pred, xs) let rec insert = fn(x, xs) if null(xs) then list(x) else if pred(x, car(xs)) then cons(x, xs) else cons(car(xs), insert(x, cdr(xs))) end end end in foldl(fn(x, a) insert(x, a) end, nil, xs) end end # リストのマージ def merge(pred, xs, ys) if null(xs) or null(ys) then if null(xs) then ys else xs end else if pred(car(xs), car(ys)) then cons(car(xs), merge(pred, cdr(xs), ys)) else cons(car(ys), merge(pred, xs, cdr(ys))) end end end # マージソート def merge_sort(pred, n, xs) if n <= 2 then if n == 1 then list(car(xs)) else if pred(car(xs), cadr(xs)) then list(car(xs), cadr(xs)) else list(cadr(xs), car(xs)) end end else let m = n / 2 in merge(pred, merge_sort(pred, m, xs), merge_sort(pred, n - m, drop(xs, m))) end end end # クイックソート def quick_sort(pred, xs) if null(xs) then nil else if null(cdr(xs)) then xs else let ys = partition(fn(y) pred(y, car(xs)) end, cdr(xs)) in append(quick_sort(pred, car(ys)), cons(car(xs), quick_sort(pred, cdr(ys)))) end end end end # 順列の生成 def permutation(f, n, xs) let rec iter = fn(n, xs, a) if n == 0 then f(reverse(a)) else foreach(fn(x) iter(n - 1, remove(fn(y) x == y end, xs), cons(x, a)) end, xs) end end in iter(n, xs, nil) end end # 組み合わせの生成 def combination(f, n, xs) let rec iter = fn(n, xs, a) if n == 0 then f(reverse(a)) else if n == length(xs) then f(append(reverse(a), xs)) else iter(n - 1, cdr(xs), cons(car(xs), a)), iter(n, cdr(xs), a) end end end in if n > length(xs) then nil else iter(n, xs, nil) end end 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 nil else let x = caar(s) in setCar(s, cdar(s)), x end end end def top(s) if null(car(s)) then nil 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 setCar(q, newCell), setCdr(q, newCell) else setCdr(cdr(q), newCell), setCdr(q, newCell) end end end def dequeue(q) if null(car(q)) then nil 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 nil else caar(q) end end def isEmptyQueue(q) null(car(q)) end