|
Domains for functions (local sections) over a jet bundle.
axiom )lib BFC BFC-
BaseFunctionCategory is now explicitly exposed in frame initial
BaseFunctionCategory will be automatically loaded when needed from
/var/zope2/var/LatexWiki/BFC.NRLIB/code
BaseFunctionCategory& is now explicitly exposed in frame initial
BaseFunctionCategory& will be automatically loaded when needed from
/var/zope2/var/LatexWiki/BFC-.NRLIB/code
axiom )lib JBC JBC-
JetBundleCategory is now explicitly exposed in frame initial
JetBundleCategory will be automatically loaded when needed from
/var/zope2/var/LatexWiki/JBC.NRLIB/code
JetBundleCategory& is now explicitly exposed in frame initial
JetBundleCategory& will be automatically loaded when needed from
/var/zope2/var/LatexWiki/JBC-.NRLIB/code
axiom )lib JBFC JBFC-
JetBundleFunctionCategory is now explicitly exposed in frame initial
JetBundleFunctionCategory will be automatically loaded when needed
from /var/zope2/var/LatexWiki/JBFC.NRLIB/code
JetBundleFunctionCategory& is now explicitly exposed in frame
initial
JetBundleFunctionCategory& will be automatically loaded when needed
from /var/zope2/var/LatexWiki/JBFC-.NRLIB/code
axiom )lib SEM
SparseEchelonMatrix is now explicitly exposed in frame initial
SparseEchelonMatrix will be automatically loaded when needed from
/var/zope2/var/LatexWiki/SEM.NRLIB/code
JetBundleExpression (JBE)
spad )abb domain JBE JetBundleExpression
M ==> Matrix
Sy ==> Symbol
PI ==> PositiveInteger
NNI ==> NonNegativeInteger
I ==> Integer
FI ==> Fraction Integer
B ==> Boolean
L ==> List
K ==> Kernel $
BOP ==> BasicOperator
SMP ==> SparseMultivariatePolynomial(I,K)
IE ==> IndexedExponents K
GB ==> GroebnerPackage(I,IE,K,SMP)
FLAF1 ==> FiniteLinearAggregateFunctions2($,L $,SMP,L SMP)
FLAF2 ==> FiniteLinearAggregateFunctions2(SMP,L SMP,$,L $)
EI ==> Expression Integer
FS ==> FunctionSpace Integer
ACFS ==> AlgebraicallyClosedFunctionSpace Integer
TFC ==> TranscendentalFunctionCategory
COC ==> CombinatorialOpsCategory
LFC ==> LiouvillianFunctionCategory
SFC ==> SpecialFunctionCategory
JBC ==> JetBundleCategory
JBE ==> JetBundleExpression JB
JBX ==> JetBundleXExpression JB
JBFC ==> JetBundleFunctionCategory JB
JP ==> SparseMultivariatePolynomial(EI,JB)
BFC ==> BaseFunctionCategory JB
OUT ==> OutputForm
SEM ==> SparseEchelonMatrix(JB,$)
SEMD ==> SparseEchelonMatrix(JB,D)
SIMPREC ==> Record(Sys:L $, JM:SEM, Depend:Union("failed",L L NNI))
ROWREC ==> Record(Indices:L JB, Entries:L $)
LDREC ==> Record(Fun:$, JMR:ROWREC, Depend:L NNI)
POWREC ==> Record(val:$, exponent:I)
Const ==> "Const"::Sy
Indep ==> "Indep"::Sy
Dep ==> "Dep"::Sy
Deriv ==> "Deriv"::Sy
errmsg ==> "inconsistent system"
++ Description:
++ \axiomType{JetBundleExpression} defines expressions over a jet bundle
++ based on \axiomType{Expression Integer}. It allows all kind of algebraic
++ operations. \axiom{simplify} is implemented using Groebner bases in
++ polynomials over kernels. Thus it might not work correctly for general
++ expressions. This also affects \axiom{dimension}.
JetBundleExpression(JB:JBC) : Cat == Def where
Cat ==> Join(JBFC,FS,ACFS,TFC,COC,LFC,SFC) with
coerce : EI -> $
coerce : $ -> EI
coerce : SMP -> $
coerce : JP -> $
numerJP : $ -> JP
++ \axiom{numerJP(f)} writes \axiom{f} as polynomial over \axiom{JB}.
reduce : $ -> $
++ \axiom{reduce(x)} reduces algebraics in \axiom{x}.
function : (Sy,L $,NNI) -> $
++ \axiom{function(f,arg,show)} generates a function with name \axiom{f}
++ and arguments \axiom{arg}. In the output only the first \axiom{show}
++ arguments are shown.
Def ==> EI add
-- -------------- --
-- Representation --
-- -------------- --
Rep := EI
coerce(jv:JB):$ == jv::EI
coerce(exp:EI):$ == exp@Rep
coerce(f:$):EI == f::Rep
coerce(p:SMP):$ == p / 1$SMP
numerJP(f:$):JP ==
res:JP := 0
p:SMP := numer f
PM := primitiveMonomials p
CO := coefficients p
for mon in PM for co in CO repeat
JV:L JB := empty
Exp:L NNI := empty
newco:EI := co::EI
for v in variables mon repeat
vs := v::$
jv:Union(JB,"failed") := retractIfCan vs
if jv case "failed" then
newco := newco * (vs::EI)
else
JV := cons(jv::JB,JV)
Exp := cons(degree(mon,v),Exp)
res := res + newco*monomial(1, reverse! JV, reverse! Exp)
res
coerce(p:JP):$ ==
res:$ := 0
PM := primitiveMonomials p
CO := coefficients p
for mon in PM for co in CO repeat
prod := co
for v in variables mon repeat
prod := prod * (v::$)**degree(p,v)
res := res + prod
res
gcd(f1:$,f2:$):$ == gcd(numer f1, numer f2)$SMP ::$
f1:$ exquo f2:$ ==
p := (numer(f1) exquo$SMP numer(f2))
p case "failed" => "failed"
p::SMP::$
recip(f:$):Union($,"failed") == 1/f
-- --------- --
-- Dimension --
------------ --
purge(l:L K,q:NNI):L K == [k for k in l | order(k::$)=q]
dimrec(lmv:L L K, indVars:L K, remVars:L K, sets:L L K):L L K ==
-- recursive computation of independent sets
res := sets
newVars := remVars
while not empty? newVars repeat
jk := first newVars
newVars := rest newVars
elem:B := false
indK := concat(indVars,jk)
for lv in lmv until elem repeat
elem := (lv=indK)
if not elem then
res := dimrec(lmv,indK,newVars,res)
elem := false
for m in res until elem repeat
elem := reduce("and", [member?(ik,m) for ik in indVars], true)
if not elem then
res := cons(indVars,res)
res
dimension(sys:L $,jm:SEM,q:NNI):NNI ==
polys:L SMP := map(numer,sys)$FLAF1
lmv := [sort! variables leadingMonomial p for p in polys]
allvars := first lmv
for lv in rest lmv repeat
allvars := removeDuplicates! merge(lv,allvars)
dim0 := (dimJ(q)$JB - #allvars)::NNI
indSets := dimrec(lmv,empty,allvars,empty)
dim:NNI := 0
for ind in indSets repeat
dim := max(dim,#ind)
dim0 + dim --reduce(max, [#ind for ind in indSets], 0)
orderDim(sys:L $,jm:SEM,q:NNI):NNI ==
polys:L SMP := map(numer,sys)$FLAF1
lmv := [sort! purge(variables(leadingMonomial(p)),q) for p in polys]
allvars := first lmv
for lv in rest lmv repeat
allvars := removeDuplicates! merge(lv,allvars)
dim0 := (dimS(q)$JB - #allvars)::NNI
indSets := dimrec(lmv,empty,allvars,empty)
dim:NNI := 0
for ind in indSets repeat
dim := max(dim,#ind)
dim0 + dim --reduce(max, [#ind for ind in indSets], 0)
-- -------------- --
-- Simplification --
-- -------------- --
simpSMP(p:SMP):SMP ==
-- local function to support simplification
ground? p => 1
tv := mainVariable p
tv case "failed" => error "inconsistent system"
--print("simpSMP")$OUT
v := tv::K
up := univariate(p,v)
monomial? up =>
--print(" monomial")$OUT
lc := leadingCoefficient up
mainVariable(lc) case "failed" =>
--print("End simpSMP")$OUT
monomial(1,v,1)
--print("End simpSMP (Rekursion)")$OUT
monomial(simpSMP lc, v, 1)
(md:=minimumDegree up)>0 =>
--print(" reduce degree")$OUT
up := monicDivide(up,monomial(1,md)).quotient
--print("END simpSMP")$OUT
multivariate(up,v)
--print("END simpSMP")$OUT
p
simpOne(f:$):$ ==
zero? f => 0
simpSMP(numer f)::$
greaterLD(r1:LDREC,r2:LDREC):B ==
-- local function for sorting purposes
empty? r1.JMR.Indices => false
empty? r2.JMR.Indices => true
ind1 := r1.JMR.Indices
ind2 := r2.JMR.Indices
first(ind1)=first(ind2) => #ind1<#ind2
first(ind1)>first(ind2)
groebner(sys:L $):L $ ==
polys:L SMP := map(numer,sys)$FLAF1
--print("groebner")$OUT
print(assign("polys",polys::OUT))$OUT
gbase := groebner(polys)$GB
--print("END groebner")$OUT
map(coerce,gbase)$FLAF2
groebnerSimp(sysL:L LDREC,ind:L JB):L LDREC ==
-- Simplification using Groebner bases for truly non-linear
-- equations. Looses all information about dependencies.
print(assign("groebnerSimp: #",(#sysL)::OUT))$OUT
tmp:L L NNI := [rec.Depend for rec in sysL]
resDep:L NNI := reduce(setUnion,tmp,empty)
resSys := groebner([rec.Fun for rec in sysL])
resJM := jacobiMatrix(resSys, [ind for eq in resSys])
print("END groebnerSimp")$OUT
[[fun,row(resJM,i),resDep] for fun in resSys for i in 1..]
linearSimp(sysL:L LDREC,ind:L JB):L LDREC ==
-- Tries to find an equation which is linear in its leading
-- derivative, in order to avoid Groebner bases.
--print(assign("linearSimp: #",(#sysL)::OUT))$OUT
solved?:B := false
srec:LDREC
sld:JB
rsysL:L LDREC := empty
while not(solved? or empty? sysL) repeat
rec := first sysL
sysL := rest sysL
ld := first rec.JMR.Indices
s := solveFor(rec.Fun,ld)
solved? := s case $
if solved? then
srec := rec
sld := ld
else
rsysL := cons(rec,rsysL)
rsysL := concat!(reverse! rsysL, sysL)
solved? =>
ssub := s::$
res:L LDREC := [srec]
sdep := srec.Depend
for rec in rsysL repeat
newFun := simpOne subst(rec.Fun,sld,ssub)
if not zero? newFun then
newJMR := row(jacobiMatrix([newFun],[ind]),1)$SEM
newDep := removeDuplicates! append(rec.Depend,sdep)
res := cons([newFun,newJMR,newDep],res)
--print("END linearSimp")$OUT
reverse! res
--print("END linearSimp")$OUT
groebnerSimp(rsysL,ind)
simpRec(sysL:L LDREC,ind:L JB):L LDREC ==
-- Checks whether a leading derivative occurs more than once.
-- If yes, linearSimp is called to simplify all equations with
-- same leading derivative. These equations are sorted according
-- to the number of jet variables occuring in them.
#sysL<2 => sysL
--print("simpRec")$OUT
frec := first sysL
fld := first frec.JMR.Indices
sysL := rest sysL
srec := first sysL
sld := first srec.JMR.Indices
fld>sld =>
--print("END simpRec")$OUT
cons(frec,simpRec(sysL,ind))
eqLD:L LDREC := [frec]
while not(empty? sysL) and (sld=fld) repeat
eqLD := cons(srec,eqLD)
sysL := rest sysL
if not empty? sysL then
srec := first sysL
sld := first srec.JMR.Indices
eqLD := sort!(greaterLD,linearSimp(reverse! eqLD, ind))
srec := first eqLD
sld := first srec.JMR.Indices
resLD:L LDREC := empty
while not(empty? eqLD) and (sld=fld) repeat
resLD := cons(srec,resLD)
eqLD := rest eqLD
if not empty? eqLD then
srec := first eqLD
sld := first srec.JMR.Indices
newSysL:L LDREC := merge(greaterLD,eqLD,sysL)
--print("END simpRec")$OUT
concat!(reverse! resLD, simpRec(newSysL,ind))
simplify(sys:L $,jm:SEM):SIMPREC ==
-- Sorts equations according to their leading derivatives.
-- Ambiguities are resolved either by solving one equation
-- for its leading derivative or by Groebner bases.
--print("##### SIMPLIFY #####")$OUT
inds := allIndices jm
sysL:L LDREC := empty
for eq in sys | not zero? eq for i in 1.. repeat
neq := simpOne eq
if neq=eq then
r := row(jm,i)
else
r := row(jacobiMatrix([neq],[row(jm,i).Indices]),1)
empty?(r.Indices) or (type(first r.Indices)=Indep) =>
error "inconsistent system"
sysL := cons([neq,r,[i::NNI]], sysL)
empty? sysL => [empty,new(empty,0),empty]
sysL := simpRec(sort!(greaterLD,sysL),inds)
resSys:L $ := empty
resJM:SEM := new(inds,#sysL)
resDep:L L NNI := empty
for rec in sysL for i in 1.. repeat
empty?(rec.JMR.Indices) or (first rec.JMR.Indices < U(1)$JB) =>
error "inconsistent system"
resSys := cons(rec.Fun, resSys)
setRow!(resJM,i,rec.JMR)
resDep := cons(rec.Depend, resDep)
--print("##### END SIMPLIFY #####")$OUT
[reverse! resSys, resJM, reverse! resDep]
-- -------------- --
-- JBFC Functions --
-- -------------- --
jetVariables(Phi:$):L JB ==
JV:L JB := empty
LKernels := tower Phi
LOps := [operator Ke for Ke in LKernels]
for Ke in LKernels for Op in LOps | has?(Op,"%jet")$BOP repeat
typ := property(Op,"%jet")::None pretend Sy
arg := argument Ke
if typ=Indep then
xindex:I := retract(second arg)
JV := cons(X(xindex::PI)$JB,JV)
else if typ=Dep then
uindex:I := retract(second arg)
JV := cons(U(uindex::PI)$JB,JV)
else
pupindex:I := retract(second arg)
mindex:L I := [retract i for i in rest rest arg]
pmindex := [i::NNI for i in mindex]
JV := cons(P(pupindex::PI,pmindex)$JB,JV)
sort(">",removeDuplicates! JV)
differentiate(fun:$,jv:JB):$ ==
x := name jv
differentiate(fun,x)
differentiate(fun:$,x:Sy):$ == differentiate(fun::EI,x)$Rep
subst(f:$,jv:JB,exp:$):$ ==
--print("subst")$OUT
res := eval(f::Rep,jv::Rep=exp::Rep)
--print("END subst")$OUT
res
solveFor(f:$,jv:JB):Union($,"failed") ==
-- Succeeds only if f is linear in jv!
fun := numer f
var:K := retract(jv::$)
md := monicDivide(fun,var::SMP,var)
vrem := variables md.remainder
vquo := variables md.quotient
member?(var,append(vrem,vquo)) => "failed"
zero? md.remainder =>
empty? vquo => 0
"failed"
- md.remainder / md.quotient
-- --------- --
-- Functions --
-- --------- --
-- Hack around the problem with the kernels. Courtesy M. Bronstein.
kernel0(op:BOP,ls:L $):$ == kernel(op, ls pretend L EI)$EI
sy2jbe(s:Sy):$ == s::EI
-- The following hacks are necessary due to the not very satisfactory
-- treatment of differentiation in FunctionSpace. They ensure that
-- partial differentiations commute and that derivatives hide the same
-- arguments as the original functions.
hidedisp(l:L $):OUT ==
-- Yields output form for functions with hidden arguments.
-- l is supposed to have the following structure:
-- l = [name,#args,#shown args,args,diff]
-- diff is a list of integers showing previous differentiations.
name:Sy := retract first l
l := rest l
num:I := retract first l
l := rest l
show:I := retract first l
l := rest l
args:L OUT := empty
for k in 1..show repeat
args := concat!(args,[first(l)::OUT])
l := rest l
for k in show+1..num repeat
l := rest l
if empty? l then
op := name::OUT
else
op := sub(name::OUT,commaSeparate [e::OUT for e in l])
empty? args => op
prefix(op,args)
hidediff(l:L $,x:Sy):$ ==
-- Differentiates functions generated by function.
-- l has the same form as in hidedisp
oldarg := copy l
name:Sy := retract first l
l := rest l
num:I := retract first l
zero? num => 0
l := rest l
show:I := retract first l
l := rest l
args:L $ := empty
for k in 1..num repeat
args := cons(first l, args)
l := rest l
diff:L I := [retract k for k in l]
oldarg := first(oldarg,(num+3)::NNI)
op := operator(name)$BOP
setProperty(op,"%specialDisp",hidedisp@(L $ -> OUT) pretend None)
setProperty(op,"%specialDiff",hidediff@((L $,Sy) -> $) pretend None)
res:$ := 0
for k in num..1 by -1 for arg in args repeat
da := differentiate(arg,x)
if not zero? da then
newarg := append(oldarg,[j::$ for j in merge(diff,[k])])
res := res + kernel0(op,newarg)*da
res
function(f:Sy,arg:L $,show:NNI):$ ==
-- Special output and differentiation routines are added using the
-- two hooks provided by FunctionSpace and BasicOperator.
op := operator(f)$BOP
setProperty(op,"%specialDisp",hidedisp@(L $ -> OUT) pretend None)
setProperty(op,"%specialDiff",hidediff@((L $,Sy) -> $) pretend None)
args := append([sy2jbe f,#arg::$,show::$],arg)
kernel0(op,args)
spad Compiling FriCAS source code from file
/var/zope2/var/LatexWiki/4806513689459485363-25px002.spad using
old system compiler.
JBE abbreviates domain JetBundleExpression
processing macro definition M ==> Matrix
processing macro definition Sy ==> Symbol
processing macro definition PI ==> PositiveInteger
processing macro definition NNI ==> NonNegativeInteger
processing macro definition I ==> Integer
processing macro definition FI ==> Fraction Integer
processing macro definition B ==> Boolean
processing macro definition L ==> List
processing macro definition K ==> Kernel $
processing macro definition BOP ==> BasicOperator
processing macro definition SMP ==> SparseMultivariatePolynomial(I,K)
processing macro definition IE ==> IndexedExponents K
processing macro definition GB ==> GroebnerPackage(I,IE,K,SMP)
processing macro definition FLAF1 ==> FiniteLinearAggregateFunctions2($,L $,SMP,L SMP)
processing macro definition FLAF2 ==> FiniteLinearAggregateFunctions2(SMP,L SMP,$,L $)
processing macro definition EI ==> Expression Integer
processing macro definition FS ==> FunctionSpace Integer
processing macro definition ACFS ==> AlgebraicallyClosedFunctionSpace Integer
processing macro definition TFC ==> TranscendentalFunctionCategory
processing macro definition COC ==> CombinatorialOpsCategory
processing macro definition LFC ==> LiouvillianFunctionCategory
processing macro definition SFC ==> SpecialFunctionCategory
processing macro definition JBC ==> JetBundleCategory
processing macro definition JBE ==> JetBundleExpression JB
processing macro definition JBX ==> JetBundleXExpression JB
processing macro definition JBFC ==> JetBundleFunctionCategory JB
processing macro definition JP ==> SparseMultivariatePolynomial(EI,JB)
processing macro definition BFC ==> BaseFunctionCategory JB
processing macro definition OUT ==> OutputForm
processing macro definition SEM ==> SparseEchelonMatrix(JB,$)
processing macro definition SEMD ==> SparseEchelonMatrix(JB,D)
processing macro definition SIMPREC ==> Record(Sys: L $,JM: SEM,Depend: Union(failed,L L NNI))
processing macro definition ROWREC ==> Record(Indices: L JB,Entries: L $)
processing macro definition LDREC ==> Record(Fun: $,JMR: ROWREC,Depend: L NNI)
processing macro definition POWREC ==> Record(val: $,exponent: I)
processing macro definition Const ==> ::(Const,Sy)
processing macro definition Indep ==> ::(Indep,Sy)
processing macro definition Dep ==> ::(Dep,Sy)
processing macro definition Deriv ==> ::(Deriv,Sy)
processing macro definition errmsg ==> inconsistent system
processing macro definition Cat ==> -- the constructor category
processing macro definition Def ==> -- the constructor capsule
------------------------------------------------------------------------
initializing NRLIB JBE for JetBundleExpression
compiling into NRLIB JBE
compiling exported coerce : JB -> $
Time: 0.33 SEC.
compiling exported coerce : Expression Integer -> $
JBE;coerce;E$;2 is replaced by exp
Time: 0.03 SEC.
compiling exported coerce : $ -> Expression Integer
JBE;coerce;$E;3 is replaced by f
Time: 0.04 SEC.
compiling exported coerce : SparseMultivariatePolynomial(Integer,Kernel $) -> $
Time: 0.02 SEC.
compiling exported numerJP : $ -> SparseMultivariatePolynomial(Expression Integer,JB)
Time: 0.72 SEC.
compiling exported coerce : SparseMultivariatePolynomial(Expression Integer,JB) -> $
Time: 0.37 SEC.
compiling exported gcd : ($,$) -> $
Time: 0.08 SEC.
compiling exported exquo : ($,$) -> Union($,failed)
Time: 0.09 SEC.
compiling exported recip : $ -> Union($,failed)
Time: 0.09 SEC.
compiling local purge : (List Kernel $,NonNegativeInteger) -> List Kernel $
Time: 0.17 SEC.
compiling local dimrec : (List List Kernel $,List Kernel $,List Kernel $,List List Kernel $) -> List List Kernel $
Time: 0.10 SEC.
compiling exported dimension : (List $,SparseEchelonMatrix(JB,$),NonNegativeInteger) -> NonNegativeInteger
Time: 0.62 SEC.
compiling exported orderDim : (List $,SparseEchelonMatrix(JB,$),NonNegativeInteger) -> NonNegativeInteger
Time: 0.60 SEC.
compiling local simpSMP : SparseMultivariatePolynomial(Integer,Kernel $) -> SparseMultivariatePolynomial(Integer,Kernel $)
Time: 0.53 SEC.
compiling exported simpOne : $ -> $
Time: 0.16 SEC.
compiling local greaterLD : (Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger),Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger)) -> Boolean
Time: 0.51 SEC.
compiling local groebner : List $ -> List $
Time: 0.16 SEC.
compiling local groebnerSimp : (List Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger),List JB) -> List Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger)
Time: 1.20 SEC.
compiling local linearSimp : (List Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger),List JB) -> List Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger)
Time: 1.28 SEC.
compiling local simpRec : (List Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger),List JB) -> List Record(Fun: $,JMR: Record(Indices: List JB,Entries: List $),Depend: List NonNegativeInteger)
Time: 0.74 SEC.
compiling exported simplify : (List $,SparseEchelonMatrix(JB,$)) -> Record(Sys: List $,JM: SparseEchelonMatrix(JB,$),Depend: Union(failed,List List NonNegativeInteger))
Time: 2.69 SEC.
compiling exported jetVariables : $ -> List JB
Time: 1.35 SEC.
compiling exported differentiate : ($,JB) -> $
Time: 0.02 SEC.
compiling exported differentiate : ($,Symbol) -> $
Time: 0.38 SEC.
compiling exported subst : ($,JB,$) -> $
Time: 0.57 SEC.
compiling exported solveFor : ($,JB) -> Union($,failed)
Time: 0.46 SEC.
compiling local kernel0 : (BasicOperator,List $) -> $
Time: 0.41 SEC.
compiling local sy2jbe : Symbol -> $
Time: 0.27 SEC.
compiling local hidedisp : List $ -> OutputForm
Time: 0.93 SEC.
compiling local hidediff : (List $,Symbol) -> $
Time: 1.25 SEC.
compiling exported function : (Symbol,List $,NonNegativeInteger) -> $
Time: 0.72 SEC.
augmenting (Integer): (CharacteristicNonZero)
augmenting (Integer): (ConvertibleTo (Pattern (Float)))
augmenting (Integer): (Group)
augmenting (Integer): (PatternMatchable (Float))
(time taken in buildFunctor: 107)
;;; *** |JetBundleExpression| REDEFINED
;;; *** |JetBundleExpression| REDEFINED
Time: 1.39 SEC.
Warnings:
[1] numerJP: newco has no value
[2] numerJP: JV has no value
[3] numerJP: Exp has no value
[4] dimension: not known that (FiniteLinearAggregate $) is of mode (CATEGORY domain (SIGNATURE nil ($)) (SIGNATURE null ((Boolean) $)) (SIGNATURE cons ($ $ $)) (SIGNATURE append ($ $ $)) (IF (has $ (SetCategory)) (PROGN (SIGNATURE setUnion ($ $ $)) (SIGNATURE setIntersection ($ $ $)) (SIGNATURE setDifference ($ $ $))) noBranch) (IF (has $ (OpenMath)) (ATTRIBUTE (OpenMath)) noBranch))
[5] dimension: not known that (FiniteLinearAggregate (SparseMultivariatePolynomial (Integer) (Kernel $))) is of mode (CATEGORY domain (SIGNATURE nil ($)) (SIGNATURE null ((Boolean) $)) (SIGNATURE cons ($ (SparseMultivariatePolynomial (Integer) (Kernel $)) $)) (SIGNATURE append ($ $ $)) (IF (has (SparseMultivariatePolynomial (Integer) (Kernel $)) (SetCategory)) (PROGN (SIGNATURE setUnion ($ $ $)) (SIGNATURE setIntersection ($ $ $)) (SIGNATURE setDifference ($ $ $))) noBranch) (IF (has (SparseMultivariatePolynomial (Integer) (Kernel $)) (OpenMath)) (ATTRIBUTE (OpenMath)) noBranch))
[6] greaterLD: Indices has no value
[7] groebner: not known that (FiniteLinearAggregate (SparseMultivariatePolynomial (Integer) (Kernel $))) is of mode (CATEGORY domain (SIGNATURE nil ($)) (SIGNATURE null ((Boolean) $)) (SIGNATURE cons ($ (SparseMultivariatePolynomial (Integer) (Kernel $)) $)) (SIGNATURE append ($ $ $)) (IF (has (SparseMultivariatePolynomial (Integer) (Kernel $)) (SetCategory)) (PROGN (SIGNATURE setUnion ($ $ $)) (SIGNATURE setIntersection ($ $ $)) (SIGNATURE setDifference ($ $ $))) noBranch) (IF (has (SparseMultivariatePolynomial (Integer) (Kernel $)) (OpenMath)) (ATTRIBUTE (OpenMath)) noBranch))
[8] groebner: not known that (FiniteLinearAggregate $) is of mode (CATEGORY domain (SIGNATURE nil ($)) (SIGNATURE null ((Boolean) $)) (SIGNATURE cons ($ $ $)) (SIGNATURE append ($ $ $)) (IF (has $ (SetCategory)) (PROGN (SIGNATURE setUnion ($ $ $)) (SIGNATURE setIntersection ($ $ $)) (SIGNATURE setDifference ($ $ $))) noBranch) (IF (has $ (OpenMath)) (ATTRIBUTE (OpenMath)) noBranch))
[9] linearSimp: Indices has no value
[10] linearSimp: rsysL has no value
[11] linearSimp: srec has no value
[12] linearSimp: sld has no value
[13] linearSimp: res has no value
[14] simpRec: Indices has no value
[15] simplify: Indices has no value
[16] simplify: sysL has no value
[17] simplify: resSys has no value
[18] simplify: resDep has no value
[19] hidediff: res has no value
Cumulative Statistics for Constructor JetBundleExpression
Time: 18.28 seconds
--------------non extending category----------------------
.. JetBundleExpression #1 of cat
(|Join| (|JetBundleFunctionCategory| |#1|)
(|FunctionSpace| (|Integer|))
(|AlgebraicallyClosedFunctionSpace| (|Integer|))
(|TranscendentalFunctionCategory|) (|CombinatorialOpsCategory|)
(|LiouvillianFunctionCategory|) (|SpecialFunctionCategory|)
(CATEGORY |domain|
(SIGNATURE |coerce| ($ (|Expression| (|Integer|))))
(SIGNATURE |coerce| ((|Expression| (|Integer|)) $))
(SIGNATURE |coerce|
($ (|SparseMultivariatePolynomial| (|Integer|)
(|Kernel| $))))
(SIGNATURE |coerce|
($ (|SparseMultivariatePolynomial|
(|Expression| (|Integer|)) |#1|)))
(SIGNATURE |numerJP|
((|SparseMultivariatePolynomial|
(|Expression| (|Integer|)) |#1|)
$))
(SIGNATURE |reduce| ($ $))
(SIGNATURE |function|
($ (|Symbol|) (|List| $) (|NonNegativeInteger|))))) has no
(IF (|has| (|Integer|) (|IntegralDomain|))
(PROGN
(ATTRIBUTE (|AlgebraicallyClosedFunctionSpace| (|Integer|)))
(ATTRIBUTE (|TranscendentalFunctionCategory|))
(ATTRIBUTE (|CombinatorialOpsCategory|))
(ATTRIBUTE (|LiouvillianFunctionCategory|))
(ATTRIBUTE (|SpecialFunctionCategory|))
(SIGNATURE |reduce| ($ $))
(SIGNATURE |number?| ((|Boolean|) $))
(SIGNATURE |simplifyPower| ($ $ (|Integer|)))
(IF (|has| (|Integer|) (|GcdDomain|))
(PROGN
(SIGNATURE |factorPolynomial|
((|Factored| (|SparseUnivariatePolynomial| $))
(|SparseUnivariatePolynomial| $)))
(SIGNATURE |squareFreePolynomial|
((|Factored| (|SparseUnivariatePolynomial| $))
(|SparseUnivariatePolynomial| $))))
|noBranch|)
(IF (|has| (|Integer|) (|RetractableTo| (|Integer|)))
(ATTRIBUTE (|RetractableTo| (|AlgebraicNumber|))) |noBranch|))
|noBranch|) finalizing NRLIB JBE
Processing JetBundleExpression for Browser database:
--->-->JetBundleExpression((coerce ($ EI))): Not documented!!!!
--->-->JetBundleExpression((coerce (EI $))): Not documented!!!!
--->-->JetBundleExpression((coerce ($ SMP))): Not documented!!!!
--->-->JetBundleExpression((coerce ($ JP))): Not documented!!!!
--------(numerJP (JP $))---------
--------(reduce ($ $))---------
--------(function ($ Sy (L $) NNI))---------
--------constructor---------
------------------------------------------------------------------------
JetBundleExpression is now explicitly exposed in frame initial
JetBundleExpression will be automatically loaded when needed from
/var/zope2/var/LatexWiki/JBE.NRLIB/codeJetBundleXExpression (JBX)
spad )abb domain JBX JetBundleXExpression
M ==> Matrix
Sy ==> Symbol
PI ==> PositiveInteger
NNI ==> NonNegativeInteger
I ==> Integer
FI ==> Fraction Integer
B ==> Boolean
L ==> List
K ==> Kernel $
BOP ==> BasicOperator
SMP ==> SparseMultivariatePolynomial(I,K)
IE ==> IndexedExponents K
GB ==> GroebnerPackage(I,IE,K,SMP)
FLAF1 ==> FiniteLinearAggregateFunctions2($,L $,SMP,L SMP)
FLAF2 ==> FiniteLinearAggregateFunctions2(SMP,L SMP,$,L $)
EI ==> Expression Integer
FS ==> FunctionSpace Integer
ACFS ==> AlgebraicallyClosedFunctionSpace Integer
TFC ==> TranscendentalFunctionCategory
COC ==> CombinatorialOpsCategory
LFC ==> LiouvillianFunctionCategory
SFC ==> SpecialFunctionCategory
JBC ==> JetBundleCategory
JBE ==> JetBundleExpression JB
JBX ==> JetBundleXExpression JB
JBFC ==> JetBundleFunctionCategory JB
JP ==> SparseMultivariatePolynomial(EI,JB)
BFC ==> BaseFunctionCategory JB
OUT ==> OutputForm
SEM ==> SparseEchelonMatrix(JB,$)
SEMD ==> SparseEchelonMatrix(JB,D)
SIMPREC ==> Record(Sys:L $, JM:SEM, Depend:Union("failed",L L NNI))
ROWREC ==> Record(Indices:L JB, Entries:L $)
LDREC ==> Record(Fun:$, JMR:ROWREC, Depend:L NNI)
POWREC ==> Record(val:$, exponent:I)
Const ==> "Const"::Sy
Indep ==> "Indep"::Sy
Dep ==> "Dep"::Sy
Deriv ==> "Deriv"::Sy
errmsg ==> "inconsistent system"
++ Description:
++ \axiomType{JetBundleXExpression} implements arbitrary functions in a jet
++ bundle which depend only on the independent variables \axiom{x}. Otherwise
++ it is identical with \axiomType{JetBundleExpression}. Such a domain is
++ needed for \axiomType{JetLinearFunction}.
JetBundleXExpression(JB:JBC) : Cat == Def where
errmsg ==> "Only functions of independent variables allowed"
Cat ==> Join(JBFC,BFC,FS,ACFS,TFC,COC,LFC,SFC) with
coerce : EI -> $
coerce : $ -> EI
retractIfCan : JBE -> Union($,"failed")
++ \axiom{retractIfCan(p)} checks whether \axiom{p} depends only on
++ the independent variables. If yes, it is coerced.
retract : JBE -> $
++ \axiom{retract(p)} is like \axiom{retractIfCan(p)} put yields a
++ hard error, if \axiom{p} contains further jet variables.
reduce : $ -> $
++ \axiom{reduce(x)} reduces the algebraics in \axiom{x}.
function : (Sy,L $) -> $
++ \axiom{function(f,arg)} generates a function with name \axiom{f}
++ and arguments \axiom{arg}.
Def ==> JBE add
Rep := JBE
coerce(jv:JB):$ ==
type(jv)^=Indep => error errmsg
coerce(jv)$JBE
retractIfCan(p:JBE):Union($,"failed") ==
reduce("and", [type(jv)=Indep for jv in jetVariables p], true) =>
p::Rep::$
"failed"
retract(p:JBE):$ ==
px:Union($,"failed") := retractIfCan(p)
px case "failed" => error errmsg
px::$
spad Compiling FriCAS source code from file
/var/zope2/var/LatexWiki/2822376641683221223-25px003.spad using
old system compiler.
JBX abbreviates domain JetBundleXExpression
processing macro definition M ==> Matrix
processing macro definition Sy ==> Symbol
processing macro definition PI ==> PositiveInteger
processing macro definition NNI ==> NonNegativeInteger
processing macro definition I ==> Integer
processing macro definition FI ==> Fraction Integer
processing macro definition B ==> Boolean
processing macro definition L ==> List
processing macro definition K ==> Kernel $
processing macro definition BOP ==> BasicOperator
processing macro definition SMP ==> SparseMultivariatePolynomial(I,K)
processing macro definition IE ==> IndexedExponents K
processing macro definition GB ==> GroebnerPackage(I,IE,K,SMP)
processing macro definition FLAF1 ==> FiniteLinearAggregateFunctions2($,L $,SMP,L SMP)
processing macro definition FLAF2 ==> FiniteLinearAggregateFunctions2(SMP,L SMP,$,L $)
processing macro definition EI ==> Expression Integer
processing macro definition FS ==> FunctionSpace Integer
processing macro definition ACFS ==> AlgebraicallyClosedFunctionSpace Integer
processing macro definition TFC ==> TranscendentalFunctionCategory
processing macro definition COC ==> CombinatorialOpsCategory
processing macro definition LFC ==> LiouvillianFunctionCategory
processing macro definition SFC ==> SpecialFunctionCategory
processing macro definition JBC ==> JetBundleCategory
processing macro definition JBE ==> JetBundleExpression JB
processing macro definition JBX ==> JetBundleXExpression JB
processing macro definition JBFC ==> JetBundleFunctionCategory JB
processing macro definition JP ==> SparseMultivariatePolynomial(EI,JB)
processing macro definition BFC ==> BaseFunctionCategory JB
processing macro definition OUT ==> OutputForm
processing macro definition SEM ==> SparseEchelonMatrix(JB,$)
processing macro definition SEMD ==> SparseEchelonMatrix(JB,D)
processing macro definition SIMPREC ==> Record(Sys: L $,JM: SEM,Depend: Union(failed,L L NNI))
processing macro definition ROWREC ==> Record(Indices: L JB,Entries: L $)
processing macro definition LDREC ==> Record(Fun: $,JMR: ROWREC,Depend: L NNI)
processing macro definition POWREC ==> Record(val: $,exponent: I)
processing macro definition Const ==> ::(Const,Sy)
processing macro definition Indep ==> ::(Indep,Sy)
processing macro definition Dep ==> ::(Dep,Sy)
processing macro definition Deriv ==> ::(Deriv,Sy)
processing macro definition errmsg ==> inconsistent system
processing macro definition inconsistent system ==> Only functions of independent variables allowed
processing macro definition Cat ==> -- the constructor category
processing macro definition Def ==> -- the constructor capsule
------------------------------------------------------------------------
initializing NRLIB JBX for JetBundleXExpression
compiling into NRLIB JBX
compiling exported coerce : JB -> $
Time: 0.18 SEC.
compiling exported retractIfCan : JetBundleExpression JB -> Union($,failed)
Time: 0.19 SEC.
compiling exported retract : JetBundleExpression JB -> $
Time: 0.08 SEC.
augmenting (Integer): (CharacteristicNonZero)
augmenting (Integer): (ConvertibleTo (Pattern (Float)))
augmenting (Integer): (Group)
augmenting (Integer): (PatternMatchable (Float))
(time taken in buildFunctor: 105)
;;; *** |JetBundleXExpression| REDEFINED
;;; *** |JetBundleXExpression| REDEFINED
Time: 1.28 SEC.
Cumulative Statistics for Constructor JetBundleXExpression
Time: 1.73 seconds
--------------non extending category----------------------
.. JetBundleXExpression #1 of cat
(|Join| (|JetBundleFunctionCategory| |#1|)
(|BaseFunctionCategory| |#1|) (|FunctionSpace| (|Integer|))
(|AlgebraicallyClosedFunctionSpace| (|Integer|))
(|TranscendentalFunctionCategory|) (|CombinatorialOpsCategory|)
(|LiouvillianFunctionCategory|) (|SpecialFunctionCategory|)
(CATEGORY |domain|
(SIGNATURE |coerce| ($ (|Expression| (|Integer|))))
(SIGNATURE |coerce| ((|Expression| (|Integer|)) $))
(SIGNATURE |retractIfCan|
((|Union| $ "failed") (|JetBundleExpression| |#1|)))
(SIGNATURE |retract| ($ (|JetBundleExpression| |#1|)))
(SIGNATURE |reduce| ($ $))
(SIGNATURE |function| ($ (|Symbol|) (|List| $))))) has no coerce : SparseMultivariatePolynomial(Expression Integer,#1) -> %
finalizing NRLIB JBX
Processing JetBundleXExpression for Browser database:
--->-->JetBundleXExpression((coerce ($ EI))): Not documented!!!!
--->-->JetBundleXExpression((coerce (EI $))): Not documented!!!!
--------(retractIfCan ((Union $ failed) JBE))---------
--------(retract ($ JBE))---------
--------(reduce ($ $))---------
--------(function ($ Sy (L $)))---------
--------constructor---------
------------------------------------------------------------------------
JetBundleXExpression is now explicitly exposed in frame initial
JetBundleXExpression will be automatically loaded when needed from
/var/zope2/var/LatexWiki/JBX.NRLIB/codeJetBundleLinearFunction (JBLF)
spad )abb domain JBLF JetBundleLinearFunction
M ==> Matrix
Sy ==> Symbol
PI ==> PositiveInteger
NNI ==> NonNegativeInteger
I ==> Integer
FI ==> Fraction Integer
B ==> Boolean
L ==> List
K ==> Kernel $
BOP ==> BasicOperator
SMP ==> SparseMultivariatePolynomial(I,K)
IE ==> IndexedExponents K
GB ==> GroebnerPackage(I,IE,K,SMP)
FLAF1 ==> FiniteLinearAggregateFunctions2($,L $,SMP,L SMP)
FLAF2 ==> FiniteLinearAggregateFunctions2(SMP,L SMP,$,L $)
EI ==> Expression Integer
FS ==> FunctionSpace Integer
ACFS ==> AlgebraicallyClosedFunctionSpace Integer
TFC ==> TranscendentalFunctionCategory
COC ==> CombinatorialOpsCategory
LFC ==> LiouvillianFunctionCategory
SFC ==> SpecialFunctionCategory
JBC ==> JetBundleCategory
JBE ==> JetBundleExpression JB
JBX ==> JetBundleXExpression JB
JBFC ==> JetBundleFunctionCategory JB
JP ==> SparseMultivariatePolynomial(EI,JB)
BFC ==> BaseFunctionCategory JB
OUT ==> OutputForm
SEM ==> SparseEchelonMatrix(JB,$)
SEMD ==> SparseEchelonMatrix(JB,D)
SIMPREC ==> Record(Sys:L $, JM:SEM, Depend:Union("failed",L L NNI))
ROWREC ==> Record(Indices:L JB, Entries:L $)
LDREC ==> Record(Fun:$, JMR:ROWREC, Depend:L NNI)
POWREC ==> Record(val:$, exponent:I)
Const ==> "Const"::Sy
Indep ==> "Indep"::Sy
Dep ==> "Dep"::Sy
Deriv ==> "Deriv"::Sy
errmsg ==> "inconsistent system"
++ Description:
++ \axiomType{JetBundleLinearFunction} implements linear functions over
++ a jet bundle. The coefficients are functions of the independent
++ variables only.
JetBundleLinearFunction(JB:JBC,D:BFC) : Cat == Def where
errmsg1 ==> "non-linear function"
errmsg2 ==> "Substitution for 1 not allowed"
Cat ==> Join(JBFC, Module D, RetractableTo D) with
if D has lazyRep then
lazyRep
coerce : D -> $
coerce : L $ -> SEMD
coerce : SEMD -> L $
++ coercion to matrices over ground domain.
ground? : $ -> B
++ \axiom{ground?(l)} yields true, if \axiom{l} is an element of the
++ ground domain \axiom{D}.
ground : $ -> $
++ \axiom{ground(l)} returns the ground part of \axiom{l}.
if D has with retractIfCan : JBE -> Union(D,"failed") then
retractIfCan : JBE -> Union($,"failed")
++ \axiom{retractIfCan(p)} tries to write a general expression as
++ a linear function.
retract : JBE -> $
++ \axiom{retract(p)} is like \axiom{retractIfCan(p)} put yields a
++ hard error, if \axiom{p} contains further jet variables.
Def ==> add
-- -------------- --
-- Representation --
-- -------------- --
-- The linear function is represented by two lists: the first contains
-- the coefficients, the second the jet variables. The second list is
-- always ordered.
Rep := Record(Coeffs:L D, JVars:L JB)
nn:PI := numIndVar()$JB
-- global constant for number of independent variables
monom(c:D,jv:JB):OUT ==
one? c => jv::OUT
one? jv => c::OUT
c::OUT * jv::OUT
coerce(l:$):OUT ==
zero? l => 0$NNI ::OUT
res:OUT := monom(first(l.Coeffs),first(l.JVars))
for c in rest l.Coeffs for jv in rest l.JVars repeat
res := res + monom(c,jv)
res
coerce(jv:JB):$ ==
jt := type jv
jt=Const => 1
jt=Indep => [[jv::D],[1]]
[[1],[jv]]
coerce(ex:D):$ ==
zero? ex => 0
[[ex],[1]]
coerce(jm:SEMD):L $ ==
res:L $ := empty
for i in 1..nrows(jm) repeat
r := row(jm,i)
if not empty? r.Indices then
res := cons([r.Entries,r.Indices], res)
reverse! res
coerce(ll:L $):SEMD ==
inds:L JB := empty
for l in ll repeat
inds := removeDuplicates! merge(">",inds,l.JVars)
res:SEMD := new(inds,#ll)
for l in ll for i in 1.. repeat
setRow!(res,i,l.JVars,l.Coeffs)
res
ground?(l:$):B == zero?(l) or one?(first l.JVars)
ground(l:$):$ ==
not member?(1$JB,l.JVars) => 0
[[last l.Coeffs],[1$JB]]
retractIfCan(l:$):Union(D,"failed") ==
zero? l => 0$D
one?(first l.JVars)$JB => first l.Coeffs
"failed"
numerator(l:$):$ == l
denominator(l:$):$ == 1
if D has with retractIfCan : JBE -> Union(D,"failed") then
retractIfCan(ex:JBE):Union($,"failed") ==
pd := retractIfCan(ex)$D
pd case D => [[pd::D],[1$JB]]
resJ := jetVariables ex
resC:L D := empty
for jv in resJ repeat
cd := retractIfCan(differentiate(ex,jv))$D
cd case "failed" => return "failed"
resC := cons(cd::D,resC)
[reverse! resC,resJ]
retract(ex:JBE):$ ==
pl:Union($,"failed") := retractIfCan ex
pl case "failed" => error errmsg1
pl::$
-- -------- --
-- Equality --
-- -------- --
zero?(l:$):B == empty? l.JVars
l1:$ = l2:$ == zero?(l1-l2)
-- ----------- --
-- Arithmetics --
-- ----------- --
0:$ == [[],[]]
1:$ == [[1],[1]]
- l:$ == [[-$D c for c in l.Coeffs], l.JVars]
l1:$ + l2:$ ==
zero? l1 => l2
zero? l2 => l1
lc2 := copy l2.Coeffs
lj2 := copy l2.JVars
resC:L D := empty
resJ:L JB := empty
for c1 in l1.Coeffs for j1 in l1.JVars repeat
while not empty?(lj2) and first(lj2)>j1 repeat
resC := cons(first lc2, resC)
resJ := cons(first lj2, resJ)
lc2 := rest lc2
lj2 := rest lj2
if not empty?(lj2) and first(lj2)=j1 then
sum := c1 +$D first lc2
if not zero? sum then
resC := cons(sum,resC)
resJ := cons(j1,resJ)
lc2 := rest lc2
lj2 := rest lj2
else
resC := cons(c1,resC)
resJ := cons(j1,resJ)
[concat!(reverse! resC,lc2), concat!(reverse! resJ,lj2)]
i:I * l:$ ==
zero? i => 0
one? i => l
[[i *$D c for c in l.Coeffs], l.JVars]
ex:D * l:$ ==
zero? ex => 0
one? ex => l
[[ex *$D c for c in l.Coeffs], l.JVars]
l1:$ * l2:$ ==
zero? l1 or zero? l2 => 0
l1.JVars = [1] => first(l1.Coeffs)*l2
l2.JVars = [1] => first(l2.Coeffs)*l1
error errmsg1
recip(l:$):Union($,"failed") ==
l.JVars = [1] =>
rc := recip(first(l.Coeffs))$D
rc case D => rc::D::$
"failed"
"failed"
-- The following two functions are currently only for simple cases
-- implemented. This suffices, however, for the needs of simplify!
l1:$ exquo l2:$ ==
not one? first l2.JVars => "failed"
d := first l2.Coeffs
newC:L D := empty
for c in l1.Coeffs repeat
e := c exquo d
e case "failed" => return "failed"
newC := cons(e,newC)
[reverse! newC, l1.JVars]
gcd(l1:$,l2:$):$ ==
(#l1.JVars>1) or (#l2.JVars>1) => 1
g := gcd(first l1.Coeffs, first l2.Coeffs)
first(l1.JVars)=first(l2.JVars) => [[g],l1.JVars]
g::$
-- -------------- --
-- JBFC Functions --
-- -------------- --
jetVariables(l:$):L JB ==
zero? l => []
res:L JB := empty
for c in l.Coeffs repeat
res := merge(">", res, jetVariables c)
res := removeDuplicates! res
if member?(1,l.JVars) then
res := concat!(remove(1,l.JVars),res)
else
res := append(l.JVars, res)
res
differentiate(l:$,s:Sy):$ ==
-- No check whether symbol might be a jet variable!!!
resC:L D := empty
resJ:L JB := empty
for c in l.Coeffs for j in l.JVars repeat
dc := differentiate(c,s)$D
if not zero? dc then
resC := cons(dc,resC)
resJ := cons(j,resJ)
[reverse! resC, reverse! resJ]
differentiate(l:$,jv:JB):$ ==
jt := type jv
jt=Indep =>
resC:L D := empty
resJ:L JB := empty
for c in l.Coeffs for j in l.JVars repeat
dc := differentiate(c,jv)$D
if not zero? dc then
resC := cons(dc,resC)
resJ := cons(j,resJ)
[reverse! resC, reverse! resJ]
pos := position(jv,l.JVars)
pos<minIndex(l.JVars) => 0
[[qelt(l.Coeffs,pos)],[1]]
jacobiMatrix(sys:L $):SEM ==
inds:L JB := empty
cinds:L JB := empty
for eq in sys repeat
inds := removeDuplicates! merge(">",inds,eq.JVars)
while #cinds<nn for co in eq.Coeffs repeat
cinds := removeDuplicates! merge(">",cinds,jetVariables(co)$D)
empty? cinds => -- constant coefficients
res:SEM := new(inds,#sys)
for eq in sys for i in 1.. repeat
setRow!(res, i, eq.JVars, [co::$ for co in eq.Coeffs])
res
res:SEM := new(append(inds,cinds),#sys)
for eq in sys for i in 1.. repeat
ents := [co::$ for co in eq.Coeffs]
rowJ:L JB := empty
rowC:L $ := empty
for cjv in cinds repeat
dJV:L JB := empty
dCo:L D := empty
for co in eq.Coeffs for jv in eq.JVars repeat
dco := differentiate(co,cjv)$D
if not zero? dco then
dJV := cons(jv,dJV)
dCo := cons(dco,dCo)
if not empty? dJV then
rowJ := cons(cjv,rowJ)
rowC := cons([reverse! dCo, reverse! dJV], rowC)
setRow!(res, i, append(eq.JVars, reverse! rowJ), _
append(ents, reverse! rowC))
res
jacobiMatrix(sys:L $,varlist:L L JB):SEM ==
inds := first varlist
for vars in rest varlist repeat
inds := removeDuplicates! merge(">",inds,vars)
res:SEM := new(inds,#sys)
for eq in sys for vars in varlist for i in 1.. repeat
ents := [co::$ for co in eq.Coeffs]
ivars := sort!("<",select(type(#1)=Indep,vars))
if empty? ivars then
setRow!(res,i,eq.JVars,ents)
else
rowJ:L JB := empty
rowC:L $ := empty
for ijv in ivars repeat
dJV:L JB := empty
dCo:L D := empty
for co in eq.Coeffs for jv in eq.JVars repeat
dco := differentiate(co,ijv)$D
if not zero? dco then
dJV := cons(jv,dJV)
dCo := cons(dco,dCo)
if not empty? dJV then
rowJ := cons(ijv,rowJ)
rowC := cons([reverse! dCo, reverse! dJV], rowC)
setRow!(res, i, append(eq.JVars, reverse! rowJ), _
append(ents, reverse! rowC))
res
-- -------------- --
-- Simplification --
-- -------------- --
leadingDer(l:$):JB ==
zero? l => 1
first l.JVars
freeOf?(l:$,jv:JB):B ==
type(jv)=Indep =>
reduce("and",[freeOf?(c,jv)$D for c in l.Coeffs],true)
not member?(jv,l.JVars)
solveFor(l:$,jv:JB):Union($,"failed") ==
-- Solving for independent variables not supported!
jt := type jv
jt=Const or jt=Indep => "failed"
pos := position(jv,l.JVars)
pos<minIndex(l.JVars) => "failed"
one?(#l.JVars) => 0
rc := recip(l.Coeffs.pos)$D
rc case "failed" => "failed"
[[-c*rc for c in delete(l.Coeffs,pos)], delete(l.JVars,pos)]
subst(l:$,jv:JB,exp:$):$ ==
-- Syntactic substitution.
jt := type jv
jt=Const => error errmsg2
jt=Indep => -- substitution in coefficients
xexp:D := retract exp
resC:L D := empty
resJ:L JB := empty
for c in l.Coeffs for cj in l.JVars repeat
nc := subst(c,jv,xexp)$D
if not zero? nc then
resC := cons(nc,resC)
resJ := cons(cj,resJ)
[reverse! resC, reverse! resJ]
pos := position(jv,l.JVars) -- substitution in jet variables
zero? pos => l
c := qelt(l.Coeffs,pos)
nl:$ := [delete(l.Coeffs,pos),delete(l.JVars,pos)]
nl + c*exp
simplify(sys:L $,jm:SEM):SIMPREC ==
one?(#sys) => [sys,jm,[[1]]]
-- make system triangular
RRec := primitiveRowEchelon(sys::SEMD)$SEMD
newSys := RRec.Ech::L $
Trafo := RRec.Lt
minR := minRowIndex Trafo
maxR := maxRowIndex Trafo
-- construct new Jacobi matrix and build dependency list
inds := allIndices jm
cinds := copy inds
while not(empty? cinds) and (type(first cinds)^=Indep) repeat
cinds := rest cinds
if not empty? cinds then
cinds := reverse! cinds
newJM:SEM := new(inds,#newSys)
dep:L L NNI := empty
for eq in newSys for j in 1.. repeat
if empty? cinds then -- constant coefficients
setRow!(newJM, j, eq.JVars, [co::$ for co in eq.Coeffs])
else -- non-constant coefficients
ents := [co::$ for co in eq.Coeffs]
rowJ:L JB := empty
rowC:L $ := empty
for cjv in cinds repeat
dJV:L JB := empty
dCo:L D := empty
for co in eq.Coeffs for jv in eq.JVars repeat
dco := differentiate(co,cjv)$D
if not zero? dco then
dJV := cons(jv,dJV)
dCo := cons(dco,dCo)
if not empty? dJV then
rowJ := cons(cjv,rowJ)
rowC := cons([reverse! dCo, reverse! dJV], rowC)
setRow!(newJM, j, append(eq.JVars, reverse! rowJ), _
append(ents, reverse! rowC))
depj:L NNI := empty
for k in maxR..minR by -1 repeat
kb := k+minIndex(sys)-minR
if not zero? qelt(Trafo,j,k) then
depj := cons((k-minR+minIndex(depj))::NNI,depj)
dep := cons(depj,dep)
[newSys, newJM, reverse! dep]
simpOne(f:$):$ ==
one?(#(f.JVars)) => [[1],f.JVars]
f
spad Compiling FriCAS source code from file
/var/zope2/var/LatexWiki/8557647151564589062-25px004.spad using
old system compiler.
JBLF abbreviates domain JetBundleLinearFunction
processing macro definition M ==> Matrix
processing macro definition Sy ==> Symbol
processing macro definition PI ==> PositiveInteger
processing macro definition NNI ==> NonNegativeInteger
processing macro definition I ==> Integer
processing macro definition FI ==> Fraction Integer
processing macro definition B ==> Boolean
processing macro definition L ==> List
processing macro definition K ==> Kernel $
processing macro definition BOP ==> BasicOperator
processing macro definition SMP ==> SparseMultivariatePolynomial(I,K)
processing macro definition IE ==> IndexedExponents K
processing macro definition GB ==> GroebnerPackage(I,IE,K,SMP)
processing macro definition FLAF1 ==> FiniteLinearAggregateFunctions2($,L $,SMP,L SMP)
processing macro definition FLAF2 ==> FiniteLinearAggregateFunctions2(SMP,L SMP,$,L $)
processing macro definition EI ==> Expression Integer
processing macro definition FS ==> FunctionSpace Integer
processing macro definition ACFS ==> AlgebraicallyClosedFunctionSpace Integer
processing macro definition TFC ==> TranscendentalFunctionCategory
processing macro definition COC ==> CombinatorialOpsCategory
processing macro definition LFC ==> LiouvillianFunctionCategory
processing macro definition SFC ==> SpecialFunctionCategory
processing macro definition JBC ==> JetBundleCategory
processing macro definition JBE ==> JetBundleExpression JB
processing macro definition JBX ==> JetBundleXExpression JB
processing macro definition JBFC ==> JetBundleFunctionCategory JB
processing macro definition JP ==> SparseMultivariatePolynomial(EI,JB)
processing macro definition BFC ==> BaseFunctionCategory JB
processing macro definition OUT ==> OutputForm
processing macro definition SEM ==> SparseEchelonMatrix(JB,$)
processing macro definition SEMD ==> SparseEchelonMatrix(JB,D)
processing macro definition SIMPREC ==> Record(Sys: L $,JM: SEM,Depend: Union(failed,L L NNI))
processing macro definition ROWREC ==> Record(Indices: L JB,Entries: L $)
processing macro definition LDREC ==> Record(Fun: $,JMR: ROWREC,Depend: L NNI)
processing macro definition POWREC ==> Record(val: $,exponent: I)
processing macro definition Const ==> ::(Const,Sy)
processing macro definition Indep ==> ::(Indep,Sy)
processing macro definition Dep ==> ::(Dep,Sy)
processing macro definition Deriv ==> ::(Deriv,Sy)
processing macro definition errmsg ==> inconsistent system
processing macro definition errmsg1 ==> non-linear function
processing macro definition errmsg2 ==> Substitution for 1 not allowed
processing macro definition Cat ==> -- the constructor category
processing macro definition Def ==> -- the constructor capsule
------------------------------------------------------------------------
initializing NRLIB JBLF for JetBundleLinearFunction
compiling into NRLIB JBLF
compiling local monom : (D,JB) -> OutputForm
Time: 0.21 SEC.
compiling exported coerce : $ -> OutputForm
Time: 0.07 SEC.
compiling exported coerce : JB -> $
Time: 0.08 SEC.
compiling exported coerce : D -> $
Time: 0.06 SEC.
compiling exported coerce : SparseEchelonMatrix(JB,D) -> List $
Time: 0.20 SEC.
compiling exported coerce : List $ -> SparseEchelonMatrix(JB,D)
Time: 0.17 SEC.
compiling exported ground? : $ -> Boolean
Time: 0.04 SEC.
compiling exported ground : $ -> $
Time: 0.06 SEC.
compiling exported retractIfCan : $ -> Union(D,failed)
Time: 0.06 SEC.
compiling exported numerator : $ -> $
JBLF;numerator;2$;10 is replaced by l
Time: 0.01 SEC.
compiling exported denominator : $ -> $
Time: 0 SEC.
augmenting D: (SIGNATURE D retractIfCan ((Union D failed) (JetBundleExpression JB)))
augmenting $: (SIGNATURE $ retractIfCan ((Union $ failed) (JetBundleExpression JB)))
augmenting $: (SIGNATURE $ retract ($ (JetBundleExpression JB)))
compiling exported retractIfCan : JetBundleExpression JB -> Union($,failed)
Time: 0.17 SEC.
compiling exported retract : JetBundleExpression JB -> $
Time: 0.06 SEC.
compiling exported zero? : $ -> Boolean
Time: 0.02 SEC.
compiling exported = : ($,$) -> Boolean
Time: 0 SEC.
compiling exported Zero : () -> $
JBLF;Zero;$;16 is replaced by CONS
Time: 0.05 SEC.
compiling exported One : () -> $
Time: 0.05 SEC.
compiling exported - : $ -> $
Time: 0.04 SEC.
compiling exported + : ($,$) -> $
Time: 0.22 SEC.
compiling exported * : (Integer,$) -> $
Time: 0.06 SEC.
compiling exported * : (D,$) -> $
Time: 0.07 SEC.
compiling exported * : ($,$) -> $
Time: 0.31 SEC.
compiling exported recip : $ -> Union($,failed)
Time: 0.21 SEC.
compiling exported exquo : ($,$) -> Union($,failed)
Time: 0.11 SEC.
compiling exported gcd : ($,$) -> $
Time: 0.10 SEC.
compiling exported jetVariables : $ -> List JB
Time: 0.08 SEC.
compiling exported differentiate : ($,Symbol) -> $
Time: 0.10 SEC.
compiling exported differentiate : ($,JB) -> $
Time: 0.25 SEC.
compiling exported jacobiMatrix : List $ -> SparseEchelonMatrix(JB,$)
Time: 0.27 SEC.
compiling exported jacobiMatrix : (List $,List List JB) -> SparseEchelonMatrix(JB,$)
Time: 0.48 SEC.
compiling exported leadingDer : $ -> JB
Time: 0.02 SEC.
compiling exported freeOf? : ($,JB) -> Boolean
Time: 0.21 SEC.
compiling exported solveFor : ($,JB) -> Union($,failed)
Time: 0.14 SEC.
compiling exported subst : ($,JB,$) -> $
Time: 0.12 SEC.
compiling exported simplify : (List $,SparseEchelonMatrix(JB,$)) -> Record(Sys: List $,JM: SparseEchelonMatrix(JB,$),Depend: Union(failed,List List NonNegativeInteger))
Time: 1.18 SEC.
compiling exported simpOne : $ -> $
Time: 0.08 SEC.
augmenting D: (SIGNATURE D retractIfCan ((Union D failed) (JetBundleExpression JB)))
augmenting $: (SIGNATURE $ retractIfCan ((Union $ failed) (JetBundleExpression JB)))
augmenting $: (SIGNATURE $ retract ($ (JetBundleExpression JB)))
(time taken in buildFunctor: 0)
;;; *** |JetBundleLinearFunction| REDEFINED
;;; *** |JetBundleLinearFunction| REDEFINED
Time: 0.01 SEC.
Warnings:
[1] coerce: res has no value
[2] +: resC has no value
[3] +: resJ has no value
[4] differentiate: resC has no value
[5] differentiate: resJ has no value
[6] jacobiMatrix: dJV has no value
[7] jacobiMatrix: dCo has no value
[8] jacobiMatrix: rowJ has no value
[9] jacobiMatrix: rowC has no value
[10] subst: resC has no value
[11] subst: resJ has no value
[12] simplify: dJV has no value
[13] simplify: dCo has no value
[14] simplify: rowJ has no value
[15] simplify: rowC has no value
[16] simplify: depj has no value
Cumulative Statistics for Constructor JetBundleLinearFunction
Time: 5.37 seconds
finalizing NRLIB JBLF
Processing JetBundleLinearFunction for Browser database:
--->-->JetBundleLinearFunction((coerce ($ D))): Not documented!!!!
--->-->JetBundleLinearFunction((coerce (SEMD (L $)))): Not documented!!!!
--------(coerce ((L $) SEMD))---------
--->-->JetBundleLinearFunction((coerce ((L $) SEMD))): Improper first word in comments: coercion
"coercion to matrices over ground domain."
--------(ground? (B $))---------
--------(ground ($ $))---------
--->-->JetBundleLinearFunction((retractIfCan ((Union D failed) JBE))): Not documented!!!!
--------(retractIfCan ((Union $ failed) JBE))---------
--------(retract ($ JBE))---------
--->-->JetBundleLinearFunction((retractIfCan ((Union D failed) JBE))): Not documented!!!!
--------constructor---------
------------------------------------------------------------------------
JetBundleLinearFunction is now explicitly exposed in frame initial
JetBundleLinearFunction will be automatically loaded when needed
from /var/zope2/var/LatexWiki/JBLF.NRLIB/code
|