M.Hiroi's Home Page

お気楽 Standard ML of New Jersey 入門

関数型電卓プログラムの改良 (付録A)

Copyright (C) 2012-2021 Makoto Hiroi
All rights reserved.

はじめに

関数型電卓プログラム 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))

foreach と copy

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-2021 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
初版 2012 年 9 月 23 日
改訂 2021 年 6 月 5 日