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 $primes
  (letrec {[$next-primes
            (lambda [$primes1 $k]
              (let {[$primes2 (while (lte? $ (floor (sqrt (itof (* 6 (+ k 1)))))) primes1)]}
                (match [(any (lambda [$p] (eq? (remainder (+ (* 6 k) 1) p) 0)) primes2)
                        (any (lambda [$p] (eq? (remainder (+ (* 6 k) 5) p) 0)) primes2)]
                  [bool bool]
                  {[[,#f ,#f] {(+ (* 6 k) 1) (+ (* 6 k) 5) @(next-primes {@primes1 (+ (* 6 k) 1) (+ (* 6 k) 5)} (+ k 1))}]
                   [[,#f ,#t] {(+ (* 6 k) 1) @(next-primes {@primes1 (+ (* 6 k) 1)} (+ k 1))}]
                   [[,#t ,#f] {(+ (* 6 k) 5) @(next-primes {@primes1 (+ (* 6 k) 5)} (+ k 1))}]
                   [[,#t ,#t] (next-primes primes1 (+ k 1))]
                   })))]}
    {2 3 5 @(next-primes {2 3 5} 1)}))

(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 $pfs (map (lambda [$n] [n (p-f n)]) nats))

(define $pfs-n
  (lambda [$n]
    (match-all pfs (list [integer (list integer)])
      [<join _ <cons [$m (loop $i [1 n] <cons $p_i ...> <nil>)] _>> [m (map (lambda [$i] p_i) (between 1 n))]])))

(define $prime?
  (lambda [$n]
    (if (eq? n 1)
      #f
      (eq? (rac (while (lte? $ n) primes)) n))))

;;;
;;; Integers
;;;
(define $integer builtin-data-matcher)

(define $power
  (lambda [$x $n]
    (foldl * 1 (take n (repeat1 x)))))

(define $mod
  (lambda [$m]
    (matcher
      {[,$n []
        {[$tgt (if (eq? (modulo tgt m) (modulo n m))
                   {[]}
                   {})]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))

(define $even?
  (lambda [$n]
    (eq? 0 (modulo n 2))))

(define $odd?
  (lambda [$n]
    (eq? 1 (modulo n 2))))

(define $between?
  (lambda [$m $n $x]
    (and (lte? m x) (lte? x n))))

(define $sum
  (lambda [$xs]
    (foldl + 0 xs)))

(define $product
  (lambda [$xs]
    (foldl * 1 xs)))

(define $fib
  (lambda [$n]
    (letrec {[$fib1 (lambda [$n $ret1 $ret2]
                      (match n nat
                        {[<o> ret2]
                         [<s <o>> ret1]
                         [<s $n1> (fib1 (- n 1) (+ ret1 ret2) ret1)]
                         }))]}
      (fib1 n 1 1))))

(define $fibs (map fib nats0))

(define $divisor?
  (lambda [$n $d]
    (eq? 0 (remainder n d))))

(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))))

;;;
;;; Float Numbers
;;;
(define $float builtin-data-matcher)

;;;
;;; Decimal Fractions
;;;
(define $decimal (algebraic-data-matcher {<df integer (list integer)>}))
(define $decimal' (algebraic-data-matcher {<df' integer (list integer) (list integer)>}))

(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 [$x]
    (let {[$m (numerator x)]
          [$n (denominator x)]}
      (let {[$q (quotient m n)]
            [$r (remainder m n)]}
          <Df q (map (lambda [$x $y] x) (rtod-helper r n))>))))

(define $rtod'
  (lambda [$x]
    (let {[$m (numerator x)]
          [$n (denominator x)]}
      (let {[$q (quotient m n)]
            [$r (remainder m n)]}
        (let {[[$s $c] (match (rtod-helper r n) (list [integer integer])
                         {[<join $s <cons $x <join $c <cons ,x _>>>> [s {x @c}]]})]}
          <Df' q (map (lambda [$x $y] x) s) (map (lambda [$x $y] x) c)>)))))

(define $show-decimal
  (lambda [$n $x]
    (match (rtod x) decimal
      {[<df $q $sc> (foldl S.append (S.append (show q) ".") (map show (take n sc)))]})))

(define $show-decimal'
  (lambda [$x]
    (match (rtod' x) decimal'
      {[<df' $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]}))