Comments
Description
Transcript
高知大学教育学部の情報数学のテキスト 文責 ： 高知大学名誉教授 中村
高知大学教育学部の情報数学のテキスト 文責 ： 高知大学名誉教授 中村 治 Scheme のプログラミング 次に LISP の方言である Scheme のプログラミングを勉強します。 DrRacket を立ち上げる。 上の領域に #lang racket が表示されていることを確認する。 そうでなければ、Language メニューで、Choose Language を選択。一番上の「Use the language declare in the source...」のラジオボタンをクリックする。「OK」ボタンをクリックする。 1 上の領域に #lang racket が表示されていることを確認する。上の行の「Run」ボタンをクリッ クする。 上の領域にはプログラムを書き込み、下の領域には実行したい関数を書き込む。 下の領域に次のように書き込む。 486 次のような返事が返る。 486 四則計算 下の領域に次のように書き込む。 2 (+ 137 349) 次のような返事が返る。 486 下の領域に次のように書き込む。 (- 1000 334) 次のような返事が返る。 666 下の領域に次のように書き込む。 (* 5 99) 次のような返事が返る。 495 下の領域に次のように書き込む。 (/ 10 5) 次のような返事が返る。 2 これらはネストしても良い。下の領域に次のように書き込む。 (+ (* 3 5) (- 10 6)) 次のような返事が返る。 19 変数の定義と使用 数値に名前を付けてみる。下の領域に次のように書き込む。 (define size 2) 今度は何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。下の領域に次のように 書き込む。 size 次のような返事が返る。 2 下の領域に次のように書き込む。 (* 5 size) 次のような返事が返る。 3 10 上の行の「Run」ボタンをクリックする。環境が初期化される。 関数の定義と使用 関数を定義してみる。下の領域に次のように書き込む。 (define (square x) (* x x)) 今度も何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。下の領域に次のように 書き込む。 (square 21) 次のような返事が返る。 441 下の領域に次のように書き込む。 (square (+ 2 5)) 次のような返事が返る。 49 下の領域に次のように書き込む。 (square (square 3)) 次のような返事が返る。 81 (define (square x) (* x x)) は、引数 x を取る関数 (square x) を (* x x) と定義すると読みます。 関数は次のように定義する。 (define (<name> <formal parameters>) <body>) ＜ name ＞ は関数の名前を表す symbol です。＜ formal parameters ＞ は引数の並びです。この 引数は ＜ body ＞ の中だけで有効なです。＜ body ＞が関数の本体の定義です。引数と ＜ body ＞の中の出現を別のものに入れ替えても同じ定義になります。引数は ＜ body ＞の中で局所的で す。つまり、 (define (square x) (* x x)) と (define (square abc) (* abc abc)) は同じ関数 square を定義していて、(square ＜ e ＞) を評価することは (* ＜ e ＞ ＜ e ＞) を計算 することになります。但し、＜ e ＞ は square の引数として一度だけまず評価され、その値の平方 を計算します。＜ e ＞ を形式的に置き換えてから、(* ＜ e ＞ ＜ e ＞) を計算するわけではありま せん。 さらに関数を定義してみる。下の領域に次のように書き込む。 4 (define (sum-of-square x y) (+ (square x) (square y))) 今度も何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。下の領域に次のように 書き込む。 (define (f a) (sum-of-square (+ a 1) (* a 2))) 今度も何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。下の領域に次のように 書き込む。 (f 5) 次のような返事が返る。 136 (define (f a) (sum-of-square (+ a 1) (* a 2))) は、引数 a を取る関数 (f a) を すでに定義している関数 (define (sum-of-square x y) (+ (square x) (square y))) を使って、(sum-of-square (+ a 1) (* a 2)) で定義しています。 絶対値関数 次に絶対値を与える関数 (abs x) を定義してみる。実際は絶対値を与える関数 (abs x) は元々シ ステムで定義されているので、わざわざ定義しなくても使えるのですが。 (define (abs x) (cond ((> x 0) x) ((= x 0) 0) ((< x 0) (- x)))) 今度も何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。 cond の構文は (cond (<p1> <e1>) (<p2> <e2>) . . . (<pn> <en>)) または 5 (cond (<p1> <e1>) (<p2> <e2>) . . . (<pn> <en>) (else <e>)) の型で、＜ pi ＞ で条件（真か偽を与える関数または変数）を指定し、、＜ pi ＞ が真であれば、そ の値が ＜ ei ＞ となる。２番目の型の場合、＜ p1 ＞, ＜ p2 ＞,..., ＜ pn ＞ がすべて偽であれば、 その値が ＜ e ＞ になる。 従って絶対値を与える関数 (abs x) を次のように定義しても良い。 (define (abs x) (cond ((< x 0) (- x)) (else x))) 今度も何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。下の領域に次のように 書き込む。 (abs -8) 次のような返事が返る。 8 さらに絶対値を与える関数 (abs x) を次のように定義しても良い。 (define (abs x) (if (< x 0) (- x) x)) 今度も何も返事をせず、次のプロンプト（入力促進記号）を表示するだけ。ここでは if 構文を使っ ている。 (if <predicate> <consequent> <alternative>) の型で使い、＜ predicate ＞ の値が真なら、＜ consequent ＞ がその値になり、＜ predicate ＞ の 値が偽なら、＜ alternative ＞ がその値になる。 引数 a に b の絶対値を加える関数 (a-plus-abs-b a b) を次のように定義しても良い。 (define (a-plus-abs-b a b) ((if (> b 0) + -) a b)) 下の領域に次のように書き込む。 (a-plus-abs-b 4 -6) 次のような返事が返る。 6 10 論理積、論理和、否定 論理積、論理和、否定はそれぞれ and, or, not で表される。 (and <e1> <e2> ... <en>) は、左から右に順に評価し、＜ ei ＞ が偽になれば、全体が偽で、それ以降の式は評価しない。す べての ＜ ei ＞ が真なら全体が真となる。例えば、 5 < x < 10 は (and (> x 5) (< x 10)) と表現できる。 (or <e1> <e2> ... <en>) は、左から右に順に評価し、＜ ei ＞ が真になれば、全体が真で、それ以降の式は評価しない。す べての ＜ ei ＞ が偽なら全体が偽となる。 (not <e>) は、＜ e ＞ が真なら全体は偽で、＜ e ＞ が偽なら全体は真である。 階乗を与える関数 次に階乗を与える関数 (factorial n) を定義してみる。 (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) 下の領域に次のように書き込む。 (factorial 5) 次のような返事が返る。 120 (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) は、階乗の再帰的な定義 N! = 1 if N = 1 N! = N * (N-1)! if N > 1 7 を Racket で表現したものです。 問題：三個の数字を引数に取り、その内の大きい二個の平方の和を返す関数を定義しなさい。 平方根を与える関数 次に平方根を与える関数 (sqrt x) を定義してみる。実際は平方根を与える関数 (sqrt x) は元々 システムで定義されているので、わざわざ定義しなくても使えるのですが、ニュートン法を使って 計算します。ニュートン法は後で説明します。 上の領域に次のように書き込む。 (define (sqrt x) (sqrt-iter 1.0 x)) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (define (improve guess x) (average guess (/ x guess))) (define (average x y) (/ (+ x y) 2)) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (square x) (* x x)) 上の行の「Run」ボタンをクリックする。上の領域に書き込んだ関数の定義が有効になる。 8 下の領域に次のように書き込む。 (sqrt 9) 次のような返事が返る。 3.00009155413138 square, good-enough?, average, improve, sqrt-iter の各関数は sqrt を定義するための みに必要だから、次のように定義する方がもっと良い。上の定義を消して、上の領域に次のように 書き込む。 (define (sqrt x) 9 (define (square x) (* x x)) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (average x y) (/ (+ x y) 2)) (define (improve guess x) (average guess (/ x guess))) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (sqrt-iter 1.0 x)) 上の行の「Run」ボタンをクリックすると上の領域に書き込んだ関数の定義が有効になる。下の 領域に次のように書き込む。 (sqrt 9) 次のような返事が返る。 3.00009155413138 10 このように上の領域に書き込むとこれらのプログラムを保存したり、保存したプログラムを読み 込んだり出来ます。 (define (sqrt x) (define (square x) (* x x)) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (average x y) (/ (+ x y) 2)) (define (improve guess x) (average guess (/ x guess))) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (sqrt-iter 1.0 x)) の (define (square x) (* x x)) は、x の平方を与える関数 (square x) を定義していて、 (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) は、近似値 guess が x の平方根に十分近いかを判定する関数 (good-enough guess x?) を guess の 平方と x の差の絶対値が 0.001 より小さいかどうかで判定することで定義し、 11 (define (average x y) (/ (+ x y) 2)) は、x と y の平均を与える関数 (average x y) を定義し、 (define (improve guess x) (average guess (/ x guess))) は、guess と x からより良い近似値に改良する関数 (improve guess x) を (average guess (/ x guess)) で定義し、 (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) は、x の平方根の近似値を、近似値 guess からはじめて、再帰的に求める関数 (sqrt-iter guess x) を、近似値 guess が良い近似値なら答えを guess にし、そうでなければ、近似値 guess をより良 い近似値に改良し、再び、(sqrt-iter guess x) を再帰的に呼ぶことで計算するように定義して います。最後に、 (sqrt-iter 1.0 x)) で、最初の近似値を 1.0 として、(sqrt-iter 1.0 x) を呼んで、x の近似値を計算しています。最 初の近似値は 1.0 でなくても、x の値に応じて、2.0 でも 3.0 でも 9.0 でも良いです。 問題：上の平方根を返す関数を参考に立方根を返す関数を定義しなさい。 硬貨による両替の個数を計算する関数 How many different ways can we make change of $1.00, given half-dollars,quarters, dimes,nickels, and pennies? に答えるためには次のようなプログラムを作ればよい。 (define (count-change amount) (cc amount 5)) (define (cc amount kinds-of-coins) (cond ((= amount 0) 1) ((or (< amount 0) (= kinds-of-coins 0)) 0) (else (+ (cc amount (- kinds-of-coins 1)) (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins))))) (define (first-denomination kinds-of-coins) (cond ((= kinds-of-coins 1) 1) ((= kinds-of-coins 2) 5) ((= kinds-of-coins 3) 10) 12 ((= kinds-of-coins 4) 25) ((= kinds-of-coins 5) 50))) 次を実行する。 (count-change 100) 292 を得る。 (define (count-change amount) (cc amount 5)) (define (cc amount kinds-of-coins) (cond ((= amount 0) 1) ((or (< amount 0) (= kinds-of-coins 0)) 0) (else (+ (cc amount (- kinds-of-coins 1)) (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins))))) (define (first-denomination kinds-of-coins) (cond ((= kinds-of-coins 1) 1) ((= kinds-of-coins 2) 5) ((= kinds-of-coins 3) 10) ((= kinds-of-coins 4) 25) ((= kinds-of-coins 5) 50))) は、まず、金額 amount をコインに両替する個数を数える関数 (count-change amount) をコインの種類が五個あるので、五種類のコインを使って、金額 amount を両替する個数を数 える関数 (cc amount 5) を計算すればよいと問題を書き直します。次に、 (define (cc amount kinds-of-coins) (cond ((= amount 0) 1) ((or (< amount 0) (= kinds-of-coins 0)) 0) (else (+ (cc amount (- kinds-of-coins 1)) (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins))))) で、kinds-of-coins 種類のコインを使って、金額 amount を両替する個数を数える関数 (cc amount kinds-of-coins) は、残りの金額 amount が 0 になれば、一と通りあったことになり、そうでなく、残りの金額 amount が負になるか両替すべきコインの種類がなくなれば、両替に失敗したことになり、従って、 13 両替の個数は 0 とし、そうでなければ、再帰的に、両替の個数は残りの金額 amount はそのまま で、使えるコインの種類を一つ減らした場合の両替の個数と使えるコインの最初のもの一枚でで 残りの金額 amount 両替したのち使えるコインの種類はそのままで両替を続けた場合の個数との 和が答えであると定義しています。文章で書くと複雑ですが、関数をじっと眺めていれば分かりま す。最後に (define (first-denomination kinds-of-coins) (cond ((= kinds-of-coins 1) 1) ((= kinds-of-coins 2) 5) ((= kinds-of-coins 3) 10) ((= kinds-of-coins 4) 25) ((= kinds-of-coins 5) 50))) で、kinds-of-coins 種類のコインの最初のものを使って両替するとは、使えるコインの種類が１種 類の場合は 1 セント、２種類の場合は 5 セント、３種類の場合は 10 セント、４種類の場合は 25 セント、そして、５種類の場合は 50 セントを両替すると定義しています。 問題：このプログラムを作り替えて、１０００円札を両替する方法の個数を求めよ。 正弦関数を計算する sin(x) は x が十分小さければ x と等しいということと sin(x) = 3 sin(x/3) - 4 sin^3(x/3) と いう公式を用いて次のように sin(x) の近似値を計算するプログラムを定義することが出来る。 (define (cube x) (* x x x)) (define (p x) (- (* 3 x) (* 4 (cube x)))) (define (sine angle) (if (not (> (abs angle) 0.1)) angle (p (sine (/ angle 3.0))))) 次を実行する。 (sine (/ pi 6)) 0.5002561624296237 を得る。 (define (cube x) (* x x x)) (define (p x) (- (* 3 x) (* 4 (cube x)))) (define (sine angle) (if (not (> (abs angle) 0.1)) angle (p (sine (/ angle 3.0))))) の (define (cube x) (* x x x)) 14 は、x の三乗を計算する関数 (cube x) を定義していて、 (define (p x) (- (* 3 x) (* 4 (cube x)))) は、x の三次関数 3x - 4x^3 を計算する関数 (p x) を定義していて、最後に (define (sine angle) (if (not (> (abs angle) 0.1)) angle (p (sine (/ angle 3.0))))) で、angle の sin は、angle の絶対値が 0.1 以下であれば、angle が答えで、そうでなければ、再 帰的に、 3 sin(angle/3) - 4 sin^3(angle/3) を計算せよと定義しています。 問題：この関数を用いて、cos(x) の近似値を計算するプログラムを定義せよ。 べき乗を計算する べき乗 b^n を計算するプログラム expt はシステムですでに定義されているので改めて定義す る必要はないが、次のようにすることが出来る。 (define (expt b n) (if (= n 0) 1 (* b (expt b (- n 1))))) これは、べき乗 b^n が帰納的に b^n = 1 if n = 0 b^n = b * b^(n-1) if n > 1 と定義できることに基づいています。しかし、これは次のように定義した方が効率がよい。 (define (fast-expt b n) (cond ((= n 0) 1) ((even? n) (sqr (fast-expt b (/ n 2)))) (else (* b (fast-expt b (- n 1)))))) これは帰納的定義 b^n = 1 if n = 0 b^n = (b^(n/2))^2 b^n = b * b^(n-1) if n is even if n is odd に基づいています。 さらに、これは次のようにも定義することができる。 (define (expt-fast b n) (define (expt-fast-iter b n e p) (cond ((zero? n) p) 15 ((even? n) (expt-fast-iter b (/ n 2) (sqr e) p)) (else (expt-fast-iter b (/ (- n 1) 2) (sqr e) (* e p))))) (expt-fast-iter b n b 1)) 次を実行する。 (expt-fast 2 1000) 10715086071862673209484250490600018105614048117055336074437503883703510511249361 22493198378815695858127594672917553146825187145285692314043598457757469857480393 45677748242309854210746050623711418779541821530464749835819412673987675591655439 46077062914571196477686542167660429831652624386837205668069376 を得る。これは文章で説明しようとすると複雑になりますが、1000 の 2 進数表現が 1111101000 であることより 2 の 1000 乗は 2^3 * 2^5 * 2^6 * 2^7 * 2^8 * 2^9 を計算すれば良いという 事実を使って計算しています。(expt-fast-iter b n e p) の p に答えの途中経過の値、e に 2 のべき乗の途中経過の値を保存して、再帰的に計算しています。多分、じっと眺めていれば分かり ます。 Fibonacci 数列を求める Fibonacci 数列は Fib(0)=0, Fib(1)=1, Fib(2)=1, Fib(3)=2, Fib(4)=3, ... , Fib(n)=Fib(n1)+Fib(n-2), ... で定義される。素朴なプログラムは次のようになる。 (define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))))) 次を実行する。 (time (fib 40)) cpu time: 40623 real time: 40819 gc time: 62 102334155 を得る。計算はしてくれましたが時間がかかります。 (define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))))) は、Fibonacci 数列の帰納的な定義 Fib(n) = 0 Fib(n) = 1 if n = 0 if n = 1 Fib(n) = Fib(n-1) + Fib(n-2) if n > 1 16 をそのままプログラミングしたものです。 次のように修正します。 (define (fib2 n) (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n)) 次を実行する。 (time (fib2 40)) cpu time: 0 real time: 0 gc time: 0 102334155 を得る。めちゃくちゃ早くなりました。 問題：アッカーマン関数 Ack(m.n) は、非負整数 m, n に対して if m = 0 n+1 Ack(m, n) = Ack(m − 1, 1) if m > 0 and n = 0 Ack(m − 1, Ack(m, n − 1)) otherwise (1) で定義されます。アッカーマン関数 Ack(m.n) を計算する関数を定義しなさい。 級数を使って円周率を計算する 1/1・3+1/5・7+1/9・11+・ ・ ・ は pi/8 に非常にゆっくり収束する。 (define (pi-sum a b) (if (> a b) 0 (+ (/ 1.0 (* a (+ a 2))) (pi-sum (+ a 4) b)))) 次を実行する。 > (* 8 (pi-sum 1 1000)) 3.139592655589783 を得る。 (define (pi-sum a b) (if (> a b) 0 (+ (/ 1.0 (* a (+ a 2))) (pi-sum (+ a 4) b)))) は、a が b 以下の間は a を 4 だけ増やしながら、1/a(a+2) を加えている。 級数を使って円周率を計算の一般化 これを一般化して、加える項を計算する関数 (term a) と次の a の値を与える関数 (next a) を 引数として 17 (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) という関数を定義することが出来る。この関数を使って (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) (define (pi-sum a b) (define (pi-term x) (/ 1.0 (* x (+ x 2)))) (define (pi-next x) (+ x 4)) (sum pi-term a pi-next b)) で、 (define (pi-sum a b) (if (> a b) 0 (+ (/ 1.0 (* a (+ a 2))) (pi-sum (+ a 4) b)))) を書き直すことが出来る。 次を実行する。 (* 8 (pi-sum2 1 1000)) 3.139592655589783 を得る。 関数 f(x) の数値積分を計算をする 同じく (sum term a next b) を使って、関数 f(x) の数値積分は次で与えられる。 (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) (define (integral f a b dx) (define (add-dx x) (+ x dx)) (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) 18 次を実行する。 (integral cube 0 1 0.01) 0.24998750000000042 を得る。ここで、cube は (define (cube x) (* x x x)) で定義される、３次関数である。次を実行する。 (integral cube 0 1 0.001) 0.249999875000001 を得る。 今度は、Simpson の公式 h (y0 + 4y1 + 2y2 + 4y3 + 2y4 + · · · + 2yn−2 + 4yn−1 + yn ) 3 where h = (b − a) , f or some even integer n, and yk = f (a + kh). n を使う。 (define (simpson f a b n) (define h (/ (- b a) n)) (define (sum term a next b) (cond ((>= a b) 0.0) (else (+ (term a) (sum term (next a) next b))))) (define (next x) (+ x (* 2 h))) (define (term x) (* (+ (* 2 (f x)) (* 4 (f (+ x h)))) (/ h 3))) (+ (sum term a next b) (* (- (f b) (f a)) (/ h 3)))) 次を実行する。 (simpson cube 0 1 100) 0.25 を得る。 関数 f(x) の固定点を求める 関数 f(x) の固定点（fixed point) f(x), f(f(x), f(f(f(x))), f(f(f(f(x)))), ... 19 は、次で見つけることが出来る。 (define (fixed-point f first-guess) (define tolerance 0.00001) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) (try first-guess)) 次を実行する。 (fixed-point cos 1.0) 0.7390822985224023 を得る。 (define (fixed-point f first-guess) (define tolerance 0.00001) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) (try first-guess)) の (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) で使っている (let ((next (f guess))) (if (close-enough? guess next) next (try next))) は、 20 (let (変数の定義の並び) body ) の形で、今の場合、変数 next に (f guess) を定義した後 (if (close-enough? guess next) next (try next)) を実行する事を指示している。これが関数の値になる。 次を実行する。 (fixed-point (lambda (y) (+ (sin y) (cos y))) 1.0) 1.2587315962971173 を得る。 (fixed-point (lambda (y) (+ (sin y) (cos y))) 1.0) の (lambda (y) (+ (sin y) (cos y))) は、関数名のない１変数 y の関数 (+ (sin y) (cos y)) を定義する方法である。 方程式 g(x) = 0 の根を Mewton 法で求める 方程式 g(x) = 0 の根を Mewton 法で求める。 (define (deriv g) (define dx 0.00001) (lambda (x) (/ (- (g (+ x dx)) (g x)) dx))) (define (newton-transform g) (lambda (x) (- x (/ (g x) ((deriv g) x))))) (define (newtons-method g guess) (fixed-point (newton-transform g) guess)) これを使って、x の平方根は次で得られる。 (define (square-root2 x) (newtons-method (lambda (y) (- (sqr y) x)) 1.0)) 次を実行する。 (square-root2 2) 1.4142135623822438 を得る。 21 (define (deriv g) (define dx 0.00001) (lambda (x) (/ (- (g (+ x dx)) (g x)) dx))) (define (newton-transform g) (lambda (x) (- x (/ (g x) ((deriv g) x))))) (define (newtons-method g guess) (fixed-point (newton-transform g) guess)) の (define (deriv g) (define dx 0.00001) (lambda (x) (/ (- (g (+ x dx)) (g x)) dx))) と (define (newton-transform g) (lambda (x) (- x (/ (g x) ((deriv g) x))))) は、関数を定義する関数である。 問題：x の立方根を計算するプログラムを定義しなさい。 ソート GNU Prolog で与えたソートのプログラムは Scheme では次のようになる。 インサートソートのプログラム (define (sort alon) (cond [(empty? alon) empty] [else (insert (first alon)(sort (rest alon)))])) (define (insert n alon) (cond [(empty? alon)(cons n empty)] [else (cond [(>= n (first alon))(cons n alon)] [else (cons (first alon)(insert n (rest alon)))])])) クイックソートのプログラム (define (qsort alon) (cond [(empty? alon) empty] [(empty? (rest alon)) (list (first alon))] [else (append 22 (qsort (smaller-items alon (first alon))) (list (first alon)) (qsort (larger-items alon (first alon))))])) (define (larger-items alon threshold) (cond [(empty? alon) empty] [else (if (> (first alon) threshold) (cons (first alon) (larger-items (rest alon) threshold)) (larger-items (rest alon) threshold))])) (define (smaller-items alon threshold) (cond [(empty? alon) empty] [else (if (< (first alon) threshold) (cons (first alon) (smaller-items (rest alon) threshold)) (smaller-items (rest alon) threshold))])) 絵を描くプログラム 最後に絵を描くプログラムの例をあげておきます。 #lang racket/gui (define size-x 400) (define size-y 400) (define-struct posn (x y)) (define picture (make-bitmap size-x size-y)) (define bm-dc (new bitmap-dc% [bitmap picture])) (send bm-dc clear) (define frame-gui (new frame% [label "Picture Language"] [width (+ size-x 10)] [height (+ size-y 35)])) (define canvas (new canvas% [parent frame-gui] [paint-callback (lambda (canvas dc) (send dc draw-bitmap picture 0 0))])) (define (draw-solid-line a b color) (send bm-dc set-pen color 1 ’solid) (send bm-dc draw-line (posn-x a) (posn-y a) (posn-x b) (posn-y b))) (define (sierpinski a b c) 23 (cond [(too-small? a b c) true] [else (local ((define a-b (mid-point a b)) (define b-c (mid-point b c)) (define c-a (mid-point a c))) (and (draw-triangle a b c) (sierpinski a a-b c-a) (sierpinski b a-b b-c) (sierpinski c c-a b-c)))])) (define (mid-point a-posn b-posn) (make-posn (mid (posn-x a-posn)(posn-x b-posn)) (mid (posn-y a-posn)(posn-y b-posn)))) (define (mid x y) (/ (+ x y) 2)) (define (too-small? a b c) (local ((define (distance u v) (local ((define x (- (posn-x u)(posn-x v))) (define y (- (posn-y u)(posn-y v)))) (sqrt (+ (* x x)(* y y))))) (define a-b (distance a b)) (define b-c (distance b c)) (define c-a (distance c a))) (or (< a-b 5)(< b-c 5)(< c-a 5)))) (define (draw-triangle a b c) (and (draw-solid-line a b "blue") (draw-solid-line b c "blue") (draw-solid-line c a "blue"))) (define A (make-posn 200 0)) (define B (make-posn 27 300)) (define C (make-posn 373 300)) (send frame-gui show #t) (sierpinski A B C) と定義して、Run のボタンをクリックする。 24 のような絵を描きます。Window を使った GUI のプログラミングに興味があれば、 http://docs.racket-lang.org/gui/index.html から、Racket のドキュメントを辿ればいいです。絵を描くことに興味があれば http://docs.racket-lang.org/draw/overview.html から、Racket のドキュメントを辿ればいいです。 絵を描く基本は、例えば、 #lang racket/gui (define size-x 400) (define size-y 400) (define picture (make-bitmap size-x size-y)) (define bm-dc (new bitmap-dc% [bitmap picture])) (send bm-dc clear) (define frame-gui (new frame% [label "Picture Language"] [width (+ size-x 10)] [height (+ size-y 35)])) (define canvas (new canvas% [parent frame-gui] [paint-callback (lambda (canvas dc) (send dc draw-bitmap picture 0 0))])) 25 (send bm-dc set-brush "green" ’solid) (send bm-dc set-pen "blue" 1 ’solid) (send bm-dc draw-rectangle 50 150 ; Top-left at (50,150), 50 pixels right 150 pixels down from top-left 300 100) ; 300 pixels wide and 100 pixels high (send bm-dc set-pen "red" 3 ’solid) (send bm-dc draw-line 50 50 ; Start at (50,50), the top-left corner 350 350) ; and draw to (350,350), the bottom-right corner (send bm-dc draw-line 50 350 ; Start at (50,350), the bottom-left corner 350 50) ; and draw to (350,50), the top-right corner (send bm-dc set-pen "white" 1 ’transparent) (send bm-dc set-smoothing ’aligned) (send bm-dc set-brush "black" ’solid) (send bm-dc draw-ellipse 100 100 ; Top-left at (100,100), 100 pixels 100 right pixels down from top-left 200 200); 200 pixels wide and 200 pixels high (send bm-dc set-brush "yellow" ’solid) (send bm-dc draw-rectangle 150 150 30 30) (send bm-dc draw-rectangle 220 150 30 30) (send bm-dc set-pen "red" 5 ’solid) (send bm-dc set-brush "yellow" ’transparent) (send bm-dc draw-arc 125 105 ; Top-left at (125,105), 125 pixels 105 right pixels down from top-left 155 155 ; 155 pixels wide and 155 pixels high (* 5/4 pi) ; start angle (* 7/4 pi)); end angle (send frame-gui show #t) で、Run のボタンをクリックする。 26 のような絵を描きます。 #lang racket/gui (define size-x 400) (define size-y 400) (define frame-gui (new frame% [label "Picture Language"] [width (+ size-x 10)] [height (+ size-y 35)])) (send frame-gui show #t) で Window が表示されます。 27 Run をクリックする。 これに canvas を追加するのに (define canvas (new canvas% [parent frame-gui] [paint-callback (lambda (canvas dc) (send dc draw-bitmap picture 0 0))])) を追加しますが、更に canvas に絵を描くために bitmap と bitmap-dc を (define picture (make-bitmap size-x size-y)) (define bm-dc (new bitmap-dc% [bitmap picture])) (send bm-dc clear) と定義して、上の canvas の定義で (send dc draw-bitmap picture 0 0))])) と canvas の dc と bitmap picture に作った bitmap-dc bm-dc を結びつけます。 28 後は (send bm-dc set-brush "green" ’solid) (send bm-dc set-pen "blue" 1 ’solid) (send bm-dc draw-rectangle 50 150 300 100) のように、描きた矩形や線や楕円を描けばいいです。 Run をクリックします。 29 参考文献 Matthias Felleisen, Robert Bruce Findler, Matthew Flatt and Shriram Krishnamurthi HOW TO DESIGN PROGRAMS The MIT Press 2001 Harold Abelson and Gerald Jay Sussman with Julie Sussman Structure and Interpretation of Computer Programs Second Edition The MIT Press 1996 (翻訳は「計算機プログラムの構造と解釈」ピアソンエデュケーション） Harold Abelson und Gerald Jay Sussman mit Julie Sussman Struktur und Interpretation von Computerprogrammen Eine Informatik-Einfuhrung 4. Auflage Springer 2001 30