l99をschemeで解いてみる

cadrグループの人の日記でl99を知ったのでschemeで解いてみる。
P26あたりから難しくなってきた。

P26

組み合わせを作る問題*1
最初に書いたもの（nCnとnC0には対応してない）

(define (combination n l)
  (if (<= n 1)
      (map list l)
      (apply append 
             (unfold (compose null? cdr)
                     (lambda (xs)
                       (map (cute cons (car xs) <>)
                            (combination (- n 1) (cdr xs))))
                     cdr l))))

(length (combination 3 (iota 12)));; => 220
(combination 3 '(a b c d e f));; => ((a b c) (a b d) (a b e) (a b f) (a c d) (a c e) (a c f) (a d e) (a d f) (a e f) (b c d) (b c e) (b c f) (b d e) (b d f) (b e f) (c d e) (c d f) (c e f) (d e f))

「(unfold (compose null? cdr) cdr )」と同じような動作をする関数がCLにはあるみたい。>mapl

maplを使ってちょっと変更

append-maplも必要になった。
ついでに0とかをとっても大丈夫なようにした

(define (mapl proc l)
  (define (loop l)
    (if (null? (cdr l))
        (list (proc l))
        (cons (proc l) (loop (cdr l)))))
  (if (null? l) '() (loop l)))

(define-macro (append-mapl proc l)
  `(apply append (mapl ,proc ,l)))

(define (c n l)
  (define (sc n l)
    (if (= n 1) 
        (map list l)
        (append-mapl (lambda (xs)
                       (map (cute cons (car xs) <>) (sc (- n 1) (cdr xs))))
                     l)))
  (if (or (zero? n) (>= n (length l))) l (sc n l)))

P27

グループ分けのの問題
group3は、まず2つの時を考えて…とかしていたらいつの間にかできてた。
その後、groupを作ろうとしたのだけど、問題の意味を読み間違えていた。
問題に沿ったものmgroupという名前で作った。

(define (lrotate lis)  `(,@(cdr lis) ,(car lis)))

(define (all-rotated-list lis)
  (fold (lambda (_ it)
          (cons (lrotate (car it)) it))
        (list lis) (cdr lis)))

(define /. (compose ceiling /))

(define (group2 lis)
  (let ((src (all-rotated-list lis))
        (n (length lis)))
    (list-ec (: i 1 (/. n 2)) (: xs src)
             (receive (l r) (split-at xs i) (list l r)))))

(define (group3 lis)
  (let ((src (all-rotated-list lis))
        (n (length lis)))
    (append-ec (: i 1 (/. n 2)) (: xs src)
               (receive (l r) (split-at xs i)
                 (map (cut cons l <>) (group2 r))))))

;;すべての可能性を表示するgroup
(define (group lis)
  (define (subproc lis k)
    (let ((src (all-rotated-list lis))
          (n (length lis)))
      (if (= k 2)
          (list-ec (: i 1 (/. n 2)) (: xs src)
                   (receive (l r) (split-at xs i) (list l r)))
          (append-ec (: i 1 (/. n 2)) (: xs src)
                          (receive (l r) (split-at xs i)
                            (map (cut cons l <>) (subproc r (- k 1)))))
          )))
  (cons (map list lis)
        (append-ec (: i 2 (length lis))
                        (subproc lis i))))

;;問題に沿ったmgroup
(define (mgroup lis nums)
  (define (subproc lis nums)
    (let1 src (all-rotated-list lis)
      (if (null? (cddr nums))
          (list-ec (: xs src)
                   (receive (l r) (split-at xs (car nums)) (list l r)))
          (append-ec (: xs src)
                          (receive (l r) (split-at xs (car nums))
                            (map (cut cons l <>) (subproc lis (cdr nums)))))
                 )))
  (when (= (length lis) (apply + nums))
    (subproc lis nums)))

append-ec便利。

append-ecに限らず、srfi42の手続きは便利なものが多い気がする

sicpで出てきた順列（permtation)の定義とかも楽に書けるようになる。

(use srfi-1)
(use srfi-42)

(define (sicp-remove e lis)
  (remove (cut = e <>) lis))

(define (permtation s)
  (if (null? s)
      (list '())
      (list-ec (: i s) (: j (permtation (sicp-remove i s)))
               (cons i j))))

(permtation '(1 2 3));; => ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

*1:組み合わせが欲しければ"(use util.combinations) (define c combinations)"とかできるみたい。