DouKaku?

#light
let nums = ["";"一";"二";"三";"四";"五";"六";"七";"八";"九"]
let ords = ["";"十";"百";"千"]
let us = ["";"万";"億";"兆"]

let rec zipWith z xs ys =
    match xs,ys with
     | _,[] -> []
     | [],_ -> []
     | x::xs',y::ys' -> (z x y)::(zipWith z xs' ys')

let kanjiName nss =
    let knss = List.map (List.map (List.nth nums)) nss
    let rnss = List.map List.rev knss
    let named_rnss = List.map (zipWith (fun o n -> n ^ o) ords) rnss
    let knss = List.map List.rev named_rnss
    List.map (String.concat "") knss
     |> List.rev
     |> (zipWith (fun o n -> n ^ o) us)
     |> List.rev
     |> String.concat ""

let toKanji n =
    let rec iterate b res num =
        if num = 0 then res
        else iterate b ((num%b)::res) (num/b)
    List.map (iterate 10 []) (iterate 10000 [] n)
    |> kanjiName