fork download
copy 
  1. (define (kansuji-tani exp)
  2.   (case exp
  3.     [(0) ""]
  4.     [(1) "十"]
  5.     [(2) "百"]
  6.     [(3) "千"]))
  7.  
  8. (define *man-ijyou* '("" "万" "億" "兆" "京" "垓" "予" "穣" "溝" "澗" "正" "載" "極" "恒河沙" "阿僧祇" "那由多" "不可思議" "無量大数"))
  9.  
  10. (define(kansuji num)
  11.   (case num
  12.     ((9) "九")
  13.     ((8) "八")
  14.     ((7) "七")
  15.     ((6) "六")
  16.     ((5) "五")
  17.     ((4) "四")
  18.     ((3) "三")
  19.     ((2) "二")
  20.     ((1) "一")
  21.     ((0) "")))
  22.  
  23. (define (number->kansuji num)
  24.   (string-join (reverse (map (lambda (el1 el2) (if (not (string=? el1 ""))
  25. 						   (string-join (list el1 el2) "")
  26. 						   ""))
  27. 			     (reverse (map ichi-sen (map (lambda (n) (map kansuji n)) (map number->list (bunkai num))))) 
  28. 			     *man-ijyou*)) ""))
  29.  
  30. (define (bunkai num)
  31.   (let loop ((q (quotient num 10000))
  32. 	     (m (modulo   num 10000))
  33. 	     (result '()))
  34.     (if (zero? q)
  35. 	(cons m result)
  36. 	(loop (quotient q 10000) (modulo q 10000) (cons m result)))))
  37.  
  38. (define (number->list n :optional (k (if (= n 1000) 3 (truncate (log n 10))))) 
  39.                                       ; (log 1000 10)が2.9999999999999996で切り捨てだと3に成らないため
  40.   (let loop ((keta k) (result '()) (m n))
  41.     (if (< keta 0)
  42. 	(reverse result)
  43. 	(let ((tani (expt 10 keta)))
  44. 	  (loop (- keta 1) 
  45. 		(cons (inexact->exact (quotient m tani)) result) 
  46. 		(- m (* (quotient m tani) tani)))))))
  47.  
  48. (define (ichi-sen lis)
  49.   (let loop ((ls lis)
  50. 	     (keta (- (length lis) 1))
  51. 	     (result '()))
  52.     (if (>= keta 0)
  53. 	(let1 ns (car ls)
  54. 	  (cond [(and (not (string=? ns "")) (string=? ns "一") (> keta 0))
  55. 		 (set! result (cons (kansuji-tani keta) result))]
  56. 		[(not (string=? ns "")) 
  57. 		 (set! result (cons (kansuji-tani keta) (cons ns result)))]
  58. 		[(string=? ns "") 
  59. 		 (set! result (cons ns result))])
  60. 	  (loop (cdr ls) (- (length (cdr ls)) 1) result))
  61. 	(string-join (reverse result) ""))))
  62.  
  63. (number->kansuji (+ (* 2 (expt 10 68))  (* 3 (expt 10 64)) (expt 10 60) 47810478801748017480174803748971890478921047801749032174))
  64. ; "二無量大数三不可思議一那由多四千七百八十一恒河沙四百七十八極八千十七載四千八百一正七千四百八十澗千七百四十八溝三百七十四穣八千九百七十一予八千九百四垓七千八百九十二京千四十七兆八千十七億四千九百三万二千百七十四"
  65.  
Runtime error #stdin #stdout #stderr 0.04s 8744KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
ice-9/psyntax.scm:987:26: In procedure scan:
ice-9/psyntax.scm:987:26: Syntax error:
/home/5XXmmC/prog.scm:38:0: source expression failed to match any pattern in form (define (number->list n :optional (k (if (= n 1000) 3 (truncate (log n 10))))) (let loop ((keta k) (result (quote ())) (m n)) (if (< keta 0) (reverse result) (let ((tani (expt 10 keta))) (loop (- keta 1) (cons (inexact->exact (quotient m tani)) result) (- m (* (quotient m tani) tani)))))))
https://ideone.com/AyhZiU
language:
Scheme (guile 2.2.4)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!