let – 局所変数を使う

関数内で局所変数を使いたいときには let を使って定義できる。

 cf. 6. 局所変数 – もうひとつのScheme入門

let 式は、(let binds body) という形をしている。具体例を示そう。

gosh> (let ((x 2)
            (y 3))
           (* x y))
6

これを使って同ページにある練習問題をやってみよう。

練習問題 1
Scheme 入門 4 の練習問題を1つの関数で書いてみてください。
つまり、初速度 v, 角度 a 度で投げたボールの飛ぶ距離を求める関数を書いてください。

おっと、その前に入門4の練習問題を示しておかないと。

練習問題 2
ボールを投げたときに飛ぶ距離を求める関数を以下の手順で書いてみようと思います。

  1. 角度の度を弧度法単位(ラジアン)に変換する関数。
    180 度は π ラジアンである。 π の定義は、
    (define pi (* 4 (atan 1.0)))
    を用いよ。
  2. 速度 vx で等速運動するものが t 秒間に移動する距離を求める関数。
  3. 垂直方向の初速度 vy で投げたものが落ちてくるまでの時間を 計算する関数。
    空気抵抗は無視し、重力加速度 g は 9.8 m s-2 とする。
    ヒント:落ちてくるときの速度は -vy になっているから、
    2 vy = g t
    が成り立つ。ここで t は落ちてくるのにかかる時間である。
  4. 1–3 の関数を利用して、初速度 v で角度 theta 度で投げたものが飛ぶ距離を求める関数。
    ヒント:まず、最初に関数を利用して角度 theta を弧度法単位に換算する(それを theta1 とする)。
    垂直、水平方向の初速度はそれぞれ v sin(theta1), v cos(theta1) で表される。 落ちてくるまでにかかる時間は関数3を用いて計算できる。 水平方向に加速度はかからないので、飛ぶ距離は関数2を用いて計算できる。
  5. 初速度 40 m/s, 角度 30 度で投げたボールが飛ぶ距離を上で定義した関数を用いて求めよ。 (肩の強いプロ野球選手が遠投したときの距離に近い値になります。)

この練習問題2の回答はこうなる。

(define pi (* 4 (atan 1.0)))

(define deg->rad
  (lambda (deg)
    (/ (* deg pi) 180.0)))

(define distance
  (lambda (vx t)
    (* vx t)))

(define vtime
  (lambda (vy)
    (/ (* 2 vy) 9.8)))

(define throw
  (lambda (v theta)
    (distance (* v (cos (deg->rad theta))) (vtime (* v (sin (deg->rad theta)))))))

(print (throw 40.0 30.0))

実行:

^o^ > gosh throw.scm
141.39190265868385

で、こっちが let の練習問題の回答。度で与えられた角度をラジアンに変換して局所変数 r に束縛している。

(define throw
  (lambda (v a)
    (let ((r (/ (* a 4 (atan 1.0)) 180.0)))
      (/ (* v (cos r) 2 v (sin r)) 9.8))))

(print (throw 40.0 30.0))

実行:

^o^ > gosh throw2.scm
141.39190265868385

練習:takeとdrop

今日も埋め草的エントリ。
再帰の練習として take と drop を書いてみた。

take

