;;;;; ;;;;; ;;;;; 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 \$+ (cambda \$xs (math-normalize1 (capply +' xs)))) (define \$- (cambda \$xs (math-normalize1 (capply -' xs)))) (define \$* (cambda \$xs (math-normalize1 (capply *' xs)))) (define \$/ b./) ;(define \$+ +') ;(define \$- -') ;(define \$* *') ;(define \$/ b./') (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))])))