Chinese Number

我帮助 Dorai Sitaram 修改 tex2page 的时候写了一个函数。可以 把 1e16 以内的整数转换成中文字符串。

比如:

(display (chinese-number 430340300))

将输出结果:

四亿三千零三十四万零三百

当然从来没有人想用中文数字写出这样的数字。我写这个函数只是为 了好玩。

下面是这个函数:

(define (chinese-number n)
  (let* ((digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))
         (logs (reverse (list 10000 1000 100 10 1)))
         (names (reverse (list "万" "千" "百" "十" "")))
         (ret "")
         (zeronum #f)
         (guowan 0)
         (allzero #t))
    (let loop ((t 0))

      (let* ((q (quotient n (list-ref logs t)))
             (r (modulo q 10)))

;        (for-each display `("digit: " , t "quotient: " ,r ", name" ,(list-ref names t)))(newline)
        (when (> q 0)

          (set! ret (string-append
                     (cond ((and        ;末位的零
                             (= r 0) 
                             (string=? (list-ref names t) ""))
                            (set! zeronum #t)
                            "")
                           ((and (< q 10) ;"一十" 的 "一" 不显示
                                 (= r 1)  ;但是 "一百一十" 的 "一" 要显示
                                 (string=? (list-ref names t) "十"))
                            (set! allzero #f)
                            "")
                           ((and (= r 0) ;"零万"
                                 (member (list-ref names t) '("万")))
                            (set! zeronum #t)
                            "")
                           ((and (= r 0) ;"零十"
                                 zeronum
                                 (member (list-ref names t) '("十")))
                            (set! zeronum #t)
                            "")
                           ((and (= r 0)
                                 zeronum) ;连续的 "零" 只显示一个
                            (set! zeronum #t)
                            "")
                           (else
                            (if (= r 0)
                                
                                  (set! zeronum #t)
                                  (begin  
                                    (set! allzero #f)
                                    (set! zeronum #f)))
                            (list-ref digits r)))
                     (if (or (> r 0) (string=? (list-ref names t) "万"))
                         (if (string=? (list-ref names t) "万")
                             (begin 
                               (set! guowan (+ 1 guowan))
                               (if (even? guowan) "亿" "万"))
                             (list-ref names t))
                             "")
                     ret))
          (when (string=? (list-ref names t) "万")
            (set! n q)
            (set! t 0))
          (loop (+ t 1)))))
    (if allzero (set! ret "零"))
    (set! ret (regexp-replace* (regexp "亿万") ret "亿"))
    ret))