gosh> (define take
  (lambda (n lis)
    (define f
      (lambda (m l1 l2)
        (if (= m 0)
            (reverse l2)
            (f (- m 1) (cdr l1) (cons (car l1) l2)))))
    (f n lis '())))
take
gosh> (take 2 '(1 2 3 4 5))
(1 2)

drop

gosh> (define drop
  (lambda (n lis)
    (if (= n 0)
        lis
        (drop (- n 1) (cdr lis)))))
drop
gosh> (drop 2 '(1 2 3 4 5))
(3 4 5)

scanlでフィボナッチ数列

たまには Haskell のエントリを。

昨日、unfoldr の使い方を調べてるときに気づいたんだけど、scanl を使ってもフィボナッチ数列を作れる。Haskell だから当然無限リストだ。

Prelude> let fib = scanl (+) 0 (1:fib)
Prelude> take 20 $ fib
[0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

これは以前書いた zipWith を使うやつよりももっと簡単。

cadr、caddr、cadddr…

前のエントリでしらっと cadr という関数を使ってるけど、これは (car (cdr ...)) と等しい。同じ要領で caddr、cadddr もある。

gosh> (cadr '(1 2 3 4 5 6 7 8 9 10))
2
gosh> (caddr '(1 2 3 4 5 6 7 8 9 10))
3
gosh> (cadddr '(1 2 3 4 5 6 7 8 9 10))
4
gosh> (caddddr '(1 2 3 4 5 6 7 8 9 10))
*** ERROR: unbound variable: caddddr
Stack Trace:
_______________________________________

d 4つ以上はないみたいだ。

cdar というのもある。これは (cdr (car ...)) に等しい。

gosh> (cdar '((1 2 3 4) (5 6 7 8)))
(2 3 4)
gosh> (cddar '((1 2 3 4) (5 6 7 8)))
(3 4)
gosh> (cdddar '((1 2 3 4) (5 6 7 8)))
(4)
gosh> (cddddar '((1 2 3 4) (5 6 7 8)))
*** ERROR: unbound variable: cddddar
Stack Trace:
_______________________________________

こっちも d 4つ以上はないみたい。

[追記]

caar というのもあった。

gosh> (car '(((((1) 2) 3) 4) 5))
((((1) 2) 3) 4)
gosh> (caar '(((((1) 2) 3) 4) 5))
(((1) 2) 3)
gosh> (caaar '(((((1) 2) 3) 4) 5))
((1) 2)
gosh> (caaaar '(((((1) 2) 3) 4) 5))
(1)
gosh> (caaaaar '(((((1) 2) 3) 4) 5))
*** ERROR: unbound variable: caaaaar
Stack Trace:
_______________________________________

a 4つまである。どうやら a と d (つまり car と cdr)をあわせて4つまであるみたいだ。

Schemeのunfoldはめんどくさい

こないだ fold について書いた。で、今日は unfold について書こうと思って調べたら、なんだか面倒な関数だということがわかった。
Gauceh のユーザマニュアルより:

Function: unfold p f g seed :optional tail-gen

[SRFI-1] 基本リスト再帰構築子です。 以下のように再帰的に定義されています。

(unfold p f g seed tail-gen) ≡
   (if (p seed)
       (tail-gen seed)
       (cons (f seed)
             (unfold p f g (g seed))))

ここでは、p は終了位置の判定、g は現在の「種」から次の「種」 を生成するのに用い、f はそれぞれの「種」をリストの要素に変換する のに用いられます。

Haskell では種からリスト要素を作るのと次のための種を作るのと、さらに終了判定まで1つの関数で済ませている(Maybe 型を使う)。たとえば100未満のフィボナッチ数列を作るにはこうする。

Prelude Data.List> takeWhile (< 100) $ unfoldr (\ (a, b) -> Just (a, (b, a+b))) 
(0, 1)
[0,1,1,2,3,5,8,13,21,34,55,89]

それに対して、Scheme の unfold ではこうなる。

gosh> (use srfi-1)
#<undef>
gosh> (define f
  (lambda (pr)
    (car pr)))
f
gosh> (define g
  (lambda (pr)
    (list (cadr pr) (+ (car pr) (cadr pr)))))
g
gosh> (unfold (lambda (pr) (> (car pr) 100)) f g '(0 1))
(0 1 1 2 3 5 8 13 21 34 55 89)

種からリストの要素への変換と、次の種の生成、終了条件がそれぞれ別の関数なので面倒。tail-gen の使い方はわからない。なくてもいいみたいだけど。おまけに car や cdr も面倒な原因か。こういうところは Haskell のほうが楽だな。

ちなみに unfold-right を使うと逆順のリストが得られる。

gosh> (unfold-right (lambda (pr) (> (car pr) 100)) f g '(0 1))
(89 55 34 21 13 8 5 3 2 1 1 0)

練習:init、inits、tail、tails

Haskell にある関数を Scheme で書いてみた。

init

Haskell

Prelude Data.List> init [1,2,3,4,5]
[1,2,3,4]

Scheme

(define init
  (lambda (lis)
    (take lis (- (length lis) 1))))

(print (init '(1 2 3 4 5)))
^o^ > gosh init.scm
(1 2 3 4)

inits

Haskell

Prelude Data.List> inits [1,2,3,4,5]
[[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4,5]]

Scheme

(define inits
  (lambda (lis)
    (define f
      (lambda (n m l)
        (cond
          ((< n m) (quote ()))
          (else (cons (take l m) (f n (+ m 1) l))))))
    (f (length lis) 0 lis)))

(print (inits '(1 2 3 4 5)))
^o^ > gosh inits.scm
(() (1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5))

tail

Haskell

Prelude Data.List> tail [1,2,3,4,5]
[2,3,4,5]

Scheme

(define tail cdr)

(print (tail '(1 2 3 4 5)))
^o^ > gosh tail.scm
(2 3 4 5)

tails

Haskell

Prelude Data.List> tails [1,2,3,4,5]
[[1,2,3,4,5],[2,3,4,5],[3,4,5],[4,5],[5],[]]

Scheme

(define tails
  (lambda (lis)
    (cond
      ((null? lis) (cons '() '()))
      (else (cons lis (tails (cdr lis)))))))

(print (tails '(1 2 3 4 5)))
^o^ > gosh tails.scm
((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5) ())

上のように、うまくいってるように見える Scheme の tails だけど、インタラクティブモードで定義して評価してやると変な値が返ってくる。

^o^ > gosh
gosh> (define tails
  (lambda (lis)
    (cond
      ((null? lis) (cons '() '()))
      (else (cons lis (tails (cdr lis)))))))
tails
gosh> (tails '(1 2 3 4 5))
((1 . #0=(2 . #1=(3 . #2=(4 . #3=(5))))) #0# #1# #2# #3# ())

最後の行が (tails '(1 2 3 4 5)) の変な値。
ところが、これを (print ...) としてやるとちゃんとした値が出力される。

gosh> (print (tails '(1 2 3 4 5)))
((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5) ())
#<undef>

どういうこと?

「Scheme手習い」読み終わった

今日書かないと1週間以上間が開いてしまうので書く。

とりあえず「Scheme手習い」を読み終わった。終わったんだけど、10章がぜんぜん消化できていないので、現状ではエントリにする事が出来ない。もう2~3回読んでなんとかなったら書くことにする。

畳み込み関数

左からの畳み込み

Scheme には左から畳み込む関数が2つある。fold と fold-left だ。違いは引数の関数に渡される引数の順序。次の例がわかり易い。

gosh> (fold list 0 '(1 2 3 4 5))
(5 (4 (3 (2 (1 0)))))
gosh> (fold-left list 0 '(1 2 3 4 5))
(((((0 1) 2) 3) 4) 5)

Haskell の foldl にあたるのが fold-left だな。

fold を使うと昨日書いた reverse がもっと簡単になる。

gosh> (define reverse
  (lambda (lis)
    (fold cons '() lis)))
reverse
gosh> (reverse '(1 2 3 4))
(4 3 2 1)

右からの畳み込み

fold-right は右から畳み込む。

gosh> (fold-right list 0 '(1 2 3 4 5))
(1 (2 (3 (4 (5 0)))))

練習:関数の定義をいくつか

これも東大の Scheme演習のページから。

 cf. Scheme演習 第3回

の問2。

(map proc list)

リストlistの要素一つ一つに対して一引数関数procを適用し、結果をリストにして返す関数。
実行例

> (map (lambda (x) (+ x 1)) (list 1 2 3 4))
(2 3 4 5)
(define map
  (lambda (proc lis)
    (if (null? lis)
        (quote ())
        (cons (proc (car lis)) (map proc (cdr lis))))))

(print (map (lambda (x) (+ x 1)) (list 1 2 3 4)))
^o^ > gosh map.scm
(2 3 4 5)

(add-squares list)

数のリストlistの要素の平方の和を返す関数。
実行例

> (add-squares (list 1 10 100))
10101
(define add-squares
  (lambda (lis)
    (if (null? lis)
        0
        (+ (* (car lis) (car lis)) (add-squares (cdr lis))))))

(print (add-squares (list 1 10 100)))

cond じゃなくて if を使ってみた。

^o^ > gosh add-squares.scm
10101

(reverse list)

リストlistを逆順にしたリストを返す関数。
実行例

> (reverse (list 1 2 3 4))
(4 3 2 1)
(define reverse
  (lambda (lis)
    (define rev
      (lambda (l1 l2)
        (if (null? l1)
            l2
            (rev (cdr l1) (cons (car l1) l2)))))
    (rev lis (quote ()))))

(print (reverse (list 1 2 3 4)))
^o^ > gosh reverse.scm
(4 3 2 1)

(assq obj alist)

ペアやリストを直接の要素とするリスト(連想リストという)alistを受け取り、その要素のうちcar部がobjと等しいような最左のものを返す関数
(ここで等しいとは、eq?による比較)
見つからない場合は#fを返す。

> (define dic '((ami net) (ame rain) (ame candy)))
> (assq 'ame dic)
(ame rain)
> (assq 'amedama dic)
#f
(define assq
  (lambda (obj alist)
    (cond
      ((null? alist) #f)
      ((eq? (car (car alist)) obj) (car alist))
      (else (assq obj (cdr alist))))))

(define dic '((ami net) (ame rain) (ame candy)))

(print (assq 'ame dic))
(print (assq 'amedama dic))
^o^ > gosh assq.scm
(ame rain)
#f

練習:if文と関数を返す関数

「Scheme手習い」10章に入る前に、少し離れて東大のScheme演習から。

 cf. Scheme演習 第2回

問2(if文)

次のような新しい if 文を関数として定義した。

(define (new-if test then-exp else-exp)
  (cond (test then-exp)
        (else else-exp)))

例えば、(new-if (= 1 2) (+ 3 4) (+ 5 6)) などとすれば、正しく 11 を返す。(確かめてみよ。)

これを使って、fac4 を次のように定義した。

(define (fac4 n)
  (new-if (= n 0)
          1
          (* n (fac4 (- n 1)))))

これを使って (fac4 3) としたら、無限ループにおちいってしまった。(確かめてみよ。)これはなぜか。

まずは前半がちゃんと動くのかを確かめてみよう。

gosh> (define (new-if test then-exp else-exp)
  (cond (test then-exp)
        (else else-exp)))
new-if
gosh> (new-if (= 1 2) (+ 3 4) (+ 5 6))
11

うん、動いてるね。
つぎは後半だ。本当に無限ループに陥るのか確かめてみよう。

gosh> (define (fac4 n)
  (new-if (= n 0)
          1
          (* n (fac4 (- n 1)))))
fac4
gosh> (fac4 3)
out of memory (32).  aborting...

うーん、無限ループなのかどうかはよくわからないけど、時間がかかった上にメモリが足りなくなって Gauche ごと落ちてしまった。とにかく、期待どおりに動かないのは確かなようだ。

で、なぜかといえば、if文が特殊形式(東大のScheme演習のページではシンタックス形式、Gauceh のユーザマニュアルでは Special Form と呼んでいる)なのにたいして、new-if は単なる関数適用だ。Scheme は正格評価なので、(new-if ...) の値を決める前に、その引数である (= n 0)、1、(* n (fac4 (- n 1))) のすべてを評価する。言い換えると (fac4 3) を評価する前に (fac4 2) を評価する必要があるわけだ。同様に、(fac4 2) の前に (fac4 1) を、(fac4 1) の前に (fac4 0)を、さらに (fac4 0) の前には (fac4 -1) を・・・・・・といった具合で永遠に続くことになる。これが無限ループの正体だ。

問3(関数を返す関数)

関数 f(x) の導関数 f'(x) は、小さい数 dx を使って近似的に下のように表せる。

[math]f'(x)=\frac{f(x+dx)-f(x)}{dx}[/math]

1 引数関数 f と小さい数 dx を受けとったら、その導関数を返すような関数 deriv を作れ。すなわち、((deriv f dx) n) のように実行すると、結果として f'(n) の値を返す。

> (define (f1 x) (* x x))
> ((deriv f1 0.001) 5)
10.001000000002591

これは簡単。

(define deriv
  (lambda (f dx)
    (lambda (x)
      (/ (- (f (+ x dx)) (f x)) dx))))

(define f1
  (lambda (x) (* x x)))

(print ((deriv f1 0.001) 5))
^o^ > gosh deriv.scm
10.001000000002591

OK。つぎ、問3の後半部分。

Newton 法を使って、1 引数の関数 f が与えられた時にf(x) = 0 の実数解を1つ求めるプログラムを作れ。精度は、f(x) と 0 の差の絶対値が 0.001 以下とする。

  • 用いる dx は0.001とする。
  • 実際に、f(x) = x2 – 4 やその他の関数に対して適用してみよ。

これにはヒントが与えられている。

おさらいとヒント

一般の関数に対する Newton 法は、関数 f(x) とその導関数 f'(x) が与えられたとき、その零点の近似値を次の式で更新していく。

[math]a_{n+1}=a_n-\frac{f(a_n)}{f'(a_n)}[/math]

従って、f(an) と 0 との誤差が 0.001 以下になるまで、順に an を求めていく補助再帰関数を定義し、適当な初期値をその補助関数に与えてやればよい。

これでどうだ。

(define deriv
  (lambda (f dx)
    (lambda (x)
      (/ (- (f (+ x dx)) (f x)) dx))))

(define newton
  (lambda (f init)
    (if (< (abs (- (f init) 0)) 0.001)
        init
        (newton f (- init (/ (f init) ((deriv f 0.001) init)))))))

(define f
  (lambda (x)
    (- (* x x) 4)))

(print (newton f 1.0))
^o^ > gosh newton.scm
2.0000002513546535

まあ、うまくいってるかな。