arithmetic.egi

;;;;;
;;;;;
;;;;; Arithmetic Operation
;;;;;
;;;;;

(define $to-math-expr (lambda [$arg] (math-normalize1 (apply to-math-expr' arg))))

(define $+' (cambda $xs (foldl b.+ (car xs) (cdr xs))))
(define $-' (cambda $xs (foldl b.- (car xs) (cdr xs))))
(define $*' (cambda $xs (foldl b.* (car xs) (cdr xs))))
(define $/' b./)

(define $f.+' (cambda $xs (foldl f.+ (car xs) (cdr xs))))
(define $f.-' (cambda $xs (foldl f.- (car xs) (cdr xs))))
(define $f.*' (cambda $xs (foldl f.* (car xs) (cdr xs))))
(define $f./' f./)

(define $+
  (cambda $xs (if (capply or (map float? xs))
                  (capply f.+' (map (lambda [$x] (if (float? x) x (itof x))) xs))
                  (math-normalize1 (capply +' xs)))))
(define $-
  (cambda $xs (if (capply or (map float? xs))
                  (capply f.-' (map (lambda [$x] (if (float? x) x (itof x))) xs))
                  (math-normalize1 (capply -' xs)))))
(define $*
  (cambda $xs (if (capply or (map float? xs))
                  (capply f.*' (map (lambda [$x] (if (float? x) x (itof x))) xs))
                  (math-normalize1 (capply *' xs)))))
(define $/
  (lambda [$x $y]
    (if (and (float? x) (float? y))
        (f./ x y)
        (if (float? x)
            (f./ x (itof y))
            (if (float? y)
                (f./ (itof x) y)
                (b./ x y))))))

(define $reduce-fraction id)

(define $sum
  (lambda [$xs]
    (if (empty? xs)
      0
      (capply + xs))))

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

(define $product
  (lambda [$xs]
    (if (empty? xs)
      1
      (capply * xs))))

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

(define $power
  (lambda [$x $n]
    (math-normalize1 (power' x n))))

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

(define $**
  (lambda [$x $n]
    (if (eq? x e)
      (exp n)
      (if (rational? n)
        (if (gte? n 0)
          (if (integer? n)
            (power x n)
            (`** x n))
          (/ 1 (** x (neg n))))
        (`** x n)))))

(define $**'
  (lambda [$x $n]
    (if (eq? x e)
      (exp n)
      (if (rational? n)
        (if (gte? n 0)
          (if (integer? n)
            (power' x n)
            (`** x n))
          (/' 1 (**' x (neg n))))
        (`** x n)))))

(define $gcd
  (cambda $xs
    (foldl b.gcd (car xs) (cdr xs))))

(define $gcd'
  (cambda $xs
    (foldl b.gcd' (car xs) (cdr xs))))

(define $b.gcd
  (lambda [$x $y]
    (match [x y] [term-expr term-expr]
      {[[_ ,0] x]
       [[,0 _] y]
       [[<term $a $xs> <term $b $ys>]
        (*' (b.gcd' (abs a) (abs b)) (foldl *' 1 (map 2#(**' %1 %2) (AC.intersect xs ys))))]})))

(define $b.gcd'
  (lambda [$x $y]
    (match [x y] [integer integer]
      {[[_ ,0] x]
       [[,0 _] y]
       [[_ ?(gte? $ x)] (b.gcd' (modulo y x) x)]
       [[_ _] (b.gcd' y x)]})))

(define $P./
  (lambda [$fx $gx $x]
    (let* {[$as (reverse (coefficients fx x))]
           [$bs (reverse (coefficients gx x))]
           [[$zs $rs] (L./ as bs)]}
      [(sum' (map2 2#(*' %1 (**' x %2)) (reverse zs) nats0))
       (sum' (map2 2#(*' %1 (**' x %2)) (reverse rs) nats0))])))