Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2007-04-25

CADRでSICP 1.5

| 20:03 | CADRでSICP 1.5 - わだばLisperになる を含むブックマーク はてなブックマーク - CADRでSICP 1.5 - わだばLisperになる

CADRでSICP Exercise 1.5.に挑戦 - Structure and Interpretation of Computer Programs

Exercise 1.5
(defun p ()
  (p))

(defun test (x y)
  (if (= x 0)
      0
    (if (functionp y)
	(funcall y)
      y)))
とした場合、
(test 0 #'p)
の評価が正規順序の評価と、作用的順序の評価でどう違っ
てくるかを説明せよ。
解答
正規順序だと、(p)が実行されることになるので、無限
ループになるんではなかろうか。ということで、(p)の
評価が終らず結果が出せない。
ちなみにCADRでは、PDL Overflowになる。
作用的順序だと、(p)は評価する必要がないので0が返さ
れ終了する。

CADRでSICP 1.4

| 20:01 | CADRでSICP 1.4 - わだばLisperになる を含むブックマーク はてなブックマーク - CADRでSICP 1.4 - わだばLisperになる

CADRでSICP Exercise 1.4.に挑戦 - Structure and Interpretation of Computer Programs

Exercise 1.4
演算子が合成式でも評価モデルが使えるかを観察せよ。
Scheme:
(define (a-plus-abs-b a b)
  ((if (> b 0) + -) a b))

解答
Lisp Machine Lispというか、Lisp-2だと
(defun a-plus-abs-b (a b)
  (funcall (if (> b 0) #'+ #'-) a b))
となると思う。
(a-plus-abs-b 3 -3)
-> 6.
にはなるけど、これは演算子が合成式ってことになりま
せんわよね。

L-99 (65)

| 19:00 | L-99 (65) - わだばLisperになる を含むブックマーク はてなブックマーク - L-99 (65) - わだばLisperになる

L-99 P65に挑戦 - L-99:Ninety-Nine Lisp Problems

  1   5   10   15   20   25
1       ,-------n-------,
2   ,---k---,       ,---u
3 ,-c-,     m       p-,
4 a  ,5,              q
5    d g

のような二分木の図を良く眺めて法則性を発見し、その

法則に従って位置情報をノードにした二分木を作成する

のがお題。

作ってる自分でも良く分からないでき上がり。

Lisp Machine Lispにはlabelsとかfletがないのだけれ

ど、どういう風に書くのが定石なのだろうか。とりあえ

ず、補助関数ってことにしてみたけれど。

残りの問題:'(27 55 58-60 63 66-69 80-99)

P65

解答
;; LISP Machine LISP
(defun tree-depth (tree)
  (if tree
      (tree-depth-aux tree 0)
    0))

(defun tree-depth-aux (tree level)
  (let ((left (cadr tree))
	(right (caddr tree)))
    (if (and (null left) (null right))
	level
      (max (tree-depth-aux left (1+ level))
	   (tree-depth-aux right (1+ level))))))

(defun depth-of-most-left-node (tree)
  (if tree
      (depth-of-most-left-node-aux tree 0)
      0))

(defun depth-of-most-left-node-aux (tree level)
  (let ((left (cadr tree)))
    (if left
	(depth-of-most-left-node-aux left (1+ level))
      level)))

(defun layout-binary-tree-2 (tree)
  (let ((depth (tree-depth tree)))
    (layout-binary-tree-2-aux 
      tree 
      (1+ (- (expt 2 (tree-depth tree))
	     (expt 2 (- (tree-depth tree) (depth-of-most-left-node tree)))))
      depth 1)))

(defun layout-binary-tree-2-aux (tree pos depth level)
  (let ((left (cadr tree))
	(right (caddr tree)))
    (cond ((null tree) '() )
	  ('T
	   (let ((offset (expt 2 (1- depth))))
	     `((,pos . ,level)
	       ,(layout-binary-tree-2-aux left  (- pos offset) (1- depth) (1+ level))
	       ,(layout-binary-tree-2-aux right (+ pos offset) (1- depth) (1+ level))))))))

;; Common Lisp
(defun tree-depth (tree)
  (if tree
      (labels ((frob (tree level)
		 (let ((left (cadr tree))
		       (right (caddr tree)))
		   (if (and (null left) (null right))
		     level
		     (max (frob left (1+ level))
			  (frob right (1+ level)))))))
	(frob tree 0))
      0))

(defun depth-of-most-left-node (tree)
  (if tree
      (labels ((frob (tree level)
		 (let ((left (cadr tree)))
		   (if left
		       (frob left (1+ level))
		       level))))
	(frob tree 0))
      0))

(defun layout-binary-tree-2 (tree)
  (let ((depth (tree-depth tree)))
    (labels ((frob (tree pos depth level)
	       (let ((left (cadr tree))
		     (right (caddr tree)))
		 (cond ((endp tree) '() )
		       ('T
			(let ((offset (expt 2 (1- depth))))
			  `((,pos . ,level)
			    ,(frob left  (- pos offset) (1- depth) (1+ level))
			    ,(frob right (+ pos offset) (1- depth) (1+ level)))))))))
      (frob tree 
	    (1+ (- (expt 2 (tree-depth tree))
		   (expt 2 (- (tree-depth tree) (depth-of-most-left-node tree)))))
	    depth 1))))

;; Scheme
(define (tree-depth tree)
  (if (null? tree)
      0
      (let frob ((tree tree)
		 (level 0))
	(let ((left  (list-ref tree 1 '() ))
	      (right (list-ref tree 2 '() )))
	  (if (and (null? left) (null? right))
	      level
	      (max (frob left (+ level 1))
		   (frob right (+ level 1))))))))

(define (depth-of-most-left-node tree)
  (if (null? tree)
      0
      (let frob ((tree tree)
		 (level 0))
	(let ((left (list-ref tree 1 '() )))
	  (if (null? left)
	      level
	      (frob left (+ 1 level)))))))

(define (layout-binary-tree-2 tree)
  (let ((depth (tree-depth tree)))
    (let frob ((tree tree)
	       (pos (+ 1 (- (expt 2 (tree-depth tree))
			    (expt 2 (- (tree-depth tree) 
				       (depth-of-most-left-node tree))))))
	       (depth depth)
	       (level 1)
	       (cont values))
      (let ((left (list-ref tree 1 '() ))
	    (right (list-ref tree 2 '() )))
	(cond ((null? tree) (cont '() ))
	      (else
	       (let ((offset (expt 2 (- depth 1))))
		 (frob left  (- pos offset) (- depth 1) (+ 1 level) 
		       (lambda (left)
			 (frob right (+ pos offset) (- depth 1) (+ 1 level)
			       (lambda (right)
				 (cont `((,pos . ,level) ,left ,right)))))))))))))

CADRでSICP 1.3

| 00:15 | CADRでSICP 1.3 - わだばLisperになる を含むブックマーク はてなブックマーク - CADRでSICP 1.3 - わだばLisperになる

CADRでSICP Exercise 1.3.に挑戦 - Structure and Interpretation of Computer Programs

Exercise 1.3
3つの数のうち、大きい方2つの自乗の和を返す手続きを
つくれ。
解答
(defun sum-square-largest-2 (x y z)
  (if (and (<= x y) (<= x z))
      (+ (* y y) (* z z))
    (sum-square-largest-2 y z x)))

(defun sum-square-largest-2 (x y z)
  (cond ((and (<= x y) (<= x z))
	 (+ (* y y) (* z z)))
	((and (<= y z) (<= y z))
	 (+ (* z z) (* x x)))
	((and (<= z x) (<= z y))
	 (+ (* x x) (* y y)))))

偶々回答の前にJoe Marshall氏の小ネタ(日本語訳)を見てしまったため、

逆に普通の答え方の方がややこしく感じられるという罠。

(defun min-of-3 (x y z)
  (if (and (<= x y) (<= x z))
      x
    (min-of-3 y z x)))

の変形として捉えたってことなのかしらん。


CADRでSICP 1.2

| 00:13 | CADRでSICP 1.2 - わだばLisperになる を含むブックマーク はてなブックマーク - CADRでSICP 1.2 - わだばLisperになる

CADRでSICP Exercise 1.2.に挑戦 - Structure and Interpretation of Computer Programs

Exercise 1.2
(5 + 4 + (2 - (3 - (6 + 4/ 5))))/ (3 * (6 - 2) * (2 - 7))
を前置記法で書け。
解答
(// (+ 5 4 (- 2 (- 3 (+ 6 (// 4 5)))))
    (* 3 (- 6 2) (- 2 7)))

//となっているのは、Maclisp〜LISP Machine LISP〜

Zetalispでは、/はエスケープ文字となっているため。

ちなみに(// 4 5)の結果は、0.となる。