構文木が文法的に正しく出力されるようにする3(if文正常出力成功)

【内部主要記事】

• 【Abstruct的？】
• 【ToDoもしくは目次】
• 【参考文献】

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 atom?
  (lambda (atom)
    (if (pair? atom) #f #t)))

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

(define if-eq '(if (eq?)))

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

(define eq?-or-atom?
  (lambda ()
    (let ((ea (mt-random-integer mt 2) ))
      (cond ((eq? ea 0) 'eq?)
            ((eq? ea 1) 'atom?)))))

;  指定された関数および終端記号を再帰的に使用して、プログラムを
;  作成します。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-atom (mt-random-integer mt 2) ))
                      (define choice (cond ((eq? eq-or-atom 0) 'eq?)
                                           ((eq? eq-or-atom 1) 'atom?)))
                      (let ((number-of-arguments (cdr (assq choice (argument-map)))))
                        ;(set! allowable-depth (- allowable-depth 2))
                        (list 'if (cons choice
                                      (create-arguments-for-function
                                        number-of-arguments
                                        (- allowable-depth 1)
                                        full-p))
                              (terminal)
                              (terminal) ))))
                   ; 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))))))

以下に実行例を示します。

gosh> (load "./random-tree.scm")
#t

;;ランダムなプログラム出力
gosh> (create-individual-program allowable-depth top-node-p full-p)
 (cons (cons (if (eq? (if (atom? (cons #\d #\e)) #\a #\s) (if (eq? (cons #\h #\t)
 (if (atom? #\e) #\x #\u)) #\a #\p)) #\e #\u) (if (eq? (cons (cons #\i #\h)
 (cons #\m #\q)) (if (eq? (if (eq? #\g #\o) #\k #\y) (cons #\g #\y)) #\b #\o)) #\t #\c))
 (cons (if (eq? (cons (cons #\s #\b) (if (eq? #\j #\b) #\b #\x))
 (if (atom? (if (eq? #\n #\o) #\h #\d)) #\h #\u)) #\i #\v)
 (cons (cons (if (eq? #\i #\u) #\e #\t) (cons #\g #\m))
 (cons (cons #\c #\t) (cons #\g #\t)))))

;;出力されたランダムなプログラムの実行
gosh> (cons (cons (if (eq? (if (atom? (cons #\d #\e)) #\a #\s) (if (eq? (cons #\h #\t)
 (if (atom? #\e) #\x #\u)) #\a #\p)) #\e #\u) (if (eq? (cons (cons #\i #\h)
 (cons #\m #\q)) (if (eq? (if (eq? #\g #\o) #\k #\y) (cons #\g #\y)) #\b #\o)) #\t #\c))
 (cons (if (eq? (cons (cons #\s #\b) (if (eq? #\j #\b) #\b #\x))
 (if (atom? (if (eq? #\n #\o) #\h #\d)) #\h #\u)) #\i #\v)
 (cons (cons (if (eq? #\i #\u) #\e #\t) (cons #\g #\m))
 (cons (cons #\c #\t) (cons #\g #\t)))))

;;実行結果
 ((#\u . #\c) #\v (#\t #\g . #\m) (#\c . #\t) #\g . #\t)