マヨイドーロを解いてみた

マイドーロでもマヨロードでもない。マヨイドーロ。scheme で解いてみた。

(define (myload0) `((Z C B)))
(define (myload1) `((Y A 'B) (Y A B 'C B)))

(define (myload n)
  (cond ((= n 0) (myload0))
        ((= n 1) (append (myload1) (myload0)))
        (else (myload-n n))))

(define (myload-n n)
  (letrec ((myload-n-local
             (lambda (n rv-top rv-all)
               (if (= n 0) rv-all
                 (let ((next-result (myload-next rv-top)))
                   (myload-n-local
                     (- n 1)
                     next-result
                     (append next-result rv-all)))))))
    (myload-n-local (- n 1)
                    (myload1)
                    (append (myload1) (myload0)))))

(define (next-goal elm0)
  (if (eq? elm0 'Y) 'Z 'Y))

(define (search-next-route goal route)
  (if (eq? goal 'Z)
    (if (eq? route 'A)
      `(Z C B 'A)
      `(Z C 'B))
    (if (eq? route 'C)
      `(Y A B 'C)
      `(Y A 'B))))

(define (myload-next lst)
  (let ((goal (next-goal (caar lst))))
    (letrec ((myload-one
               (lambda (elm0)
                 (let* ((route0 (cadr elm0))
                        (route0-remain (cddr elm0))
                        (route1 (caddr elm0))
                        (route1-remain (cdddr elm0))
                        (route1-exist? (symbol? route1))
                        (next-route0 (search-next-route goal route0))
                        (next-route1 (if route1-exist?
                                       (search-next-route goal route1) '()))
                        (rv0 (append next-route0 route0-remain))
                        (rv1 (append next-route1 route1-remain))
                        (rv (list rv0)))
                   (if route1-exist? (cons rv1 rv) rv))))

             (myload-next0
               (lambda (lst0 rv)
                 (if (null? lst0) rv
                   (let ((top-elm (car lst0))
                         (remain-lst (cdr lst0)))
                     (myload-next0 remain-lst
                                   (append (myload-one top-elm) rv)))))))

      (myload-next0 lst '()))))

(define (print-one r-load)
  (let ((load-x (reverse r-load)))
    (display "$X")
    (letrec ((print-one0
               (lambda (r-load0)
                 (let ((elm0 (car r-load0))
                       (remain0 (cdr r-load0)))
                   (display "\\rightarrow ")
                   (if (symbol? elm0)
                     (display elm0)
                     (begin
                       (display "\\dot{")
                       (display (cadr elm0))
                       (display "}")))
                   (if (not (null? remain0))
                     (print-one0 remain0))))))
      (print-one0 load-x)
      (print "$"))))

(define (print-all all-load)
  (if (null? all-load)
    #t
    (begin
      (print-one (car all-load))
      (print)
      (print-all (cdr all-load)))))

(print-all (myload 8))

出力は TeX。あっているかどうか不明。2H くらいかかったかな、、、

結果を張り付ける。

え？ Y に至る経路の数をだすだけなの？Y も Z も全部書き出しちゃった。参考までに書くと、ドットは反転した場所。数学的な意味はないので念のため。

あとバッククォートじゃないほうがいい。無駄なアロケート（というのかどうかしらんが）してしまうので。