カテゴリー: Scheme

letrec の練習。

　cf. 7. 繰り返し – もうひとつの Scheme 入門

の練習問題4より。

my-reverse

リストの要素の順番を反転させる関数 my-reverse。

(define my-reverse
  (lambda (ls)
    (letrec ((iter (lambda (l1 l2)
                     (if (null? l1)
                         l2
                         (iter (cdr l1) (cons (car l1) l2))))))
      (iter ls '()))))

(print (my-reverse '(1 2 3 4 5)))

^o^ > gosh my-reverse4.scm
(5 4 3 2 1)

sum

数のリストの要素の合計を求める関数。

(define sum
  (lambda (lis)
    (letrec ((iter (lambda (l s)
                     (if (null? l)
                         s
                         (iter (cdr l) (+ s (car l)))))))
      (iter lis 0))))

(print (sum '(1 2 3 4 5)))

^o^ > gosh sum2.scm
15

string->integer

正の整数を表す文字列を整数に変関する関数。

(define string->integer
  (lambda (str)
    (letrec ((iter (lambda (ls i)
                     (if (null? ls)
                         i
                         (iter (cdr ls) (+ (* i 10) (- (char->integer (car ls)) 48)))))))
      (iter (string->list str) 0))))

(print (string->integer "1234"))

^o^ > gosh string-to-integer2.scm
1234

letrec は局所関数を定義する一般的な方法だそうだ。

　cf. 7. 繰り返し – もうひとつの Scheme 入門

let と違って定義内で自分の名前を参照できるので、再帰関数を定義することができる。
例を示そう。↓これは以前書いた take。define を使って局所関数 f を定義している。

(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 '())))

これを letrec を使って書き直すとこうなる。

(define take
  (lambda (n lis)
    (letrec ((f (lambda (m l1 l2)
                  (if (= m 0)
                      (reverse l2)
                      (f (- m 1) (cdr l1) (cons (car l1) l2))))))
      (f n lis '()))))

(print (take 2 '(1 2 3 4 5)))

3行目（から6行目）で局所関数に f という名前をつけている。そして6行目でその f を再帰的に呼び出している。
実行結果：

^o^ > gosh take-letrec.scm
(1 2)

名前つきlet の練習。

　cf. 7. 繰り返し – もうひとつの Scheme 入門

の練習問題3より。

my-delete

リスト (ls) から要素 (x) を取り除いたリストを返す関数。

(define my-delete
  (lambda (x ls)
    (let loop ((y x) (l1 ls) (l2 '()))
      (if (null? l1)
          (reverse l2)
          (loop y (cdr l1) (if (eq? y (car l1))
                               l2
                               (cons (car l1) l2)))))))

(print (my-delete 'c '(a b c d e)))

^o^ > gosh my-delete3.scm
(a b d e)

この関数は下のように素直な再帰のほうがわかりやすいけど、代わりに末尾再帰にならない。

(define my-delete
  (lambda (x ls)
    (cond
      ((null? ls) '())
      ((eq? x (car ls)) (my-delete x (cdr ls)))
      (else (cons (car ls) (my-delete x (cdr ls)))))))

index

リスト (ls) の要素 (x) の位置を返す関数。位置は 0 から数え始め、 x がない場合は #f を返す。

(define index
  (lambda (x ls)
    (let loop ((y x) (l ls) (n 0))
      (cond
        ((null? l) #f)
        ((eq? y (car l)) n)
        (else (loop y (cdr l) (+ n 1)))))))

(print (index 'c '(a b c d e)))
(print (index 'f '(a b c d e)))

^o^ > gosh index2.scm
2
#f

sum

数のリストの要素の合計を求める関数。

(define sum
  (lambda (lis)
    (let loop ((l lis) (s 0))
      (if (null? l)
          s
          (loop (cdr l) (+ s (car l)))))))

(print (sum '(1 2 3 4 5)))

^o^ > gosh sum.scm
15

string->integer

正の整数を表す文字列を整数に変関する関数。入力エラーチェックはしなくて良い。
例： “1232” → 1232
ヒント：

1. 文字 #\0 … #\9 のASCII コード番号から 48 を引くとその数そのものになります。 アスキーコードを求める関数は char->integer です。
2. 文字列を文字のリストに変換する関数 string->list を使うと便利です。

(define string->integer
  (lambda (str)
    (let loop ((ls (string->list str)) (i 0))
      (if (null? ls)
          i
          (loop (cdr ls) (+ (* i 10) (- (char->integer (car ls)) 48)))))))

(print (string->integer "1234"))

^o^ > gosh string-to-integer.scm
1234

range

0 から n 未満の整数のリストを返す関数。

(define range
  (lambda (n)
    (let loop ((m (- n 1)) (l '()))
      (if (< m 0)
          l
          (loop (- m 1) (cons m l))))))

(print (range 10))

^o^ > gosh range.scm
(0 1 2 3 4 5 6 7 8 9)

ave

任意個の引数をとりそれらの平均を返す関数。レストパラメータを使う。全ての引数は数、エラー処理は不要。

(define ave
  (lambda ls
    (let loop ((l ls) (s 0) (n (length ls)))
      (if (null? l)
          (/ s n)
          (loop (cdr l) (+ s (car l)) n)))))

(print (ave 1.1 2.3 4.6))
(print (ave 3.3 4.7 10.2 20.6 100.1))

^o^ > gosh ave.scm
2.6666666666666665
27.779999999999994

(lambda ls ...) という書き方で、0個以上の引数をとりすべて ls にリストとして束縛される。以下も参照。
　cf. 可変長の引数をとる関数

cf. 7. 繰り返し – もうひとつの Scheme 入門

以前 my-reverse という関数を書いた。

(define my-reverse
  (lambda (lis)
    (define rev
      (lambda (l1 l2)
        (if (null? l1)
            l2
            (rev (cdr l1) (cons (car l1) l2)))))
    (rev lis (quote ()))))

この my-reverse では rev という名前の再帰する局所関数を定義して、それを呼び出している。

名前つきlet はこの再帰する局所関数の代わりになるものだ。ループに名前をつけたものといってもいい。名前つきlet は (let name binds body) という形をしている。name がループの名前で、body の中で再帰的に呼び出すことができる。binds は普通の let と同じように局所変数とその値（ループするときの初期値になる）の組からなる。body の中で再帰するときには新たな引数を与える。
なんだかうまく説明できないけど、例を見たほうがはやいだろう。上の my-reverse を名前つきlet を使って書き直すと次のようになる。

(define my-reverse
  (lambda (ls)
    (let loop ((l1 ls) (l2 (quote ())))
      (if (null? l1)
          l2
          (loop (cdr l1) (cons (car l1) l2))))))

(print (my-reverse '(1 2 3 4 5)))

3行目の loop がループにつけた名前だ。このとき引数の l1 は ls、l2 は (quote ()) で初期化される。そして6行目で再帰的に呼び出している。新しい引数は (cdr l1) と (cons (car l1) l2) だ。
実行してみよう。

^o^ > gosh my-reverse3.scm
(5 4 3 2 1)

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

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

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

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

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

練習問題 1
Scheme 入門 4 の練習問題を１つの関数で書いてみてください。
つまり、初速度 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) で表される。 落ちてくるまでにかかる時間は関数３を用いて計算できる。 水平方向に加速度はかからないので、飛ぶ距離は関数２を用いて計算できる。
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

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)

前のエントリでしらっと 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つまであるみたいだ。

こないだ 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)

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>

どういうこと？

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

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