カテゴリー: Scheme

多値

昨日、継続渡しの練習で partition という手続きを書いた。
同じ名前の手続きが SRFI-1 ライブラリに定義されている。けど、ちょっと動作が違う。

gosh> (use srfi-1)
#<undef>
gosh> (partition odd? '(1 2 3 4 5))
(1 3 5)
(2 4)

(1 3 5) と (2 4) がひとつのリストに入っているんじゃなくて、２行にわたって表示されている。実は、SRFI-1 の partition は２つの値を返している。partition のように２つ（あるいはそれ以上）の値を返すことを「多値」というらしい。

　cf. Scheme:多値

多値を返すには values を使う。

gosh> (values 'foo 'bar 'baz)
foo
bar
baz

一方、多値を受け取るには receive が使える。

gosh> (receive (odds evens) (partition odd? '(1 2 3 4 5))
  (print odds))
(1 3 5)
#<undef>

odds と evens が返される多値に束縛される変数だ。必要がないからといって、数を合わせないとダメらしい。

gosh> (receive (odds) (partition odd? '(1 2 3 4 5))
  (print odds))
*** ERROR: received more values than expected
Stack Trace:
_______________________________________

ふーん、なんとなくわかった（ような気がする）けど、ちょっとピンとこないな。

継続渡しの練習

リストを、述語 p を適用した結果が真になるものと偽になるものに分ける partition を継続渡しスタイルで書いてみた。

(define partition
  (lambda (p lis co)
    (cond
      ((null? lis)
        (co '() '()))
      ((p (car lis))
        (partition p (cdr lis) (lambda (l r) (co (cons (car lis) l) r))))
      (else
        (partition p (cdr lis) (lambda (l r) (co l (cons (car lis) r))))))))

(print (partition odd? '(1 2 3 4 5) list))
takatoh@nightschool $ gosh partition.scm
((1 3 5) (2 4))

末尾再帰の練習

まずはフツウの再帰で書いたもの。

(define myfilter
  (lambda (proc lis)
    (cond
      ((null? lis) '())
      ((proc (car lis)) (cons (car lis) (myfilter proc (cdr lis))))
      (else (myfilter proc (cdr lis))))))

(print (myfilter odd? '(1 2 3 4 5)))
takatoh@nightschool $ gosh myfilter.scm
(1 3 5)

で、こっちが末尾再帰で書いたもの。

(define myfilter-tail
  (lambda (proc lis)
    (letrec ((iter (lambda (l1 l2)
      (cond
        ((null? l1) (reverse l2))
        ((proc (car l1)) (iter (cdr l1) (cons (car l1) l2)))
        (else (iter (cdr l1) l2))))))
          (iter lis '()))))

(print (myfilter-tail odd? '(1 2 3 4 5)))

内部で iter という局所関数を定義して、それを呼び出している。

takatoh@nightschool $ gosh myfilter-tail.scm
(1 3 5)

group

リストの要素を、隣り合った同じ要素ごとにまとめる。

(define group
  (lambda (lis)
    (let loop ((l1 (cdr lis)) (l2 (list (car lis))) (l3 '()))
      (cond
        ((null? l1) (reverse (cons l2 l3)))
        ((eq? (car l1) (car l2)) (loop (cdr l1) (cons (car l1) l2) l3))
        (else (loop (cdr l1) (list (car l1)) (cons l2 l3)))))))

(print (group '(1 1 2 2 3 3 3)))
(print (group '(a a b b b c c)))
takatoh@nightschool $ gosh group.scm
((1 1) (2 2) (3 3 3))
((a a) (b b b) (c c))

「同じ要素」を得るための proc を渡せるようにしたもの。

(define group-by
  (lambda (proc lis)
    (let loop ((l1 (cdr lis)) (l2 (list (car lis))) (l3 '()))
      (cond
        ((null? l1) (reverse (cons (reverse l2) l3)))
        ((eq? (proc (car l1)) (proc (car l2))) (loop (cdr l1) (cons (car l1) l2) l3))
        (else (loop (cdr l1) (list (car l1)) (cons (reverse l2) l3)))))))

(for-each print (group-by car '((1 1) (1 2) (2 3) (2 4) (2 5))))

ひとつのリストにしてしまうと見難いので for-each でグループごとに出力してみた。

takatoh@nightschool $ gosh group-by.scm
((1 1) (1 2))
((2 3) (2 4) (2 5))

[追記]

gauche.sequence モジュールの group-sequence を使うとおなじことが出来る。

gosh> (use gauche.sequence)
#<undef>
gosh> (group-sequence '(1 1 2 2 3 3 3))
((1 1) (2 2) (3 3 3))
gosh> (group-sequence '(a a b b b c c))
((a a) (b b b) (c c))
gosh> (for-each print (group-sequence '((1 1) (1 2) (2 3) (2 4) (2 5)) :key car))
((1 1) (1 2))
((2 3) (2 4) (2 5))
#<undef>

練習：do

Scheme 入門　7.繰り返しから、練習問題5。

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

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

(print (my-reverse-do '(1 2 3 4 5)))
takatoh@nightschool $ gosh my-reverse-do.scm
(5 4 3 2 1)

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

(define sum-do
  (lambda (ls)
    (do ((l ls (cdr l)) (s 0 (+ s (car l))))
        ((null? l) s))))

(print (sum-do '(1 2 3 4 5)))
takatoh@nightschool $ gosh sum-do.scm
15

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

(define string-&gt;integer-do
  (lambda (str)
    (do ((l (string-&gt;list str) (cdr l))
        (i 0 (+ (- (char-&gt;integer (car l)) 48) (* i 10))))
        ((null? l) i))))

(print (string-&gt;integer-do "12345"))
takatoh@nightschool $ gosh string-to-integer-do.scm
12345

[追記]

do 構文について補足。このあいだは do 構文の体裁を↓こう書いたけど

(do ((変数 初期値 ステップ))
    (終了条件)
    本体)

より正しくはこう。

(do ((変数 初期値 ステップ) ...)
    (終了条件 式)
    本体)

まず、変数は複数定義できる。それから、終了条件の後に式を書くと、式を評価した値が do 構文の値になる。でもって、本体は必要がなければ省略ができる。
上の3つの例ではどれもそうなっている。
Gauche のユーザリファレンスには次のような例が出ている。

(do ((i 0 (+ i 1))
     (j 0 (+ i j)))
    ((= i 10) j)
    (print j))

この例では、i と j の２つの変数を使って、最終的には j を返している。そして毎回のループごとに本体 (print j) を実行している。

gosh> (do ((i 0 (+ i 1))
           (j 0 (+ i j)))
          ((= i 10) j)
          (print j))
0
0
1
3
6
10
15
21
28
36
45

これを見ると、値を得るには終了条件の後の式を使って、本体は副作用に使うのがいいのかも。

set!

set! は変数への束縛を、別の値を指すように変更する。つまり代入。

gosh> (define x 1)
x
gosh> x
1
gosh> (set! x 10)
10
gosh> x
10

set! のもうひとつの形式は「一般化されたset!」で、 (set! (proc arg …) expression) という形をしていて、(proc arg …) の結果が expression に置き換えられる。

gosh> (define x (list 1 2))
x
gosh> x
(1 2)
gosh> (set! (car x) (list 10 20))
#<undef>
gosh> x
((10 20) 2)

uniq

重複する要素を削除する uniq。ソートされているのが前提。

(define uniq
  (lambda (lis)
    (let loop ((e (car lis)) (l (cdr lis)))
      (cond
        ((null? l) (list e))
        ((eq? e (car l)) (loop e (cdr l)))
        (else (cons e (loop (car l) (cdr l))))))))

(print (uniq '(1 1 1 2 3 3)))
takatoh@nightschool $ gosh uniq.scm
(1 2 3)

リストのリストを引数にとって、car がユニークになるような手続き。

(define uniq-car
  (lambda (lis)
    (let loop ((e (car lis)) (l (cdr lis)))
      (cond
        ((null? l) (list e))
        ((eq? (car e) (caar l)) (loop e (cdr l)))
        (else (cons e (loop (car l) (cdr l))))))))

(print (uniq-car '((1 1) (1 2) (2 1) (2 2) (2 3) (3 1))))
takatoh@nightschool $ gosh uniq-car.scm
((1 1) (2 1) (3 1))

もう少し進んで、比較する方法を引数で渡せるようにしてみる。

(define uniq-in
  (lambda (proc lis)
    (let loop ((e (car lis)) (l (cdr lis)))
      (cond
        ((null? l) (list e))
        ((eq? (proc e) (proc (car l))) (loop e (cdr l)))
        (else (cons e (loop (car l) (cdr l))))))))

(print (uniq-in car '((1 1) (1 2) (2 1) (2 2) (2 3) (3 1))))
(print (uniq-in cadr '((1 1) (2 1) (3 1) (1 2) (2 2) (1 3))))
takatoh@nightschool $ gosh uniq-in.scm
((1 1) (2 1) (3 1))
((1 1) (1 2) (1 3))

サイコロの確率の問題をSchemeで解いてみた

一昨日から二重だの三重だののループをやってたのは、これがやりたかったからだ。

　cf. 知恵袋で見つけたサイコロの確率の問題をPythonで解いてみた。 – rscの日記

1個のさいころを3回投げる。1回目に出る目をa1、2回目に出る目をa2、3回目に出る目をa3とし、整数nをn=(a1-a2)(a2-a3)(a3-a1)と定める。このとき、|n|=30である確率を求めよ。

(define triplex
  (lambda (lis)
    (let ((result '()))
      (do ((l1 lis (cdr l1)))
          ((null? l1))
          (do ((l2 lis (cdr l2)))
              ((null? l2))
              (do ((l3 lis (cdr l3)))
                  ((null? l3))
                  (set! result (cons (list (car l1) (car l2) (car l3)) result)))))
                  (reverse result))))

(define check
  (lambda (l)
    (let ((a1 (car l)) (a2 (cadr l)) (a3 (caddr l)))
      (if (= (abs (* (- a1 a2) (- a2 a3) (- a3 a1))) 30)
          #t
          #f))))

(define dice30
  (lambda ()
    (let loop ((s 0) (c 0) (l (triplex '(1 2 3 4 5 6))))
      (cond
        ((null? l) (/ s c))
        ((check (car l)) (loop (+ s 1) (+ c 1) (cdr l)))
        (else (loop s (+ c 1) (cdr l)))))))

(print (dice30))
takatoh@nightschool $ gosh dice30.scm
1/18

というわけで、無事答えがでた。

Schemeで二重のループ

昨日の記事のコメントで do を使うループを教えてもらった。ありがとうございます。

早速練習してみるよ。
詳しい情報はこのへんから。

　cf. 4.8 繰り返し – Gauche ユーザリファレンス

まずは単純に一重のループから。

(define loop
  (lambda (lis)
    (do ((l lis (cdr l)))
        ((null? l))
        (print (car l)))))

(loop '(1 2 3))

do 構文は次のような体裁をしている。

(do ((変数 初期値 ステップ))
    (終了条件)
    本体)

変数はループ内で使われる変数で、初期値で初期化される。ステップは次のループに移るときに変数に入る値だ。上の例では、l が変数、lis が初期値、(cdr l) がステップに当たる。終了条件は、まあそのまんま。リストが空になったら終了。で、１回のループごとに本体が評価される、と。
さてやってみよう。

takatoh@nightschool $ gosh loop-do.scm
1
2
3

いいね。イケてるね。
じゃあ、二重のループはというと、本体の部分にもうひとつ do を使えばいい。

(define loop
  (lambda (lis)
    (do ((l1 lis (cdr l1)))
        ((null? l1))
        (do ((l2 lis (cdr l2)))
            ((null? l2))
            (print (list (car l1) (car l2)))))))

(loop '(1 2 3))

二重にしたので、リストにして出力している。

takatoh@nightschool $ gosh loop-do2.scm
(1 1)
(1 2)
(1 3)
(2 1)
(2 2)
(2 3)
(3 1)
(3 2)
(3 3)

うまくいった。
さて、ここから本題。昨日やったように、ループの中で出力するんじゃなくて結果をリストとして返したい。斉藤さんの例では、result という変数を用意して、ループ１回ごとに追加した結果を代入している。
そうか、代入を使えばいいのか。というか Scheme でも代入を使うのか。

(define loop
  (lambda (lis)
    (let ((result '()))
      (do ((l1 lis (cdr l1)))
          ((null? l1))
          (do ((l2 lis (cdr l2)))
              ((null? l2))
              (set! result (cons (list (car l1) (car l2)) result))))
              (reverse result))))

(for-each print (loop '(1 2 3)))

(set! result …) のところが代入をしているところ。cons を使っているからリストが逆順になっているので、最後に (reverse result) している。
実行してみよう。

takatoh@nightschool $ gosh loop-do3.scm
(1 1)
(1 2)
(1 3)
(2 1)
(2 2)
(2 3)
(3 1)
(3 2)
(3 3)

よし、うまくいった。改めてコメントをくれた斉藤さんに感謝を。

おまけ

調子に乗って三重のループ。

(define loop
  (lambda (lis)
    (let ((result '()))
      (do ((l1 lis (cdr l1)))
          ((null? l1))
          (do ((l2 lis (cdr l2)))
              ((null? l2))
              (do ((l3 lis (cdr l3)))
                  ((null? l3))
                  (set! result (cons (list (car l1) (car l2) (car l3)) result)))))
                  (reverse result))))

(for-each print (loop '(1 2 3)))
takatoh@nightschool $ gosh loop-triple.scm
(1 1 1)
(1 1 2)
(1 1 3)
(1 2 1)
(1 2 2)
(1 2 3)
(1 3 1)
(1 3 2)
(1 3 3)
(2 1 1)
(2 1 2)
(2 1 3)
(2 2 1)
(2 2 2)
(2 2 3)
(2 3 1)
(2 3 2)
(2 3 3)
(3 1 1)
(3 1 2)
(3 1 3)
(3 2 1)
(3 2 2)
(3 2 3)
(3 3 1)
(3 3 2)
(3 3 3)