今日の一行

scheme

今日の一行(お題修正)リストのフラット化。
定義から、

  • 言語S
 式   ::= '0' | '(' 並び ')'
  • 言語T
 式   ::= '0' | '1' | 並び

修正部分から、

言語Ｓでは，'(' '(' 並び ')' 式 ')' と '(' 並び 式 ')' を同一視してよい．

なので

[1] (0 (0 0))     = (0 (0 0))　
[2] (0 (0 (0 0))) = (0 (0 (0 0)))
[3] (0 ((0 0) 0)) = (0 (0 0 0))
[4] ((0 0) 0)     = (0 0 0)
[5] (((0 0) 0) 0) = (0 0 0 0)
[6] ((0 (0 0)) 0) = (0 (0 0) 0)
[7] ((0 0) (0 0)) = (0 0 (0 0))

でもって、問題は

s2t は、すべての e ∈ Sの式 について s2t(e) ∈ Tの式 を満し、かつ、すべての e ∈ Sの式 についてそれぞれ e ＝ t2s(s2t(e))であるような変換 t2s が存在する

だから、言語Sを言語T(2進数だね)にできて、その2進数から言語Sを復元できればよいと。

'('を'10'、')'を'11'とすると、とりあえず変換ができるけど、もっとよい方法がありそう。。。
[6]とかが、問題なんだよなぁ。
かりにそうすると[1]-[7]のs2t結果は

[1] (0 (0 0))     = (0 (0 0))     = 0 10 0 0 11
[2] (0 (0 (0 0))) = (0 (0 (0 0))) = 0 10 0 10 0 0 11 11
[3] (0 ((0 0) 0)) = (0 (0 0 0))   = 0 10 0 0 0 11
[4] ((0 0) 0)     = (0 0 0)       = 0 0 0
[5] (((0 0) 0) 0) = (0 0 0 0)     = 0 0 0 0
[6] ((0 (0 0)) 0) = (0 (0 0) 0)   = 0 10 0 0 11 0
[7] ((0 0) (0 0)) = (0 0 (0 0))   = 0 0 10 0 0 11

こんな感じかなぁ。一番外側ははずしてある。言語Tは2桁以上の2進数だから、あってるよね。

まず、t2sから。文法に間違いがあったら、解読できた部分と残りを返す。

;; t2s
(define (t2s tlist)
  (let loop ((slist '())
	     (t tlist))
    (cond ((null? t) (reverse slist))
	   ((eq? 0 (car t))
	    (loop (cons (car t) slist)
		  (cdr t)))
	   ((eq? 0 (cadr t))
	     (receive (s t) (t2s (cddr t))
	       (loop (cons s slist)
		     t)))
	   (else
	    (values (reverse slist) (cddr t))))))

実行例

gosh> (t2s '(0 0 1 0 0 0 1 1 ))
(0 0 (0 0))
gosh> (t2s '(0 1 0 0 0 1 1 0))
(0 (0 0) 0)

次はs2t。

;; s2t
(define (s2t slist)
  ;; slist to simply slist
  (define (simply slist)
    (if (not (pair? slist))
	slist
	(let* ((kar (car slist))
	       (kdr (map simply (cdr slist))))
	  (if (pair? kar)
	      (append (simply (car slist)) kdr)
	      (cons (car slist) kdr)))))
  ;; simply slist to tlist
  (define (ss2t sslist)
    (let loop ((tlist '())
	       (ss sslist))
      (cond ((null? ss) tlist)
	    ((not (pair? (car ss)))
	     (loop (cons 0 tlist)
		   (cdr ss)))
	    (else
	     (loop (append (list 1 1)
			   (ss2t (car ss))
			   (cons 0
				 (cons 1 tlist)))
		   (cdr ss))))))
  (reverse (ss2t (simply slist))))

実行例

gosh> (for-each (lambda (slist)
       (display (equal? slist (t2s (s2t slist))))
       (newline))
     '((0 (0 0))
       (0 (0 (0 0)))
       (0 (0 0 0))
       (0 0 0)
       (0 0 0 0)
       (0 (0 0) 0)
       (0 0 (0 0))))
#t
#t
#t
#t
#t
#t
#t
#<undef>