2528. call/ccを用いた不可思議な再帰コード集

亀田馬志 (Dec 01, 2009)
;;; 元ネタは「もうひとつのScheme入門」
;;; http://www.shido.info/lisp/scheme7.html
;;; より。

;; [code 1] 階乗を求める手続き fact
(define (fact n)
  (call/cc
   (lambda (break)
     (* (if (= n 1)
            (break 1)
            n) (fact (- n 1))))))

;; 実行例
;; > (fact 5)
;; 120

;;; 練習問題1

;; 1.リストの要素の数を数える手続き my-length
(define (my-length ls)
  (call/cc
   (lambda (break)
     (+ 1 (my-length (cdr (if (null? ls)
                              (break 0)
                              ls)))))))

;; 2.数のリストの要素の合計を求める手続き my-sum
(define (my-sum ls)
  (call/cc
   (lambda (break)
     (+ (car (if (null? ls)
                 (break 0)
                 ls)) (my-sum (cdr ls))))))

;; 3.リスト (ls) から要素 (x) を取り除いたリストを返す手続き
(define (remove x ls)
  (call/cc
   (lambda (exterior-break)
     (let ((h (car (if (null? ls)
                       (exterior-break '())
                       ls))))
       ((lambda (y) (call/cc
                (lambda (interior-break)
                  (cons (if (eqv? x h)
                            (interior-break y)
                            h) y))))
        (remove x (cdr ls)))))))

;; 4.リスト (ls) の要素 (x) の位置を返す手続き。位置は 0 から数え始め、 x がない場合は #f を返す。
(define (position x ls)
  (position-aux x ls 0))

(define (position-aux x ls i)
  (call/cc
   (lambda (break)
     (position-aux (if (eqv? x (car (if (null? ls)
                                        (break #f)
                                        ls)))
                       (break i)
                       x) (cdr ls) (+ 1 i)))))
                                
;; リストの要素を全て2倍にする関数
(define (list*2 ls)
  (call/cc
   (lambda (break)
     (cons (* 2 (car (if (null? ls)
                         (break '())
                         ls)))
           (list*2 (cdr ls))))))

;; [code 2] 末尾再帰版階乗計算手続き fact-tail
(define (fact-tail n)
  (fact-rec n n))

(define (fact-rec n p)
  (call/cc
   (lambda (break)
     (let ((m (- (if (= n 1)
                     (break p)
                     n) 1)))
       (fact-rec m (* p m))))))

;; 実行例
;; > (fact-tail 5)
;; 120

;;; 練習問題2

;; 1.リストの要素の順番を反転させる手続き my-reverse
(define (my-reverse ls)
  (my-reverse-rec ls '()))

(define (my-reverse-rec ls0 ls1)
  (call/cc
   (lambda (break)
     (my-reverse-rec (cdr (if (null? ls0)
                              (break ls1)
                              ls0)) (cons (car ls0) ls1)))))

;; 2.数のリストの要素の合計を求める手続き my-sum-tail
(define (my-sum-tail ls)
  (my-sum-rec ls 0))

(define (my-sum-rec ls n)
  (call/cc
   (lambda (break)
     (my-sum-rec (cdr (if (null? ls)
                          (break n)
                          ls)) (+ n (car ls))))))

;; 3.正の整数を表す文字列を整数に変換する手続き my-string->integer
(define (my-string->integer str)
  (char2int (string->list str) 0))

(define (char2int ls n)
  (call/cc
   (lambda (break)
     (char2int (cdr (if (null? ls)
                        (break n)
                        ls)) (+ (- (char->integer (car ls)) 48)
                                (* n 10))))))

;; [code 3] named-let での例
(define (fact-let n)
  (call/cc
   (lambda (break)
     (let loop ((n1 n) (p n))
       (let ((m (- (if (= n1 1)
                       (break p)
                       n1) 1)))
         (loop m (* p m)))))))

;;; 練習問題3

;; 1a. remove
(define (remove x ls)
  (call/cc
   (lambda (break)
     (let loop ((ls0 ls) (ls1 '()))
       (loop (cdr (if (null? ls0)
                      (break (reverse ls1))
                      ls0))
             (if (eqv? x (car ls0))
                 ls1
                 (cons (car ls0) ls1)))))))

;; 1b. position
(define (position x ls)
  (call/cc
   (lambda (break)
     (let loop ((ls0 ls) (i 0))
       (loop (cdr (cond ((null? ls0) (break #f))
                        ((eqv? x (car ls0)) (break i))
                        (else ls0))) (+ 1 i))))))

;; 2a. my-reverse-let
(define (my-reverse-let ls)
  (call/cc
   (lambda (break)
     (let loop ((ls0 ls) (ls1 '()))
       (loop (cdr (if (null? ls0)
                      (break ls1)
                      ls0)) (cons (car ls0) ls1))))))

;; 2b. my-sum-let
(define (my-sum-let ls)
  (call/cc
   (lambda (break)
     (let loop ((ls0 ls) (n 0))
       (loop (cdr (if (null? ls0)
                      (break n)
                      ls0)) (+ (car ls0) n))))))

;; 2c. my-string->integer-let
(define (my-string->integer-let str)
  (call/cc
   (lambda (break)
     (let loop ((ls0 (string->list str)) (n 0))
       (loop (cdr (if (null? ls0)
                      (break n)
                      ls0))
             (+ (- (char->integer (car ls0)) 48)
                (* n 10)))))))

;; 3.0 から n 未満の整数のリストを返す手続き range
(define (range n)
  (call/cc
   (lambda (break)
     (let loop ((i 0) (ls1 '()))
       (loop (+ 1 (if (= i n)
                      (break (reverse ls1))
                      i)) (cons i ls1))))))

;; 4.任意個の引数をとりそれらの平均を返す関数
(define (ave . ls)
  (call/cc
   (lambda (break)
     (let loop ((sum 0) (ls1 ls))
       (loop (+ sum (car (if (null? ls1)
                             (break (/ sum (length ls)))
                             ls1))) (cdr ls1))))))

;; 実行例
;; > (ave 1.1 2.3 4.6)
;; 2.6666666666666665
;; > (ave 3.3 4.7 10.2 20.6 100.1)
;; 27.779999999999994
元ねた: