構文木が文法的に正しく出力されるようにする2

内部リンク

• Abstruct的？
• ToDoもしくは目次

• 以下の変更を加える
  • carを使わない。
  • cdrを使わない。
  • (実質、非終端記号(関数)はcons、if、list?、eq?)

とりあえず、出力された構文木(コード)は実行可能になりました。
まだ、if構文が(文法的に正しくても)、通常の使い方として
出力するように書き換えられていません。

(use math.mt-random)

(define mt (make <mersenne-twister> :seed (sys-time)))

(define terminal
  (lambda ()
    (let ((rdm (mt-random-integer mt 26) ))
          (string-ref "abcdefghijklmnopqrstuvwxyz" rdm))))

(define non-terminal
  (lambda ()
    (let ((rdm (mt-random-integer mt 2) ))
      (cond
        ;((eq? rdm 0) 'car)
        ;((eq? rdm 1) 'cdr)
        ((eq? rdm 0) 'cons)
        (else 'if)))))
        ;(eq? rdm 3) 'quote)
        ;((eq? rdm 3) 'if)
        ;((eq? rdm 4) 'define)
        ;((eq? rdm 4) 'eq?)
        ;(else 'list?)))))

(define argument-map
  (lambda ()
    (list
      ;(cons 'car 1)
      ;(cons 'cdr 1)
      (cons 'cons 2)
      (cons 'eq? 2)
      (cons 'list? 1))))

(define allowable-depth 5) ;const
(define full-p #t) ;const
(define top-node-p #f) ;const

;  指定された関数および終端記号を再帰的に使用して、プログラムを
;  作成します。argument-mapは、関数セットにおける各関数が
;  いくつの引数を持つべきかを決定するのに使用されます。
;  allowable-depthさは私たちが作成することができる木の残りの
;  深さであり、0がヒットした時は、単体の終端記号を選択します。
;  私たちが木のトップのノードとして呼ばれている場合に限り、
;  top-node-pは真です。これは、常に木の一番上に関数を置いた
;  ことを私たちが確かめることを可能にします。
;  full-pは、最高に枝が多い個体かどうかを示します。
(define create-individual-program
  (lambda (allowable-depth
           top-node-p
           full-p)
    (cond ((<= allowable-depth 0)
           ;; 最深に到達。よって終端記号を選択する。
           (terminal))
          ((or full-p top-node-p)
           ;; top-node-p か full-p を満たした。
           ;; よって非終端記号(関数)だけを選択する。
           (let ((choice (non-terminal)))
             ; if が選択されたら eq? か list? を cons し
             ; choice を eq? か list? に変換する。
             (cond ((eq? 'if choice)
                    (let ((eq-or-list (mt-random-integer mt 2) ))
                      (define choice (cond ((eq? eq-or-list 0) 'eq?)
                                           ((eq? eq-or-list 1) 'list?)))
                      (let ((number-of-arguments (cdr (assq choice (argument-map)))))
                        (cons 'if (cons choice
                                        (create-arguments-for-function
                                          number-of-arguments
                                          (- allowable-depth 1)
                                          full-p))))))
                   ; choiceがif以外の場合。
                   (else
                     (let ((number-of-arguments (cdr (assq choice (argument-map)))))
                       (cons choice
                             (create-arguments-for-function
                               number-of-arguments
                               (- allowable-depth 1)
                               full-p)))))))
          (else
           ;; 非終端記号(関数)か終端記号から1つ選ぶ。
           ;0 or 1 でまず2択にしてから関数を呼ぶ
           (let ((set (mt-random-integer mt 2) ))
             (let ((choice (cond ((eq? set 0) (terminal))
                                 ((eq? set 1) (non-terminal)) ) ))
               (cond ((eq? set 1)
                   ;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
                   (let ((function choice)
                         (number-of-arguments (cdr (assq choice (argument-map)))))
                     (cons function
                           (create-arguments-for-function
                             number-of-arguments
                             (- allowable-depth 1)
                             full-p))))
                   ;; atomを選ぶ
                   (else
                     (terminal)) ) ))))))


;  ツリーのノード用の引数のリストを作成します。
;  引数の数は、今から作成される残りの引数の数です。
;  各引数は、create-individual-programを
;  使用することで正常な方法で作成されます。
(define create-arguments-for-function
  (lambda (number-of-arguments
           allowable-depth
           full-p)
    (cond ((eq? number-of-arguments 0)
           ())
          (else
            (cons (create-individual-program
                    allowable-depth
                    ()
                    full-p)
                  (create-arguments-for-function
                    (- number-of-arguments 1)
                    allowable-depth
                    full-p))))))

実行例

1.ランダムな構文木の出力
gosh> (create-individual-program allowable-depth top-node-p full-p)
(cons (if eq? (cons (if eq? (if list? #\b) (if eq? #\f #\g)) (if eq? (if list? #\t)
 (cons #\f #\c))) (cons (cons (cons #\j #\o) (if list? #\t)) (cons (if eq? #\n #\o)
 (if eq? #\e #\s)))) (if eq? (cons (if eq? (if list? #\h) (cons #\m #\g))
 (cons (cons #\w #\i) (if eq? #\g #\y))) (cons (cons (if eq? #\x #\i)
 (if eq? #\y #\y)) (if eq? (if list? #\o) (cons #\l #\k)))))

2.出力された構文木(コード)を実行
gosh>
(cons (if eq? (cons (if eq? (if list? #\b) (if eq? #\f #\g)) (if eq? (if list? #\t)
 (cons #\f #\c))) (cons (cons (cons #\j #\o) (if list? #\t)) (cons (if eq? #\n #\o)
 (if eq? #\e #\s)))) (if eq? (cons (if eq? (if list? #\h) (cons #\m #\g))
 (cons (cons #\w #\i) (if eq? #\g #\y))) (cons (cons (if eq? #\x #\i)
 (if eq? #\y #\y)) (if eq? (if list? #\o) (cons #\l #\k)))))

3.結果
((#\b . #\t) #\h (#\w . #\i) . #\g)

注意：「#\」は文字型を意味します。