egison 3.7.1 → 3.7.2
raw patch · 4 files changed
+66/−39 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- egison.cabal +1/−1
- hs-src/Language/Egison/Core.hs +0/−1
- lib/math/analysis/derivative.egi +7/−3
- lib/math/normalize.egi +58/−34
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 3.7.1+Version: 3.7.2 Synopsis: Programming language with non-linear pattern-matching against non-free data Description: An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.
hs-src/Language/Egison/Core.hs view
@@ -639,7 +639,6 @@ fn <- evalExpr env fnExpr xs <- mapM (\ms -> applyFunc env fn (Value (makeTuple ms))) (map (\ms -> map toEgison ms) (enumTensorIndices ns)) case (ns, xs) of- ([1], x:[]) -> return $ x _ -> fromTensor (Tensor ns (V.fromList xs) []) evalExpr env (TensorContractExpr fnExpr tExpr) = do
lib/math/analysis/derivative.egi view
@@ -52,11 +52,15 @@ (define $grad ∇) +;(define $taylor-expansion+; (lambda [$f $x $a]+; (map2 *+; (map 1#(/ (** (- x a) %1) (fact %1)) nats0)+ ; (map (substitute {[x a]} $) (iterate (∂/∂ $ x) f)))))+ (define $taylor-expansion (lambda [$f $x $a]- (map2 *- (map 1#(/ (** (- x a) %1) (fact %1)) nats0)- (map (substitute {[x a]} $) (iterate (∂/∂ $ x) f)))))+ (multivariate-taylor-expansion f [| x |] [| a |]))) (define $maclaurin-expansion (taylor-expansion $ $ 0))
lib/math/normalize.egi view
@@ -147,62 +147,86 @@ (define $rewrite-rule-for-cos-and-sin-expr (lambda [$expr] (match [expr expr] [math-expr math-expr]- {[[<div (+ (* $a (,cos $θ) $mr)+ {[[<div (+ (* $a (,cos $慮) $mr) $pr1) $pr2>- (| <div (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _) _>- <div _ (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _)>)]- (rewrite-rule-for-cos-and-sin-expr (/' (+' (*' a (-' (cos (/ θ 2))^2 (sin (/ θ 2))^2) mr) pr1) pr2))]- [[<div (+ (* $a (,sin $θ) $mr)+ (| <div (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _) _>+ <div _ (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _)>)]+ (rewrite-rule-for-cos-and-sin-expr (/' (+' (*' a (-' (cos (/ 慮 2))^2 (sin (/ 慮 2))^2) mr) pr1) pr2))]+ [[<div (+ (* $a (,sin $慮) $mr) $pr1) $pr2>- (| <div (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _) _>- <div _ (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _)>)]- (rewrite-rule-for-cos-and-sin-expr (/' (+' (*' (*' a 2) (*' (cos (/ θ 2)) (sin (/ θ 2))) mr) pr1) pr2))]+ (| <div (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _) _>+ <div _ (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _)>)]+ (rewrite-rule-for-cos-and-sin-expr (/' (+' (*' (*' a 2) (*' (cos (/ 慮 2)) (sin (/ 慮 2))) mr) pr1) pr2))] [[<div $pr2- (+ (* $a (,cos $θ) $mr)+ (+ (* $a (,cos $慮) $mr) $pr1)>- (| <div (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _) _>- <div _ (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _)>)]- (rewrite-rule-for-cos-and-sin-expr (/' pr2 (+' (*' a (-' (cos (/ θ 2))^2 (sin (/ θ 2))^2) mr) pr1)))]+ (| <div (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _) _>+ <div _ (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _)>)]+ (rewrite-rule-for-cos-and-sin-expr (/' pr2 (+' (*' a (-' (cos (/ 慮 2))^2 (sin (/ 慮 2))^2) mr) pr1)))] [[<div $pr2- (+ (* $a (,sin $θ) $mr)+ (+ (* $a (,sin $慮) $mr) $pr1)>- (| <div (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _) _>- <div _ (+ (* _ (| (,cos ,(/ θ 2)) (,sin ,(/ θ 2))) _) _)>)]- (rewrite-rule-for-cos-and-sin-expr (/' pr2 (+' (*' (*' a 2) (*' (cos (/ θ 2)) (sin (/ θ 2))) mr) pr1)))]+ (| <div (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _) _>+ <div _ (+ (* _ (| (,cos ,(/ 慮 2)) (,sin ,(/ 慮 2))) _) _)>)]+ (rewrite-rule-for-cos-and-sin-expr (/' pr2 (+' (*' (*' a 2) (*' (cos (/ 慮 2)) (sin (/ 慮 2))) mr) pr1)))] [_ expr]}))) (define $rewrite-rule-for-cos-and-sin-poly (lambda [$poly] (match poly math-expr- {[(+ (* $a (,cos $θ)^,2 $mr)- (* ,a (,sin ,θ)^,2 ,mr)+ {[(+ (* $a (,cos $慮)^,2 $mr)+ (* ,a (,sin ,慮)^,2 ,mr) $pr) (rewrite-rule-for-cos-and-sin-poly (+' pr (*' a mr)))]- ; [(+ (* $a (,cos $θ)^,2 $mr)- ; (* ,(* -1 a) (,sin ,θ)^,2 ,mr)- ; $pr)- ; (rewrite-rule-for-cos-and-sin-poly (+' pr (*' a (cos (* 2 θ)) mr)))]- ; [(+ (* $a (,cos $θ) (,sin ,θ) $mr)- ; $pr)- ; (rewrite-rule-for-cos-and-sin-poly (+' pr (*' (/ a 2) (sin (* 2 θ)) mr)))] [(+ (* $a $mr)- (* ,(* -1 a) (,sin $θ)^,2 ,mr)+ (* ,(* -1 a) (,sin $慮)^,2 ,mr) $pr)- (rewrite-rule-for-cos-and-sin-poly (+' pr (*' a (cos θ)^2 mr)))]+ (rewrite-rule-for-cos-and-sin-poly (+' pr (*' a (cos 慮)^2 mr)))] [(+ (* $a $mr)- (* ,(* -1 a) (,cos $θ)^,2 ,mr)+ (* ,(* -1 a) (,cos $慮)^,2 ,mr) $pr)- (rewrite-rule-for-cos-and-sin-poly (+' pr (*' a (sin θ)^2 mr)))]- ; (- 1 (cos (* 2 θ))) = (* 2 (sin θ)^2)- ; [(+ (* $a $mr)- ; (* ,(* -1 a) (,cos $θ) ,mr)- ; $pr)- ; (rewrite-rule-for-cos-and-sin-poly (+' pr (*' (* 2 a) (sin (/ θ 2))^2 mr)))]+ (rewrite-rule-for-cos-and-sin-poly (+' pr (*' a (sin 慮)^2 mr)))] [_ poly]}))) (define $rewrite-rule-for-cos-to-sin 1#(map-terms rewrite-rule-for-cos-to-sin-term' %1))++(define $rewrite-rule-for-cos-to-sin-term'+ (lambda [$term]+ (match term math-expr+ {[(* $a (,cos $θ)^,2 $mr)+ (*' a (-' 1 (sin θ)^2) (rewrite-rule-for-cos-to-sin-term' mr))]+ [_ term]})))++;;+;; d+;;++(define $rewrite-rule-for-d (map-terms rewrite-rule-for-d-term $))++(define $rewrite-rule-for-d-term+ (lambda [$term]+ (match term math-expr+ {[(* _ (,d _) (,d _) _)+ 0]+ [_ term]})))++;;+;; ∂/∂+;;++(define $rewrite-rule-for-∂/∂ (map-polys rewrite-rule-for-∂/∂-poly $))++(define $rewrite-rule-for-∂/∂-poly+ (lambda [$poly]+ (match poly math-expr+ {[(+ (* $a <apply (& $g <symbol $f $subs>) $args>^$n $mr)+ (* $b <apply <symbol ,f ?1#(eq?/m (multiset something) subs %1)> ,args>^,n ,mr)+ $pr)+ (+ (* (+ a b) (`g args)^n mr)+ pr)]+ [_ poly]}))) (define $rewrite-rule-for-cos-to-sin-term' (lambda [$term]