aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/efstruc.spad.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/efstruc.spad.pamphlet')
-rw-r--r--src/algebra/efstruc.spad.pamphlet100
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),