diff options
Diffstat (limited to 'simplify.hs')
| -rw-r--r-- | simplify.hs | 46 |
1 files changed, 43 insertions, 3 deletions
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 |