結城浩のSICP日記 RSSフィード

2006-05-14

[]p.152:循環検査 p.152:循環検査 - 結城浩のSICP日記 を含むブックマーク

ひげぽんさんが問題3.18近辺にチャレンジしているので、結城も考えた。

問題3.18: リストが循環しているかどうかを調べる関数を定義する。

結城の解答(cyclic?関数)

(define (cyclic? x)
  (define visited '())
  (let loop ((x x))
    (cond ((not (pair? x)) #f)
          ((memq x visited) #t)
          (else
            (set! visited (cons x visited))
            (loop (cdr x))))))

;以下、テスト。
(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(cyclic? 'a)
;=> #f

(cyclic? (list 'a 'b 'c))
;=> #f

(cyclic? (make-cycle (list 'a)))
;=> #t

(cyclic? (make-cycle (list 'a 'b)))
;=> #t

(cyclic? (make-cycle (list 'a 'b 'c)))
;=> #t

問題3.19: リストが循環しているかどうかを調べる関数を定義する。ただしメモリを食わない方法で。

結城の解答(cyclic?関数)

  • xとyの追っかけっこ。
  • xが先行。xが2歩進むとき、yは1歩進む。つまり差は1歩ずつ開いていく。
  • ループに入ったら、先行していたはずのxがyに1歩ずつ近づいていく。yが一周する前には必ずxが追いつく。
(define (cyclic? x)
  (define (loop? x y)
    (cond ((not (pair? x)) #f)
          ((eq? x y) #t)
          ((not (pair? (cdr x))) #f)
          (else
            (loop? (cddr x) (cdr y)))))
  (cond ((not (pair? x)) #f)
        (else
          (loop? (cdr x) x))))

;以下、テスト。
(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(cyclic? 'a)
;=> #f

(cyclic? (list 'a 'b 'c))
;=> #f

(cyclic? (make-cycle (list 'a)))
;=> #t

(cyclic? (make-cycle (list 'a 'b)))
;=> #t

(cyclic? (make-cycle (list 'a 'b 'c)))
;=> #t

(define p (cons 'a 'a))
(set-cdr! p p)
(cyclic? p)
;=> #t

CPSでパスカルの三角形 CPSでパスカルの三角形 - 結城浩のSICP日記 を含むブックマーク

Continuation Passing Styleを使ってパスカルの三角形を書き直してみます。

(use srfi-42)

(define (combination n k)
  (define (combination/cps n k result cont)
    (cond ((= k 0) (cont (+ result 1)))
          ((= k n) (cont (+ result 1)))
          (else
            (combination/cps (- n 1) k result
              (lambda (x)
                (combination/cps (- n 1) (- k 1) x cont))))))
  (combination/cps n k 0 (lambda (x) x)))

(define (line n) (list-ec (: k 0 (+ n 1)) (combination n k)))
(do-ec (: n 0 10) (print (line n)))

実行結果です。

(1)
(1 1)
(1 2 1)
(1 3 3 1)
(1 4 6 4 1)
(1 5 10 10 5 1)
(1 6 15 20 15 6 1)
(1 7 21 35 35 21 7 1)
(1 8 28 56 70 56 28 8 1)
(1 9 36 84 126 126 84 36 9 1)

追記:(= k 1)ではなく(= k 0)でした。

(use srfi-42)

(define (combination n k)
  (define (combination/cps n k result cont)
    (cond ((= k 0) (cont (+ result 1)))
          ((= k n) (cont (+ result 1)))
          (else
            (combination/cps (- n 1) k result
              (lambda (x)
                (combination/cps (- n 1) (- k 1) x cont))))))
  (combination/cps n k 0 (lambda (x) x)))

(define (line n) (list-ec (: k 0 (+ n 1)) (combination n k)))
(do-ec (: n 0 10) (print (line n)))

CGI練習 CGI練習 - 結城浩のSICP日記 を含むブックマーク

Gaucheのwww.cgiモジュールに書いてあった例を分解して写経。さらにtableではなくdlにしてみる。

cgi.scm

#!/gauche/bin/gosh

(use text.html-lite)
(use www.cgi)

(define (main args)
  (cgi-main make-tree))

(define (make-tree params)
  (list
    (cgi-header)
    (html-doctype)
    (make-html params)))

(define (make-html params)
  (html:html
    (make-head params)
    (make-body params)))

(define (make-head params)
  (html:head (html:title "Example")))

(define (make-body params)
  (html:body
    (html:dl
      (make-dt-dd params))))

(define (make-dt-dd params)
  (cond ((null? params) '())
        (else
          (cons (list
                  (html:dt (html-escape-string (caar params)))
                  (html:dd (html-escape-string (x->string (cadar params)))))
                (make-dt-dd (cdr params))))))

.htaccess

Options ExecCGI
AddHandler cgi-script .scm

コマンドラインでの実行結果。

> gosh cgi.scm
Enter parameters (name=value).  ^D to stop.
parama=aaa<aaa
paramb=b"bb"b
^Z
Content-type: text/html

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
       "http://www.w3.org/TR/html4/strict.dtd">
<html><head><title>Example</title
></head
><body><dl><dt>parama</dt
><dd>aaa&lt;aaa</dd
><dt>paramb</dt
><dd>b&quot;bb&quot;b</dd
></dl
></body
></html
>

ブラウザから

http://www.example.com/cgi.scm?parama=aaa<aaa&paramb=b"bb"b

にアクセス。

逆クォートとカンマ 逆クォートとカンマ - 結城浩のSICP日記 を含むブックマーク

疑問:以下の(1)と(2)は同じだろうか?

`(,(foo) ,(bar) ,(baz))     ; (1)
(list (foo) (bar) (baz))    ; (2)

[]p.152:対の個数を数える p.152:対の個数を数える - 結城浩のSICP日記 を含むブックマーク

ひげぽんさんとIRCでしゃべっていて問題3.17がおもしろいという話をお聞きしたので、私も考えた。

問題3.17: 対の個数を数える(シェアしている対をダブって数えないこと)

結城の解答

(define (count-pairs x)
  (define visited '())
  (define (count-pairs-sub x)
    (cond ((not (pair? x)) 0)
          ((memq x visited) 0)
          (else
            (set! visited (cons x visited))
            (+ 1
               (count-pairs-sub (car x))
               (count-pairs-sub (cdr x))))))
  (count-pairs-sub x))

; テスト
(define a (cons (list 'a 'b) (list 'a 'b)))
(define b (cons a a))
(count-pairs a) ;=> 5
(count-pairs b) ;=> 6

いつものようにnamed-letを使う練習も。

(define (count-pairs x)
  (define visited '())
  (let visit ((x x))
    (cond ((not (pair? x)) 0)
          ((memq x visited) 0)
          (else
            (set! visited (cons x visited))
            (+ 1
               (visit (car x))
               (visit (cdr x)))))))
  • memqを使う。memberを使ってはいけないはず。

追記:ひげぽんさんの解答を読んでこういう書き方もあることに気づきました。最後に数えますけれど。

(define (count-pairs x)
  (define visited '())
  (let visit ((x x))
    (if (and (pair? x) (not (memq x visited)))
          (begin
            (set! visited (cons x visited))
            (visit (car x))
            (visit (cdr x)))))
  (length visited))