月: 2016年8月

真ん中優先。真ん中がないときは右側優先。

(define thin-out
  (lambda (lis n)
    (let* ((r (- (length lis) n))
      (a (if (= (mod r 2) 0) (/ r 2) (+ (div r 2) 1)))
      (b (+ a n)))
      (append (take lis a) (drop lis b)))))

(print (iota 10))
(print (thin-out (iota 10) 1))
(print (thin-out (iota 10) 2))
(print (thin-out (iota 10) 3))

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

最初の要素は0番目。

(define delete-nth
  (lambda (lis n)
    (let loop ((c 0) (l lis) (r '()))
      (if (null? l)
          (reverse r)
          (if (= c n)
            (loop (+ c 1) (cdr l) r)
            (loop (+ c 1) (cdr l) (cons (car l) r)))))))

(print (iota 10))
(print (delete-nth (iota 10) 3))
(print '(a b c d e f g h i j))
(print (delete-nth '(a b c d e f g h i j) 3))

^o^ > gosh delete-nth.scm
(0 1 2 3 4 5 6 7 8 9)
(0 1 2 4 5 6 7 8 9)
(a b c d e f g h i j)
(a b c e f g h i j)

ちゃんと 3 と d が消えている。

これを拡張して、「n番目」を複数とれるようにしてみよう。

(define delete-nth
  (lambda (lis . ns)
    (let loop ((c 0) (l lis) (r '()))
      (if (null? l)
          (reverse r)
          (if (include? c ns)
              (loop (+ c 1) (cdr l) r)
              (loop (+ c 1) (cdr l) (cons (car l) r)))))))

(define include?
  (lambda (x lis)
  (cond ((null? lis) #f)
        ((= x (car lis)) #t)
        (else (include? x (cdr lis))))))

(print (iota 10))
(print (delete-nth (iota 10) 3 5 7))
(print '(a b c d e f g h i j))
(print (delete-nth '(a b c d e f g h i j) 3 5 7))

^o^ > gosh delete-nth2.scm
(0 1 2 3 4 5 6 7 8 9)
(0 1 2 4 6 8 9)
(a b c d e f g h i j)
(a b c e g i j)

要素がリストに含まれているか否かを判定する述語が見当たらなかったので、include? を自作した。

先週のエントリを見て省略可能な引数を扱う方法を書いてくれた人がいる。

　cf. 省略可能引数 – 主題のない日記

そこでは、R6RS/R7RS で定められている case-lambda と Gauche の拡張である let-optionals* が紹介されている。どちらも省略可能な引数を簡単に扱うためのマクロのようだ。

my-iota を case-lambda を使って書くとこうなる。

(define my-iota
  (case-lambda
    ((count) (my-iota count 0 1))
    ((count start) (my-iota count start 1))
    ((count start step)
      (let loop ((c count)
        (i (+ start (* (- count 1) step)))
        (lis '()))
        (if (= c 0)
            lis
            (loop (- c 1) (- i step) (cons i lis)))))))

(print (my-iota 10))
(print (my-iota 10 2))
(print (my-iota 10 2 2))
(print (my-iota 10 2 -2))

ついでに step に負数を指定すると期待通りに動作しない不具合も直しておいた。
実行例：

^o^ > gosh my-iota4a.scm
(0 1 2 3 4 5 6 7 8 9)
(2 3 4 5 6 7 8 9 10 11)
(2 4 6 8 10 12 14 16 18 20)
(2 0 -2 -4 -6 -8 -10 -12 -14 -16)

一方、let-optionals* を使って書くとこんな感じ：

(define my-iota
  (lambda (count . restargs)
    (let-optionals* restargs
      ((start 0)
       (step 1))
      (let loop ((c count)
        (i (+ start (* (- count 1) step)))
        (lis '()))
        (if (= c 0)
            lis
            (loop (- c 1) (- i step) (cons i lis)))))))

(print (my-iota 10))
(print (my-iota 10 2))
(print (my-iota 10 2 2))
(print (my-iota 10 2 -2))

^o^ > gosh my-iota4b.scm
(0 1 2 3 4 5 6 7 8 9)
(2 3 4 5 6 7 8 9 10 11)
(2 4 6 8 10 12 14 16 18 20)
(2 0 -2 -4 -6 -8 -10 -12 -14 -16)

当然ながら実行結果はどちらも同じだけど、どちらかというと case-lambda のほうが好みだな。引数の数でパターンマッチしてる感じがいい。let-optionals* だと省略可能引数の部分だけ別に書くことになるのでコードの見通しが悪いような気がする。

Gauche のマニュアルだと、case-lambda は http://practical-scheme.net/gauche/man/gauche-refj_24.html の一番下、let-optionals* は http://practical-scheme.net/gauche/man/gauche-refj_58.html の 6.18.4 省略可能引数のパージング にある。

たまには Scheme を。

Scheme で整数のリストを作るには iota 手続きが使える。

^o^ > gosh
gosh> (iota 10)
(0 1 2 3 4 5 6 7 8 9)
gosh> (iota 10 2)
(2 3 4 5 6 7 8 9 10 11)
gosh> (iota 10 2 2)
(2 4 6 8 10 12 14 16 18 20)

これを自前で実装してみよう。
最初に作ったのがこれ。可変長引数なので、引数の数に応じて対応する補助手続きを呼び出している。

(define my-iota
  (lambda (n . args)
    (cond ((null? args) (my-iota-simple n))
          ((= (length args) 1) (my-iota-start n (car args)))
          (else (my-iota-step n (car args) (cadr args))))))

(define my-iota-simple
  (lambda (n)
    (let loop ((start 0) (i (- n 1)) (lis '()))
      (if (< i start)
          lis
          (loop start (- i 1) (cons i lis))))))

(define my-iota-start
  (lambda (n start)
    (let loop ((i (- (+ start n) 1)) (lis '()))
      (if (< i start)
          lis
          (loop (- i 1) (cons i lis))))))

(define my-iota-step
  (lambda (n start step)
    (let loop ((i (+ start (* (- n 1) step))) (lis '()))
      (if (< i start)
          lis
          (loop (- i step) (cons i lis)))))) (print (my-iota 10))

(print (my-iota 10 2))
(print (my-iota 10 2 2))

実行例：

^o^ > gosh my-iota.scm
(0 1 2 3 4 5 6 7 8 9)
(2 3 4 5 6 7 8 9 10 11)
(2 4 6 8 10 12 14 16 18 20)

上の実装では3つの補助手続きを定義しているけど、内容は同じようなものなので1つにまとめることにした。つまり、引数を3つとる補助手続き my-iota-general を定義しておいて、本体手続き my-iota のほうで場合分けをして呼び出す。

(define my-iota
  (lambda (n . args)
    (cond ((null? args) (my-iota-general n 0 1))
          ((= (length args) 1) (my-iota-general n (car args) 1))
          (else (my-iota-general n (car args) (cadr args))))))

(define my-iota-general
  (lambda (n start step)
    (let loop ((i (+ start (* (- n 1) step))) (lis '()))
      (if (< i start)
          lis
          (loop (- i step) (cons i lis))))))

(print (my-iota 10))
(print (my-iota 10 2))
(print (my-iota 10 2 2)) 

^o^ > gosh my-iota2.scm
(0 1 2 3 4 5 6 7 8 9)
(2 3 4 5 6 7 8 9 10 11)
(2 4 6 8 10 12 14 16 18 20)

だいぶシンプルになった。もう一歩進めてみよう。上の my-iota 手続きの中では場合分けをして my-iota-general の引数 start、step を決めているので、let で局所変数にしてしまえば my-iota-general の本体部分を取り込むことができる。

(define my-iota
  (lambda (n . args)
    (let ((start (if (>= (length args) 1) (car args) 0))
          (step (if (>= (length args) 2) (cadr args) 1)))
         (let loop ((i (+ start (* (- n 1) step))) (lis '()))
           (if (< i start)
               lis
               (loop (- i step) (cons i lis)))))))

(print (my-iota 10))
(print (my-iota 10 2))
(print (my-iota 10 2 2)) 

^o^ > gosh my-iota3.scm
(0 1 2 3 4 5 6 7 8 9)
(2 3 4 5 6 7 8 9 10 11)
(2 4 6 8 10 12 14 16 18 20)

めでたく1つの手続きにできた。