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-05-07

L-99 (68)

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

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

だんだん解けそうなのがなくなってきてしまった。問題

が解けないと面白くないじゃないか。

今回のお題は、a)二分木を行きがけ順(preorder)と、通り

がけ順(in-order)の二通りの文字列表現にする。b)は意

図が良く分からない。c)はin-orderとpreorderの文字列

によって一意に構造が特定できるので、それから木構造

を生成する。d)はDifference listを使ってみる。

それと、同じノード名を使用した場合の動作についての

考察

bとdはいまいち良く分からないので、aとcを解答。

同じノード名を使用した場合、一意に構造が特定できな

いので、プログラムによって動作が異なってくると思う。

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

P68

;; LISP Machine LISP
(load "string-join.lisp")

(defun preorder (tree)
  (string-join (preorder-aux tree)))

(defun preorder-aux (tree)
  (if tree
      `(,(string (car tree)) 
	,@(preorder-aux (cadr tree)) 
	,@(preorder-aux (caddr tree)))
    '("") ))

(defun inorder (tree)
  (string-join (inorder-aux tree)))

(defun inorder-aux (tree)
  (if tree
      `(,@(inorder-aux (cadr tree)) 
	,(string (car tree)) 
	,@(inorder-aux (caddr tree)))
    '("") ))

(defun snull (str)
  (if (and (stringp str) (string-equal str ""))
      ""
    nil))

(defun disassemble-tree-string (pre in)
  (if (or (snull pre) (snull in))
      ""
    (let* ((root (aref pre 0))
	   (left-in   (substring in  0 (string-search root in)))
	   (left-pre  (substring pre 1 (1+ (string-length left-in))))
	   (right-in  (substring in  (1+ (string-search root in))))
	   (right-pre (substring pre (1+ (string-length left-in)))))
      (values (string root) left-in left-pre right-in right-pre))))

(defun pre+in->tree (pre in)
  (if (or (snull pre) (snull in))
      '()
    (multiple-value-bind (root left-in left-pre right-in right-pre) 
	(disassemble-tree-string pre in)
      `(,(read-from-string root)
	,(pre+in->tree left-pre left-in)
	,(pre+in->tree right-pre right-in)))))

;; Common Lisp
(load "./string-join")

(defun preorder (tree)
  (labels ((frob (tree)
	     (if tree
		 `(,(string (car tree)) ,@(frob (cadr tree)) ,@(frob (caddr tree)))
		 '(""))))
    (string-join (frob tree))))

(defun inorder (tree)
  (labels ((frob (tree)
	     (if tree
		 `(,@(frob (cadr tree)) ,(string (car tree)) ,@(frob (caddr tree)))
		 '(""))))
    (string-join (frob tree))))

(defun snull (str)
  (if (and (stringp str) (string= str ""))
      ""
      nil))

(defun disassemble-tree-string (pre in)
  (if (or (snull pre) (snull in))
      ""
      (let* ((root (char pre 0))
	     (left-in   (subseq in  0 (position root in)))
	     (left-pre  (subseq pre 1 (1+ (length left-in))))
	     (right-in  (subseq in  (1+ (position root in))))
	     (right-pre (subseq pre (1+ (length left-in)))))
	(values (string root) left-in left-pre right-in right-pre))))

(defun pre+in->tree (pre in)
  (if (or (snull pre) (snull in))
      '()
      (multiple-value-bind (root left-in left-pre right-in right-pre) (disassemble-tree-string pre in)
	`(,(read-from-string root)
	   ,(pre+in->tree left-pre left-in)
	   ,(pre+in->tree right-pre right-in))))) 

;; Scheme
(define (preorder tree)
  (letrec ((frob 
	    (lambda (tree)
	      (if (null? tree)
		  '("")
		  `(,(symbol->string (car tree)) ,@(frob (cadr tree)) ,@(frob (caddr tree)))))))
    (string-join (frob tree) "")))

(define (inorder tree)
  (letrec ((frob 
	    (lambda (tree)
	      (if (null? tree)
		  '("")
		  `(,@(frob (cadr tree)) ,(symbol->string (car tree)) ,@(frob (caddr tree)))))))
    (string-join (frob tree) "")))

(define (disassemble-tree-string pre in)
  (if (or (string-null? pre) (string-null? in))
      ""
      (let* ((len       (string-length in))
	     (root      (substring pre 0 1))
	     (left-in   (substring in  0 (string-scan in root)))
	     (left-pre  (substring pre 1 (+ 1 (string-length left-in))))
	     (right-in  (substring in  (+ 1 (string-scan in root))   len))
	     (right-pre (substring pre (+ 1 (string-length left-in)) len)))
	(values root left-in left-pre right-in right-pre))))

(define (pre+in->tree pre in)
  (if (or (string-null? pre) (string-null? in))
      '()
      (receive (root left-in left-pre right-in right-pre) (disassemble-tree-string pre in)
	       `(,(string->symbol root)
		 ,(pre+in->tree left-pre left-in)
		 ,(pre+in->tree right-pre right-in)))))
;