diff options
Diffstat (limited to 'src/algebra/efstruc.spad.pamphlet')
-rw-r--r-- | src/algebra/efstruc.spad.pamphlet | 100 |
1 files changed, 50 insertions, 50 deletions
diff --git a/src/algebra/efstruc.spad.pamphlet b/src/algebra/efstruc.spad.pamphlet index fe6d0bb3..320842e5 100644 --- a/src/algebra/efstruc.spad.pamphlet +++ b/src/algebra/efstruc.spad.pamphlet @@ -127,8 +127,6 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where SMP ==> SparseMultivariatePolynomial(R, K) REC ==> Record(func:F, kers: List K, vals:List F) U ==> Union(vec:Vector Q, func:F, fail: Boolean) - POWER ==> "%power"::SY - NTHR ==> "nthRoot"::SY Exports ==> with normalize: F -> F @@ -159,6 +157,8 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where ++ tanQ(q,a) is a local function with a conditional implementation. Implementation ==> add + macro POWER == '%power + macro NTHR == 'nthRoot import TangentExpansions F import IntegrationTools(R, F) import IntegerLinearDependence F @@ -242,35 +242,35 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where [f, empty(), empty()] deprel(ker, k, x) == - is?(k, "log"::SY) or is?(k, "exp"::SY) => + is?(k, 'log) or is?(k, 'exp) => qdeprel([differentiate(g, x) for g in toY ker], differentiate(ktoY k, x)) - is?(k, "atan"::SY) or is?(k, "tan"::SY) => + is?(k, 'atan) or is?(k, 'tan) => qdeprel([differentiate(g, x) for g in toU ker], differentiate(ktoU k, x)) is?(k, NTHR) => rootDep(ker, k) - comb? and is?(k, "factorial"::SY) => - factdeprel([x for x in ker | is?(x,"factorial"::SY) and x~=k],k) + comb? and is?(k, 'factorial) => + factdeprel([x for x in ker | is?(x,'factorial) and x~=k],k) [true] ktoY k == - is?(k, "log"::SY) => k::F - is?(k, "exp"::SY) => first argument k + is?(k, 'log) => k::F + is?(k, 'exp) => first argument k 0 ktoZ k == - is?(k, "log"::SY) => first argument k - is?(k, "exp"::SY) => k::F + is?(k, 'log) => first argument k + is?(k, 'exp) => k::F 0 ktoU k == - is?(k, "atan"::SY) => k::F - is?(k, "tan"::SY) => first argument k + is?(k, 'atan) => k::F + is?(k, 'tan) => first argument k 0 ktoV k == - is?(k, "tan"::SY) => k::F - is?(k, "atan"::SY) => first argument k + is?(k, 'tan) => k::F + is?(k, 'atan) => first argument k 0 smpElem(p, l) == @@ -284,41 +284,41 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where empty?(args :List F := [realElem(a, l) for a in argument k]) => kf z := first args is?(k, POWER) => (zero? z => 0; exp(last(args) * log z)) - is?(k, "cot"::SY) => inv tan z - is?(k, "acot"::SY) => atan inv z - is?(k, "asin"::SY) => atan(z / sqrt(1 - z**2)) - is?(k, "acos"::SY) => atan(sqrt(1 - z**2) / z) - is?(k, "asec"::SY) => atan sqrt(1 - z**2) - is?(k, "acsc"::SY) => atan inv sqrt(1 - z**2) - is?(k, "asinh"::SY) => log(sqrt(1 + z**2) + z) - is?(k, "acosh"::SY) => log(sqrt(z**2 - 1) + z) - is?(k, "atanh"::SY) => log((z + 1) / (1 - z)) / (2::F) - is?(k, "acoth"::SY) => log((z + 1) / (z - 1)) / (2::F) - is?(k, "asech"::SY) => log((inv z) + sqrt(inv(z**2) - 1)) - is?(k, "acsch"::SY) => log((inv z) + sqrt(1 + inv(z**2))) - is?(k, "%paren"::SY) or is?(k, "%box"::SY) => + is?(k, 'cot) => inv tan z + is?(k, 'acot) => atan inv z + is?(k, 'asin) => atan(z / sqrt(1 - z**2)) + is?(k, 'acos) => atan(sqrt(1 - z**2) / z) + is?(k, 'asec) => atan sqrt(1 - z**2) + is?(k, 'acsc) => atan inv sqrt(1 - z**2) + is?(k, 'asinh) => log(sqrt(1 + z**2) + z) + is?(k, 'acosh) => log(sqrt(z**2 - 1) + z) + is?(k, 'atanh) => log((z + 1) / (1 - z)) / (2::F) + is?(k, 'acoth) => log((z + 1) / (z - 1)) / (2::F) + is?(k, 'asech) => log((inv z) + sqrt(inv(z**2) - 1)) + is?(k, 'acsch) => log((inv z) + sqrt(1 + inv(z**2))) + is?(k, '%paren) or is?(k, '%box) => empty? rest args => z kf if has?(op := operator k, 'htrig) then iez := inv(ez := exp z) - is?(k, "sinh"::SY) => (ez - iez) / (2::F) - is?(k, "cosh"::SY) => (ez + iez) / (2::F) - is?(k, "tanh"::SY) => (ez - iez) / (ez + iez) - is?(k, "coth"::SY) => (ez + iez) / (ez - iez) - is?(k, "sech"::SY) => 2 * inv(ez + iez) - is?(k, "csch"::SY) => 2 * inv(ez - iez) + is?(k, 'sinh) => (ez - iez) / (2::F) + is?(k, 'cosh) => (ez + iez) / (2::F) + is?(k, 'tanh) => (ez - iez) / (ez + iez) + is?(k, 'coth) => (ez + iez) / (ez - iez) + is?(k, 'sech) => 2 * inv(ez + iez) + is?(k, 'csch) => 2 * inv(ez - iez) if has?(op, 'trig) then tz2 := tan(z / (2::F)) - is?(k, "sin"::SY) => 2 * tz2 / (1 + tz2**2) - is?(k, "cos"::SY) => (1 - tz2**2) / (1 + tz2**2) - is?(k, "sec"::SY) => (1 + tz2**2) / (1 - tz2**2) - is?(k, "csc"::SY) => (1 + tz2**2) / (2 * tz2) + is?(k, 'sin) => 2 * tz2 / (1 + tz2**2) + is?(k, 'cos) => (1 - tz2**2) / (1 + tz2**2) + is?(k, 'sec) => (1 + tz2**2) / (1 - tz2**2) + is?(k, 'csc) => (1 + tz2**2) / (2 * tz2) op args --The next 5 functions are used by normalize, once a relation is found depeval(f, lk, k, v) == - is?(k, "log"::SY) => logeval(f, lk, k, v) - is?(k, "exp"::SY) => expeval(f, lk, k, v) - is?(k, "tan"::SY) => taneval(f, lk, k, v) - is?(k, "atan"::SY) => ataneval(f, lk, k, v) + is?(k, 'log) => logeval(f, lk, k, v) + is?(k, 'exp) => expeval(f, lk, k, v) + is?(k, 'tan) => taneval(f, lk, k, v) + is?(k, 'atan) => ataneval(f, lk, k, v) is?(k, NTHR) => rooteval(f, lk, k, v(minIndex v)) [f, empty(), empty()] @@ -358,7 +358,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where u := first argument k fns := toU lk c := u - +/[qelt(v, i) * x for i in minIndex v .. maxIndex v for x in fns] - (rec := goodCoef(v, lk, "tan"::SY)) case "failed" => + (rec := goodCoef(v, lk, 'tan)) case "failed" => tannosimp(f, lk, k, v, fns, c) v0 := retract(inv qelt(v, rec.index))@Z lv := [qelt(v, i) for i in minIndex v .. maxIndex v | @@ -369,7 +369,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where [eval(f, [rec.ker], [g]), [rec.ker], [g]] tannosimp(f, lk, k, v, fns, c) == - every?(is?(#1, "tan"::SY), lk) => + every?(is?(#1, 'tan), lk) => dd := (d := (cd := splitDenominator v).den)::F newt := [tan(u / dd) for u in fns]$List(F) newtan := [tanNa(t, d) for t in newt]$List(F) @@ -383,7 +383,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where [eval(f, [k], [h]), [k], [h]] expnosimp(f, lk, k, v, fns, g) == - every?(is?(#1, "exp"::SY), lk) => + every?(is?(#1, 'exp), lk) => dd := (d := (cd := splitDenominator v).den)::F newe := [exp(y / dd) for y in fns]$List(F) newexp := [e ** d for e in newe]$List(F) @@ -463,7 +463,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where y := first argument k fns := toY lk g := y - +/[qelt(v, i) * z for i in minIndex v .. maxIndex v for z in fns] - (rec := goodCoef(v, lk, "exp"::SY)) case "failed" => + (rec := goodCoef(v, lk, 'exp)) case "failed" => expnosimp(f, lk, k, v, fns, exp g) v0 := retract(inv qelt(v, rec.index))@Z lv := [qelt(v, i) for i in minIndex v .. maxIndex v | @@ -520,7 +520,6 @@ InnerTrigonometricManipulations(R,F,FG): Exports == Implementation where KG ==> Kernel FG PG ==> SparseMultivariatePolynomial(GR, KG) UP ==> SparseUnivariatePolynomial PG - NTHR ==> "nthRoot"::SY Exports ==> with GF2FG : GF -> FG @@ -543,6 +542,7 @@ InnerTrigonometricManipulations(R,F,FG): Exports == Implementation where ++ \spad{exp(2*u)} otherwise. Implementation ==> add + macro NTHR == 'nthRoot ker2explogs: (KG, List KG, List SY) -> FG smp2explogs: (PG, List KG, List SY) -> FG supexp : (UP, GF, GF, Z) -> GF @@ -744,12 +744,12 @@ TrigonometricManipulations(R, F): Exports == Implementation where -- "failed" otherwise kcomplex k == op := operator k - is?(k, "nthRoot"::SY) => + is?(k, 'nthRoot) => arg := argument k even?(retract(n := second arg)@Z) and ((u := sign(first arg)) case Z) and (u::Z < 0) => op(s1, n / 2::F) * op(- first arg, n) "failed" - is?(k, "log"::SY) and ((u := sign(a := first argument k)) case Z) + is?(k, 'log) and ((u := sign(a := first argument k)) case Z) and (u::Z < 0) => op(- a) + ipi "failed" @@ -796,7 +796,7 @@ TrigonometricManipulations(R, F): Exports == Implementation where localexplogs(f, g, lx) == trigs2explogs(F2FG g, [K2KG k for k in tower f - | is?(k, "tan"::SY) or is?(k, "cot"::SY)], lx) + | is?(k, 'tan) or is?(k, 'cot)], lx) trigs f == real? f => f @@ -877,7 +877,7 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where localexplogs(f, g, lx) == trigs2explogs(g, [k for k in tower f - | is?(k, "tan"::SY) or is?(k, "cot"::SY)], lx) + | is?(k, 'tan) or is?(k, 'cot)], lx) complexElementary f == any?(has?(#1, 'rtrig), |