From feb0e2129ee4b65c8dc4f1e3c7a532908418d417 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 17 Jun 2016 10:05:02 +0200
Subject: Bugfixing, more patterns!

---
 simplify.hs | 46 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 43 insertions(+), 3 deletions(-)

(limited to 'simplify.hs')

diff --git a/simplify.hs b/simplify.hs
index cb3e5af..f2eaa28 100644
--- a/simplify.hs
+++ b/simplify.hs
@@ -61,7 +61,12 @@ foldNumbers node = case node of
         (Negative n) -> Negative $ Reciprocal fn
         (Reciprocal n2) -> n2
         _ -> Reciprocal $ fn
-    (Apply name args) -> Apply name $ map foldNumbers args
+    (Apply name args) -> let fargs = map foldNumbers args -- Apply name $ map foldNumbers args
+        in case name of
+            "pow" -> if all astIsNumber fargs
+                         then Number $ astFromNumber (fargs!!0) ** astFromNumber (fargs!!1)
+                         else Apply "pow" fargs
+            _ -> Apply name fargs
     (Sum args) -> Sum $ dofoldnums sum args 0
     (Product args) -> dofoldnegsToProd $ dofoldnums product args 1
     _ -> node
@@ -148,7 +153,42 @@ patterndb = [
 
          Sum [Product [Sum [Capture "n1",Capture "n2"],
                        Capture "x"],
-              Capture "rest"])
+              Capture "rest"]),
+
+        (Product [CaptureTerm "x",  -- x*x*[rest] -> x^2*[rest]
+                  CaptureTerm "x",
+                  Capture "rest"],
+         Product [Apply "pow" [Capture "x",Number 2],
+                  Capture "rest"]),
+
+        (Product [CaptureTerm "x",  -- x*x^n*[rest] -> x^(n+1)*[rest]
+                  Apply "pow" [CaptureTerm "x",CaptureTerm "n"],
+                  Capture "rest"],
+         Product [Apply "pow" [Capture "x",Sum [Capture "n",Number 1]],
+                  Capture "rest"]),
+
+        (Product [Apply "pow" [CaptureTerm "x",CaptureTerm "a"],  -- x^a*x^b*[rest] -> x^(a+b)*[rest]
+                  Apply "pow" [CaptureTerm "x",CaptureTerm "b"],
+                  Capture "rest"],
+         Product [Apply "pow" [Capture "x",Sum [Capture "a",Capture "b"]],
+                  Capture "rest"]),
+
+        (Apply "pow" [Apply "pow" [CaptureTerm "x",CaptureTerm "n"],CaptureTerm "m"],  -- (x^n)^m -> x^(n*m)
+         Apply "pow" [Capture "x",Product [Capture "n",Capture "m"]]),
+
+        (Apply "pow" [CaptureTerm "x",Number 1],  -- x^1 -> x
+         Capture "x"),
+
+
+        (Apply "d" [CaptureConstr "x" (Variable undefined),CaptureTerm "x"],  -- d(x,x) -> 1
+         Number 1),
+
+        (Apply "d" [Apply "pow" [CaptureConstr "x" (Variable undefined),CaptureTerm "n"],  -- d(x^n,x) -> n*x^(n-1)
+                    CaptureTerm "x"],
+         Product [Capture "n",Apply "pow" [Capture "x",Sum [Capture "n",Number (-1)]]]),
+
+        (Apply "d" [Sum [CaptureTerm "a",Capture "b"],CaptureTerm "x"],  -- d(a+[b],x) -> d(a,x) + d([b],x)
+         Sum [Apply "d" [Capture "a",Capture "x"],Apply "d" [Capture "b",Capture "x"]])
     ]
 
 astChildMap :: AST -> (AST -> AST) -> AST
@@ -169,4 +209,4 @@ applyPatterns node = let matches = filter (not . null . fst) $ map (\(pat,repl)
     in if null matches
         then astChildMap node applyPatterns
         else let ((capdict:_),repl) = head matches  -- TODO: don't take the first option of the first match, but use them all
-             in replaceCaptures capdict repl
+             in {-applyPatterns $-} replaceCaptures capdict repl
-- 
cgit v1.2.3-54-g00ecf