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

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)))))))))))))