egison-3.5.7: lib/core/number.egi
;;;;;
;;;;;
;;;;; Number
;;;;;
;;;;;
;;;
;;; Natural Numbers
;;;
(define $nat
(matcher
{[,$n []
{[$tgt (if (eq? tgt n) {[]} {})]}]
[<o> []
{[0 {[]}]
[_ {}]}]
[<s $> nat
{[$tgt (match (compare tgt 0) ordering
{[<greater> {(- tgt 1)}]
[_ {}]})]}]
[$ [something]
{[$tgt {tgt}]}]
}))
(define $nats {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 @(map (+ 100 $) nats)})
(define $nats0 {0 @nats})
(define $odds {1 @(map (+ $ 2) odds)})
(define $evens {2 @(map (+ $ 2) evens)})
(define $fibs {1 1 @(map2 + fibs (cdr fibs))})
(define $prime?
(lambda [$n]
(not (any 1#(eq? (remainder n %1) 0)
(while (lte? $ (floor (sqrt (itof n)))) primes)))))
(define $primes {2 @(filter prime? (drop 2 nats))})
(define $divisor?
(lambda [$n $d]
(eq? 0 (remainder n d))))
(define $find-factor
(lambda [$n]
(match primes (list integer)
{[<join _ <cons (& ?(divisor? n $) $x) _>> x]})))
(define $prime-factorization
(match-lambda integer
{[,1 {}]
[$n (let {[$p (find-factor n)]}
{p @(prime-factorization (quotient n p))})]}))
(define $p-f prime-factorization)
(define $even?
(lambda [$n]
(eq? 0 (modulo n 2))))
(define $odd?
(lambda [$n]
(eq? 1 (modulo n 2))))
(define $square?
(lambda [$n]
(let {[$x (round (sqrt n))]}
(eq? n (power x 2)))))
(define $gcd
(lambda [$ns]
(match ns (multiset integer)
{[<cons $n <nil>> n]
[<cons (& ,(min ns) $m) $rs>
(gcd {m @(delete 0 (map (lambda [$r] (modulo r m)) rs))})]})))
(define $fact
(lambda [$n]
(foldl * 1 (between 1 n))))
(define $perm
(lambda [$n $r]
(foldl * 1 (between (- n (- r 1)) n))))
(define $comb
(lambda [$n $r]
(/ (perm n r)
(fact r))))
;;;
;;; Integers
;;;
(define $mod
(lambda [$m]
(matcher
{[,$n []
{[$tgt (if (eq? (modulo tgt m) (modulo n m))
{[]}
{})]}]
[$ [something]
{[$tgt {tgt}]}]
})))
(define $power
(lambda [$x $n]
(foldl * 1 (take n (repeat1 x)))))
(define $sum
(lambda [$xs]
(foldl + 0 xs)))
(define $product
(lambda [$xs]
(foldl * 1 xs)))
;;;
;;; Decimal Fractions
;;;
(define $rtod-helper
(lambda [$m $n]
(let {[$q (quotient (* m 10) n)]
[$r (remainder (* m 10) n)]}
{[q r] @(rtod-helper r n)})))
(define $rtod
(lambda [$c $x]
(let* {[$m (numerator x)]
[$n (denominator x)]
[$q (quotient m n)]
[$r (remainder m n)]}
[q (take c (map fst (rtod-helper r n)))])))
(define $rtod'
(lambda [$x]
(let* {[$m (numerator x)]
[$n (denominator x)]
[$q (quotient m n)]
[$r (remainder m n)]
[[$s $c] (find-cycle (rtod-helper r n))]}
[q (map fst s) (map fst c)])))
(define $show-decimal
(lambda [$c $x]
(match (rtod c x) [integer (list integer)]
{[[$q $sc] (foldl S.append (S.append (show q) ".") (map show sc))]})))
(define $show-decimal'
(lambda [$x]
(match (rtod' x) [integer (list integer) (list integer)]
{[[$q $s $c] (foldl S.append "" {(S.append (show q) ".") @(map show s) " " @(map show c) " ..."})]})))
;;;
;;; Continued Fraction
;;;
(define $regular-continued-fraction
(lambda [$as]
(+ (car as)
(foldr (lambda [$a $r] (/ 1 (+ a r)))
0
(cdr as)))))
(define $continued-fraction
(match-lambda [(list integer) (list integer)]
{[[<cons $a $as> <cons $b $bs>]
(+ a (/ b (continued-fraction as bs)))]
[[<cons $a <nil>> <nil>] a]}))
(define $regular-continued-fraction-of-sqrt
(lambda [$n]
undefined))