;;;;; ;;;;; ;;;;; Arithmetic Operation ;;;;; ;;;;; (define $to-math-expr (macro [$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] [[ ] (*' (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))])))