"漢数字からアラビア数字"をschemeで2

なんとなく億まで対応するようにしてみた。

(define (kj_to_ar kj-string)
  (define kj-base '((#\十 10) (#\百 100) (#\千 1000) (#\万 10000) (#\億 100000000)))
  (define kj-number '((#\零 0) (#\一 1) (#\二 2) (#\三 3) (#\四 4) (#\五 5) (#\六 6) (#\七 7)(#\八 8) (#\九 9)))
  (define (kj-ref kj kj-list)
    (cadr (assoc kj kj-list)))
  (define (base-char? kj)
    (let ((base (assoc kj kj-base)))
      (if (not base)
          base
          (car base))))
  (let ((r-kj (reverse (string->list kj-string))))
    (define (iter rest pre-base result)
      (cond ((and (null? rest) (null? pre-base)) result)
            ((and (null? rest) (not (null? pre-base)))
             (+ result (kj-ref pre-base kj-base)))
            ((and (null? pre-base))
             (if (base-char? (car rest))
                 (iter (cdr rest) (car rest) result)
                 (iter (cdr rest) '() 
                       (+ result (kj-ref (car rest) kj-number)))))
            (else
             (if (base-char? (car rest))
                 (iter (cdr rest) (car rest) 
                       (+ result (kj-ref pre-base kj-base)))
                 (iter (cdr rest) '()
                       (+ result (* (kj-ref (car rest) kj-number)
                                    (kj-ref pre-base kj-base))))))))
    (iter r-kj '() 0)))

実行

gosh> (kj_to_ar "二千百十一")
2111
gosh> (kj_to_ar "五")
5
gosh> (kj_to_ar "二十五")
25
gosh> (kj_to_ar "四千一")
4001
gosh> (kj_to_ar "百")
100

実力不足だなー。