DouKaku? 1792 nobsun: 昔のコード、漢数字名があるかぎり表示可能...(整数の漢数字表記)

Comment detail

昔のコード、漢数字名があるかぎり表示可能 123456789012345678901234567890 =>十二穣三千四百五十六禾予七千八百九十外千二百三十四京五千六百七十八兆九千十二億三千四百五十六万七千八百九十 Data.UTF8 は手製のライブラリ http://www.sampou.org/cgi-bin/haskell.cgi?nobsun%3autf8

module Main where

import System.Environment
import Data.List
import qualified Data.UTF8 as U

main = do { a:_ <- getArgs
          ; U.putStrLn $ toKanSuuji a
          }

toKan,toKan' :: String -> String
toKan  = concat . reverse .zipWith mkname base10000 
       . map (concat . reverse . conv4) . slices 4
toKan' = concat . reverse . zipWith mkname baseBig 
       . map toKan . slices 8

toKanSuuji str
 = case splitAt 52 $ reverse str of
     (s,"") -> toKan $ padding 4 s
     (s,b) -> if length b > 40
                 then "こんな大きな数の漢字数字名は知りません"
                 else (toKan' $ padding 8 b) ++ toKan s
   where
     padding n s = s ++ replicate ((n - (length s `mod` n)) `mod` n) '0'

slices :: Int -> [a] -> [[a]]
slices n = unfoldr phi
  where phi [] = Nothing
        phi xs = Just $ splitAt n xs

base1 = ["","一","二","三","四","五","六","七","八","九"]
base10 = ["","十","百","千"]
base10000 = ["","万","億","兆","京","外","禾予","穣","溝","澗","正","載","極"]
baseBig = ["恒河沙","阿僧祇","那由多","不可思議","無量大数"]

conv4 = zipWith mkname' base10 . map ((base1 !!) . read . (:[]))

mkname "" "" = ""
mkname "" d = d
mkname p "" = ""
mkname p d = d++p

mkname' "" "" = ""
mkname' "" d = d
mkname' p "" = ""
mkname' p "一" = p
mkname' p d = d++p

うへぇ外じゃなくて垓ですね。タトしちゃった。

(n - (length s `mod` n)) `mod` n は (- length s) `mod n でよい？

-- 「なんとなくlength使いたくない Maybe大好き のオレが来ましたよ」的には
-- foo s = slices 4 $ padding 4 s
-- は
foo s = map (map (fromMaybe '0')) $ takeWhile (isJust.head)
  $ slices 4 $ map Just s ++ repeat Nothing

たぶん同じ時に書いたScheme版を発掘。

(use text.tree)

(define (漢数字 整数)
  (define 桁 '("" "" "弐" "参" "四" "伍" "六" "七" "八" "九"))
  (define 小位列 '("千" "百" "拾" ""))
  (define 大位列 '("" "万" "億" "兆" "京" "垓" "(禾予)" "穰" "溝" "澗" "正"
                   "載" "極"))
  (define 特位列 '("恒河砂" "阿僧祇" "那由多" "不可思議" "無量大数"))
  (define 壱恒河砂 (expt 10 52))
  (define 限界 (expt 10 92))

  (define (小再帰 数 単位 位列)
    (cond ((zero? 数) '())
          ((= 数 1) '("壱"))
          ((>= 数 単位)
           `(,(list-ref 桁 (quotient 数 単位)) ,(car 位列)
             ,@(小再帰 (modulo 数 単位) (/ 単位 10) (cdr 位列))))
          (else (小再帰 数 (/ 単位 10) (cdr 位列)))))

  (define (大再帰 数 位列)
    `(,@(if (>= 数 10000)
            (大再帰 (quotient 数 10000) (cdr 位列))
            '())
      ,@(if (zero? (modulo 数 10000))
            '()
            `(,(小再帰 (modulo 数 10000) 1000 小位列) ,(car 位列)))))

  (define (特大再帰 数 位列)
    `(,@(if (>= 数 100000000)
            (特大再帰 (quotient 数 100000000) (cdr 位列))
            '())
      ,@(if (zero? (modulo 数 100000000))
            '()
            `(,(大再帰 (modulo 数 100000000) 大位列) ,(car 位列)))))

  (tree->string
   (cond ((>= 整数 限界) "限界突破")
         ((>= 整数 壱恒河砂) 
          (list (特大再帰 (quotient 整数 壱恒河砂) 特位列)
                (大再帰 (modulo 整数 壱恒河砂) 大位列)))
         (else (大再帰 整数 大位列))))
  )

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq