カテゴリー: Scheme

あるリストについて二重のループを実行したい。
例えば 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

リストの個数を返す手続き。

　cf. lengthの別の実装 – 理想のユーザ・インターフェイスを求めて

名前付きletの使い方を忘れてて調べた^^;

(define length
  (lambda (l)
    (let loop ((len 0) (lis l))
      (if (null? lis)
          len
          (loop (+ len 1) (cdr lis))))))

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

takatoh@nightschool $ gosh length.scm
5

Twitter で流れてきたので、Scheme でやってみた。

問: 組み体操で10段のピラミッドを作ったとき、最も重量がかかるのはどの場所で、それはおよそ何kgか

— あ〜る菊池誠(反緊縮)公式 (@kikumaco) September 16, 2014

(define main
  (lambda (args)
    (print (reaction-of-kumitaiso (string->number (cadr args))))))

(define self-weight
  (lambda (n)
    (if (= n 1)
        (list 0.5 0.5)
        (cons 0.5 (append (make-list (- n 1) 1.0) '(0.5))))))

(define reaction-of-kumitaiso
  (lambda (n)
    (if (= n 1)
        (self-weight 1)
        (let ((u (map (lambda (x) (/ x 2.0)) (reaction-of-kumitaiso (- n 1)))))
          (map + (cons 0.0 u) (append u '(0.0)) (self-weight n))))))

1人分の体重を1.0として10段だと、一番下の支点にかかる重量は、

takatoh@nightschool $ gosh kumitaiso.scm 10
(0.9990234375 2.986328125 4.9091796875 6.6171875 7.841796875 8.29296875 7.841796875 6.6171875 4.9091796875 2.986328125 0.9990234375)

最大になるのは真ん中の支点で、8.29296875。1人の体重が60kgだと仮定すれば、

gosh> (* 8.29296875 60.0)
497.578125

となって、およそ500kg。うへぇ！

↓こういうのを見つけたので Scheme でやってみよう、と思ったら CodeEval って Scheme ないんでやんの。

　cf. Python2でCodeEvalのPascals Triangle – brainstorm
　cf. Pascals Triangle – CodeEval

しょうがないから勝手にやる。

(define pascals-triangle
  (lambda (depth)
    (let loop ((n depth) (pas '((1))))
      (if (= n 1)
          (reverse pas)
          (let ((next (map + (cons 0 (car pas)) (append (car pas) '(0)))))
            (loop (- n 1) (cons next pas)))))))

(define flatten
  (lambda (list-of-list)
    (fold-left append '() list-of-list)))

(define print-pascals-triangle
  (lambda (depth)
    (print (string-join (map number->string (flatten (pascals-triangle (string->number depth)))) " "))))

(define main
  (lambda (args)
    (with-input-from-file (cadr args)
      (lambda ()
        (port-for-each print-pascals-triangle read-line)))))

^o^ > type input-pascal.txt
6

^o^ > gosh pascal.scm input-pascal.txt
1 1 1 1 2 1 1 3 3 1 1 4 6 4 1 1 5 10 10 5 1

たぶんあってる。

cf. http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E5%87%A6%E7%90%86#H-1d1usg4

ファイルから1行ずつ読み込んで処理をするやり方。

(define main
  (lambda (args)
    (with-input-from-file (cadr args)
      (lambda ()
        (port-for-each print read-line)))))

この例では print してるだけだけど、代わりにここに行を処理する関数を入れてやればいい。

^o^ > type foo.txt
foo
bar
baz

^o^ > gosh read-each-lines.scm foo.txt
foo
bar
baz

次は行ごとのリストにする方法。

(define main
  (lambda (args)
    (print (call-with-input-file (cadr args) port->string-list))))

^o^ > gosh read-lines-list.scm foo.txt
(foo bar baz)

最後に、ファイル全体を文字列にするには：

(define main
  (lambda (args)
    (print (call-with-input-file (cadr args) port->string))))

^o^ > gosh read-lines-string.scm foo.txt
foo
bar
baz

昨日、あとで調べてみよう、と書いた cut について調べてみた。

　cf. 4.3 手続きを作る – Gauche ユーザリファレンス

[SRFI-26] 手続きを簡潔に書ける便利なマクロです。 いわゆる部分適用を実現するために使えます。

SRFI-26 とあるけど、Gauche では標準で使えるようになっている。

たとえば、文字列3つを引数にとって、”-” でつなげる手続きを考えよう。

gosh> (define foo
  (lambda (a b c)
    (string-join (list a b c) "-")))
foo
gosh> (foo "hoge" "fuga" "piyo")
"hoge-fuga-piyo"

この手続き foo の引数のうち、2つめだけをあとから与えるようにしたいとする。つまり、1つめと3つめだけ先に部分適用したい、と。そういうときに cut を使えば実現できる。

gosh> (cut foo "hoge" <> "piyo")
#<closure #f>

シンボル <> が後から与えられる引数の代わりになっている。実際に使ってみると：

gosh> ((cut foo "hoge" <> "piyo") "fuga")
"hoge-fuga-piyo"

確かに2つめの引数をあとから与えることができている。
シンボル <> はいくつあってもいいらしい。後から与えられる引数と対応した <> に当てはめられる。

シンボル <...> を使うと可変長引数をとることができるようになる。

gosh> (cut list <...>)
#<closure #f>
gosh> ((cut list <...>) "foo" "bar" "baz")
("foo" "bar" "baz")

なるほどねぇ。つまり昨日の (cut show-help (car args)) は手続き（ただし、引数なし）を作っていたわけだ。

main 手続きでコマンドライン引数を受け取れることを覚えたので、今度は引数（オプション）を処理するやり方を調べてみた。もちろん、Gauche にも用意されている。

　cf. 9.19 gauche.parseopt – コマンドライン引数の解析 – Gauche ユーザリファレンス

この gauche.parseopt というモジュールは、Perl のコマンドライン処理にヒントを得たものらしい。とにかく例を見ながら書いてみた。

(use gauche.parseopt)

(define greeting
  (lambda (name n morning)
    (let ((message (greeting-massage morning)))
      (let loop ((m n) (l '()))
        (if (= m 0)
            l
            (let ((msg (string-append message ", " name "!")))
              (loop (- m 1) (cons msg l))))))))

(define greeting-massage
  (lambda (morning)
    (if morning
        "Good morning"
        "Hello")))

(define show-help
  (lambda (progname)
    (print (string-append "Usage: gosh " progname " [options] NAME"))
    (print "Options:")
    (print " -m --morning Good morning.")
    (print " -t --times=N N times greeting.")
    (print " -h --help Show this message.")
    (exit)))

(define main
  (lambda (args)
    (let-args (cdr args)
      ((morning "m|morning")
       (times "t|times=i" 1)
       (help "h|help" => (cut show-help (car args)))
       . restargs
      )
      (for-each print (greeting (car restargs) times morning)))))

いろいろ書いているけど、キモは33～38行目の let-args だ。ここで、スクリプトの受け付けるオプションを定義している。基本形は (morning "m|morning")。m が短いオプション名で morning が長いオプション名。-m オプションが指定されると #t に変数 morning が束縛される。
オプションは引数をとることもできる。”t|times=i” という書き方は -t（–times）オプションが整数を引数に取ることを指示している。と同時に、1 とあるのはオプションが指定されなかったときのデフォルト値だ。
-h（–help）オプションはコールバック関数を呼び出す。(cut ...)というのは例をまねただけなのでよくわからない（あとで調べてみよう）けど、これでヘルプを表示する show-help 関数を呼び出せるようだ。
で、オプションとして解析されなかった残りのコマンドライン引数は、restargs に束縛される。

それじゃ、うまく動くか試してみよう。

^o^ > gosh greeting.scm --help
Usage: gosh greeting.scm [options] NAME
Options:
  -m --morning       Good morning.
  -t --times=N       N times greeting.
  -h --help          Show this message.

^o^ > gosh greeting.scm Andy
Hello, Andy!

^o^ > gosh greeting.scm --morning Andy
Good morning, Andy!

^o^ > gosh greeting.scm --morning --times 3 Andy
Good morning, Andy!
Good morning, Andy!
Good morning, Andy!

うまくいったようだ。
もっと詳しくはリファレンスマニュアルで。

※追記あり

Scheme では繰り返しを再帰で実現する。じゃ、n 回の繰り返しはこう書けばいいだろうか。

(define hello
  (lambda (n)
    (let loop ((m n))
      (if (= m 0)
          #t
          (begin
            (print "Hello!")
            (loop (- m 1)))))))

(define main
  (lambda (args)
    (hello (string->number (cadr args)))))

このスクリプトは、引数の回数だけ “Hello!” を繰り返し出力する。

^o^ > gosh hello-loop.scm 3
Hello!
Hello!
Hello!

確かに n 回の繰り返しを行っていて、目的は達成している。けど、気になるのは hello 関数の返り値だ。ここでは便宜的に（というか苦し紛れに）#t を返しているけど、なんだか気持ちが悪い気がする。Scheme 的にはどうなんだろうか。

[追記]

Kei さんからコメントをもらった。返り値が要らないなら when か unless を使えばいいとのこと（未定義値が返ってくる）。

gosh> (define (hello n)
  (let loop ((i 0))
    (unless (= i n)
            (print "Hello!")
            (loop (+ i 1)))))
hello
gosh> (hello 3)
Hello!
Hello!
Hello!
#<undef>

確かに #<undef> が返ってきている。この方がしっくりくるな。when を使うとこうかな。

gosh> (define (hello n)
  (let loop ((i 0))
    (when (< i n)
          (print "Hello!")
          (loop (+ i 1)))))
hello
gosh> (hello 3)
Hello!
Hello!
Hello!
#<undef>

なるほど。うん、unless と when を覚えた。Kei さんありがとうございます。

と、ここまで書いといて何だけど、そもそも print を繰り返すこと自体が Scheme 的じゃない気がしてきた。なのでこう書き直してみた。

(define hello
  (lambda (n)
    (let loop ((m n) (ls '()))
      (if (= m 0)
          ls
          (loop (- m 1) (cons "Hello!" ls))))))

(define main
  (lambda (args)
    (for-each print (hello (string->number (cadr args))))))

hello 関数が返すのは “Hello!” のリストで、それを main 関数のほうで出力している。

^o^ > gosh hello-loop2.scm 3
Hello!
Hello!
Hello!

良くなった。