月: 2015年3月

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->integer-do
  (lambda (str)
    (do ((l (string->list str) (cdr l))
        (i 0 (+ (- (char->integer (car l)) 48) (* i 10))))
        ((null? l) i))))

(print (string->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! は変数への束縛を、別の値を指すように変更する。つまり代入。

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。ソートされているのが前提。

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

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

　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

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

昨日の記事のコメントで 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)

あるリストについて二重のループを実行したい。
例えば Python で書くとこういうこと。

def loop_double(lis):
    for i in lis:
        for j in lis:
            print [i, j]

loop_double([1, 2, 3])

takatoh@nightschool $ python loop_double.py
[1, 1]
[1, 2]
[1, 3]
[2, 1]
[2, 2]
[2, 3]
[3, 1]
[3, 2]
[3, 3]

すごく簡単そうに見えるけど、Scheme でやってみたらどうやるのかわからなくて悩んだ。ググっても Scheme の二重ループの例は見当たらない。
で、結局こう書いた。

(define loop-double
  (lambda (lis)
    (letrec ((f (lambda (l1 l2)
      (if (null? l1)
          '()
          (append (map (lambda (x)
                    (cons (car l1) (list x))) l2)
            (f (cdr l1) l2))))))
            (f lis lis))))

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

Scheme らしく、ループの中で処理を実行するんじゃなくて引数のリストを返す手続きにしてみた。それはいいんだけど、内側では map を使ってるんで厳密には二重ループじゃないよな。

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

まあ、ほしい結果は得られたんでとりあえずは良しとするか。
でもホントはどうやったらいいんだろう？

久しぶりの Scheme。約5ヶ月ぶり。ネタも古くてこれ。

　cf. 連続する数列をハイフンでまとめるPythonスクリプト – blog.PanicBlanket.com

(define f
  (lambda (p)
    (cond
      ((= (cadr p) 1) "")
      ((> (cadr p) 1) (string-append (number->string (car p)) ", ")))))

(define g
  (lambda (p)
    (cond
      ((= (cadr p) 1) (string-append (number->string (car p)) "-"))
      ((> (cadr p) 1) (string-append (number->string (car p)) ", ")))))

(define serial
  (lambda (s l)
    (let ((p (car l)))
      (cond
        ((= (cadr p) 1) (serial (string-append s (f p)) (cdr l)))
        ((> (cadr p) 1) (discrete (string-append s (f p)) (cdr l)))
        (else (string-append s (number->string (car p))))))))

(define discrete
  (lambda (s l)
    (let ((p (car l)))
      (cond
        ((= (cadr p) 1) (serial (string-append s (g p)) (cdr l)))
        ((> (cadr p) 1) (discrete (string-append s (g p)) (cdr l)))
        (else (string-append s (number->string (car p))))))))

(define list-with-diff
  (lambda (lis)
    (map list lis (append (map - (cdr lis) lis) (list 0)))))

(define hyphenate
  (lambda (str)
    (letrec ((lis (map string->number (string-split str " ")))
             (l (list-with-diff lis)))
      (cond
        ((= (cadar l) 1) (serial (g (car l)) (cdr l)))
        (else (discrete (g (car l)) (cdr l)))))))

(print (hyphenate "1 2 3"))
(print (hyphenate "1 2 3 5 7 8"))
(print (hyphenate "1 3 4 5 7"))

takatoh@nightschool $ gosh hyphenate_num.scm
1-3
1-3, 5, 7-8
1, 3-5, 7