M.Hiroi's Home Page

Memorandum

プログラミングに関する覚え書や四方山話です。
[ Home | 2016年 1月, 3月, 7月, 9月, 11月 ]

2016 年 11 月

11月5日

●F#

F# については拙作のページ F# Programming をお読みください。


2016 年 9 月

9月11日

●Mono

Mono の説明は削除しました。C# については拙作のページ C# Programming をお読みください。


2016 年 7 月

7月30日

●tagbody と go

Common Lisp のお話です。block のタグはレキシカルスコープで管理されますが、同様に tagbody と go のタグ (ジャンプ先) もレキシカルスコープで管理されます。go をラムダ式に包んで他の関数に渡すこともでき、そのラムダ式を評価するとそのタグにジャンプすることができます。

簡単な例を示しましょう。使用した処理系は SBCL です。

* (defun foo (x) (tagbody
(let ((f #'(lambda () (go exit))))
  (funcall x f) (print 1))
exit
(print 2)))

FOO
* (foo #'(lambda (f) (funcall f)))

2 
NIL
* (foo #'(lambda (f) f))

1 
2 
NIL

関数 foo の引数 x は関数で、その引数に go exit を包んだラムダ式を渡します。foo に渡す関数の中で引数を評価すると、go exit が実行されるので、tagbody のタグ exit に制御が移ります。したがって、(funcall x f) のあとの (print 1) は実行されません。引数を評価しない場合、(print 1) が実行されて、そのあとに (print 2) が実行されます。

ISLisp にも tagbody と go が用意されていて、その動作は Common Lisp と同じです。OKI-ISLisp での動作例を示します。

ISLisp>(defun print (x) (format (standard-output) "~A~%" x))
PRINT
ISLisp>(defun foo (x) (tagbody
(let ((f (lambda () (go exit))))
  (funcall x f) (print 1))
exit
(print 2)))
FOO
ISLisp>(foo (lambda (f) (funcall f)))
2
NIL
ISLisp>(foo (lambda (f) f))
1
2
NIL

7月9日

●Lisp / Scheme の繰り返し

Lisp / Scheme のお話です。繰り返しといえば、Scheme では named-let などの再帰定義、Common Lisp では dotime, dolist, do や loop でしょうか。たとえば、リストの総和を求める関数 sum-list を Scheme と Common Lisp で定義すると、次のようになります。

リスト : 総和を求める

; Scheme 版
(define (sum-list xs)
  (let loop ((xs xs) (a 0))
    (if (null? xs)
        a
        (loop (cdr xs) (+ a (car xs))))))

; Common Lisp 版
(defun sum-list (xs)
  (do ((xs xs (cdr xs))
       (a 0 (+ a (car xs))))
      ((null xs) a)))
gosh> (sum-list '(1 2 3 4 5))
15
* (sum-list '(1 2 3 4 5))

15

畳み込み (fold や reduce など) を使ったほうが簡単ですが、あえて繰り返しでプログラムしています。ここで仕様を変更して、負の要素があったら -1 を返すことにしましょう。Scheme 版は末尾再帰なので、簡単にプログラムすることができます。

リスト : 総和 (2)

; Scheme 版
(define (sum-list1 xs)
  (let loop ((xs xs) (a 0))
    (cond ((null? xs) a)
          ((negative? (car xs)) -1)
          (else (loop (cdr xs) (+ a (car xs)))))))
gosh> (sum-list1 '(1 2 3 -4 5))
-1

negative? でリストの要素 (car xs) が負かチェックして、そうであれば loop を再帰呼び出しせずに -1 を返すだけです。

Common Lisp の場合、繰り返しから脱出する return を使うと簡単です。

リスト : 総和 (2)

; Common Lisp 版
(defun sum-list1 (xs)
  (do ((xs xs (cdr xs))
       (a 0 (+ a (car xs))))
      ((null xs) a)
      (if (minusp (car xs))
          (return -1))))
* (sum-list1 '(1 2 3 -4 5))

-1

Common Lisp の場合、do 系の本体は暗黙の block (タグは nil) に囲まれていて、return や return-from nil で繰り返しから脱出することができます。リストの要素 (car xs) が負ならば、(return -1) を評価して、繰り返しから脱出します。この場合、do の返り値は return の引数 (-1) になります。

次は、リストのリストを行列とみなして、行列の要素の総和を求める関数 sum-matrix を定義しましょう。sum-matrix は負の要素を見つけたら -1 を返します。

リスト : 行列の総和

; Scheme 版
(define (sum-matrix xs)
  (let loop1 ((xs xs) (a 0))
    (if (null? xs)
        a
        (let loop2 ((ys (car xs)) (b 0))
          (cond ((null? ys)
                 (loop1 (cdr xs) (+ a b)))
                ((negative? (car ys)) -1)
                (else (loop2 (cdr ys) (+ b (car ys)))))))))

; Common Lisp 版
(defun sum-matrix (xs)
  (do ((xs xs (cdr xs))
       (a 0))
      ((null xs) a)
      (do ((ys (car xs) (cdr ys)))
          ((null ys))
          (if (minusp (car ys))
              (return-from sum-matrix -1)
            (incf a (car ys))))))
gosh> (sum-matrix '((1 2 3) (4 5 6)))
21
gosh> (sum-matrix '((1 2 3) (4 -5 6)))
-1
* (sum-matrix '((1 2 3) (4 5 6)))

21
* (sum-matrix '((1 2 3) (4 5 -6)))

-1

Scheme 版は name-let で二重ループを実現しています。負の要素を見つけたら loop1 や loop2 を再帰呼び出しせずに -1 を返すだけです。Common Lisp の場合、関数の本体は暗黙の block (タグは関数名) で囲まれているので、(return-from sum-matix -1) を評価すれば二重ループを脱出して -1 を返すことができます。

Common Lisp の場合、block のタグはレキシカルスコープです。次のように、高階関数から return-from で脱出することもできます。

リスト : 総和 (3)

; Common Lisp 版
(defun sum-list11 (xs)
  (reduce #'(lambda (a x)
              (if (minusp x)
                  (return-from sum-list11 -1)
                (+ a x)))
          xs
          :initial-value 0))
* (sum-list11 '(1 2 3 4 5 6))

21
* (sum-list11 '(-1 2 3 4 5 6))

-1
* (sum-list11 '(1 2 3 4 5 -6))

-1

畳み込みを行う関数 reduce に渡すラムダ式で、要素 x が負ならば return-from で -1 を返します。タグ sum-list11 はレキシカルスコープなので、ラムダ式の中から参照することができ、return-from でそのブロックから脱出することができます。

また、return-from tag をラムダ式に包んで他の関数に渡すこともできます。この場合、渡されたラムダ式を実行すると、tag で指定した block から脱出することができるのです。次のリストを見てください。

リスト : 行列の総和 (2)

; Common Lisp 版
(defun sum-list2 (failure xs)
  (do ((xs xs (cdr xs))
       (a 0 (+ a (car xs))))
      ((null xs) a)
      (if (minusp (car xs))
          (funcall failure))))

(defun sum-matrix1 (xs)
  (do ((xs xs (cdr xs))
       (a 0 (+ a (sum-list2 #'(lambda () (return-from sum-matrix1 -1))
                            (car xs)))))
      ((null xs) a)))
* (sum-matrix1 '((1 2 3) (4 5 6) (7 8 9)))

45
* (sum-matrix1 '((1 2 3) (4 5 6) (-7 8 9)))

-1

sum-matrix1 は行列 xs から 1 行ずつ取り出して sum-list2 に渡します。このとき、(return-from sum-matrix1 -1) を包んだラムダ式もいっしょに渡します。Common Lisp はレキシカルスコープなので、ラムダ式の中からタグ sum-matrix1 を参照することができます。次に、sum-list2 でリストの要素が負の場合、渡されたラムダ式 failure を評価します。すると、制御は sum-matrix1 に戻って -1 を返すことができます。

この動作は Scheme の call/cc による大域脱出とよく似ています。Scheme で同様のプログラムを作ると次のようになります。

リスト : 行列の総和 (2)

; Scheme 版
(define (sum-list2 failure xs)
  (let loop ((xs xs) (a 0))
    (cond ((null? xs) a)
          ((negative? (car xs)) (failure -1))
          (else (loop (cdr xs) (+ a (car xs)))))))

(define (sum-matrix1 xs)
  (call/cc
   (lambda (bk)
     (let loop ((xs xs) (a 0))
       (if (null? xs)
           a
           (loop (cdr xs) (+ a (sum-list2 bk (car xs)))))))))
gosh> (sum-matrix1 '((1 2 3) (4 5 6) (7 8 9)))
45
gosh> (sum-matrix1 '((1 2 3) (4 5 6) (7 -8 9)))
-1

call/cc で継続を取り出して変数 bk にセットし、それを sum-list2 に渡します。sum-list2 では、要素が負であれば継続 failure を評価して -1 を返します。

Common Lisp の場合、catch, throw による例外処理をサポートしているので、block とラムダ式を使って大域脱出をプログラムすることはないでしょうが、高階関数などで処理を中断させたい場合、この方法を使うことができます。それにしても、こんなことができるなんて Common Lisp は凄いですね。改めて強力なプログラミング言語だと思いました。

ところで、ISLisp は Common Lisp のサブセットなので、block tag と return-from tag でブロックから脱出することができます。ただし、Common Lisp とは違って、暗黙のブロックはありません。ご参考までに、ISLisp のプログラムと実行結果を示します。

リスト : ISLisp バージョン

(defun sum-list (xs)
  (for ((xs xs (cdr xs))
        (a 0 (+ a (car xs))))
       ((null xs) a)))

(defun sum-list1 (xs)
  (block exit
    (for ((xs xs (cdr xs))
          (a 0 (+ a (car xs))))
         ((null xs) a)
         (if (< (car xs) 0)
             (return-from exit -1)))))

; 畳み込み
(defun fold-left (f a xs)
  (for ((acc a (funcall f acc (car ys)))
        (ys xs (cdr ys)))
       ((null ys) acc)))

(defun sum-list11 (xs)
  (block exit
    (fold-left (lambda (a x)
                 (if (< x 0)
                     (return-from exit -1)
                   (+ a x)))
               0
               xs)))

(defun sum-matrix (xs)
  (block exit
    (for ((xs xs (cdr xs))
          (a 0))
         ((null xs) a)
         (for ((ys (car xs) (cdr ys)))
                  ((null ys))
                  (if (< (car ys) 0)
                      (return-from exit -1)
                    (setq a (+ a (car ys))))))))

(defun sum-list2 (failure xs)
  (for ((xs xs (cdr xs))
        (a 0 (+ a (car xs))))
       ((null xs) a)
       (if (< (car xs) 0)
           (funcall failure))))

(defun sum-matrix1 (xs)
  (block exit
    (for ((xs xs (cdr xs))
          (a 0 (+ a (sum-list2 (lambda () (return-from exit -1))
                               (car xs)))))
         ((null xs) a))))
ISLisp>(sum-list '(1 2 3 4 5))
15
ISLisp>(sum-list1 '(1 2 -3 4 5))
-1
ISLisp>(fold-left #'+ 0 '(1 2 3 4 5 6))
21
ISLisp>(sum-list11 '(1 2 3 4 5 6))
21
ISLisp>(sum-list11 '(-1 2 3 4 5 6))
-1
ISLisp>(sum-list11 '(1 2 3 4 5 -6))
-1
ISLisp>(sum-matrix '((1 2 3) (4 5 6)))
21
ISLisp>(sum-matrix '((1 2 3) (4 -5 6)))
-1
ISLisp>(sum-matrix1 '((1 2 3) (4 5 6)))
21
ISLisp>(sum-matrix1 '((1 2 3) (4 -5 6)))
-1

2016 年 3 月

3月20日

●マスターマインド (改)

M.Hiroi' Home Page で取り上げたマスターマインドは、0 から 9 までの重複しない 4 つの数字からなる隠しコードを当てるゲームでした。マスターマインドを解く場合、簡単な推測アルゴリズムを使うと、平均質問回数が 5.56 回で、質問回数の最大値は 9 回になります。

今回は数字の個数を 5 個に増やして、平均質問回数とその最大値がどうなるか、julia でプログラムを作って確かめてみました。プログラムは Julia: マスターマインドの解法 を改造すると簡単に作ることができます。説明は割愛しますので、詳細は プログラムリスト をお読みください。

結果ですが、平均質問回数が 5.99 回、質問回数の最大値は 9 で、そのときのコードは 84 通りになりました。もっと難しくなるかと思っていたので、予想外の結果にちょっと驚きました。

●プログラムリスト

#
# mastermind.jl : マスターマインドの解法
#                 (0 - 9 の数字から 5 個を選ぶ場合)
#
#                 Copyright (C) 2016 Makoto Hiroi
#

# 定数
const CSIZE = 5

# 質問したコードとその結果
type Query
    bulls::Int
    cows::Int
    code::Array{Int, 1}
end

# 0 - 9 から 5 個の数字を選ぶ順列を生成
function permutations(f, xs, n = 1)
    if n > CSIZE
        f(xs[1:CSIZE])
    else
        tmp = xs[n]
        for i in n : length(xs)
            xs[n] = xs[i]
            xs[i] = tmp
            permutations(f, xs, n + 1)
            xs[i] = xs[n]
            xs[n] = tmp
        end
    end
end

# bulls を数える
function count_bulls(xs, ys)
    c = 0
    for i in 1 : CSIZE
        if xs[i] == ys[i]; c += 1; end
    end
    c
end

# 同じ数字を数える
function count_same_number(xs, ys)
    c = 0
    for x in xs
        for y in ys
            if x == y
                c += 1
                break
            end
        end
    end
    c
end

function check(answer, xs)
    global query
    for q in query
        b = count_bulls(q.code, xs)
        c = count_same_number(q.code, xs) - b
        if b != q.bulls || c != q.cows
            return
        end
    end
    b = count_bulls(answer, xs)
    c = count_same_number(answer, xs) - b
    q = Query(b, c, xs)
    push!(query, q)
    if b == CSIZE
        throw(length(query))
    end
end

function solver()
    c = 0
    m = 0
    max_code = []
    function solver_sub(answer)
        global query
        query = Query[]
        try
            permutations(xs -> check(answer, xs), collect(0:9))
        catch e
            if m < e
                m = e
                max_code = []
            end
            if m == e
                push!(max_code, answer)
            end
            c += e
        end
    end
    permutations(solver_sub, collect(0:9))
    println(c / (10 * 9 * 8 * 7 * 6))
    println(m)
    println(max_code)
    println(length(max_code))
end

solver()
5.994246031746032
9
Any[[1,8,3,9,0],[3,9,8,0,1],[5,2,9,1,7],[5,0,6,8,3],[5,7,8,1,2],[5,8,3,7,0],
[6,5,4,1,2],[6,5,4,0,2],[6,0,1,3,9],[7,2,3,4,5],[7,3,1,4,9],[7,3,8,0,6],
[7,3,8,2,5],[7,4,0,3,5],[7,4,9,2,6],[7,5,4,0,2],[7,5,4,0,1],[7,5,9,0,3],
[7,6,8,0,3],[7,8,0,2,5],[7,8,9,6,1],[7,9,1,6,3],[8,2,1,7,9],[8,2,7,6,0],
[8,3,6,4,2],[8,4,6,0,1],[8,6,4,3,0],[8,6,5,4,3],[8,6,0,1,2],[8,7,5,4,0],
[8,7,5,0,1],[8,7,6,2,3],[8,7,6,1,2],[8,7,6,0,2],[8,7,0,6,3],[8,7,0,2,5],
[8,7,0,9,1],[8,7,9,1,2],[8,7,9,0,2],[8,0,7,6,5],[8,0,7,9,4],[8,9,1,7,2],
[9,1,0,3,8],[9,1,0,4,7],[9,2,6,0,4],[9,3,7,6,5],[9,3,8,4,0],[9,4,3,7,6],
[9,4,1,8,0],[9,4,5,0,3],[9,4,6,3,0],[9,5,3,8,7],[9,5,4,2,0],[9,5,4,8,1],
[9,5,4,8,0],[9,5,6,8,7],[9,5,7,6,8],[9,5,7,0,3],[9,6,4,0,1],[9,7,3,8,1],
[9,7,3,8,0],[9,7,4,2,5],[9,7,5,1,2],[9,7,6,1,2],[9,7,1,6,3],[9,7,0,5,3],
[9,7,0,2,5],[9,8,2,4,0],[9,8,3,5,1],[9,8,3,6,0],[9,8,3,7,1],[9,8,4,1,5],
[9,8,4,0,7],[9,8,6,1,2],[9,8,6,0,2],[9,8,7,2,5],[9,8,1,5,3],[9,8,1,0,7],
[9,8,0,5,7],[9,8,0,6,7],[9,8,0,1,7],[9,0,2,8,3],[9,0,7,5,6],[9,0,8,6,5]]
84

2016 年 1 月

1月30日

●ハミングの問題 (Hamming's Problem)

今回は「ハミングの問題」を解いてみましょう。

[ハミングの問題]

7 以上の素数で割り切れない正の整数を小さい順に N 個求めよ

参考文献 : 奥村晴彦,『C言語による最新アルゴリズム事典』, 技術評論社, 1991 (361 ページより引用)

7 以上の素数で割り切れない正の整数は、素因子が 2, 3, 5 しかない自然数のことです。これを「ハミング数 (Hamming Numbers)」といいます。ハミング数は素因数分解したとき、2i * 3j * 5k (i, j, k >= 0) の形式になります。たとえば、100 以下のハミング数は次のようになります。

1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36, 40, 45, 48, 50, 
54, 60, 64, 72, 75, 80, 81, 90, 96, 100

今回は問題を少し変えて、正の整数 n 以下のハミング数をすべて求めるプログラムを作ってみましょう。一番簡単な方法は、1 から n までの整数列を生成して、そこからハミング数を取り出していくことです。これを Python (PyPy ver 4.0.1) でプログラムすると次のようになります。

リスト : ハミングの問題

import time

def check(n):
    while n % 2 == 0: n /= 2
    while n % 3 == 0: n /= 3
    while n % 5 == 0: n /= 5
    return n == 1

def hamming(n):
    return [x for x in xrange(1, n + 1) if check(x)]

for x in xrange(2, 9):
    s = time.clock()
    print 10 ** x, len(hamming(10 ** x))
    print time.clock() - s

関数 check(n) は n がハミング数かチェックします。これは 2, 3, 5 だけで割り切れるか試しているだけです。実行結果は次のようになります。

100 34
0.00136311918243
1000 86
0.00761471403654
10000 175
0.0319288043131
100000 313
0.0208745701766
1000000 507
0.092587141429
10000000 768
0.892231480216
100000000 1105
9.03453561814

実行環境 : Windows 7, Core i7-2670QM 2.20GHz, PyPy 4.0.1

プログラムはとても簡単ですが、引数 n の値が大きくなると時間がかかるようになります。n に比べてハミング数の個数は少ないようなので、式 2i * 3j * 5k (i, j, k >= 0) を使ってハミング数を生成したほうがよさそうです。引数 n に対して i, j, k の上限値は log2 n, log3 n, log5 n で求めることができます。たとえば、100000000 の場合は次のようになります。

i : 0 - 26
j : 0 - 16
k : 0 - 11

全体で 27 * 17 * 12 = 5508 個しかありません。この中から 100000000 以下の数を選べばいいわけです。プログラムは次のようになります。

リスト : ハミングの問題 (2)

import math

def hamming2(n):
    xs2 = [2 ** x for x in xrange(0, int(math.log(n, 2)) + 1)]
    xs3 = [3 ** x for x in xrange(0, int(math.log(n, 3)) + 1)]
    xs5 = [5 ** x for x in xrange(0, int(math.log(n, 5)) + 1)]
    return sorted([x * y * z for x in xs2 for y in xs3 for z in xs5 if x * y * z <= n])

for x in xrange(8, 12):
    s = time.clock()
    print 10 ** x, len(hamming2(10 ** x))
    print time.clock() - s

2, 3, 5 のべき乗の集合を生成し、その要素を内包表記で掛け合わせて、条件を満たす数値を選択していくだけです。実行結果は次のようになりました。

100000000 1105
0.014069237311
1000000000 1530
0.00531532510766
10000000000 2053
0.0165216389339
100000000000 2683
0.0105336177752

とても速くなりましたね。このほかにも 参考文献 のプログラムが高速で、Python でジェネレータにすることも簡単です。

リスト : ハミングの問題 (3)

def hamming4():
    hs = []
    j2 = j3 = j5 = 0
    m2 = m3 = m5 = 1
    while True:
        m = min(m2, m3, m5)
        hs.append(m)
        yield m
        while m2 <= m:
            m2 = 2 * hs[j2]
            j2 += 1
        while m3 <= m:
            m3 = 3 * hs[j3]
            j3 += 1
        while m5 <= m:
            m5 = 5 * hs[j5]
            j5 += 1

for x in hamming4():
    print x,
    if x >= 100: break
1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 40 45 48 50 54 60 64 72 75
80 81 90 96 100

このプログラムは配列 hs にハミング数をそのまま保持しているため、巨大なハミング数を求めようとするとメモリ不足になると思われます。そのような場合、不要になったハミング数を hs から削除するとうまくいくかもしれません。興味のある方はプログラムを改良してみてください。


1月9日

Algorithms with Python 部分和問題 へ移動しました。


1月3日

●擬似完全数と不思議数

Algorithms with Python 部分和問題 へ移動しました。


1月1日

あけましておめでとうございます

旧年中は大変お世話になりました
本年も M.Hiroi's Home Page をよろしくお願い申し上げます


Copyright (C) 2016 Makoto Hiroi
All rights reserved.

[ Home ]