number.egi

;;;;;
;;;;;
;;;;; Number
;;;;;
;;;;;

;;;
;;; Natural Numbers
;;;
(define $nat
  (matcher
    {[<o> []
      {[0 {[]}]
       [_ {}]}]
     [<s $> nat
      {[$tgt (match (compare tgt 0) ordering
               {[<greater> {(- tgt 1)}]
                [_ {}]})]}]
     [,$n []
      {[$tgt (if (eq? tgt n) {[]} {})]}]
     [$ [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]
    (eq? n (find-factor n))))

(define $primes {2 @(filter prime? (drop 2 nats))})

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

(define $find-factor
  (memoized-lambda [$n]
    (match (take-while (lte? $ (floor (sqrt (itof n)))) primes) (list integer)
      {[<join _ <cons (& ?(divisor? n $) $x) _>> x]
       [_ n]})))

(define $prime-factorization
  (match-lambda integer
    {[,1 {}]
     [(& ?(lt? $ 0) $n) {-1 @(prime-factorization (neg n))}]
     [$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 $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))))

(define $n-adic
  (lambda [$n $x]
    (if (eq? x 0)
      {}
      (let {[$q (quotient x n)]
            [$r (remainder x n)]}
        {@(n-adic n q) r}))))

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

;;;
;;; Floats
;;;
(define $exp2
  (lambda [$x $y]
    (exp (* (log x) y))))

;;;
;;; 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 [$x]
    (let* {[$m (numerator x)]
           [$n (denominator x)]
           [$q (quotient m n)]
           [$r (remainder m n)]}
      [q (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 (2#[%1 (take c %2)] (rtod 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 [$n $as]
    (+ n
       (foldr (lambda [$a $r] (/ 1 (+ a r)))
              0
              as))))

(define $continued-fraction
  (lambda [$n $as $bs]
    (match [as bs] [(list integer) (list integer)]
      {[[<cons $a $as> <cons $b $bs>]
        (+ n (/ b (continued-fraction a as bs)))]
       [[<nil> <nil>] n]})))

(define $regular-continued-fraction-of-sqrt-helper
  (lambda [$m $a $b] ; a+b*rt(m)
    (let* {[$n (floor (+ (rtof a) (* (rtof b) (sqrt (rtof m)))))]
           [$x (- m (power n 2))]}
      (if (eq? x 0)
        {[a b n]}
        (let {[$y (- (power (- n a) 2) (* b b m))]}
          {[a b n] @(regular-continued-fraction-of-sqrt-helper m (/ (- a n) y) (neg (/ b y)))})))))

(define $regular-continued-fraction-of-sqrt
  (lambda [$m]
    (let* {[$n (floor (sqrt (rtof m)))]
           [$x (- m (power n 2))]}
      ; n+rt(m)-n
      ; n+(rt(m)-n)*(rt(m)+n)/(rt(m)+n)
      ; n+x/(rt(m)+n)
      (if (eq? x 0)
        [n {} {}]
        [n (map 3#%3 (regular-continued-fraction-of-sqrt-helper m (/ n x) (/ 1 x)))]))))

(define $regular-continued-fraction-of-sqrt'
  (lambda [$m]
    (let* {[$n (floor (sqrt (rtof m)))]
           [$x (- m (power n 2))]}
      (if (eq? x 0)
        [n {} {}]
        (let {[[$s $c] (find-cycle (regular-continued-fraction-of-sqrt-helper m (/ n x) (/ 1 x)))]}
          [n (map 3#%3 s) (map 3#%3 c)])))))