From aa7596b4fc365c30e51fb4a1088186d5a8dd6218 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Sat, 29 Aug 2015 06:04:04 -0400 Subject: [PATCH] books/bookvol10.4 add signatures to all package functions Goal: Proving Axiom Correct For every function in the packages add the signature of the function to the COQ extract. --- books/bookvol10.4.pamphlet | 9009 +++++++++++++++++++++++++++++----------- changelog | 2 + patch | 8 +- src/axiom-website/patches.html | 2 + 4 files changed, 6661 insertions(+), 2360 deletions(-) diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index b91d68b..05590ae 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -255,8 +255,6 @@ AffineAlgebraicSetComputeWithGroebnerBasis(K,symb,PolyRing,E,ProjPt):Exports_ OV2 ==> OrderedVariableList(ss2) InGB ==> InterfaceGroebnerPackage(K,ss2,LexE,OV2,DD) - affineAlgSetLocal : List DD -> _ - Union(List(ProjPt),"failed","Infinite",Integer) import PPFC1 import PolyRing @@ -264,43 +262,26 @@ AffineAlgebraicSetComputeWithGroebnerBasis(K,symb,PolyRing,E,ProjPt):Exports_ listVar:List(OV):= [index(i::PI)$OV for i in 1..#symb] - polyToYX1 : PolyRing -> DD - -- NOTE : polyToYX1 set the last variable to 1 and swap the 1st and 2nd var - -- so that a call to grobner will eliminate the second var before the - -- first one - -- 23/10/98 : Ce n'est plus vrai. La fonction a ete "repare'". - -- A priori ce la ne creait pas de bug, car on tenait compte de - -- cette particulariite dans la fonction affineAlgSetLocal. - -- cette derniere fct a aussi ete "ajuste'" - -- 27/10/98 - -- Ce n'est pas vraie !!! Il fauit trouve X d'abord et ensuite Y !! - -- sinon tout sr la notion de places distinguee fout le camp !!! - - polyToX10 : PolyRing -> SUP(K) --fonctions de resolution de sys. alg. de dim 0 if K has FiniteFieldCategory then + affineRationalPoints : (PolyRing,PositiveInteger) -> List(ProjPt) affineRationalPoints(crv:PolyRing,extdegree:PI):List(ProjPt) == --The code of this is almost the same as for algebraicSet --We could just construct the ideal and call algebraicSet --Should we do that? This might be a bit faster. - listPtsIdl:List(ProjPt):= empty() - x:= monomial(1,directProduct(vector([1,0])$Vector(NNI)))$DD y:= monomial(1,directProduct(vector([0,1])$Vector(NNI)))$DD - if K has PseudoAlgebraicClosureOfFiniteFieldCategory then setTower!(1$K)$K q:= size()$K px:= x**(q**extdegree) - x py:= y**(q**extdegree) - y - crvXY1 := polyToYX1 crv rpts:= affineAlgSetLocal([crvXY1,px,py]) - -- si les 3 tests qui suivent ne sont pas la, -- alors ca ne compile pas !!! ??? rpts case "failed" =>_ @@ -312,17 +293,23 @@ AffineAlgebraicSetComputeWithGroebnerBasis(K,symb,PolyRing,E,ProjPt):Exports_ rpts case List(ProjPt) => rpts error "Unknown: From affineRationalPoints in AFALGGRO," + affineSingularPoints : PolyRing -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineSingularPoints(crb)== F:= polyToYX1 crb Fx:=differentiate(F,index(1)$OV2) Fy:=differentiate(F,index(2)$OV2) affineAlgSetLocal([F,Fx,Fy]) + affineAlgSet : List(PolyRing) -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineAlgSet(ideal : List PolyRing )== idealXY1 := [polyToYX1 pol for pol in ideal] affineAlgSetLocal idealXY1 --fonctions de resolution de sys. alg. de dim 0 + affineAlgSetLocal : List DD -> _ + Union(List(ProjPt),"failed","Infinite",Integer) affineAlgSetLocal(idealToXY1:List DD ) == listPtsIdl:List(ProjPt) idealGroXY1:=groebner(idealToXY1)$InGB @@ -358,6 +345,17 @@ AffineAlgebraicSetComputeWithGroebnerBasis(K,symb,PolyRing,E,ProjPt):Exports_ degExt listPtsIdl + -- NOTE : polyToYX1 set the last variable to 1 and swap the 1st and 2nd var + -- so that a call to grobner will eliminate the second var before the + -- first one + -- 23/10/98 : Ce n'est plus vrai. La fonction a ete "repare'". + -- A priori ce la ne creait pas de bug, car on tenait compte de + -- cette particulariite dans la fonction affineAlgSetLocal. + -- cette derniere fct a aussi ete "ajuste'" + -- 27/10/98 + -- Ce n'est pas vraie !!! Il fauit trouve X d'abord et ensuite Y !! + -- sinon tout sr la notion de places distinguee fout le camp !!! + polyToYX1 : PolyRing -> DD polyToYX1(pol)== zero?(pol) => 0 dd:= degree pol @@ -368,6 +366,7 @@ AffineAlgebraicSetComputeWithGroebnerBasis(K,symb,PolyRing,E,ProjPt):Exports_ eppr:=directProduct(ppv)$LexE monomial(lc,eppr)$DD + polyToYX1 reductum pol + polyToX10 : PolyRing -> SUP(K) polyToX10(pol)== zero?(pol) => 0 dd:= degree pol @@ -599,13 +598,14 @@ AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt):Ex==Impl where import ProjPt evAtcoef: (UPUP,K) -> SUP(K) - evAtcoef(pol,a)== zero?(pol) => 0 dd:= degree pol lc:= leadingCoefficient pol monomial( lc(a), dd )$SUP(K) + evAtcoef( reductum(pol), a ) + polyRing2UPUP : PolyRing -> _ + SparseUnivariatePolynomial(SparseUnivariatePolynomial(K)) polyRing2UPUP(pol)== zero?(pol) => 0 dd:= degree pol @@ -615,6 +615,8 @@ AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt):Ex==Impl where if K has FiniteFieldCategory then + affineRationalPoints : (PolyRing,PositiveInteger) -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineRationalPoints(crv:PolyRing,extdegree:PositiveInteger) == listPtsIdl:List(ProjPt):= empty() x:= monomial(1,directProduct(vector([1,0,0])$Vector(NNI)))$PolyRing @@ -636,6 +638,9 @@ AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt):Ex==Impl where rpts case List(ProjPt) => rpts error "case unknown: From affineRationalPoints in AFALGRES" + allPairsAmong : _ + List(SparseUnivariatePolynomial(SparseUnivariatePolynomial(K))) -> _ + List(List(SparseUnivariatePolynomial(SparseUnivariatePolynomial(K)))) allPairsAmong(lp)== #lp = 2 => [lp] rlp:=rest lp @@ -644,9 +649,14 @@ AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt):Ex==Impl where frontL:= [[pol,p] for p in rlp] concat( frontL , subL ) + affineSingularPoints : PolyRing -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineSingularPoints(pol:PolyRing)== affineSingularPoints( polyRing2UPUP pol ) + affineSingularPoints : _ + SparseUnivariatePolynomial(SparseUnivariatePolynomial(K)) -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineSingularPoints(pol:UPUP)== ground? pol => "failed" lc := coefficients pol @@ -662,9 +672,14 @@ AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt):Ex==Impl where h:= last lp resultant(g,h) + affineAlgSet : List(PolyRing) -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineAlgSet(lpol:List PolyRing)== affineAlgSetLocal( [ polyRing2UPUP pol for pol in lpol ] ) + affineAlgSetLocal : _ + List(SparseUnivariatePolynomial(SparseUnivariatePolynomial(K))) -> _ + Union(List(ProjPt),"failed",Infinite,Integer) affineAlgSetLocal(lpol:List UPUP)== listPtsIdl:List(ProjPt) allP:= allPairsAmong lpol @@ -1023,18 +1038,16 @@ AlgebraicFunction(R, F): Exports == Implementation where (* package AF *) (* - ialg : List F -> F - dvalg: (List F, SE) -> F - dalg : List F -> OutputForm - opalg := operator("rootOf"::Symbol)$CommonOperators oproot := operator("nthRoot"::Symbol)$CommonOperators belong? op == has?(op, ALGOP) - dalg l == second(l)::OutputForm + dalg : List F -> OutputForm + dalg l == second(l)::OutputForm + rootOf : (SparseUnivariatePolynomial(F),Symbol) -> F rootOf(p, x) == k := kernel(x)$K (r := retractIfCan(p)@Union(F, "failed")) case "failed" => @@ -1043,34 +1056,37 @@ AlgebraicFunction(R, F): Exports == Implementation where degree denom f > 0 => error "roofOf: variable appears in denom" inrootof(n, k::F) + dvalg: (List F, SE) -> F dvalg(l, x) == p := numer univariate(first l, retract(second l)@K) alpha := kernel(opalg, l) - (map((s:F):F +-> differentiate(s, x), p) alpha)_ / ((differentiate p) alpha) + ialg : List F -> F ialg l == f := univariate(p := first l, retract(x := second l)@K) degree denom f > 0 => error "roofOf: variable appears in denom" inrootof(numer f, x) + operator : BasicOperator -> BasicOperator operator op == is?(op, "rootOf"::Symbol) => opalg is?(op, "nthRoot"::Symbol) => oproot error "Unknown operator" if R has AlgebraicallyClosedField then - UP2R: UP -> Union(UPR, "failed") + inrootof : (SparseUnivariatePolynomial(F),F) -> F inrootof(q, x) == monomial? q => 0 - (d := degree q) <= 0 => error "rootOf: constant polynomial" (d = 1) => - leadingCoefficient(reductum q) / leadingCoefficient q ((rx := retractIfCan(x)@Union(SE, "failed")) case SE) and ((r := UP2R q) case UPR) => rootOf(r::UPR, rx::SE)::F kernel(opalg, [q x, x]) + UP2R: UP -> Union(UPR, "failed") UP2R p == ans:UPR := 0 while p ^= 0 repeat @@ -1082,6 +1098,7 @@ AlgebraicFunction(R, F): Exports == Implementation where else + inrootof : (SparseUnivariatePolynomial(F),F) -> F inrootof(q, x) == monomial? q => 0 (d := degree q) <= 0 => error "rootOf: constant polynomial" @@ -1089,37 +1106,39 @@ AlgebraicFunction(R, F): Exports == Implementation where kernel(opalg, [q x, x]) evaluate(opalg, ialg)$BasicOperatorFunctions1(F) + setProperty(opalg, SPECIALDIFF, dvalg@((List F, SE) -> F) pretend None) + setProperty(opalg, SPECIALDISP, dalg@(List F -> OutputForm) pretend None) if R has RetractableTo Integer then + import PolynomialRoots(IndexedExponents K, K, R, P, F) dumvar := "%%var"::Symbol::F - lzero : List F -> F - dvroot : List F -> F - inroot : List F -> F - hackroot: (F, Z) -> F - inroot0 : (F, Z, Boolean, Boolean) -> F - + lzero : List F -> F lzero l == 0 + droot : List(F) -> OutputForm droot l == x := first(l)::OutputForm (n := retract(second l)@Z) = 2 => root x root(x, n::OutputForm) + dvroot : List F -> F dvroot l == n := retract(second l)@Z (first(l) ** ((1 - n) / n)) / (n::F) + ?**? : (F,Fraction(Integer)) -> F if R has RETRACT(INT) x ** q == qr := divide(numer q, denom q) x ** qr.quotient * inroot([x, (denom q)::F]) ** qr.remainder + hackroot: (F, Z) -> F hackroot(x, n) == (n = 1) or (x = 1) => x (((dx := denom x) ^= 1) and @@ -1130,6 +1149,7 @@ AlgebraicFunction(R, F): Exports == Implementation where ((-1::F) ** (1::Q / 2::Q) + 1) / ((2::F) ** (1::Q / 2::Q)) kernel(oproot, [x, n::F]) + inroot : List F -> F inroot l == zero?(n := retract(second l)@Z) => error "root: exponent = 0" ((x := first l) = 1) or (n = 1) => x @@ -1143,6 +1163,7 @@ AlgebraicFunction(R, F): Exports == Implementation where -- removes powers of positive integers from numer and denom -- num? or den? is true if numer or denom already processed + inroot0 : (F, Z, Boolean, Boolean) -> F inroot0(x, n, num?, den?) == rn:Union(Z, "failed") := (num? => "failed"; retractIfCan numer x) rd:Union(Z, "failed") := (den? => "failed"; retractIfCan denom x) @@ -1160,27 +1181,40 @@ AlgebraicFunction(R, F): Exports == Implementation where n, num?, true) / rec.coef hackroot(x, n) - if R has AlgebraicallyClosedField then iroot(r, n) == nthRoot(r, n)::F - else + if R has AlgebraicallyClosedField + then - iroot0: (R, Z) -> F + iroot : (R,Integer) -> F + iroot(r, n) == nthRoot(r, n)::F + + else if R has RadicalCategory then - if R has imaginary:() -> R then iroot(r, n) == nthRoot(r, n)::F + + if R has imaginary:() -> R + then + + iroot : (R,Integer) -> F + iroot(r, n) == nthRoot(r, n)::F + else + iroot : (R,Integer) -> F iroot(r, n) == odd? n or r >= 0 => nthRoot(r, n)::F iroot0(r, n) else + iroot : (R,Integer) -> F iroot(r, n) == iroot0(r, n) + iroot0: (R, Z) -> F iroot0(r, n) == rec := rroot(r, n::NonNegativeInteger) rec.coef * hackroot(rec.radicand, rec.exponent) + definingPolynomial : F -> F definingPolynomial x == (r := retractIfCan(x)@Union(K, "failed")) case K => is?(k := r::K, opalg) => first argument k @@ -1189,6 +1223,7 @@ AlgebraicFunction(R, F): Exports == Implementation where dumvar - x dumvar - x + minPoly : Kernel(F) -> SparseUnivariatePolynomial(F) minPoly k == is?(k, opalg) => numer univariate(first argument k, @@ -1199,15 +1234,18 @@ AlgebraicFunction(R, F): Exports == Implementation where monomial(1, 1) - k::F::UP evaluate(oproot, inroot)$BasicOperatorFunctions1(F) + derivative(oproot, [dvroot, lzero]) else -- R is not retractable to Integer + droot : List(F) -> OutputForm droot l == x := first(l)::OutputForm (n := second l) = 2::F => root x root(x, n::OutputForm) + minPoly : Kernel(F) -> SparseUnivariatePolynomial(F) minPoly k == is?(k, opalg) => numer univariate(first argument k, @@ -1354,10 +1392,9 @@ AlgebraicHermiteIntegration(F,UP,UPUP,R):Exports == Implementation where (* package INTHERAL *) (* - localsolve: (Matrix UP, Vector UP, UP) -> Vector UP - -- the denominator of f should have no prime factor P s.t. P | P' -- (which happens only for P = t in the exponential case) + HermiteIntegrate : (R,(UP -> UP)) -> Record(answer: R,logpart: R) HermiteIntegrate(f, derivation) == ratform:R := 0 n := rank() @@ -1382,6 +1419,7 @@ AlgebraicHermiteIntegration(F,UP,UPUP,R):Exports == Implementation where iden := u * v [ratform, integralRepresents(inum, iden)] + localsolve: (Matrix UP, Vector UP, UP) -> Vector UP localsolve(mat, vec, modulus) == ans:Vector(UP) := new(nrows mat, 0) diagonal? mat => @@ -1782,26 +1820,6 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R0, SparseMultivariatePolynomial(R0, K), F) - F2R : F -> R - F2UPR : F -> UPR - UP2SUP : UP -> SUP - SUP2UP : SUP -> UP - UPQ2F : UPQ -> UP - univ : (F, K) -> QF - pLogDeriv : (LOG, R -> R) -> R - nonLinear : List FAC -> Union(FAC, "failed") - mkLog : (UP, Q, R, F) -> List LOG - R2UP : (R, K) -> UPR - alglogint : (R, UP -> UP) -> Union(List LOG, "failed") - palglogint : (R, UP -> UP) -> Union(List LOG, "failed") - trace00 : (DIV, UP, List LOG) -> Union(List LOG,"failed") - trace0 : (DIV, UP, Q, FD) -> Union(List LOG, "failed") - trace1 : (DIV, UP, List Q, List FD, Q) -> Union(List LOG, "failed") - nonQ : (DIV, UP) -> Union(List LOG, "failed") - rlift : (F, K, K) -> R - varRoot? : (UP, F -> F) -> Boolean - algintexp : (R, UP -> UP) -> IR - algintprim : (R, UP -> UP) -> IR dummy:R := 0 @@ -1809,10 +1827,13 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where dumy := kernel(new()$SE)$K + F2UPR : F -> UPR F2UPR f == F2R(f)::UPR + F2R : F -> R F2R f == f::UP::QF::R + algintexp : (R, UP -> UP) -> IR algintexp(f, derivation) == d := (c := integralCoordinates f).den v := c.num @@ -1832,6 +1853,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where zero? p => mkAnswer(h.answer, u::List(LOG), empty()) FAIL3 + algintprim : (R, UP -> UP) -> IR algintprim(f, derivation) == h := HermiteIntegrate(f, derivation) zero?(h.logpart) => h.answer::IR @@ -1841,6 +1863,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where -- checks whether f = +/[ci (ui)'/(ui)] -- f dx must have no pole at infinity + palglogint : (R, UP -> UP) -> Union(List LOG, "failed") palglogint(f, derivation) == rec := algSplitSimple(f, derivation) ground?(r := doubleResultant(f, derivation)) => "failed" @@ -1869,20 +1892,25 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where trace0(rec, pp, g / cd.den, dv0) trace1(rec, pp, la, ld, bb) + UPQ2F : UPQ -> UP UPQ2F p == map((x:Q):F+->x::F,p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP) + UP2SUP : UP -> SUP UP2SUP p == map((x:F):F+->x,p)$UnivariatePolynomialCategoryFunctions2(F, UP, F, SUP) + SUP2UP : SUP -> UP SUP2UP p == map((x:F):F+->x,p)$UnivariatePolynomialCategoryFunctions2(F, SUP, F, UP) + varRoot? : (UP, F -> F) -> Boolean varRoot?(p, derivation) == for c in coefficients primitivePart p repeat derivation(c) ^= 0 => return true false + pLogDeriv : (LOG, R -> R) -> R pLogDeriv(log, derivation) == map(derivation, log.coeff) ^= 0 => error "can only handle logs with constant coefficients" @@ -1901,6 +1929,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where ans := ans + coefficient(algans, i) (log.scalar)::R * ans + R2UP : (R, K) -> UPR R2UP(f, k) == x := dumx :: F g := @@ -1910,14 +1939,17 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where map((x1:F):R+->rlift(x1, dumx, dumy), univariate(g, k, minPoly k))_ $UnivariatePolynomialCategoryFunctions2(F,SUP,R,UPR) + univ : (F, K) -> QF univ(f, k) == g := univariate(f, k) (SUP2UP numer g) / (SUP2UP denom g) + rlift : (F, K, K) -> R rlift(f, kx, ky) == reduce map(x1+->univ(x1, kx), retract(univariate(f, ky))@SUP)_ $UnivariatePolynomialCategoryFunctions2(F,SUP,QF,UPUP) + nonQ : (DIV, UP) -> Union(List LOG, "failed") nonQ(rec, p) == empty? rest(lf := factors ffactor primitivePart p) => trace00(rec, first(lf).factor, empty()$List(LOG)) @@ -1925,6 +1957,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where -- case when the irreducible factor p has roots which sum to 0 -- p is assumed doubly transitive for now + trace0 : (DIV, UP, Q, FD) -> Union(List LOG, "failed") trace0(rec, q, r, dv0) == lg:List(LOG) := zero? dv0 => empty() @@ -1932,6 +1965,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where mkLog(1, r / (rc0.order::Q), rc0.function, 1) trace00(rec, q, lg) + trace00 : (DIV, UP, List LOG) -> Union(List LOG,"failed") trace00(rec, pp, lg) == p0 := divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha0 := zeroOf UP2SUP pp) @@ -1953,6 +1987,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where -- let [alpha_1,...,alpha_m] be the roots of q(z) -- in this function, b = - alpha_1 - ... - alpha_m is <> 0 -- which implies only one generic log term + trace1 : (DIV, UP, List Q, List FD, Q) -> Union(List LOG, "failed") trace1(rec, q, la, ld, b) == -- cd = [[b1,...,bk], d] such that ai / b = bi / d cd := splitDenominator [a / b for a in la] @@ -1973,6 +2008,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where NOTI -- maybe doubly-transitive mkLog(q, inv((- rc.order * cd.den)::Q), rc.function, alpha) + mkLog : (UP, Q, R, F) -> List LOG mkLog(q, scalr, lgd, alpha) == degree(q) <= 1 => [[scalr, monomial(1, 1)$UPR - F2UPR alpha, lgd::UPR]] @@ -1982,6 +2018,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where -- return the non-linear factor, if unique -- or any linear factor if they are all linear + nonLinear : List FAC -> Union(FAC, "failed") nonLinear l == found:Boolean := false ans := first l @@ -1993,12 +2030,14 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where ans -- f dx must be locally integral at infinity + palginfieldint : (R,(UP -> UP)) -> Union(R,"failed") palginfieldint(f, derivation) == h := HermiteIntegrate(f, derivation) zero?(h.logpart) => h.answer "failed" -- f dx must be locally integral at infinity + palgintegrate : (R,(UP -> UP)) -> IntegrationResult(R) palgintegrate(f, derivation) == h := HermiteIntegrate(f, derivation) zero?(h.logpart) => h.answer::IR @@ -2011,6 +2050,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where mkAnswer(h.answer, u::List(LOG), [[difFirstKind, dummy]]) -- for mixed functions. f dx not assumed locally integral at infinity + algintegrate : (R,(UP -> UP)) -> IntegrationResult(R) algintegrate(f, derivation) == zero? degree(x' := derivation(x := monomial(1, 1)$UP)) => algintprim(f, derivation) @@ -2019,6 +2059,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where algintexp(f, derivation) error "should not happen" + alglogint : (R, UP -> UP) -> Union(List LOG, "failed") alglogint(f, derivation) == varRoot?(doubleResultant(f, derivation), x1+->retract(derivation(x1::UP))@F) => "failed" @@ -2167,14 +2208,10 @@ AlgebraicIntegration(R, F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - rootintegrate: (F, K, K, UP -> UP) -> IR - algintegrate : (F, K, K, UP -> UP) -> IR - UPUP2F : (UPUP, RF, K, K) -> F - F2UPUP : (F, K, K, UP) -> UPUP - UP2UPUP : (UP, K) -> UPUP - + F2UPUP : (F, K, K, UP) -> UPUP F2UPUP(f, kx, k, p) == UP2UPUP(univariate(f, k, p), kx) + rootintegrate: (F, K, K, UP -> UP) -> IR rootintegrate(f, t, k, derivation) == r1 := mkIntegral(modulus := UP2UPUP(p := minPoly k, t)) f1 := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1) @@ -2184,6 +2221,7 @@ AlgebraicIntegration(R, F): Exports == Implementation where map(x1+->UPUP2F(lift x1, r1.coef, t, k), algintegrate(reduce f1, derivation)$ALG)$IR2 + algintegrate : (F, K, K, UP -> UP) -> IR algintegrate(f, t, k, derivation) == r1 := mkIntegral(modulus := UP2UPUP(p := minPoly k, t)) f1 := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1) @@ -2192,14 +2230,18 @@ AlgebraicIntegration(R, F): Exports == Implementation where map(x1+->UPUP2F(lift x1, r1.coef, t, k), algintegrate(reduce f1, derivation)$ALG)$IR2 + UP2UPUP : (UP, K) -> UPUP UP2UPUP(p, k) == map(x1+->univariate(x1,k),p)$SparseUnivariatePolynomialFunctions2(F,RF) + UPUP2F : (UPUP, RF, K, K) -> F UPUP2F(p, cf, t, k) == map((x1:RF):F+->multivariate(x1, t), p)$SparseUnivariatePolynomialFunctions2(RF, F) (multivariate(cf, t) * k::F) + algint : (F,Kernel(F),Kernel(F),(SparseUnivariatePolynomial(F) -> _ + SparseUnivariatePolynomial(F))) -> IntegrationResult(F) algint(f, t, y, derivation) == is?(y, "nthRoot"::SY) => rootintegrate(f, t, y, derivation) is?(y, "rootOf"::SY) => algintegrate(f, t, y, derivation) @@ -2499,32 +2541,36 @@ AlgebraicManipulations(R, F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,P,F) - innerRF : (F, List K) -> F - rootExpand : K -> F - algkernels : List K -> List K - rootkernels: List K -> List K - dummy := kernel(new()$SY)$K - ratDenom x == innerRF(x, algkernels tower x) + ratDenom : F -> F + ratDenom x == innerRF(x, algkernels tower x) + ratDenom : (F,List(Kernel(F))) -> F ratDenom(x:F, l:List K):F == innerRF(x, algkernels l) - ratDenom(x:F, y:F) == ratDenom(x, [y]) + ratDenom : (F,F) -> F + ratDenom(x:F, y:F) == ratDenom(x, [y]) - ratDenom(x:F, l:List F) == ratDenom(x, [retract(y)@K for y in l]$List(K)) + ratDenom : (F,List(F)) -> F + ratDenom(x:F, l:List F) == ratDenom(x, [retract(y)@K for y in l]$List(K)) + algkernels : List K -> List K algkernels l == select_!((z1:K):Boolean +-> has?(operator z1, ALGOP), l) + rootkernels: List K -> List K rootkernels l == select_!((z1:K):Boolean +-> is?(operator z1, NTHR::SY), l) + ratPoly : F -> SparseUnivariatePolynomial(F) ratPoly x == numer univariate(denom(ratDenom inv(dummy::P::F - x))::F, dummy) + rootSplit : F -> F rootSplit x == lk := rootkernels tower x eval(x, lk, [rootExpand k for k in lk]) + rootExpand : K -> F rootExpand k == x := first argument k n := second argument k @@ -2532,6 +2578,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where op(numer(x)::F, n) / op(denom(x)::F, n) -- all the kernels in ll must be algebraic + innerRF : (F, List K) -> F innerRF(x, ll) == empty?(l := sort_!((z1:K,z2:K):Boolean +-> z1 > z2,kernels x)$List(K)) or empty? setIntersection(ll, tower x) => x @@ -2549,13 +2596,9 @@ AlgebraicManipulations(R, F): Exports == Implementation where import PolynomialRoots(IndexedExponents K, K, R, P, F) - sroot : K -> F - inroot : (OP, F, N) -> F - radeval: (P, K) -> F - breakup: List K -> List REC - if R has RadicalCategory then + rootKerSimp : (BasicOperator,F,NonNegativeInteger) -> F rootKerSimp(op, x, n) == (r := retractIfCan(x)@Union(R, "failed")) case R => nthRoot(r::R, n)::F @@ -2563,11 +2606,13 @@ AlgebraicManipulations(R, F): Exports == Implementation where else + rootKerSimp : (BasicOperator,F,NonNegativeInteger) -> F rootKerSimp(op, x, n) == inroot(op, x, n) -- l is a list of nth-roots, returns a list of records of the form -- [a**(1/n1),a**(1/n2),...], [n1,n2,...]] -- such that the whole list covers l exactly + breakup: List K -> List REC breakup l == empty? l => empty() k := first l @@ -2583,6 +2628,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where ll := breakup others concat([concat(k, same), concat(n, expo)], ll) + rootProduct : F -> F rootProduct x == for rec in breakup rootkernels tower x repeat k0 := first(l := rec.ker) @@ -2595,6 +2641,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where x := radeval(eval(nx, l, lv), k) / radeval(eval(dx, l, lv), k) x + rootPower : F -> F rootPower x == for k in rootkernels tower x repeat x := radeval(numer x, k) / radeval(denom x, k) @@ -2602,6 +2649,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where -- replaces (a**(1/n))**m in p by a power of a simpler radical of a if -- n and m have a common factor + radeval: (P, K) -> F radeval(p, k) == a := first(arg := argument k) n := (retract(second arg)@Integer)::NonNegativeInteger @@ -2615,6 +2663,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where q := reductum q leadingCoefficient(q)::F + ans + inroot : (OP, F, N) -> F inroot(op, x, n) == (x = 1) => x (x ^= -1) and (((num := numer x) = 1) or (num = -1)) => @@ -2627,10 +2676,12 @@ AlgebraicManipulations(R, F): Exports == Implementation where x := first argument(pr.var) x ** qr.quotient * rootKerSimp(op,x,denom(q)::N) ** qr.remainder + sroot : K -> F sroot k == pr := froot(first(arg := argument k),(retract(second arg)@Z)::N) pr.coef * rootKerSimp(operator k, pr.radicand, pr.exponent) + rootSimp : F -> F rootSimp x == lk := rootkernels tower x eval(x, lk, [sroot k for k in lk]) @@ -2750,9 +2801,12 @@ AlgebraicMultFact(OV,E,P) : C == T INNER ==> InnerMultFact(OV,E,AN,P) + factor : (P,List(AlgebraicNumber)) -> Factored(P) factor(p:P,lalg:L AN) : Factored P == factor(p,(z1:BP):Factored(BP) +-> factor(z1,lalg)$AF)$INNER + factor : (SparseUnivariatePolynomial(P),List(AlgebraicNumber)) -> _ + Factored(SparseUnivariatePolynomial(P)) factor(up:USP,lalg:L AN) : Factored USP == factor(up,(z1:BP):Factored(BP) +-> factor(z1,lalg)$AF)$INNER @@ -3299,12 +3353,11 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ -- local functions - convVM : Vector R -> Matrix R - -- converts n2-vector to (n,n)-matrix row by row - + -- converts n-square matrix to n2-vector row by row convMV : Matrix R -> Vector R - -- converts n-square matrix to n2-vector row by row + -- converts n2-vector to (n,n)-matrix row by row + convVM : Vector R -> Matrix R convVM v == cond : Matrix(R) := new(n,n,0$R)$M(R) z : Integer := 0 @@ -3314,22 +3367,26 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(cond,i,j,v.z) cond + radicalOfLeftTraceForm : () -> List(A) radicalOfLeftTraceForm() == ma : M R := leftTraceMatrix()$A map(represents, nullSpace ma)$ListFunctions2(Vector R, A) + basisOfLeftAnnihilator : A -> List(A) basisOfLeftAnnihilator a == ca : M R := transpose (coordinates(a) :: M R) cond : M R := reduce(vertConcat$(M R), [ca*transpose(gamma.i) for i in 1..#gamma]) map(represents, nullSpace cond)$ListFunctions2(Vector R, A) + basisOfRightAnnihilator : A -> List(A) basisOfRightAnnihilator a == ca : M R := transpose (coordinates(a) :: M R) cond : M R := reduce(vertConcat$(M R), [ca*(gamma.i) for i in 1..#gamma]) map(represents, nullSpace cond)$ListFunctions2(Vector R, A) + basisOfLeftNucloid : () -> List(Matrix(R)) basisOfLeftNucloid() == cond : Matrix(R) := new(n3,n2,0$R)$M(R) condo: Matrix(R) := new(n3,n2,0$R)$M(R) @@ -3350,6 +3407,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ r2 := r2 + n [convVM(sol) for sol in nullSpace(cond+condo)] + basisOfCommutingElements : () -> List(A) basisOfCommutingElements() == --gamma1 := first gamma --gamma1 := gamma1 - transpose gamma1 @@ -3363,6 +3421,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ [(gam := gamma.i) - transpose gam for i in 1..#gamma]) map(represents, nullSpace cond)$ListFunctions2(Vector R, A) + basisOfLeftNucleus : () -> List(A) basisOfLeftNucleus() == condi: Matrix(R) := new(n3,n,0$R)$Matrix(R) z : Integer := 0 @@ -3378,6 +3437,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(condi,z,i,entry)$Matrix(R) map(represents, nullSpace condi)$ListFunctions2(Vector R,A) + basisOfRightNucleus : () -> List(A) basisOfRightNucleus() == condo : Matrix(R) := new(n3,n,0$R)$Matrix(R) z : Integer := 0 @@ -3393,6 +3453,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(condo,z,i,entry)$Matrix(R) map(represents, nullSpace condo)$ListFunctions2(Vector R,A) + basisOfMiddleNucleus : () -> List(A) basisOfMiddleNucleus() == conda : Matrix(R) := new(n3,n,0$R)$Matrix(R) z : Integer := 0 @@ -3408,6 +3469,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(conda,z,i,entry)$Matrix(R) map(represents, nullSpace conda)$ListFunctions2(Vector R,A) + basisOfNucleus : () -> List(A) basisOfNucleus() == condi: Matrix(R) := new(3*n3,n,0$R)$Matrix(R) z : Integer := 0 @@ -3435,6 +3497,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(condi,w,i,ent)$Matrix(R) map(represents, nullSpace condi)$ListFunctions2(Vector R,A) + basisOfCenter : () -> List(A) basisOfCenter() == gamma1 := first gamma gamma1 := gamma1 - transpose gamma1 @@ -3465,6 +3528,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ D := vertConcat(condi,B)$Matrix(R) map(represents, nullSpace D)$ListFunctions2(Vector R, A) + basisOfRightNucloid : () -> List(Matrix(R)) basisOfRightNucloid() == cond : Matrix(R) := new(n3,n2,0$R)$M(R) condo: Matrix(R) := new(n3,n2,0$R)$M(R) @@ -3485,6 +3549,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ r2 := r2 + n [convVM(sol) for sol in nullSpace(cond+condo)] + basisOfCentroid : () -> List(Matrix(R)) basisOfCentroid() == cond : Matrix(R) := new(2*n3,n2,0$R)$M(R) condo: Matrix(R) := new(2*n3,n2,0$R)$M(R) @@ -3510,6 +3575,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ r2 := r2 + n [convVM(sol) for sol in nullSpace(cond+condo)] + doubleRank : A -> NonNegativeInteger doubleRank x == cond : Matrix(R) := new(2*n,n,0$R) for k in 1..n repeat @@ -3527,6 +3593,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(cond,u,k,enter)$Matrix(R) rank(cond)$(M R) + weakBiRank : A -> NonNegativeInteger weakBiRank(x) == cond : Matrix(R) := new(n2,n,0$R)$Matrix(R) z : Integer := 0 @@ -3541,6 +3608,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(cond,z,k,entry)$Matrix(R) rank(cond)$(M R) + biRank : A -> NonNegativeInteger biRank(x) == cond : Matrix(R) := new(n2+2*n+1,n,0$R)$Matrix(R) z : Integer := 0 @@ -3570,6 +3638,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(cond,c,j, elt(x,j)) rank(cond)$(M R) + leftRank : A -> NonNegativeInteger leftRank x == cond : Matrix(R) := new(n,n,0$R) for k in 1..n repeat @@ -3580,6 +3649,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ setelt(cond,j,k,entry)$Matrix(R) rank(cond)$(M R) + rightRank : A -> NonNegativeInteger rightRank x == cond : Matrix(R) := new(n,n,0$R) for k in 1..n repeat @@ -3593,6 +3663,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _ if R has EuclideanDomain then + basis : Vector(A) -> Vector(A) basis va == v : V A := remove(zero?, va)$(V A) v : V A := removeDuplicates v @@ -3792,45 +3863,47 @@ AlgFactor(UP): Exports == Implementation where UPCF2 ==> UnivariatePolynomialCategoryFunctions2 - fact : (UP, List K) -> FR - ifactor : (SUP, List K) -> Factored SUP - extend : (UP, Z) -> FR - allk : List AN -> List K - downpoly: UP -> UPQ - liftpoly: UPQ -> UP - irred? : UP -> Boolean - - allk l == removeDuplicates concat [kernels x for x in l] + allk : List AN -> List K + allk l == removeDuplicates concat [kernels x for x in l] - liftpoly p == map(x +-> x::AN, p)$UPCF2(Q, UPQ, AN, UP) + liftpoly: UPQ -> UP + liftpoly p == map(x +-> x::AN, p)$UPCF2(Q, UPQ, AN, UP) - downpoly p == map(x +-> retract(x)@Q, p)$UPCF2(AN, UP ,Q, UPQ) + downpoly: UP -> UPQ + downpoly p == map(x +-> retract(x)@Q, p)$UPCF2(AN, UP ,Q, UPQ) + ifactor : (SUP, List K) -> Factored SUP ifactor(p,l) == (fact(p pretend UP, l)) pretend Factored(SUP) - factor p == fact(p, allk coefficients p) + factor : UP -> Factored(UP) + factor p == fact(p, allk coefficients p) factor(p, l) == fact(p, allk removeDuplicates concat(l, coefficients p)) + split : UP -> Factored(UP) split p == fp := factor p unit(fp) * _*/[extend(fc.factor, fc.exponent) for fc in factors fp] + extend : (UP, Z) -> FR extend(p, n) == (degree p = 1) => primeFactor(p, n) q := monomial(1, 1)$UP - zeroOf(p pretend SUP)::UP primeFactor(q, n) * split((p exquo q)::UP) ** (n::N) + doublyTransitive? : UP -> Boolean doublyTransitive? p == irred? p and irred?((p exquo (monomial(1, 1)$UP - zeroOf(p pretend SUP)::UP))::UP) + irred? : UP -> Boolean irred? p == fp := factor p (numberOfFactors fp = 1) and (nthExponent(fp, 1) = 1) + fact : (UP, List K) -> FR fact(p, l) == (degree p = 1) => primeFactor(p, 1) empty? l => @@ -4427,22 +4500,9 @@ AnnaNumericalIntegrationPackage(): EE == II where (* package INTPACK *) (* - zeroMeasure: Measure -> Result - scriptedVariables?: MDNIA -> Boolean - preAnalysis:(Union(nia:NIA,mdnia:MDNIA),RT) -> RT - measureSpecific:(ST,RT,Union(nia:NIA,mdnia:MDNIA)) -> _ - Record(measure:F,explanations:LST,extra:Result) - changeName:(Result,ST) -> Result - recoverAfterFail:(Union(nia:NIA,mdnia:MDNIA),RT,Measure,INT,Result) -> _ - Record(a:Result,b:Measure) - better?:(Result,Result) -> Boolean - integrateConstant:(EF,SOCF) -> Result - integrateConstantList: (EF,LSOCF) -> Result - integrateArgs:(NumericalIntegrationProblem,RT) -> Result - integrateSpecific:(Union(nia:NIA,mdnia:MDNIA),ST,Result) -> Result - import ExpertSystemToolsPackage + integrateConstantList: (EF,LSOCF) -> Result integrateConstantList(exp:EF,ras:LSOCF):Result == c:OCF := ((retract(exp)@F)$EF)::OCF b := [hi(j)-lo(j) for j in ras] @@ -4451,6 +4511,7 @@ AnnaNumericalIntegrationPackage(): EE == II where text := coerce("Constant Function")$AnyFunctions1(ST) construct([[result@S,a],[method@S,text]])$Result + integrateConstant:(EF,SOCF) -> Result integrateConstant(exp:EF,ra:SOCF):Result == c := (retract(exp)@F)$EF r:OCF := (c::OCF)*(hi(ra)-lo(ra)) @@ -4458,12 +4519,14 @@ AnnaNumericalIntegrationPackage(): EE == II where text := coerce("Constant Function")$AnyFunctions1(ST) construct([[result@S,a],[method@S,text]])$Result + zeroMeasure: Measure -> Result zeroMeasure(m:Measure):Result == a := coerce(0$DF)$AnyFunctions1(DF) text := coerce("Constant Function")$AnyFunctions1(String) r := construct([[result@Symbol,a],[method@Symbol,text]])$Result concat(measure2Result m,r)$ExpertSystemToolsPackage + scriptedVariables?: MDNIA -> Boolean scriptedVariables?(mdnia:MDNIA):Boolean == vars:List Symbol := variables(mdnia.fn)$EDF var1 := first(vars)$(List Symbol) @@ -4474,6 +4537,7 @@ AnnaNumericalIntegrationPackage(): EE == II where return false true + preAnalysis:(Union(nia:NIA,mdnia:MDNIA),RT) -> RT preAnalysis(args:Union(nia:NIA,mdnia:MDNIA),t:RT):RT == import RT r:RT := selectIntegrationRoutines t @@ -4484,11 +4548,14 @@ AnnaNumericalIntegrationPackage(): EE == II where selectNonFiniteRoutines r selectMultiDimensionalRoutines r + changeName:(Result,ST) -> Result changeName(ans:Result,name:ST):Result == sy:S := coerce(name "Answer")$S anyAns:Any := coerce(ans)$AnyFunctions1(Result) construct([[sy,anyAns]])$Result + measureSpecific:(ST,RT,Union(nia:NIA,mdnia:MDNIA)) -> _ + Record(measure:F,explanations:LST,extra:Result) measureSpecific(name:ST,R:RT,args:Union(nia:NIA,mdnia:MDNIA)): Record(measure:F,explanations:ST,extra:Result) == args case nia => @@ -4511,6 +4578,8 @@ AnnaNumericalIntegrationPackage(): EE == II where error("measureSpecific","invalid type name: " name)$ErrorFunctions error("measureSpecific","invalid type name")$ErrorFunctions + measure : (NumericalIntegrationProblem,RoutinesTable) -> _ + Record(measure: Float,name: String,explanations: List(String),extra: Result) measure(a:NumericalIntegrationProblem,R:RT):Measure == args:Union(nia:NIA,mdnia:MDNIA) := retract(a)$NumericalIntegrationProblem sofar := 0$F @@ -4540,9 +4609,12 @@ AnnaNumericalIntegrationPackage(): EE == II where meth := append(meth,str)$LST [sofar,best,meth,ext] + measure : NumericalIntegrationProblem -> _ + Record(measure: Float,name: String,explanations: List(String),extra: Result) measure(a:NumericalIntegrationProblem):Measure == measure(a,routines()$RT) + integrateSpecific:(Union(nia:NIA,mdnia:MDNIA),ST,Result) -> Result integrateSpecific(args:Union(nia:NIA,mdnia:MDNIA),n:ST,ex:Result):Result == args case nia => arg:NIA := args.nia @@ -4564,6 +4636,7 @@ AnnaNumericalIntegrationPackage(): EE == II where error("integrateSpecific","invalid type name: " n)$ErrorFunctions error("integrateSpecific","invalid type name: " n)$ErrorFunctions + better?:(Result,Result) -> Boolean better?(r:Result,s:Result):Boolean == a1 := search("abserr"::S,r)$Result a1 case "failed" => false @@ -4575,6 +4648,8 @@ AnnaNumericalIntegrationPackage(): EE == II where negative?(abserr2) => true (abserr1 < abserr2) -- true if r.abserr better than s.abserr + recoverAfterFail:(Union(nia:NIA,mdnia:MDNIA),RT,Measure,INT,Result) -> _ + Record(a:Result,b:Measure) recoverAfterFail(n:Union(nia:NIA,mdnia:MDNIA),routs:RT,m:Measure,iint:INT, r:Result):Record(a:Result,b:Measure) == bestName := m.name @@ -4616,6 +4691,7 @@ AnnaNumericalIntegrationPackage(): EE == II where m.name := bestName [r,m] + integrateArgs:(NumericalIntegrationProblem,RT) -> Result integrateArgs(prob:NumericalIntegrationProblem,t:RT):Result == args:Union(nia:NIA,mdnia:MDNIA):= retract(prob)$NumericalIntegrationProblem routs := copy(t)$RT @@ -4654,45 +4730,65 @@ AnnaNumericalIntegrationPackage(): EE == II where concat(att2Result att,r)$ExpertSystemToolsPackage r + integrate : NumericalIntegrationProblem -> Result integrate(args:NumericalIntegrationProblem):Result == integrateArgs(args,routines()$RT) + integrate : (Expression(Float),Segment(OrderedCompletion(Float)),_ + Float,Float,RoutinesTable) -> Result integrate(exp:EF,ra:SOCF,epsabs:F,epsrel:F,r:RT):Result == Var:LS := variables(exp)$EF empty?(Var)$LS => integrateConstant(exp,ra) args:NIA:= [first(Var)$LS,ef2edf exp,socf2socdf ra,f2df epsabs,f2df epsrel] integrateArgs(args::NumericalIntegrationProblem,r) + integrate : (Expression(Float),Segment(OrderedCompletion(Float)),_ + Float,Float) -> Result integrate(exp:EF,ra:SOCF,epsabs:F,epsrel:F):Result == integrate(exp,ra,epsabs,epsrel,routines()$RT) + integrate : (Expression(Float),Segment(OrderedCompletion(Float)),Float) ->_ + Result integrate(exp:EF,ra:SOCF,err:F):Result == positive?(err)$F => integrate(exp,ra,0$F,err) integrate(exp,ra,1.0E-5,err) + integrate : (Expression(Float),Segment(OrderedCompletion(Float))) -> Result integrate(exp:EF,ra:SOCF):Result == integrate(exp,ra,0$F,1.0E-5) + integrate : (Expression(Float),SegmentBinding(OrderedCompletion(Float)),_ + String) -> Union(Result,"failed") integrate(exp:EF,sb:SBOCF, st:ST) == st = "numerical" => integrate(exp,segment sb) "failed" + integrate : (Expression(Float),SegmentBinding(OrderedCompletion(Float)),_ + Symbol) -> Union(Result,"failed") integrate(exp:EF,sb:SBOCF, s:S) == s = (numerical::Symbol) => integrate(exp,segment sb) "failed" + integrate : (Expression(Float),List(Segment(OrderedCompletion(Float))),_ + Float,Float,RoutinesTable) -> Result integrate(exp:EF,ra:LSOCF,epsabs:F,epsrel:F,r:RT):Result == vars := variables(exp)$EF empty?(vars)$LS => integrateConstantList(exp,ra) args:MDNIA := [ef2edf exp,convert ra,f2df epsabs,f2df epsrel] integrateArgs(args::NumericalIntegrationProblem,r) + integrate : (Expression(Float),List(Segment(OrderedCompletion(Float))),_ + Float,Float) -> Result integrate(exp:EF,ra:LSOCF,epsabs:F,epsrel:F):Result == integrate(exp,ra,epsabs,epsrel,routines()$RT) + integrate : (Expression(Float),List(Segment(OrderedCompletion(Float))),_ + Float) -> Result integrate(exp:EF,ra:LSOCF,epsrel:F):Result == zero? epsrel => integrate(exp,ra,1.0e-6,epsrel) integrate(exp,ra,0$F,epsrel) + integrate : (Expression(Float),List(Segment(OrderedCompletion(Float)))) ->_ + Result integrate(exp:EF,ra:LSOCF):Result == integrate(exp,ra,1.0e-4) *) @@ -5165,18 +5261,9 @@ AnnaNumericalOptimizationPackage(): EE == II where (* package OPTPACK *) (* - preAnalysis:RT -> RT - zeroMeasure:Measure -> Result - optimizeSpecific:(UNOALSA,String) -> Result - measureSpecific:(String,RT,UNOALSA) -> Measure2 - changeName:(Result,String) -> Result - recoverAfterFail:(UNOALSA,RT,Measure,INT,Result) -> _ - Record(a:Result,b:Measure) - constant:UNOALSA -> Union(DF, "failed") - optimizeConstant:DF -> Result - import ExpertSystemToolsPackage,e04AgentsPackage,NumericalOptimizationProblem + constant:UNOALSA -> Union(DF, "failed") constant(args:UNOALSA):Union(DF,"failed") == args case noa => Args := args.noa @@ -5184,23 +5271,27 @@ AnnaNumericalOptimizationPackage(): EE == II where retractIfCan(f)@Union(DoubleFloat,"failed") "failed" + optimizeConstant:DF -> Result optimizeConstant(c:DF): Result == a := coerce(c)$AnyFunctions1(DF) text := coerce("Constant Function")$AnyFunctions1(String) construct([[objf@Symbol,a],[method@Symbol,text]])$Result + preAnalysis:RT -> RT preAnalysis(args:UNOALSA,t:RT):RT == r := selectOptimizationRoutines(t)$RT args case lsa => selectSumOfSquaresRoutines(r)$RT r + zeroMeasure:Measure -> Result zeroMeasure(m:Measure):Result == a := coerce(0$F)$AnyFunctions1(F) text := coerce("Zero Measure")$AnyFunctions1(String) r := construct([[objf@Symbol,a],[method@Symbol,text]])$Result concat(measure2Result m,r) + measureSpecific:(String,RT,UNOALSA) -> Measure2 measureSpecific(name:String,R:RT,args:UNOALSA): Measure2 == args case noa => arg:NOA := args.noa @@ -5219,6 +5310,8 @@ AnnaNumericalOptimizationPackage(): EE == II where error("measureSpecific","invalid type name: " name)$ErrorFunctions error("measureSpecific","invalid argument type")$ErrorFunctions + measure : (NumericalOptimizationProblem,RoutinesTable) -> _ + Record(measure: Float,name: String,explanations: List(String)) measure(Args:NumericalOptimizationProblem,R:RT):Measure == args:UNOALSA := retract(Args)$NumericalOptimizationProblem sofar := 0$F @@ -5248,9 +5341,12 @@ AnnaNumericalOptimizationPackage(): EE == II where meth := append(meth,str)$(List String) [sofar,best,meth] + measure : NumericalOptimizationProblem -> _ + Record(measure: Float,name: String,explanations: List(String)) measure(args:NumericalOptimizationProblem):Measure == measure(args,routines()$RT) + optimizeSpecific:(UNOALSA,String) -> Result optimizeSpecific(args:UNOALSA,name:String):Result == args case noa => arg:NOA := args.noa @@ -5269,12 +5365,15 @@ AnnaNumericalOptimizationPackage(): EE == II where error("optimizeSpecific","invalid type name: " name)$ErrorFunctions error("optimizeSpecific","invalid type name: " name)$ErrorFunctions + changeName:(Result,String) -> Result changeName(ans:Result,name:String):Result == st:String := concat([name,"Answer"])$String sy:Symbol := coerce(st)$Symbol anyAns:Any := coerce(ans)$AnyFunctions1(Result) construct([[sy,anyAns]])$Result + recoverAfterFail:(UNOALSA,RT,Measure,INT,Result) -> _ + Record(a:Result,b:Measure) recoverAfterFail(args:UNOALSA,routs:RT,m:Measure, iint:INT,r:Result):Record(a:Result,b:Measure) == while positive?(iint) repeat @@ -5295,6 +5394,7 @@ AnnaNumericalOptimizationPackage(): EE == II where iint := retract(iany)$AnyFunctions1(INT) [r,m] + optimize : (NumericalOptimizationProblem,RoutinesTable) -> Result optimize(Args:NumericalOptimizationProblem,t:RT):Result == args:UNOALSA := retract(Args)$NumericalOptimizationProblem routs := copy(t)$RT @@ -5321,9 +5421,11 @@ AnnaNumericalOptimizationPackage(): EE == II where attr:Record(key:Symbol,entry:Any) := [attributes@Symbol,atta] insert!(attr,r)$Result + optimize : NumericalOptimizationProblem -> Result optimize(args:NumericalOptimizationProblem):Result == optimize(args,routines()$RT) + goodnessOfFit : NumericalOptimizationProblem -> Result goodnessOfFit(Args:NumericalOptimizationProblem):Result == r := optimize(Args) args1:UNOALSA := retract(Args)$NumericalOptimizationProblem @@ -5354,21 +5456,28 @@ AnnaNumericalOptimizationPackage(): EE == II where r2 := e04ycf(0,m,n,f,s,n,v,-1)$NagOptimisationPackage concat(r,r2) + optimize : (Expression(Float),List(Float),List(OrderedCompletion(Float)),_ + List(Expression(Float)),List(OrderedCompletion(Float))) -> Result optimize(f:EF,start:LF,lower:LOCF,cons:LEF,upper:LOCF):Result == args:NOA := [ef2edf(f),[f2df i for i in start],[ocf2ocdf j for j in lower], [ef2edf k for k in cons], [ocf2ocdf l for l in upper]] optimize(args::NumericalOptimizationProblem) + optimize : (Expression(Float),List(Float),List(OrderedCompletion(Float)),_ + List(OrderedCompletion(Float))) -> Result optimize(f:EF,start:LF,lower:LOCF,upper:LOCF):Result == optimize(f,start,lower,empty()$LEF,upper) + optimize : (Expression(Float),List(Float)) -> Result optimize(f:EF,start:LF):Result == optimize(f,start,empty()$LOCF,empty()$LOCF) + optimize : (List(Expression(Float)),List(Float)) -> Result optimize(lf:LEF,start:LF):Result == args:LSA := [[ef2edf i for i in lf],[f2df j for j in start]] optimize(args::NumericalOptimizationProblem) + goodnessOfFit : (List(Expression(Float)),List(Float)) -> Result goodnessOfFit(lf:LEF,start:LF):Result == args:LSA := [[ef2edf i for i in lf],[f2df j for j in start]] goodnessOfFit(args::NumericalOptimizationProblem) @@ -5856,19 +5965,12 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where import ODEA,NumericalODEProblem f2df:F -> DF - ef2edf:EF -> EDF - preAnalysis:(ODEA,RT) -> RT - zeroMeasure:Measure -> Result - measureSpecific:(ST,RT,ODEA) -> Record(measure:F,explanations:ST) - solveSpecific:(ODEA,ST) -> Result - changeName:(Result,ST) -> Result - recoverAfterFail:(ODEA,RT,Measure,Integer,Result) -> _ - Record(a:Result,b:Measure) - f2df(f:F):DF == (convert(f)@DF)$F + ef2edf:EF -> EDF ef2edf(f:EF):EDF == map(f2df,f)$ExpressionFunctions2(F,DF) + preAnalysis:(ODEA,RT) -> RT preAnalysis(args:ODEA,t:RT):RT == rt := selectODEIVPRoutines(t)$RT if positive?(# variables(args.g)) then @@ -5877,12 +5979,14 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where changeMeasure(rt,d02bhf@Symbol,getMeasure(rt,d02bhf@Symbol)*0.8) rt + zeroMeasure:Measure -> Result zeroMeasure(m:Measure):Result == a := coerce(0$F)$AnyFunctions1(F) text := coerce("Zero Measure")$AnyFunctions1(ST) r := construct([[result@Symbol,a],[method@Symbol,text]])$Result concat(measure2Result m,r)$ExpertSystemToolsPackage + measureSpecific:(ST,RT,ODEA) -> Record(measure:F,explanations:ST) measureSpecific(name:ST,R:RT,ode:ODEA):Record(measure:F,explanations:ST) == name = "d02bbfAnnaType" => measure(R,ode)$d02bbfAnnaType name = "d02bhfAnnaType" => measure(R,ode)$d02bhfAnnaType @@ -5890,6 +5994,8 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where name = "d02ejfAnnaType" => measure(R,ode)$d02ejfAnnaType error("measureSpecific","invalid type name: " name)$ErrorFunctions + measure : (NumericalODEProblem,RoutinesTable) -> _ + Record(measure: Float,name: String,explanations: List(String)) measure(Ode:NumericalODEProblem,R:RT):Measure == ode:ODEA := retract(Ode)$NumericalODEProblem sofar := 0$F @@ -5918,8 +6024,11 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where meth := append(meth,str)$LST [sofar,best,meth] + measure : NumericalODEProblem -> _ + Record(measure: Float,name: String,explanations: List(String)) measure(ode:NumericalODEProblem):Measure == measure(ode,routines()$RT) + solveSpecific:(ODEA,ST) -> Result solveSpecific(ode:ODEA,n:ST):Result == n = "d02bbfAnnaType" => ODESolve(ode)$d02bbfAnnaType n = "d02bhfAnnaType" => ODESolve(ode)$d02bhfAnnaType @@ -5927,11 +6036,14 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where n = "d02ejfAnnaType" => ODESolve(ode)$d02ejfAnnaType error("solveSpecific","invalid type name: " n)$ErrorFunctions + changeName:(Result,ST) -> Result changeName(ans:Result,name:ST):Result == sy:Symbol := coerce(name "Answer")$Symbol anyAns:Any := coerce(ans)$AnyFunctions1(Result) construct([[sy,anyAns]])$Result + recoverAfterFail:(ODEA,RT,Measure,Integer,Result) -> _ + Record(a:Result,b:Measure) recoverAfterFail(ode:ODEA,routs:RT,m:Measure,iint:Integer,r:Result): Record(a:Result,b:Measure) == while positive?(iint) repeat @@ -5958,6 +6070,7 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where iint := retract(iany)$AnyFunctions1(Integer) [r,m] + solve : (NumericalODEProblem,RoutinesTable) -> Result solve(Ode:NumericalODEProblem,t:RT):Result == ode:ODEA := retract(Ode)$NumericalODEProblem routs := copy(t)$RT @@ -5981,8 +6094,11 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where iflist case "failed" => r concat(iflist2Result iflist, r)$ExpertSystemToolsPackage + solve : NumericalODEProblem -> Result solve(ode:NumericalODEProblem):Result == solve(ode,routines()$RT) + solve : (Vector(Expression(Float)),Float,Float,List(Float),_ + Expression(Float),List(Float),Float,Float) -> Result solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,G:EF,intVals:LF,epsabs:F,epsrel:F)_ :Result == d:ODEA:= [f2df xStart,f2df xEnd,vector([ef2edf e for e in members f])$VEDF, @@ -5990,18 +6106,26 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where ef2edf G,f2df epsabs,f2df epsrel] solve(d::NumericalODEProblem,routines()$RT) + solve : (Vector(Expression(Float)),Float,Float,List(Float),_ + Expression(Float),List(Float),Float) -> Result solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,G:EF,intVals:LF,tol:F):Result == solve(f,xStart,xEnd,yInitial,G,intVals,tol,tol) + solve : (Vector(Expression(Float)),Float,Float,List(Float),List(Float),_ + Float) -> Result solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,intVals:LF,tol:F):Result == solve(f,xStart,xEnd,yInitial,1$EF,intVals,tol) + solve : (Vector(Expression(Float)),Float,Float,List(Float),_ + Expression(Float),Float) -> Result solve(f:VEF,xStart:F,xEnd:F,y:LF,G:EF,tol:F):Result == solve(f,xStart,xEnd,y,G,empty()$LF,tol) + solve : (Vector(Expression(Float)),Float,Float,List(Float),Float) -> Result solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,tol:F):Result == solve(f,xStart,xEnd,yInitial,1$EF,empty()$LF,tol) + solve : (Vector(Expression(Float)),Float,Float,List(Float)) -> Result solve(f:VEF,xStart:F,xEnd:F,yInitial:LF):Result == solve(f,xStart,xEnd,yInitial,1.0e-4) @@ -6330,23 +6454,20 @@ AnnaPartialDifferentialEquationPackage(): EE == II where import PDEB, d03AgentsPackage, ExpertSystemToolsPackage, NumericalPDEProblem zeroMeasure:Measure -> Result - measureSpecific:(ST,RT,PDEB) -> Record(measure:F,explanations:ST) - solveSpecific:(PDEB,ST) -> Result - changeName:(Result,ST) -> Result - recoverAfterFail:(PDEB,RT,Measure,Integer,Result) -> _ - Record(a:Result,b:Measure) - zeroMeasure(m:Measure):Result == a := coerce(0$F)$AnyFunctions1(F) text:= coerce("No available routine appears appropriate")$AnyFunctions1(ST) r := construct([[result@Symbol,a],[method@Symbol,text]])$Result concat(measure2Result m,r)$ExpertSystemToolsPackage + measureSpecific:(ST,RT,PDEB) -> Record(measure:F,explanations:ST) measureSpecific(name:ST,R:RT,p:PDEB):Record(measure:F,explanations:ST) == name = "d03eefAnnaType" => measure(R,p)$d03eefAnnaType --name = "d03fafAnnaType" => measure(R,p)$d03fafAnnaType error("measureSpecific","invalid type name: " name)$ErrorFunctions + measure : (NumericalPDEProblem,RoutinesTable) -> _ + Record(measure: Float,name: String,explanations: List(String)) measure(P:NumericalPDEProblem,R:RT):Measure == p:PDEB := retract(P)$NumericalPDEProblem sofar := 0$F @@ -6375,18 +6496,24 @@ AnnaPartialDifferentialEquationPackage(): EE == II where meth := append(meth,str)$LST [sofar,best,meth] + measure : NumericalPDEProblem -> _ + Record(measure: Float,name: String,explanations: List(String)) measure(P:NumericalPDEProblem):Measure == measure(P,routines()$RT) + solveSpecific:(PDEB,ST) -> Result solveSpecific(p:PDEB,n:ST):Result == n = "d03eefAnnaType" => PDESolve(p)$d03eefAnnaType --n = "d03fafAnnaType" => PDESolve(p)$d03fafAnnaType error("solveSpecific","invalid type name: " n)$ErrorFunctions + changeName:(Result,ST) -> Result changeName(ans:Result,name:ST):Result == sy:Symbol := coerce(name "Answer")$Symbol anyAns:Any := coerce(ans)$AnyFunctions1(Result) construct([[sy,anyAns]])$Result + recoverAfterFail:(PDEB,RT,Measure,Integer,Result) -> _ + Record(a:Result,b:Measure) recoverAfterFail(p:PDEB,routs:RT,m:Measure,iint:Integer,r:Result): Record(a:Result,b:Measure) == while positive?(iint) repeat @@ -6407,6 +6534,7 @@ AnnaPartialDifferentialEquationPackage(): EE == II where iint := retract(iany)$AnyFunctions1(Integer) [r,m] + solve : (NumericalPDEProblem,RoutinesTable) -> Result solve(P:NumericalPDEProblem,t:RT):Result == routs := copy(t)$RT m := measure(P,routs) @@ -6427,8 +6555,12 @@ AnnaPartialDifferentialEquationPackage(): EE == II where r := concat(construct([explaa]),r) concat(measure2Result m,r)$ExpertSystemToolsPackage + solve : NumericalPDEProblem -> Result solve(P:NumericalPDEProblem):Result == solve(P,routines()$RT) + solve : (Float,Float,Float,Float,NonNegativeInteger,NonNegativeInteger,_ + List(Expression(Float)),List(List(Expression(Float))),String,_ + DoubleFloat) -> Result solve(xmi:F,xma:F,ymi:F,yma:F,nx:NNI,ny:NNI,pe:LEF,bo:List LEF,s:ST,to:DF):Result == cx:PDEC := [f2df xmi, f2df xma, nx, 1, empty()$MDF, empty()$MDF] @@ -6437,6 +6569,9 @@ AnnaPartialDifferentialEquationPackage(): EE == II where [[ef2edf u for u in w] for w in bo],s,to] solve(p::NumericalPDEProblem,routines()$RT) + solve : (Float,Float,Float,Float,NonNegativeInteger,NonNegativeInteger,_ + List(Expression(Float)),List(List(Expression(Float))),String) -> _ + Result solve(xmi:F,xma:F,ymi:F,yma:F,nx:NNI,ny:NNI,pe:LEF,bo:List LEF,s:ST):Result == solve(xmi,xma,ymi,yma,nx,ny,pe,bo,s,0.0001::DF) @@ -6554,13 +6689,18 @@ AnyFunctions1(S:Type): with Sexpr:SExpression := devaluate(S)$Lisp - retractable? a == dom(a) = Sexpr + retractable? : Any -> Boolean + retractable? a == dom(a) = Sexpr + + coerce : S -> Any coerce(s:S):Any == any(Sexpr, s::None) + retractIfCan : Any -> Union(S,"failed") retractIfCan a == retractable? a => obj(a) pretend S "failed" + retract : Any -> S retract a == retractable? a => obj(a) pretend S error "Cannot retract value." @@ -6972,18 +7112,23 @@ ApplicationProgramInterface(): Exports == Implementation where (* package API *) (* + getDomains : Symbol -> Set(Symbol) getDomains(cat:Symbol):Set(Symbol) == set [symbol car first destruct a _ for a in (destruct domainsOf(cat,NIL$Lisp)$Lisp)::List(SExpression)] + getAncestors : Symbol -> Set(Symbol) getAncestors(cat:Symbol):Set(Symbol) == set [symbol car first destruct a _ for a in (destruct ancestorsOf(cat,NIL$Lisp)$Lisp)::List(SExpression)] + credits : () -> Void credits() == ( credits()$Lisp ; void() ) + summary : () -> Void summary() == ( summary()$Lisp ; void() ) + reportInstantiations : Boolean -> Void reportInstantiations(b:Boolean): Void == REPORTINSTANTIATIONS(b)$Lisp void @@ -7176,16 +7321,10 @@ ApplyRules(Base, R, F): Exports == Implementation where import PatternFunctions1(Base, F) - splitRules: List RR -> Record(lker: List K,lval: List F,rl: List RR) - localApply : (List K, List F, List RR, F, PositiveInteger) -> F - rewrite : (F, PR, List Symbol) -> F - app : (List RR, F) -> F applist : (List RR, List F) -> List F - isit : (F, P) -> PR - isitwithpred: (F, P, List P, List PR) -> PR - applist(lrule, arglist) == [app(lrule, arg) for arg in arglist] + splitRules: List RR -> Record(lker: List K,lval: List F,rl: List RR) splitRules l == ncr := empty()$List(RR) lk := empty()$List(K) @@ -7198,16 +7337,19 @@ ApplyRules(Base, R, F): Exports == Implementation where lv := concat(rhs(u::Equation F), lv) [lk, lv, ncr] + applyRules : (List(RewriteRule(Base,R,F)),F) -> F applyRules(l, s) == rec := splitRules l repeat (new:= localApply(rec.lker,rec.lval,rec.rl,s,1)) = s => return s s := new + applyRules : (List(RewriteRule(Base,R,F)),F,PositiveInteger) -> F applyRules(l, s, n) == rec := splitRules l localApply(rec.lker, rec.lval, rec.rl, s, n) + localApply : (List K, List F, List RR, F, PositiveInteger) -> F localApply(lk, lv, lrule, subject, n) == for i in 1..n repeat for k in lk for v in lv repeat @@ -7215,6 +7357,7 @@ ApplyRules(Base, R, F): Exports == Implementation where subject := app(lrule, subject) subject + rewrite : (F, PR, List Symbol) -> F rewrite(f, res, l) == lk := empty()$List(K) lv := empty()$List(F) @@ -7225,14 +7368,17 @@ ApplyRules(Base, R, F): Exports == Implementation where if R has ConvertibleTo InputForm then + localUnquote : (F,List(Symbol)) -> F localUnquote(f, l) == empty? l => f eval(f, l) else + localUnquote : (F,List(Symbol)) -> F localUnquote(f, l) == f + isitwithpred: (F, P, List P, List PR) -> PR isitwithpred(subject, pat, vars, bad) == failed?(u := patternMatch(subject, pat, new()$PR)) => u satisfy?(u, pat)::Boolean => u @@ -7240,12 +7386,14 @@ ApplyRules(Base, R, F): Exports == Implementation where for v in vars repeat addBadValue(v, getMatch(v, u)::F) isitwithpred(subject, pat, vars, concat(u, bad)) + isit : (F, P) -> PR isit(subject, pat) == hasTopPredicate? pat => for v in (l := variables pat) repeat resetBadValues v isitwithpred(subject, pat, l, empty()) patternMatch(subject, pat, new()$PR) + app : (List RR, F) -> F app(lrule, subject) == for r in lrule repeat not failed?(u := isit(subject, pattern r)) => @@ -7346,6 +7494,7 @@ ApplyUnivariateSkewPolynomial(R:Ring, M: LeftModule R, (* package APPLYORE *) (* + apply : (P,(M -> M),M) -> M apply(p, f, m) == w:M := 0 mn:M := m @@ -7529,12 +7678,13 @@ AssociatedEquations(R, L):Exports == Implementation where (* package ASSOCEQ *) (* - makeMatrix: (Vector MAT, N) -> MAT - diff:L := D() + makeMatrix: (Vector MAT, N) -> MAT makeMatrix(v, n) == matrix [parts row(v.i, n) for i in 1..#v] + associatedSystem : (L,PositiveInteger) -> _ + Record(mat: Matrix(R),vec: Vector(List(PositiveInteger))) associatedSystem(op, m) == eq: Vector R S := SetOfMIntegersInOneToN(m, n := degree(op)::PI) @@ -7563,6 +7713,7 @@ AssociatedEquations(R, L):Exports == Implementation where setRow_!(M, i, eq) [M, ww] + uncouplingMatrices : Matrix(R) -> Vector(Matrix(R)) uncouplingMatrices m == n := nrows m v:Vector MAT := new(n, zero(1, 0)$MAT) @@ -7573,14 +7724,14 @@ AssociatedEquations(R, L):Exports == Implementation where if R has Field then import PrecomputedAssociatedEquations(R, L) - makeop: Vector R -> L makeeq: (Vector List PI, MAT, N, N) -> REC - computeIt: (L, PI, N) -> REC - makeeq(v, m, i, n) == [v.i, makeop row(m, i) - 1, [v.j for j in 1..n | j ^= i], [makeop row(m, j) for j in 1..n | j ^= i]] + associatedEquations : (L,PositiveInteger) -> _ + Record(minor: List(PositiveInteger),eq: L,_ + minors: List(List(PositiveInteger)),ops: List(L)) associatedEquations(op, m) == (u:= firstUncouplingMatrix(op, m)) case "failed" => computeIt(op,m,1) (v := inverse(u::MAT)) case "failed" => computeIt(op, m, 2) @@ -7591,6 +7742,7 @@ AssociatedEquations(R, L):Exports == Implementation where for i in 1..s repeat ww.i := elements(w.i) makeeq(ww, v::MAT, 1, s) + computeIt: (L, PI, N) -> REC computeIt(op, m, k) == rec := associatedSystem(op, m) a := uncouplingMatrices(rec.mat) @@ -7599,6 +7751,7 @@ AssociatedEquations(R, L):Exports == Implementation where (u := inverse(a.i)) case MAT => return makeeq(rec.vec,u::MAT,i,n) error "associatedEquations: full degenerate case" + makeop: Vector R -> L makeop v == op:L := 0 for i in 1..#v repeat op := op + monomial(v i, i) @@ -7693,8 +7846,10 @@ AttachPredicates(D:Type): Exports == Implementation where import FunctionSpaceAttachPredicates(Integer, FE, D) - suchThat(p:Symbol, f:D -> Boolean) == suchThat(p::FE, f) + suchThat : (Symbol,(D -> Boolean)) -> Expression(Integer) + suchThat(p:Symbol, f:D -> Boolean) == suchThat(p::FE, f) + suchThat : (Symbol,List((D -> Boolean))) -> Expression(Integer) suchThat(p:Symbol, l:List(D -> Boolean)) == suchThat(p::FE, l) *) @@ -8468,27 +8623,12 @@ input. (* package AXSERV *) (* - getFile: (SExpression,String) -> Void - getCommand: (SExpression,String) -> Void - getDescription: String -> String - getInterp: (SExpression,String) -> Void - getLisp: (SExpression,String) -> Void - getShow: (SExpression,String) -> Void - lastStep: () -> String - lastType: () -> String - formatMessages: String -> String - makeErrorPage: String -> String - getSourceFile: (String,String,String) -> String - makeDBPage: String -> String - getContentType: String -> String - readTheFile: SExpression -> String - outputToSocket: (SExpression,String,String) -> Void - + getDatabase : (String,String) -> String getDatabase(constructor:String, key:String):String == answer:=string GETDATABASE(INTERN$Lisp constructor,INTERN$Lisp key)$Lisp - -- WriteLine$Lisp concat ["getDatabase: ",constructor," ",key," ",answer] answer + axServer : (Integer,(SExpression -> Void)) -> Void axServer(port:Integer,serverfunc:SExpression->Void):Void == WriteLine$Lisp "listening on port 8085" s := SiSock(port,serverfunc)$Lisp @@ -8500,8 +8640,8 @@ input. w := SiAccept(s)$Lisp serverfunc(w) + multiServ : SExpression -> Void multiServ(s:SExpression):Void == - -- WriteLine("multiServ begin")$Lisp headers:String := "" char:String -- read in the http headers @@ -8509,13 +8649,11 @@ input. STRING(READ_-CHAR_-NO_-HANG(s,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF"_ repeat headers := concat [headers,char] - -- sayTeX$Lisp headers StringMatch("([^ ]*)", headers)$Lisp u:UniversalSegment(Integer) u := segment(MatchBeginning(1)$Lisp+1,_ MatchEnd(1)$Lisp)$UniversalSegment(Integer) reqtype:String := headers.u - -- sayTeX$Lisp concat ["request type: ",reqtype] if reqtype = "GET" then StringMatch("GET ([^ ]*)",headers)$Lisp u:UniversalSegment(Integer) @@ -8549,6 +8687,7 @@ input. -- WriteLine("multiServ end")$Lisp -- WriteLine("")$Lisp + getFile: (SExpression,String) -> Void getFile(s:SExpression,pathvar:String):Void == -- WriteLine("")$Lisp WriteLine$Lisp concat ["getFile: ",pathvar] @@ -8569,27 +8708,29 @@ input. q:=MAKE_-STRING_-INPUT_-STREAM(makeDBPage(pathvar))$Lisp outputToSocket(s,readTheFile(q),contentType) + makeErrorPage: String -> String makeErrorPage(msg:String):String == page:String:="" page:=page "" page:=page "Error" msg "" - -- WriteLine(page)$Lisp page + getDescription: String -> String getDescription(dom:String):String == d:=CADR(CADAR(GETDATABASE(INTERN(dom)$Lisp,'DOCUMENTATION)$Lisp)$Lisp)$Lisp string d + getSourceFile: (String,String,String) -> String getSourceFile(constructorkind:String,_ abbreviation:String,_ dom:String):String == sourcekey:="@<<" constructorkind " " abbreviation " " dom ">>" - -- WriteLine(sourcekey)$Lisp sourcefile:=lowerCase last split(getDatabase(dom,"SOURCEFILE"),char "/") sourcefile:=sourcefile ".pamphlet" + makeDBPage: String -> String makeDBPage(pathvar:String):String == params:List(String):=split(pathvar,char "?") for i in 1..#params repeat WriteLine$Lisp concat ["params: ",params.i] @@ -8720,10 +8861,10 @@ input. page:=page "" page:=page "" page:=page "" - -- WriteLine(page)$Lisp page:=page "" page + readTheFile: SExpression -> String readTheFile(q:SExpression):String == -- WriteLine("begin reading file")$Lisp r := MAKE_-STRING_-OUTPUT_-STREAM()$Lisp @@ -8734,6 +8875,7 @@ input. -- WriteLine("end reading file")$Lisp filestream + outputToSocket: (SExpression,String,String) -> Void outputToSocket(s:SExpression,filestream:String,contentType:String):Void == filelength:String := string(#filestream) file:String := "" @@ -8749,6 +8891,7 @@ input. CLOSE(f)$Lisp CLOSE(s)$Lisp + getCommand: (SExpression,String) -> Void getCommand(s:SExpression,command:String):Void == WriteLine$Lisp concat ["getCommand: ",command] SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp @@ -8790,6 +8933,7 @@ input. CLOSE(q)$Lisp CLOSE(s)$Lisp + getInterp: (SExpression,String) -> Void getInterp(s:SExpression,command:String):Void == WriteLine$Lisp concat ["getInterp: ",command] SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp @@ -8831,6 +8975,7 @@ input. CLOSE(q)$Lisp CLOSE(s)$Lisp + getLisp: (SExpression,String) -> Void getLisp(s:SExpression,command:String):Void == WriteLine$Lisp concat ["getLisp: ",command] evalresult:=EVAL(READ_-FROM_-STRING(command)$Lisp)$Lisp @@ -8870,6 +9015,7 @@ input. CLOSE(q)$Lisp CLOSE(s)$Lisp + getShow: (SExpression,String) -> Void getShow(s:SExpression,showarg:String):Void == WriteLine$Lisp concat ["getShow: ",showarg] realarg:=SUBSEQ(showarg,6)$Lisp @@ -8916,6 +9062,7 @@ input. CLOSE(q)$Lisp CLOSE(s)$Lisp + lastType: () -> String lastType():String == SETQ(first$Lisp,FIRST(_$internalHistoryTable$Lisp)$Lisp)$Lisp count:Integer := 0 @@ -8939,9 +9086,11 @@ input. string SECOND(SECOND(FIRST(first$Lisp)$Lisp)$Lisp)$Lisp "" + lastStep: () -> String lastStep():String == string car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp + formatMessages: String -> String formatMessages(str:String):String == -- WriteLine("formatMessages")$Lisp -- I need to replace any ampersands with & and may also need to @@ -8967,6 +9116,7 @@ input. str := concat [str,"
",s,"
"] str + getContentType: String -> String getContentType(pathvar:String):String == -- WriteLine("getContentType begin")$Lisp -- set default content type @@ -9109,22 +9259,23 @@ BalancedFactorisation(R, UP): Exports == Implementation where (* package BALFACT *) (* - balSqfr : (UP, Integer, List UP) -> Factored UP - balSqfr1: (UP, Integer, UP) -> Factored UP - + balancedFactorisation : (UP,UP) -> Factored(UP) balancedFactorisation(a:UP, b:UP) == balancedFactorisation(a, [b]) + balSqfr1: (UP, Integer, UP) -> Factored UP balSqfr1(a, n, b) == g := gcd(a, b) fa := sqfrFactor((a exquo g)::UP, n) ground? g => fa fa * balSqfr1(g, n, (b exquo (g ** order(b, g)))::UP) + balSqfr : (UP, Integer, List UP) -> Factored UP balSqfr(a, n, l) == b := first l empty? rest l => balSqfr1(a, n, b) */[balSqfr1(f.factor, n, b) for f in factors balSqfr(a,n,rest l)] + balancedFactorisation : (UP,List(UP)) -> Factored(UP) balancedFactorisation(a:UP, l:List UP) == empty?(ll := select(z1 +-> z1 ^= 0, l)) => error "balancedFactorisation: 2nd argument is empty or all 0" @@ -9332,27 +9483,34 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where (* package BOP1 *) (* + evaluate : (BasicOperator,(A -> A)) -> BasicOperator evaluate(op:OP, func:A -> A) == evaluate(op, (ll:List(A)):A +-> func first ll) + evaluate : BasicOperator -> Union((List(A) -> A),"failed") evaluate op == (func := property(op, EVAL)) case "failed" => "failed" (func::None) pretend (List A -> A) + evaluate : (BasicOperator,List(A)) -> Union(A,"failed") evaluate(op:OP, args:List A) == (func := property(op, EVAL)) case "failed" => "failed" ((func::None) pretend (List A -> A)) args + evaluate : (BasicOperator,(List(A) -> A)) -> BasicOperator evaluate(op:OP, func:List A -> A) == setProperty(op, EVAL, func pretend None) + derivative : BasicOperator -> Union(List((List(A) -> A)),"failed") derivative op == (func := property(op, DIFF)) case "failed" => "failed" ((func::None) pretend List(List A -> A)) + derivative : (BasicOperator,List((List(A) -> A))) -> BasicOperator derivative(op:OP, grad:List(List A -> A)) == setProperty(op, DIFF, grad pretend None) + derivative : (BasicOperator,(A -> A)) -> BasicOperator derivative(op:OP, f:A -> A) == unary? op or nary? op => derivative(op, [(ll:List(A)):A +-> f first ll]$List(List A -> A)) @@ -9360,35 +9518,35 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where if A has OrderedSet then - cdisp : (OUT, List OUT) -> OUT - csex : (IN, List IN) -> IN - eqconst?: (OP, OP) -> Boolean - ltconst?: (OP, OP) -> Boolean - constOp : A -> OP - opconst:OP := comparison(equality(operator("constant"::Symbol, 0), eqconst?), ltconst?) + cdisp : (OUT, List OUT) -> OUT cdisp(a, l) == a + csex : (IN, List IN) -> IN csex(a, l) == a + eqconst?: (OP, OP) -> Boolean eqconst?(a, b) == (va := property(a, CONST)) case "failed" => not has?(b, CONST) ((vb := property(b, CONST)) case None) and ((va::None) pretend A) = ((vb::None) pretend A) + ltconst?: (OP, OP) -> Boolean ltconst?(a, b) == (va := property(a, CONST)) case "failed" => has?(b, CONST) ((vb := property(b, CONST)) case None) and ((va::None) pretend A) < ((vb::None) pretend A) + constOp : A -> OP constOp a == setProperty( display(copy opconst, (ll:List(OUT)):OUT +-> cdisp(a::OUT, ll)), CONST, a pretend None) + constantOpIfCan : BasicOperator -> Union(A,"failed") constantOpIfCan op == is?(op, "constant"::Symbol) and ((u := property(op, CONST)) case None) => (u::None) pretend A @@ -9396,11 +9554,13 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where if A has ConvertibleTo IN then + constantOperator : A -> BasicOperator constantOperator a == input(constOp a, (ll:List(IN)):IN +-> csex(convert a, ll)) else + constantOperator : A -> BasicOperator constantOperator a == constOp a *) @@ -10339,13 +10499,16 @@ Bezier(R:Ring): with (* package BEZIER *) (* + linearBezier : (List(R),List(R)) -> (R -> List(R)) linearBezier(a,b) == t +-> [(1-t)*(a.1) + t*(b.1), (1-t)*(a.2) + t*(b.2)] + quadraticBezier : (List(R),List(R),List(R)) -> (R -> List(R)) quadraticBezier(a,b,c) == t +-> [(1-t)**2*(a.1) + 2*t*(1-t)*(b.1) + t**2*(c.1), (1-t)**2*(a.2) + 2*t*(1-t)*(b.2) + t**2*(c.2)] + cubicBezier : (List(R),List(R),List(R),List(R)) -> (R -> List(R)) cubicBezier(a,b,c,d) == t +-> [(1-t)**3*(a.1) + 3*t*(1-t)**2*(b.1) + 3*t**2*(1-t)*(c.1) + t**3*(d.1), @@ -10597,6 +10760,7 @@ In symbolic form the resultant can show the multiplicity of roots. (* package BEZOUT *) (* + sylvesterMatrix : (UP,UP) -> M sylvesterMatrix(p,q) == n1 := degree p; n2 := degree q; n := n1 + n2 sylmat : M := new(n,n,0) @@ -10617,11 +10781,12 @@ In symbolic form the resultant can show the multiplicity of roots. qsetelt_!(sylmat,minR + n2 + i,minC + n2 - deg + i,coef) sylmat - bezoutMatrix(p,q) == -- This function computes the Bezout matrix for 'p' and 'q'. -- See Knuth, The Art of Computer Programming, Vol. 2, p. 619, # 12. -- One must have deg(p) >= deg(q), so the arguments are reversed -- if this is not the case. + bezoutMatrix : (UP,UP) -> M + bezoutMatrix(p,q) == n1 := degree p; n2 := degree q; n := n1 + n2 n1 < n2 => bezoutMatrix(q,p) m1 : I := n1 - 1; m2 : I := n2 - 1; m : I := n - 1 @@ -10682,10 +10847,12 @@ In symbolic form the resultant can show the multiplicity of roots. if R has commutative("*") then + bezoutResultant : (UP,UP) -> R bezoutResultant(f,g) == determinant bezoutMatrix(f,g) if R has IntegralDomain then + bezoutDiscriminant : UP -> R bezoutDiscriminant f == degMod4 := (degree f) rem 4 (degMod4 = 0) or (degMod4 = 1) => @@ -10694,6 +10861,7 @@ In symbolic form the resultant can show the multiplicity of roots. else + bezoutDiscriminant : UP -> R bezoutDiscriminant f == lc f = 1 => degMod4 := (degree f) rem 4 @@ -11025,16 +11193,18 @@ BlowUpPackage(K,symb,PolyRing,E, BLMET):Exports == Implementation where import PackPoly import NP + makeAff :(List(K),BLMET) -> AFP makeAff( l:List(K) , chart: BLMET ):AFP == (excepCoord chart) = 1 => affinePoint( l )$AFP affinePoint( reverse l )$AFP - blowExp: (E2, NNI, BLMET ) -> E2 - - maxOf: (K,K) -> K - - getStrTrans: ( BlUpRing , List BlUpRing , BLMET, K ) -> recStr - + stepBlowUp : _ + (DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),_ + AffinePlane(K),BLMET,K) -> _ + Record(mult: NonNegativeInteger,subMult: NonNegativeInteger,_ + blUpRec: List(Record(recTransStr: _ + DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),_ + recPoint: AffinePlane(K),recChart: BLMET,definingExtension: K))) stepBlowUp(crb:BlUpRing,pt:AFP,chart:BLMET,actualExtension:K) == -- next is with Hamburger-Noether method BLMET has HamburgerNoether => @@ -11104,6 +11274,7 @@ BlowUpPackage(K,symb,PolyRing,E, BLMET):Exports == Implementation where [multPt, 0 ,listRec]$blowUpReturn error "Desingularisation is not implemented for the blowing up method chosen, see BlowingUpMethodCategory." + getStrTrans: ( BlUpRing , List BlUpRing , BLMET, K ) -> recStr getStrTrans( crb , inedge , actChart, actualExtension ) == edge:= copy inedge s := slope(edge)$NP @@ -11162,6 +11333,7 @@ BlowUpPackage(K,symb,PolyRing,E, BLMET):Exports == Implementation where for p in lAff for z in listOfZeroes ] [sMult, listBlRec ]$recStr + blowExp: (E2, NNI, BLMET ) -> E2 blowExp(exp,mult,chart)== -- CHH zero?( excepCoord chart) => exp lexp:List NNI:=parts(exp) @@ -11175,9 +11347,15 @@ BlowUpPackage(K,symb,PolyRing,E, BLMET):Exports == Implementation where lbexp(ch2):=lexp(ch2) directProduct(vector(lbexp)$Vector(NNI))$E2 + quadTransform : _ + (DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),_ + NonNegativeInteger,BLMET) -> _ + DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) quadTransform(pol,mult,chart)== -- CHH mapExponents(blowExp(#1,mult,chart),pol) + polyRingToBlUpRing : (PolyRing,BLMET) -> _ + DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) polyRingToBlUpRing(pol,chart)== zero? pol => 0 lc:= leadingCoefficient pol @@ -11186,6 +11364,9 @@ BlowUpPackage(K,symb,PolyRing,E, BLMET):Exports == Implementation where e:= directProduct( vector( ll)$Vector(NNI) )$E2 monomial(lc , e )$BlUpRing + polyRingToBlUpRing( reductum pol, chart ) + biringToPolyRing : _ + (DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),BLMET)_ + -> PolyRing biringToPolyRing(pol,chart)== zero? pol => 0 lc:= leadingCoefficient pol @@ -11198,12 +11379,12 @@ BlowUpPackage(K,symb,PolyRing,E, BLMET):Exports == Implementation where e:= directProduct( vector( ll)$Vector(NNI) )$E monomial(lc , e )$PolyRing + biringToPolyRing( reductum pol, chart ) + applyTransform : (PolyRing,BLMET) -> PolyRing applyTransform(pol,chart)== biringToPolyRing( quadTransform( polyRingToBlUpRing( pol, chart ) ,_ 0 , chart) , chart ) --- K has PseudoAlgebraicClosureOfFiniteFieldCategory => maxTower([a,b])$K --- K has PseudoAlgebraicClosureOfRationalNumberCategory => maxTower([a,b])$K + maxOf: (K,K) -> K maxOf(a:K,b:K):K == K has PseudoAlgebraicClosureOfPerfectFieldCategory => maxTower([a,b])$K 1$K @@ -11357,29 +11538,26 @@ BoundIntegerRoots(F, UP): Exports == Implementation where import RationalFactorize(UPQ) import UnivariatePolynomialCategoryFunctions2(F, UP, Q, UPQ) - qbound : (UP, UPQ) -> Z - zroot1 : UP -> Z - qzroot1: UPQ -> Z - negint : Q -> Z - -- returns 0 if p has no integer root < 0, -- its negative integer root otherwise + qzroot1: UPQ -> Z qzroot1 p == negint(- leadingCoefficient(reductum p)/leadingCoefficient p) -- returns 0 if p has no integer root < 0, -- its negative integer root otherwise + zroot1 : UP -> Z zroot1 p == z := - leadingCoefficient(reductum p) / leadingCoefficient p (r := retractIfCan(z)@Union(Q, "failed")) case Q => negint(r::Q) 0 -- returns 0 if r is not a negative integer, r otherwise + negint : Q -> Z negint r == ((u := retractIfCan(r)@Union(Z, "failed")) case Z) and (u::Z < 0) => u::Z 0 if F has ExpressionSpace then - bringDown: F -> Q -- the random substitution used by bringDown is NOT always a ring-homorphism -- (because of potential algebraic kernels), but is ALWAYS a Z-linear map. @@ -11388,10 +11566,12 @@ BoundIntegerRoots(F, UP): Exports == Implementation where -- the only problem is that evaluating with random numbers can cause a -- division by 0. We should really be able to trap this error later and -- reevaluate with a new set of random numbers MB 11/91 + bringDown: F -> Q bringDown f == t := tower f retract eval(f, t, [random()$Q :: F for k in t]) + integerBound : UP -> Integer integerBound p == (degree p) = 1 => zroot1 p q1 := map(bringDown, p) @@ -11400,11 +11580,13 @@ BoundIntegerRoots(F, UP): Exports == Implementation where else + integerBound : UP -> Integer integerBound p == (degree p) = 1 => zroot1 p qbound(p, map((z1:F):Q +-> retract(z1)@Q, p)) -- we can probably do better here (i.e. without factoring) + qbound : (UP, UPQ) -> Z qbound(p, q) == bound:Z := 0 for rec in factors factor q repeat @@ -11588,12 +11770,14 @@ BrillhartTests(UP): Exports == Implementation where import GaloisGroupFactorizationUtilities(Z,UP,Float) + squaredPolynomial: UP -> Boolean squaredPolynomial(p:UP):Boolean == d := degree p d = 0 => true odd? d => false squaredPolynomial reductum p + primeEnough? : (Z,Z) -> Boolean primeEnough?(n:Z,b:Z):Boolean == -- checks if n is prime, with the possible exception of -- factors whose product is at most b @@ -11609,15 +11793,19 @@ BrillhartTests(UP): Exports == Implementation where brillharttrials: N := 6 + brillhartTrials : () -> NonNegativeInteger brillhartTrials():N == brillharttrials + brillhartTrials : NonNegativeInteger -> NonNegativeInteger brillhartTrials(n:N):N == (brillharttrials,n) := (n,brillharttrials) n + brillhartIrreducible? : UP -> Boolean brillhartIrreducible?(p:UP):Boolean == brillhartIrreducible?(p,noLinearFactor? p) + brillhartIrreducible? : (UP,Boolean) -> Boolean brillhartIrreducible?(p:UP,noLinears:Boolean):Boolean == -- See [1] zero? brillharttrials => false origBound := (largeEnough := rootBound(p)+1) @@ -11643,6 +11831,7 @@ BrillhartTests(UP): Exports == Implementation where not polyx2 and primeEnough?(p(-i),small) => return true false + noLinearFactor? : UP -> Boolean noLinearFactor?(p:UP):Boolean == (odd? leadingCoefficient p) and (odd? coefficient(p,0)) and (odd? p(1)) @@ -11741,9 +11930,13 @@ CartesianTensorFunctions2(minix, dim, S, T): CTPcat == CTPdef where (* package CARTEN2 *) (* + reshape : (List(T$),CartesianTensor(minix,dim,S)) -> _ + CartesianTensor(minix,dim,T$) reshape(l, s) == unravel l - map(f, s) == unravel [f e for e in ravel s] + map : ((S -> T$),CartesianTensor(minix,dim,S)) -> _ + CartesianTensor(minix,dim,T$) + map(f, s) == unravel [f e for e in ravel s] *) @@ -11950,15 +12143,13 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) - algPoly : UPUP -> Record(coef:RF, poly:UPUP) - RPrim : (UP, UP, UPUP) -> Record(coef:RF, poly:UPUP) - good? : (F, UP, UP) -> Boolean - infIntegral?: (UPUP, UPUP) -> Boolean - - eval(p, x, y) == map(s +-> s(x), p) monomial(y, 1) + eval : (UPUP,Fraction(UP),Fraction(UP)) -> UPUP + eval(p, x, y) == map(s +-> s(x), p) monomial(y, 1) + good? : (F, UP, UP) -> Boolean good?(a, p, q) == p(a) ^= 0 and q(a) ^= 0 + algPoly : UPUP -> Record(coef:RF, poly:UPUP) algPoly p == ground?(a:= retract(leadingCoefficient(q:=clearDenominator p))@UP) => RPrim(1, a, q) @@ -11969,6 +12160,7 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where q := clearDenominator q monomial(inv(d::RF), 1) RPrim(c, a, q) + RPrim : (UP, UP, UPUP) -> Record(coef:RF, poly:UPUP) RPrim(c, a, q) == (a = 1) => [c::RF, q] [(a * c)::RF, clearDenominator q monomial(inv(a::RF), 1)] @@ -11976,6 +12168,9 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where -- always makes the algebraic integral, but does not send a point -- to infinity -- if the integrand does not have a pole there (in the case of an nth-root) + chvar : (UPUP,UPUP) -> _ + Record(func: UPUP,poly: UPUP,c1: Fraction(UP),_ + c2: Fraction(UP),deg: NonNegativeInteger) chvar(f, modulus) == r1 := mkIntegral modulus f1 := f monomial(r1inv := inv(r1.coef), 1) @@ -11991,6 +12186,7 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where -- and it can be guaranteed that p(x,y)dx -- is integral at infinity -- expects y to be integral. + infIntegral?: (UPUP, UPUP) -> Boolean infIntegral?(p, modulus) == (r := radPoly modulus) case "failed" => false ninv := inv(r.deg::Q) @@ -12003,11 +12199,13 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where p := reductum p degp <= ninv + mkIntegral : UPUP -> Record(coef: Fraction(UP),poly: UPUP) mkIntegral p == (r := radPoly p) case "failed" => algPoly p rp := rootPoly(r.radicand, r.deg) [rp.coef, monomial(1, rp.exponent)$UPUP - rp.radicand::RF::UPUP] + goodPoint : (UPUP,UPUP) -> F goodPoint(p, modulus) == q := (r := radPoly modulus) case "failed" => @@ -12018,6 +12216,8 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where good?(a := i::F, q, d) => return a good?(-a, q, d) => return -a + radPoly : UPUP -> _ + Union(Record(radicand: Fraction(UP),deg: NonNegativeInteger),"failed") radPoly p == (r := retractIfCan(reductum p)@Union(RF, "failed")) case "failed" => "failed" @@ -12026,6 +12226,8 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where -- we have y**m = g(x) = n(x)/d(x), so if we can write -- (n(x) * d(x)**(m-1)) ** (1/m) = c(x) * P(x) ** (1/n) -- then z**q = P(x) where z = (d(x) / c(x)) * y + rootPoly : (Fraction(UP),NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: Fraction(UP),radicand: UP) rootPoly(g, m) == zero? g => error "Should not happen" pr := nthRoot(squareFree((numer g) * (d := denom g) ** (m-1)::N), @@ -12128,12 +12330,14 @@ CharacteristicPolynomialInMonogenicalAlgebra(R : CommutativeRing, import UnivariatePolynomialCategoryFunctions2(R, PolR, PolR, Pol(PolR)) + XtoY : (PolR) -> Pol(PolR) XtoY(Q : PolR) : Pol(PolR) == map(x+->monomial(x, 0), Q) P : Pol(PolR) := XtoY(definingPolynomial()$E) X : Pol(PolR) := monomial(monomial(1, 1)$PolR, 0) + characteristicPolynomial : E -> PolR characteristicPolynomial(x : E) : PolR == Qx : PolR := lift(x) -- on utilise le fait que resultant_Y (P(Y), X - Qx(Y)) @@ -12227,7 +12431,7 @@ CharacteristicPolynomialPackage(R:CommutativeRing):C == T where (* package CHARPOL *) (* - ---- characteristic polynomial ---- + characteristicPolynomial : (Matrix(R),R) -> R characteristicPolynomial(A:M,v:R) : R == dimA :PI := (nrows A):PI dimA ^= ncols A => error " The matrix is not square" @@ -12581,6 +12785,7 @@ CoerceVectorMatrixPackage(R : CommutativeRing): public == private where imbedP : R -> Polynomial R imbedP r == (r:: Polynomial R) + coerceP : Vector(Matrix(R)) -> Vector(Matrix(Polynomial(R))) coerceP(g:Vector Matrix R) : Vector Matrix Polynomial R == m2 : Matrix Polynomial R lim : List Matrix R := entries g @@ -12590,6 +12795,7 @@ CoerceVectorMatrixPackage(R : CommutativeRing): public == private where l := cons(m2,l) vector reverse l + coerce : Vector(Matrix(R)) -> Vector(Matrix(Fraction(Polynomial(R)))) coerce(g:Vector Matrix R) : Vector Matrix Fraction Polynomial R == m3 : Matrix Fraction Polynomial R lim : List Matrix R := entries g @@ -13391,32 +13597,6 @@ CombinatorialFunction(R, F): Exports == Implementation where (* package COMBF *) (* - ifact : F -> F - iiipow : List F -> F - iperm : List F -> F - ibinom : List F -> F - isum : List F -> F - idsum : List F -> F - iprod : List F -> F - idprod : List F -> F - dsum : List F -> O - ddsum : List F -> O - dprod : List F -> O - ddprod : List F -> O - equalsumprod : (K, K) -> Boolean - equaldsumprod : (K, K) -> Boolean - fourth : List F -> F - dvpow1 : List F -> F - dvpow2 : List F -> F - summand : List F -> F - dvsum : (List F, SE) -> F - dvdsum : (List F, SE) -> F - dvprod : (List F, SE) -> F - dvdprod : (List F, SE) -> F - facts : (F, List SE) -> F - K2fact : (K, List SE) -> F - smpfact : (SMP, List SE) -> F - -- This macro will be used in product and summation, both the 5 and 3 -- argument forms. It is used to introduce a dummy variable in place of the -- summation index within the summands. This in turn is necessary to keep the @@ -13441,15 +13621,19 @@ CombinatorialFunction(R, F): Exports == Implementation where oppow := operator(POWER::Symbol)$CommonOperators - factorial x == opfact x + factorial : F -> F + factorial x == opfact x - binomial(x, y) == opbinom [x, y] + binomial : (F,F) -> F + binomial(x, y) == opbinom [x, y] - permutation(x, y) == opperm [x, y] + permutation : (F,F) -> F + permutation(x, y) == opperm [x, y] import F import Kernel F + number? : F -> Boolean number?(x:F):Boolean == if R has RetractableTo(Z) then ground?(x) or @@ -13457,7 +13641,8 @@ CombinatorialFunction(R, F): Exports == Implementation where else ground?(x) - x ** y == + ?**? : (F,F) -> F + x ** y == -- Do some basic simplifications is?(x,POWER) => args : List F := argument first kernels x @@ -13472,24 +13657,33 @@ CombinatorialFunction(R, F): Exports == Implementation where oppow [expr.val, (expr.exponent)*y] oppow [x, y] - belong? op == has?(op, "comb") + belong? : BasicOperator -> Boolean + belong? op == has?(op, "comb") - fourth l == third rest l + fourth : List F -> F + fourth l == third rest l - dvpow1 l == second(l) * first(l) ** (second l - 1) + dvpow1 : List F -> F + dvpow1 l == second(l) * first(l) ** (second l - 1) - factorials x == facts(x, variables x) + factorials : F -> F + factorials x == facts(x, variables x) - factorials(x, v) == facts(x, [v]) + factorials : (F,Symbol) -> F + factorials(x, v) == facts(x, [v]) - facts(x, l) == smpfact(numer x, l) / smpfact(denom x, l) + facts : (F, List SE) -> F + facts(x, l) == smpfact(numer x, l) / smpfact(denom x, l) - summand l == eval(first l, retract(second l)@K, third l) + summand : List F -> F + summand l == eval(first l, retract(second l)@K, third l) + product : (F,Symbol) -> F product(x:F, i:SE) == dm := dummy opprod [eval(x, k := kernel(i)$K, dm), dm, k::F] + summation : (F,Symbol) -> F summation(x:F, i:SE) == dm := dummy opsum [eval(x, k := kernel(i)$K, dm), dm, k::F] @@ -13497,9 +13691,11 @@ CombinatorialFunction(R, F): Exports == Implementation where -- These two operations return the product or the sum as unevaluated operators -- A dummy variable is introduced to make the indexing variable local. + dvsum : (List F, SE) -> F dvsum(l, x) == opsum [differentiate(first l, x), second l, third l] + dvdsum : (List F, SE) -> F dvdsum(l, x) == x = retract(y := third l)@SE => 0 if member?(x, variables(h := third rest rest l)) or @@ -13508,6 +13704,7 @@ CombinatorialFunction(R, F): Exports == Implementation where else opdsum [differentiate(first l, x), second l, y, g, h] + dvprod : (List F, SE) -> F dvprod(l, x) == dm := retract(dummy)@SE f := eval(first l, retract(second l)@K, dm::F) @@ -13515,7 +13712,7 @@ CombinatorialFunction(R, F): Exports == Implementation where opsum [differentiate(first l, x)/first l * p, second l, third l] - + dvdprod : (List F, SE) -> F dvdprod(l, x) == x = retract(y := third l)@SE => 0 if member?(x, variables(h := third rest rest l)) or @@ -13527,15 +13724,19 @@ CombinatorialFunction(R, F): Exports == Implementation where -- These four operations handle the conversion of sums and products to -- OutputForm + dprod : List F -> O dprod l == prod(summand(l)::O, third(l)::O) + ddprod : List F -> O ddprod l == prod(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O) + dsum : List F -> O dsum l == sum(summand(l)::O, third(l)::O) + ddsum : List F -> O ddsum l == sum(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O) @@ -13544,11 +13745,13 @@ CombinatorialFunction(R, F): Exports == Implementation where -- Kernel. Note that we can assume that the operators are equal, since this is -- checked in Kernel itself. + equalsumprod : (K, K) -> Boolean equalsumprod(s1, s2) == l1 := argument s1 l2 := argument s2 (eval(first l1, retract(second l1)@K, second l2) = first l2) + equaldsumprod : (K, K) -> Boolean equaldsumprod(s1, s2) == l1 := argument s1 l2 := argument s2 @@ -13559,20 +13762,24 @@ CombinatorialFunction(R, F): Exports == Implementation where -- These two operations return the product or the sum as unevaluated operators -- A dummy variable is introduced to make the indexing variable local. + product : (F,SegmentBinding(F)) -> F product(x:F, s:SegmentBinding F) == k := kernel(variable s)$K dm := dummy opdprod [eval(x,k,dm), dm, k::F, lo segment s, hi segment s] + summation : (F,SegmentBinding(F)) -> F summation(x:F, s:SegmentBinding F) == k := kernel(variable s)$K dm := dummy opdsum [eval(x,k,dm), dm, k::F, lo segment s, hi segment s] + smpfact : (SMP, List SE) -> F smpfact(p, l) == map(x +-> K2fact(x, l), y+->y::F, p)_ $PolynomialCategoryLifting(IndexedExponents K, K, R, SMP, F) + K2fact : (K, List SE) -> F K2fact(k, l) == empty? [v for v in variables(kf := k::F) | member?(v, l)] => kf empty?(args:List F := [facts(a, l) for a in argument k]) => kf @@ -13584,6 +13791,7 @@ CombinatorialFunction(R, F): Exports == Implementation where factorial(n) / (factorial(p) * factorial(n-p)) (operator k) args + operator : BasicOperator -> BasicOperator operator op == is?(op, "factorial"::Symbol) => opfact is?(op, "permutation"::Symbol) => opperm @@ -13595,41 +13803,49 @@ CombinatorialFunction(R, F): Exports == Implementation where is?(op, POWER) => oppow error "Not a combinatorial operator" + iprod : List F -> F iprod l == zero? first l => 0 (first l = 1) => 1 kernel(opprod, l) + isum : List F -> F isum l == zero? first l => 0 kernel(opsum, l) + idprod : List F -> F idprod l == member?(retract(second l)@SE, variables first l) => kernel(opdprod, l) first(l) ** (fourth rest l - fourth l + 1) + idsum : List F -> F idsum l == member?(retract(second l)@SE, variables first l) => kernel(opdsum, l) first(l) * (fourth rest l - fourth l + 1) + ifact : F -> F ifact x == zero? x or (x = 1) => 1 kernel(opfact, x) + ibinom : List F -> F ibinom l == n := first l ((p := second l) = 0) or (p = n) => 1 (p = 1) or (p = n - 1) => n kernel(opbinom, l) + iperm : List F -> F iperm l == zero? second l => 1 kernel(opperm, l) if R has RetractableTo Z then + iidsum : List(F) -> F iidsum l == (r1:=retractIfCan(fourth l)@Union(Z,"failed")) case "failed" or @@ -13639,6 +13855,7 @@ CombinatorialFunction(R, F): Exports == Implementation where => idsum l +/[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z] + iidprod : List(F) -> F iidprod l == (r1:=retractIfCan(fourth l)@Union(Z,"failed")) case "failed" or @@ -13648,6 +13865,7 @@ CombinatorialFunction(R, F): Exports == Implementation where => idprod l */[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z] + iiipow : List F -> F iiipow l == (u := isExpt(x := first l, OPEXP)) case "failed" => kernel(oppow, l) rec := u::Record(var: K, exponent: Z) @@ -13658,6 +13876,7 @@ CombinatorialFunction(R, F): Exports == Implementation where if F has RadicalCategory then + ipow : List(F) -> F ipow l == (r := retractIfCan(second l)@Union(Fraction Z,"failed")) case "failed" => iiipow l @@ -13665,6 +13884,7 @@ CombinatorialFunction(R, F): Exports == Implementation where else + ipow : List(F) -> F ipow l == (r := retractIfCan(second l)@Union(Z, "failed")) case "failed" => iiipow l @@ -13672,6 +13892,7 @@ CombinatorialFunction(R, F): Exports == Implementation where else + ipow : List(F) -> F ipow l == zero?(x := first l) => zero? second l => error "0 ** 0" @@ -13686,10 +13907,12 @@ CombinatorialFunction(R, F): Exports == Implementation where if R has CombinatorialFunctionCategory then + iifact : F -> F iifact x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => ifact x factorial(r::R)::F + iiperm : List(F) -> F iiperm l == (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" @@ -13698,6 +13921,7 @@ CombinatorialFunction(R, F): Exports == Implementation where if R has RetractableTo(Z) and F has Algebra(Fraction(Z)) then + iibinom : List(F) -> F iibinom l == (s:=retractIfCan(second l)@Union(R,"failed")) case R and (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 => @@ -13722,6 +13946,7 @@ CombinatorialFunction(R, F): Exports == Implementation where else + iibinom : List(F) -> F iibinom l == (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" @@ -13730,14 +13955,18 @@ CombinatorialFunction(R, F): Exports == Implementation where else + iifact : F -> F iifact x == ifact x + iibinom : List(F) -> F iibinom l == ibinom l + iiperm : List(F) -> F iiperm l == iperm l if R has ElementaryFunctionCategory then + iipow : List(F) -> F iipow l == (r1:=retractIfCan(first l)@Union(R,"failed")) case "failed" or (r2:=retractIfCan(second l)@Union(R,"failed")) case "failed" @@ -13746,46 +13975,66 @@ CombinatorialFunction(R, F): Exports == Implementation where else + iipow : List(F) -> F iipow l == ipow l if F has ElementaryFunctionCategory then + dvpow2 : List F -> F dvpow2 l == if zero?(first l) then 0 else log(first l) * first(l) ** second(l) evaluate(opfact, iifact)$BasicOperatorFunctions1(F) + evaluate(oppow, iipow) + evaluate(opperm, iiperm) + evaluate(opbinom, iibinom) + evaluate(opsum, isum) + evaluate(opdsum, iidsum) + evaluate(opprod, iprod) + evaluate(opdprod, iidprod) + derivative(oppow, [dvpow1, dvpow2]) -- These four properties define special differentiation rules for sums and -- products. setProperty(opsum, SPECIALDIFF, dvsum@((List F, SE) -> F) pretend None) + setProperty(opdsum, SPECIALDIFF, dvdsum@((List F, SE)->F) pretend None) + setProperty(opprod, SPECIALDIFF, dvprod@((List F, SE)->F) pretend None) + setProperty(opdprod, SPECIALDIFF, dvdprod@((List F, SE)->F) pretend None) -- Set the properties for displaying sums and products and testing for -- equality. setProperty(opsum, SPECIALDISP, dsum@(List F -> O) pretend None) + setProperty(opdsum, SPECIALDISP, ddsum@(List F -> O) pretend None) + setProperty(opprod, SPECIALDISP, dprod@(List F -> O) pretend None) + setProperty(opdprod, SPECIALDISP, ddprod@(List F -> O) pretend None) + setProperty(opsum, SPECIALEQUAL, equalsumprod@((K,K) -> Boolean)_ pretend None) + setProperty(opdsum, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean)_ pretend None) + setProperty(opprod, SPECIALEQUAL, equalsumprod@((K,K) -> Boolean)_ pretend None) + setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean)_ pretend None) @@ -13904,10 +14153,12 @@ CommonDenominator(R, Q, A): Exports == Implementation where (* package CDEN *) (* + clearDenominator : A -> A clearDenominator l == d := commonDenominator l map(x+->numer(d*x)::Q, l) + splitDenominator : A -> Record(num: A,den: R) splitDenominator l == d := commonDenominator l [map(x+->numer(d*x)::Q, l), d] @@ -13915,13 +14166,14 @@ CommonDenominator(R, Q, A): Exports == Implementation where if R has GcdDomain then qlcm: (Q, Q) -> Q - qlcm(a, b) == lcm(numer a, numer b)::Q + commonDenominator : A -> R commonDenominator l == numer reduce(qlcm, map(x+->denom(x)::Q, l), 1) else + commonDenominator : A -> R commonDenominator l == numer reduce("*", map(x+->denom(x)::Q, l), 1) *) @@ -14268,14 +14520,6 @@ CommonOperators(): Exports == Implementation where (* package COMMONOP *) (* - dpi : List O -> O - dgamma : List O -> O - dquote : List O -> O - dexp : O -> O - dfact : O -> O - startUp : Boolean -> Void - setDummyVar: (OP, NonNegativeInteger) -> OP - brandNew?:Reference(Boolean) := ref true opalg := operator("rootOf"::Symbol, 2)$OP @@ -14445,50 +14689,67 @@ CommonOperators(): Exports == Implementation where -- operators whose second and third arguments are dummy variables dummyvarop2 := [opdint, opdsum, opdprod] + operator : Symbol -> BasicOperator operator s == if (deref brandNew?) then startUp false for op in allop repeat is?(op, s) => return copy op operator(s)$OP - dpi l == "%pi"::Symbol::O + dpi : List O -> O + dpi l == "%pi"::Symbol::O + dfact : O -> O dfact x == postfix("!"::Symbol::O, (ATOM(x)$Lisp => x; paren x)) + dquote : List O -> O dquote l == prefix(quote(first(l)::O), rest l) + dgamma : List O -> O dgamma l == prefix(hconcat("|"::Symbol::O, overbar(" "::Symbol::O)), l) + setDummyVar: (OP, NonNegativeInteger) -> OP setDummyVar(op, n) == setProperty(op, DUMMYVAR, n pretend None) + dexp : O -> O dexp x == e := "%e"::Symbol::O x = 1::O => e e ** x + fsupersub : List O -> O fsupersub(x:List O):O == supersub("A"::Symbol::O, x) + fbinomial : List O -> O fbinomial(x:List O):O == binomial(first x, second x) - fpower(x:List O):O == first(x) ** second(x) + fpower : List O -> O + fpower(x:List O):O == first(x) ** second(x) - fsum(x:List O):O == sum(first x, second x, third x) + fsum : List O -> O + fsum(x:List O):O == sum(first x, second x, third x) - fprod(x:List O):O == prod(first x, second x, third x) + fprod : List O -> O + fprod(x:List O):O == prod(first x, second x, third x) - fint(x:List O):O == + fint : List O -> O + fint(x:List O):O == int(first x * hconcat("d"::Symbol::O, second x),empty(), third x) + fpren : List InputForm -> InputForm fpren(x:List InputForm):InputForm == convert concat(convert("("::Symbol)@InputForm, concat(x, convert(")"::Symbol)@InputForm)) + fpow : List InputForm -> InputForm fpow(x:List InputForm):InputForm == convert concat(convert("**"::Symbol)@InputForm, x) + froot : List InputForm -> InputForm froot(x:List InputForm):InputForm == convert [convert("**"::Symbol)@InputForm, first x, 1 / second x] + startUp : Boolean -> Void startUp b == brandNew?() := b display(oppren, paren) @@ -14622,9 +14883,8 @@ CommuteUnivariatePolynomialCategory(R, UP, UPUP): Exports == Impl where (* package COMMUPC *) (* - makePoly: (UP, N) -> UPUP - -- converts P(x,y) to P(y,x) + swap : UPUP -> UPUP swap poly == ans:UPUP := 0 while poly ^= 0 repeat @@ -14632,6 +14892,7 @@ CommuteUnivariatePolynomialCategory(R, UP, UPUP): Exports == Impl where poly := reductum poly ans + makePoly: (UP, N) -> UPUP makePoly(poly, d) == ans:UPUP := 0 while poly ^= 0 repeat @@ -14788,12 +15049,14 @@ ComplexFactorization(RR,PR) : C == T where UPCF2 := UnivariatePolynomialCategoryFunctions2(R,PR,GRN,SUP GRN) UPCFB := UnivariatePolynomialCategoryFunctions2(GRN,SUP GRN,R,PR) + myMap : R -> GRN myMap(r:R) : GRN == R is GI => cr :GI := r pretend GI complex((real cr)::RN,(imag cr)::RN) R is GRN => r pretend GRN + compND : GRN -> Record(cnum:GI,cden:Integer) compND(cc:GRN):Record(cnum:GI,cden:Integer) == ccr:=real cc cci:=imag cc @@ -14803,6 +15066,7 @@ ComplexFactorization(RR,PR) : C == T where [complex(((ccd exquo dccr)::Integer)*numer ccr, ((ccd exquo dcci)::Integer)*numer cci),ccd] + conv : SUP GRN -> Record(convP:SUP GI, convD:RN) conv(f:SUP GRN) :Record(convP:SUP GI, convD:RN) == pris:SUP GI :=0 dris:Integer:=1 @@ -14818,6 +15082,7 @@ ComplexFactorization(RR,PR) : C == T where dris1:=dris [pris,dris::RN] + backConv : Factored SUP GRN -> Factored PR backConv(ffr:Factored SUP GRN) : Factored PR == R is GRN => makeFR((unit ffr) pretend PR,[[f.flg,(f.fctr) pretend PR,f.xpnt] @@ -14835,6 +15100,7 @@ ComplexFactorization(RR,PR) : C == T where makeFR((uconst pretend R)::PR,ris) + factor : PR -> Factored(PR) factor(pol : PR) : Factored PR == ratPol:SUP GRN := 0 ratPol:=map(myMap,pol)$UPCF2 @@ -14914,6 +15180,7 @@ ComplexFunctions2(R:CommutativeRing, S:CommutativeRing): with (* package COMPLEX2 *) (* + map : ((R -> S),Complex(R)) -> Complex(S) map(fn, gr) == complex(fn real gr, fn imag gr) *) @@ -15029,6 +15296,9 @@ ComplexIntegerSolveLinearPolynomialEquation(R,CR): C == T oldtable:Vector List CP := empty() + solveLinearPolynomialEquation : _ + (List(SparseUnivariatePolynomial(CR)),SparseUnivariatePolynomial(CR))_ + -> Union(List(SparseUnivariatePolynomial(CR)),"failed") solveLinearPolynomialEquation(lp,p) == if (oldlp ^= lp) then -- we have to generate a new table @@ -15131,6 +15401,7 @@ ComplexPattern(R, S, CS) : C == T where ipat : Pattern R := patternVariable("%i"::Symbol, true, false, false) + convert : CS -> Pattern(R) convert(cs) == zero? imag cs => convert real cs convert real cs + ipat * convert imag cs @@ -15245,6 +15516,7 @@ ComplexPatternMatch(R, S, CS) : C == T where ivar : PS := "%i"::Symbol::PS + makeComplex : PS -> CS makeComplex(p:PS):CS == up := univariate p degree up > 1 => error "not linear in %i" @@ -15252,10 +15524,13 @@ ComplexPatternMatch(R, S, CS) : C == T where rcoef:=leadingCoefficient(reductum p) complex(rcoef,icoef) + makePoly : CS -> PS makePoly(cs:CS):PS == real(cs)*ivar + imag(cs)::PS if PS has PatternMatchable(R) then + patternMatch : (CS,Pattern(R),PatternMatchResult(R,CS)) -> _ + PatternMatchResult(R,CS) if Polynomial(S) has PATMAB(R) patternMatch(cs, pat, result) == zero? imag cs => patternMatch(real cs, pat, result) @@ -15948,52 +16223,32 @@ ComplexRootFindingPackage(R, UP): public == private where -- constants c : C r : R + --globalDigits : I := 10 ** 41 globalDigits : I := 10 ** 7 + globalEps : R := --a : R := (1000000000000000000000 :: I) :: R a : R := (1000 :: I) :: R 1/a + emptyLine : OF := " " + dashes: OF := center "---------------------------------------------------" + dots : OF := center "..................................................." + one : R := 1$R - two : R := 2 * one - ten : R := 10 * one - eleven : R := 11 * one - weakEps := eleven/ten - --invLog2 : R := 1/log10 (2*one) - -- signatures of local functions + two : R := 2 * one - absC : C -> R - -- - absR : R -> R - -- - calculateScale : UP -> R - -- - makeMonic : UP -> UP - -- 'makeMonic p' divides 'p' by the leading coefficient, - -- to guarantee new leading coefficient to be 1$R we cannot - -- simply divide the leading monomial by the leading coefficient - -- because of possible rounding errors - min: (FAE, FAE) -> FAE - -- takes factorization with smaller error - nthRoot : (R, NNI) -> R - -- nthRoot(r,n) determines an approximation to the n-th - -- root of r, if \spadtype{R} has ?**?: (R,Fraction Integer)->R - -- we use this, otherwise we use approxNthRoot via - -- \spadtype{Integer} - shift: (UP,C) -> UP - -- shift(p,c) changes p(x) into p(x+c), thereby modifying the - -- roots u_j of p to the roots (u_j - c) of shift(p,c) - scale: (UP,C) -> UP - -- scale(p,c) changes p(x) into p(cx), thereby modifying the - -- roots u_j of p to the roots ((1/c) u_j) of scale(p,c) + ten : R := 10 * one + eleven : R := 11 * one - -- implementation of exported functions + weakEps := eleven/ten + complexZeros : (UP,R) -> List(Complex(R)) complexZeros(p,eps) == --r1 : R := rootRadius(p,weakEps) --eps0 : R = r1 * nthRoot(eps, degree p) @@ -16002,8 +16257,10 @@ ComplexRootFindingPackage(R, UP): public == private where facs : FR UP := factor(p,eps0) [-coefficient(linfac.factor,0) for linfac in factors facs] + complexZeros : UP -> List(Complex(R)) complexZeros p == complexZeros(p,globalEps) + setErrorBound : R -> R setErrorBound r == r <= 0 => error "setErrorBound: need error bound greater 0" globalEps := r @@ -16016,6 +16273,7 @@ ComplexRootFindingPackage(R, UP): public == private where messagePrint "setErrorBound: internal error bound set to" globalEps + pleskenSplit : (UP,R,Boolean) -> Factored(UP) pleskenSplit(poly,eps,info) == p := makeMonic poly fp : FR UP @@ -16036,7 +16294,6 @@ ComplexRootFindingPackage(R, UP): public == private where split : FAE sR : Rep := st :: Rep psR : Rep := sR ** (degree poly) - notFoundSplit : Boolean := true while notFoundSplit repeat -- if info then @@ -16055,13 +16312,13 @@ ComplexRootFindingPackage(R, UP): public == private where splits : L FAE := divisorCascade(p, makeMonic tp, info) split := reduce(min,splits) notFoundSplit := (eps <= split.error) - for fac in split.factors repeat fp := (degree fac = 1) => fp * nilFactor(fac,1)$(FR UP) fp * irreducibleFactor(fac,1)$(FR UP) fp + startPolynomial : UP -> Record(start: UP,factors: Factored(UP)) startPolynomial p == -- assume minimumDegree is 0 --print (p :: OF) fp : FR UP := 1 @@ -16118,6 +16375,7 @@ ComplexRootFindingPackage(R, UP): public == private where --lu : L R := [(lrr.i + lrr.(i+1))/2 for i in 1..(maxIndex(lrr)-1)] [startPoly - monomial(listOfCenters.po,0),fp] + norm : UP -> R norm p == -- reduce(_+$R,map(absC,coefficients p)) nm : R := 0 @@ -16125,8 +16383,10 @@ ComplexRootFindingPackage(R, UP): public == private where nm := nm + absC c nm + pleskenSplit : (UP,R) -> Factored(UP) pleskenSplit(poly,eps) == pleskenSplit(poly,eps,false) + graeffe : UP -> UP graeffe p == -- If p = ao x**n + a1 x**(n-1) + ... + a x + an -- and q = bo x**n + b1 x**(n-1) + ... + b x + bn @@ -16159,6 +16419,7 @@ ComplexRootFindingPackage(R, UP): public == private where aBack := cons(ak, aBack) gp + rootRadius : (UP,R) -> R rootRadius(p,errorQuotient) == errorQuotient <= 1$R => error "rootRadius: second Parameter must be greater than 1" @@ -16179,8 +16440,10 @@ ComplexRootFindingPackage(R, UP): public == private where pp := makeMonic scale(pp,complex(rho,0$R)) rR + rootRadius : UP -> R rootRadius(p) == rootRadius(p, 1+globalEps) + schwerpunkt : UP -> Complex(R) schwerpunkt p == zero? p => 0$C zero? (d := degree p) => error _ @@ -16192,6 +16455,7 @@ ComplexRootFindingPackage(R, UP): public == private where degree * leadingCoefficient not invertible in ring of coefficients" - (nC*(denom::C)) + reciprocalPolynomial : UP -> UP reciprocalPolynomial p == zero? p => 0 d : NNI := degree p @@ -16199,6 +16463,8 @@ ComplexRootFindingPackage(R, UP): public == private where lm : L UP := [monomial(coefficient(p,i),(md-i) :: NNI) for i in 0..d] sol := reduce(_+, lm) + divisorCascade : (UP,UP,Boolean) -> _ + List(Record(factors: List(UP),error: R)) divisorCascade(p, tp, info) == lfae : L FAE := nil() for i in 1..degree tp while (degree tp > 0) repeat @@ -16225,12 +16491,16 @@ ComplexRootFindingPackage(R, UP): public == private where if info then print emptyLine reverse lfae + divisorCascade : (UP,UP) -> List(Record(factors: List(UP),error: R)) divisorCascade(p, tp) == divisorCascade(p, tp, false) + factor : (UP,R) -> Factored(UP) factor(poly,eps) == factor(poly,eps,false) + factor : UP -> Factored(UP) factor(p) == factor(p, globalEps) + factor : (UP,R,Boolean) -> Factored(UP) factor(poly,eps,info) == result : FR UP := coerce monomial(leadingCoefficient poly,0) d : NNI := degree poly @@ -16276,16 +16546,21 @@ ComplexRootFindingPackage(R, UP): public == private where -- implementation of local functions + absC : C -> R absC c == nthRoot(norm(c)$C,2) + absR : R -> R absR r == r < 0 => -r r + -- takes factorization with smaller error + min: (FAE, FAE) -> FAE min(fae1,fae2) == fae2.error < fae1.error => fae2 fae1 + calculateScale : UP -> R calculateScale p == d := degree p maxi :R := 0 @@ -16305,22 +16580,38 @@ ComplexRootFindingPackage(R, UP): public == private where rho = 0 => one rho + -- 'makeMonic p' divides 'p' by the leading coefficient, + -- to guarantee new leading coefficient to be 1$R we cannot + -- simply divide the leading monomial by the leading coefficient + -- because of possible rounding errors + makeMonic : UP -> UP makeMonic p == p = 0 => p monomial(1,degree p)$UP + (reductum p)/(leadingCoefficient p) + -- scale(p,c) changes p(x) into p(cx), thereby modifying the + -- roots u_j of p to the roots ((1/c) u_j) of scale(p,c) + scale: (UP,C) -> UP scale(p, c) == -- eval(p,cx) is missing !! eq : Equation UP := equation(monomial(1,1), monomial(c,1)) eval(p,eq) -- improvement?: direct calculation of the new coefficients + -- shift(p,c) changes p(x) into p(x+c), thereby modifying the + -- roots u_j of p to the roots (u_j - c) of shift(p,c) + shift: (UP,C) -> UP shift(p,c) == rhs : UP := monomial(1,1) + monomial(c,0) eq : Equation UP := equation(monomial(1,1), rhs) eval(p,eq) -- improvement?: direct calculation of the new coefficients + -- nthRoot(r,n) determines an approximation to the n-th + -- root of r, if \spadtype{R} has ?**?: (R,Fraction Integer)->R + -- we use this, otherwise we use approxNthRoot via + -- \spadtype{Integer} + nthRoot : (R, NNI) -> R nthRoot(r,n) == R has RealNumberSystem => r ** (1/n) R has QuotientFieldCategory Integer => @@ -16338,6 +16629,9 @@ ComplexRootFindingPackage(R, UP): public == private where )fin -- for late use: + -- graeffe2 p determines q such that \spad{q(-z**2) = p(z)*p(-z)}. + -- Note that the roots of q are the squares of the roots of p. + graeffe2 : UP -> UP graeffe2 p == -- substitute x by -x : eq : Equation UP := equation(monomial(1,1), monomial(-1$C,1)) @@ -16352,6 +16646,7 @@ ComplexRootFindingPackage(R, UP): public == private where pp := reductum pp gp + shift2: (UP,C) -> UP shift2(p,c) == d := degree p cc : C := 1 @@ -16366,6 +16661,7 @@ ComplexRootFindingPackage(R, UP): public == private where res := res + monomial(cc,j)$UP res + scale2: (UP,C) -> UP scale2(p,c) == d := degree p cc : C := 1 @@ -16376,14 +16672,6 @@ ComplexRootFindingPackage(R, UP): public == private where for i in 0..d repeat res := res + monomial(coef.(i+1),i)$UP res - scale2: (UP,C) -> UP - - shift2: (UP,C) -> UP - - graeffe2 : UP -> UP - ++ graeffe2 p determines q such that \spad{q(-z**2) = p(z)*p(-z)}. - ++ Note that the roots of q are the squares of the roots of p. - *) \end{chunk} @@ -16496,6 +16784,7 @@ ComplexRootPackage(UP,Par) : T == C where (* package CMPLXRT *) (* + complexZeros : (UP,Par) -> List(Complex(Par)) complexZeros(p:UP,eps:Par):List CP == x1:Symbol():=new() x2:Symbol():=new() @@ -16694,37 +16983,43 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where import InnerTrigonometricManipulations(R, FR, F) import ElementaryFunctionStructurePackage(Complex R, F) - rreal?: Complex R -> Boolean - kreal?: Kernel F -> Boolean - localexplogs : (F, F, List SY) -> F - - real f == real complexForm f + real : F -> Expression(R) + real f == real complexForm f - imag f == imag complexForm f + imag : F -> Expression(R) + imag f == imag complexForm f - rreal? r == zero? imag r + rreal?: Complex R -> Boolean + rreal? r == zero? imag r - kreal? k == every?(real?, argument k)$List(F) + kreal?: Kernel F -> Boolean + kreal? k == every?(real?, argument k)$List(F) + complexForm : F -> Complex(Expression(R)) complexForm f == explogs2trigs f + trigs : F -> F trigs f == GF2FG explogs2trigs f + real? : F -> Boolean real? f == every?(rreal?, coefficients numer f) and every?(rreal?, coefficients denom f) and every?(kreal?, kernels f) + localexplogs : (F, F, List SY) -> F localexplogs(f, g, lx) == trigs2explogs(g, [k for k in tower f | is?(k, "tan"::SY) or is?(k, "cot"::SY)], lx) + complexElementary : F -> F complexElementary f == any?(x +-> has?(x, "rtrig"), operators(g := realElementary f))$List(BasicOperator) => localexplogs(f, g, variables g) g + complexElementary : (F,Symbol) -> F complexElementary(f, x) == any?(y +-> has?(operator y, "rtrig"), [k for k in tower(g := realElementary(f, x)) @@ -16732,6 +17027,7 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where localexplogs(f, g, [x]) g + complexNormalize : (F,Symbol) -> F complexNormalize(f, x) == any?(y +-> has?(operator y, "rtrig"), [k for k in tower(g := realElementary(f, x)) @@ -16739,6 +17035,7 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where (rischNormalize(localexplogs(f, g, [x]), x).func) rischNormalize(g, x).func + complexNormalize : F -> F complexNormalize f == l := variables(g := realElementary f) any?(y +-> has?(y, "rtrig"), operators g)$List(BasicOperator) => @@ -16901,15 +17198,12 @@ ConstantLODE(R, F, L): Exports == Implementation where import FunctionSpaceIntegration(R, F) import FunctionSpaceUnivariatePolynomialFactor(R, F, SUP) - homoBasis: (L, F) -> List F - quadSol : (SUP, F) -> List F - basisSqfr: (SUP, F) -> List F - basisSol : (SUP, Z, F) -> List F - + constDsolve : (L,F,Symbol) -> Record(particular: F,basis: List(F)) constDsolve(op, g, x) == b := homoBasis(op, x::F) [particularSolution(op, g, b, (f1:F):F +-> int(f1, x))::F, b] + homoBasis: (L, F) -> List F homoBasis(op, x) == p:SUP := 0 while op ^= 0 repeat @@ -16920,6 +17214,7 @@ ConstantLODE(R, F, L): Exports == Implementation where b := concat_!(b, basisSol(ff.factor, dec(ff.exponent), x)) b + basisSol : (SUP, Z, F) -> List F basisSol(p, n, x) == l := basisSqfr(p, x) zero? n => l @@ -16930,12 +17225,14 @@ ConstantLODE(R, F, L): Exports == Implementation where xn := x * xn l + basisSqfr: (SUP, F) -> List F basisSqfr(p, x) == ((d := degree p) = 1) => [exp(- coefficient(p, 0) * x / leadingCoefficient p)] d = 2 => quadSol(p, x) [exp(a * x) for a in rootsOf p] + quadSol : (SUP, F) -> List F quadSol(p, x) == (u := sign(delta := (b := coefficient(p, 1))**2 - 4 * (a := leadingCoefficient p) * (c := coefficient(p, 0)))) @@ -17249,21 +17546,25 @@ CoordinateSystems(R): Exports == Implementation where (* package COORDSYS *) (* + cartesian : Point(R) -> Point(R) cartesian pt == -- we just want to interpret the cartesian coordinates -- from the first N elements of the point - so the -- identity function will do pt + polar : Point(R) -> Point(R) polar pt0 == pt := copy pt0 r := elt(pt0,1); theta := elt(pt0,2) pt.1 := r * cos(theta); pt.2 := r * sin(theta) pt + cylindrical : Point(R) -> Point(R) cylindrical pt0 == polar pt0 -- apply polar transformation to first 2 coordinates + spherical : Point(R) -> Point(R) spherical pt0 == pt := copy pt0 r := elt(pt0,1); theta := elt(pt0,2); phi := elt(pt0,3) @@ -17271,21 +17572,25 @@ CoordinateSystems(R): Exports == Implementation where pt.3 := r * cos(phi) pt + parabolic : Point(R) -> Point(R) parabolic pt0 == pt := copy pt0 u := elt(pt0,1); v := elt(pt0,2) pt.1 := (u*u - v*v)/(2::R) ; pt.2 := u*v pt - parabolicCylindrical pt0 == parabolic pt0 -- apply parabolic transformation to first 2 coordinates + parabolicCylindrical : Point(R) -> Point(R) + parabolicCylindrical pt0 == parabolic pt0 + paraboloidal : Point(R) -> Point(R) paraboloidal pt0 == pt := copy pt0 u := elt(pt0,1); v := elt(pt0,2); phi := elt(pt0,3) pt.1 := u*v*cos(phi); pt.2 := u*v*sin(phi); pt.3 := (u*u - v*v)/(2::R) pt + elliptic : R -> (Point(R) -> Point(R)) elliptic a == x+-> pt := copy(x) @@ -17293,9 +17598,11 @@ CoordinateSystems(R): Exports == Implementation where pt.1 := a*cosh(u)*cos(v); pt.2 := a*sinh(u)*sin(v) pt - ellipticCylindrical a == elliptic a -- apply elliptic transformation to first 2 coordinates + ellipticCylindrical : R -> (Point(R) -> Point(R)) + ellipticCylindrical a == elliptic a + prolateSpheroidal : R -> (Point(R) -> Point(R)) prolateSpheroidal a == x+-> pt := copy(x) @@ -17305,6 +17612,7 @@ CoordinateSystems(R): Exports == Implementation where pt.3 := a*cosh(xi)*cos(eta) pt + oblateSpheroidal : R -> (Point(R) -> Point(R)) oblateSpheroidal a == x+-> pt := copy(x) @@ -17314,6 +17622,7 @@ CoordinateSystems(R): Exports == Implementation where pt.3 := a*sinh(xi)*sin(eta) pt + bipolar : R -> (Point(R) -> Point(R)) bipolar a == x+-> pt := copy(x) @@ -17322,9 +17631,11 @@ CoordinateSystems(R): Exports == Implementation where pt.2 := a*sin(u)/(cosh(v)-cos(u)) pt - bipolarCylindrical a == bipolar a -- apply bipolar transformation to first 2 coordinates + bipolarCylindrical : R -> (Point(R) -> Point(R)) + bipolarCylindrical a == bipolar a + toroidal : R -> (Point(R) -> Point(R)) toroidal a == x+-> pt := copy(x) @@ -17334,6 +17645,7 @@ CoordinateSystems(R): Exports == Implementation where pt.3 := a*sin(u)/(cosh(v)-cos(u)) pt + conical : (R,R) -> (Point(R) -> Point(R)) conical(a,b) == x+-> pt := copy(x) @@ -17490,12 +17802,14 @@ CRApackage(R:EuclideanDomain): Exports == Implementation where x:BB -- Definition for modular reduction mapping with several moduli + modTree : (R,List(R)) -> List(R) modTree(a,lm) == t := balancedBinaryTree(#lm, 0$R) setleaves_!(t,lm) mapUp_!(t,"*") leaves mapDown_!(t, a, "rem") + chineseRemainder : (List(R),List(R)) -> R chineseRemainder(lv:List(R), lm:List(R)):R == #lm ^= #lv => error "lists of moduli and values not of same length" x := balancedBinaryTree(#lm, 0$R) @@ -17511,6 +17825,7 @@ CRApackage(R:EuclideanDomain): Exports == Implementation where y := setleaves_!(y,l) value(mapUp_!(y, x, (a,b,c,d)+->a*d + b*c)) rem value(x) + chineseRemainder : (List(List(R)),List(R)) -> List(R) chineseRemainder(llv:List List(R), lm:List(R)):List(R) == x := balancedBinaryTree(#lm, 0$R) x := setleaves_!(x, lm) @@ -17535,6 +17850,7 @@ CRApackage(R:EuclideanDomain): Exports == Implementation where u case "failed" => error [c, " not spanned by ", a, " and ",b] [u.coef2, u.coef1] + multiEuclideanTree : (List(R),R) -> List(R) multiEuclideanTree(fl, rhs) == x := balancedBinaryTree(#fl, rhs) x := setleaves_!(x, fl) @@ -18738,6 +19054,12 @@ CycleIndicators: Exports == Implementation where \begin{chunk}{COQ CYCLES} (* package CYCLES *) (* + h ==> complete + s ==> powerSum + alt ==> alternating + cyc ==> cyclic + dih ==> dihedral + ev == eval import PartitionsAndPermutations import IntegerNumberTheoryFunctions @@ -18748,6 +19070,7 @@ CycleIndicators: Exports == Implementation where list: Stream L I -> L L I list st == entries complete st + complete : Integer -> SymmetricPolynomial(Fraction(Integer)) complete i == if i=0 then 1 @@ -18760,8 +19083,11 @@ CycleIndicators: Exports == Implementation where even?: L I -> B even? li == even?( #([i for i in li | even? i])) - alt i == + alternating : Integer -> SymmetricPolynomial(Fraction(Integer)) + alternating i == 2 * _+/[trm(partition li) for li in list(partitions i) | even? li] + + elementary : Integer -> SymmetricPolynomial(Fraction(Integer)) elementary i == if i=0 then 1 @@ -18783,13 +19109,16 @@ CycleIndicators: Exports == Implementation where li : L I := [n for j in 1..m] monomial(1,partition li) - s n == ss(n,1) + powerSum : Integer -> SymmetricPolynomial(Fraction(Integer)) + powerSum n == ss(n,1) - cyc n == + cyclic : Integer -> SymmetricPolynomial(Fraction(Integer)) + cyclic n == n = 1 => s 1 _+/[(eulerPhi(i) / n) * ss(i,numer(n/i)) for i in divisors n] - dih n == + dihedral : Integer -> SymmetricPolynomial(Fraction(Integer)) + dihedral n == k := n quo 2 odd? n => (1/2) * cyc n + (1/2) * ss(2,k) * s 1 (1/2) * cyc n + (1/4) * ss(2,k) + (1/4) * ss(2,k-1) * ss(1,2) @@ -18813,6 +19142,7 @@ CycleIndicators: Exports == Implementation where prod := c * prod2 * prod xx * prod + graphs : Integer -> SymmetricPolynomial(Fraction(Integer)) graphs n == _+/[trm2 li for li in list(partitions n)] cupp: (PTN,SPOL RN) -> SPOL RN @@ -18822,15 +19152,21 @@ CycleIndicators: Exports == Implementation where dg = pt => (pdct pt) * monomial(leadingCoefficient spol,dg) cupp(pt,reductum spol) + cup : (SymmetricPolynomial(Fraction(Integer)),_ + SymmetricPolynomial(Fraction(Integer))) -> _ + SymmetricPolynomial(Fraction(Integer)) cup(spol1,spol2) == zero? spol1 => 0 p := leadingCoefficient(spol1) * cupp(degree spol1,spol2) p + cup(reductum spol1,spol2) - ev spol == + eval : SymmetricPolynomial(Fraction(Integer)) -> Fraction(Integer) + eval spol == zero? spol => 0 leadingCoefficient(spol) + ev(reductum spol) + cap : (SymmetricPolynomial(Fraction(Integer)),_ + SymmetricPolynomial(Fraction(Integer))) -> Fraction(Integer) cap(spol1,spol2) == ev cup(spol1,spol2) mtpol: (I,SPOL RN) -> SPOL RN @@ -18848,11 +19184,15 @@ CycleIndicators: Exports == Implementation where prod := _*/[fn2 i for i in (degree spol)::L(I)] lc * prod + evspol(fn2,reductum spol) + wreath : (SymmetricPolynomial(Fraction(Integer)),_ + SymmetricPolynomial(Fraction(Integer))) -> _ + SymmetricPolynomial(Fraction(Integer)) wreath(spol1,spol2) == evspol(x+->mtpol(x,spol2),spol1) hh: I -> SPOL RN --symmetric group hh n == if n=0 then 1 else if n<0 then 0 else h n + SFunction : List(Integer) -> SymmetricPolynomial(Fraction(Integer)) SFunction li == a:Matrix SPOL RN:=matrix [[hh(k -j+i) for k in li for j in 1..#li] for i in 1..#li] @@ -18863,6 +19203,8 @@ CycleIndicators: Exports == Implementation where #li1 > #li2 => roundup(li1,concat(li2,0)) li2 + skewSFunction : (List(Integer),List(Integer)) -> _ + SymmetricPolynomial(Fraction(Integer)) skewSFunction(li1,li2)== #li1 < #li2 => error "skewSFunction: partition1 does not include partition2" @@ -19000,6 +19342,7 @@ CyclicStreamTools(S,ST): Exports == Implementation where (* package CSTTOOLS *) (* + cycleElt : ST -> Union(ST,"failed") cycleElt x == y := x for i in 0.. repeat @@ -19008,6 +19351,7 @@ CyclicStreamTools(S,ST): Exports == Implementation where if odd? i then x := rst x eq?(x,y) => return y + computeCycleLength : ST -> NonNegativeInteger computeCycleLength cycElt == i : NonNegativeInteger y := cycElt @@ -19015,6 +19359,7 @@ CyclicStreamTools(S,ST): Exports == Implementation where y := rst y eq?(y,cycElt) => return i + computeCycleEntry : (ST,ST) -> ST computeCycleEntry(x,cycElt) == y := rest(x, computeCycleLength cycElt) repeat @@ -19142,6 +19487,7 @@ CyclotomicPolynomialPackage: public == private where (* package CYCLOTOM *) (* + cyclotomic : Integer -> SparseUnivariatePolynomial(Integer) cyclotomic(n:Integer): SUP == x,y,z,l: SUP g := factors factor(n)$IFP @@ -19153,6 +19499,8 @@ CyclotomicPolynomialPackage: public == private where l := multiplyExponents(l,((u.factor)**((u.exponent-1)::NNI))::NNI) l + cyclotomicDecomposition : Integer -> _ + List(SparseUnivariatePolynomial(Integer)) cyclotomicDecomposition(n:Integer):LSUP == x,y,z: SUP l,ll,m: LSUP @@ -19169,6 +19517,8 @@ CyclotomicPolynomialPackage: public == private where l := append(l,m) l + cyclotomicFactorization : Integer -> _ + Factored(SparseUnivariatePolynomial(Integer)) cyclotomicFactorization(n:Integer):FR == f : SUP fr : FR := 1$FR @@ -19379,6 +19729,8 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where (* package CAD *) (* + cylindricalDecomposition : List(Polynomial(TheField)) -> _ + List(Cell(TheField)) cylindricalDecomposition(lpols) == lv : List(Symbol) := [] for pol in lpols repeat @@ -19387,6 +19739,8 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where lv := reverse(sort(lv)) cylindricalDecomposition(lpols,lv) + cylindricalDecomposition : (List(Polynomial(TheField)),List(Symbol)) -> _ + List(Cell(TheField)) cylindricalDecomposition(lpols,lvars) == lvars = [] => error("CAD: cylindricalDecomposition: empty list of vars") mv := first(lvars) @@ -19407,6 +19761,8 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where PACK1 ==> CylindricalAlgebraicDecompositionUtilities(ThePols,RUP) PACK2 ==> CylindricalAlgebraicDecompositionUtilities(TheField,BUP) + specialise : (List(Polynomial(TheField)),Cell(TheField)) -> _ + List(SparseUnivariatePolynomial(TheField)) specialise(lpols,cell) == lpols = [] => error("CAD: specialise: empty list of pols") sp := samplePoint(cell) @@ -19418,6 +19774,8 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where res := cons(p1,res) res + coefficientSet : SparseUnivariatePolynomial(Polynomial(TheField)) -> _ + List(Polynomial(TheField)) coefficientSet(pol) == res : List(ThePols) := [] for c in coefficients(pol) repeat @@ -19426,6 +19784,10 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where res SUBRES ==> SubResultantPackage(ThePols,RUP) + + discriminantSet : _ + List(SparseUnivariatePolynomial(Polynomial(TheField))) -> _ + List(Polynomial(TheField)) discriminantSet(lpols) == res : List(ThePols) := [] for p in lpols repeat @@ -19436,6 +19798,10 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where if not(ground? d) then res := cons(d,res) res + principalSubResultantSet : _ + (SparseUnivariatePolynomial(Polynomial(TheField)),_ + SparseUnivariatePolynomial(Polynomial(TheField))) -> _ + List(Polynomial(TheField)) principalSubResultantSet(p,q) == if degree(p) < degree(q) then (p,q) := (q,p) @@ -19444,6 +19810,9 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where v := subresultantVector(p,q)$SUBRES [coefficient(v.i,i) for i in 0..(((#v)-2)::N)] + resultantSet : _ + List(SparseUnivariatePolynomial(Polynomial(TheField))) -> _ + List(Polynomial(TheField)) resultantSet(lpols) == res : List(ThePols) := [] laux := lpols @@ -19455,6 +19824,9 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where if not(ground? r) then res := cons(r,res) res + projectionSet : _ + List(SparseUnivariatePolynomial(Polynomial(TheField))) -> _ + List(Polynomial(TheField)) projectionSet(lpols) == res : List(ThePols) := [] for p in lpols repeat @@ -19596,12 +19968,14 @@ CylindricalAlgebraicDecompositionUtilities(R,P) : PUB == PRIV where (* package CADU *) (* + squareFreeBasis : List(P) -> List(P) squareFreeBasis(lpols) == lpols = [] => [] pol := first(lpols) sqpol := unitCanonical(squareFreePart(pol)) gcdBasis(cons(sqpol,squareFreeBasis(rest(lpols)))) + gcdBasisAdd : (P,List(P)) -> List(P) gcdBasisAdd(p,lpols) == (degree(p) = 0) => lpols null lpols => [unitCanonical p] @@ -19614,6 +19988,7 @@ CylindricalAlgebraicDecompositionUtilities(R,P) : PUB == PRIV where if degree(p1) > 0 then basis := cons(p1,basis) gcdBasisAdd(g,basis) + gcdBasis : List(P) -> List(P) gcdBasis(lpols) == (#lpols <= 1) => lpols basis := gcdBasis(rest lpols) @@ -19942,35 +20317,23 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where import PowerSeriesLimitPackage(R, F) import UnivariatePolynomialCommonDenominator(Z, Q, UPQ) - mkLogPos : F -> F - keeprec? : (Q, REC) -> B - negative : F -> Union(B, "failed") - mkKerPos : K -> Union(F, "positive") - posRoot : (UP, B) -> Union(B, "failed") - realRoot : UP -> Union(B, "failed") - var : UP -> Union(Z, "failed") - maprat : UP -> Union(UPZ, "failed") - variation : (UP, F) -> Union(Z, "failed") - infeval : (UP, OFE) -> Union(F, "failed") - checkHalfAx : (UP, F, Z, B) -> Union(B, "failed") - findLimit : (F, K, OFE, String, B) -> Union(OFE, "failed") - checkBudan : (UP, OFE, OFE, B) -> Union(B, "failed") - checkDeriv : (UP, OFE, OFE) -> Union(B, "failed") - sameSign : (UP, OFE, OFE) -> Union(B, "failed") - intrat : (OFE, OFE) -> U - findRealZero: (UPZ, U, B) -> List REC - + variation : (UP, F) -> Union(Z, "failed") variation(p, a) == var p(monomial(1, 1)$UP - a::UP) + keeprec? : (Q, REC) -> B keeprec?(a, rec) == (a > rec.right) or (a < rec.left) + checkHalfAx : (UP, F, Z, B) -> Union(B, "failed") checkHalfAx(p, a, d, incl?) == posRoot(p(d * (monomial(1, 1)$UP - a::UP)), incl?) + ignore? : String -> Boolean ignore? str == str = IGNOR => true error "integrate: last argument must be 'noPole'" + computeInt : (Kernel(F),F,OrderedCompletion(F),OrderedCompletion(F),_ + Boolean) -> Union(OrderedCompletion(F),"failed") computeInt(k, f, a, b, eval?) == is?(f, "integral"::SE) => "failed" if not eval? then f := mkLogPos f @@ -19979,6 +20342,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where infinite?(ia::OFE) and (ia::OFE = ib::OFE) => "failed" ib::OFE - ia::OFE + findLimit : (F, K, OFE, String, B) -> Union(OFE, "failed") findLimit(f, k, a, dir, eval?) == r := retractIfCan(a)@Union(F, "failed") r case F => @@ -19988,6 +20352,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where (u := limit(f, equation(k::F::OFE, a))) case OFE => u::OFE "failed" + mkLogPos : F -> F mkLogPos f == lk := empty()$List(K) lv := empty()$List(F) @@ -19997,22 +20362,28 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where lv := concat(v::F, lv) eval(f, lk, lv) + mkKerPos : K -> Union(F, "positive") mkKerPos k == (u := negative(f := first argument k)) case "failed" => log(f**2) / (2::F) u::B => log(-f) "positive" + negative : F -> Union(B, "failed") negative f == (u := sign f) case "failed" => "failed" u::Z < 0 + checkForZero : (Polynomial(R),Symbol,OrderedCompletion(F),_ + OrderedCompletion(F),Boolean) -> Union(Boolean,"failed") checkForZero(p, x, a, b, incl?) == checkForZero( map(s+->s::F, univariate(p, x))_ $SparseUnivariatePolynomialFunctions2(P, F), a, b, incl?) + checkForZero : (SparseUnivariatePolynomial(F),OrderedCompletion(F),_ + OrderedCompletion(F),Boolean) -> Union(Boolean,"failed") checkForZero(q, a, b, incl?) == ground? q => false (d := maprat q) case UPZ and not((i := intrat(a, b)) case failed) => @@ -20022,6 +20393,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where "failed" u::B + maprat : UP -> Union(UPZ, "failed") maprat p == ans:UPQ := 0 while p ^= 0 repeat @@ -20032,6 +20404,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where map(numer,(splitDenominator ans).num )$SparseUnivariatePolynomialFunctions2(Q, Z) + intrat : (OFE, OFE) -> U intrat(a, b) == (n := whatInfinity a) ^= 0 => (r := retractIfCan(b)@Union(F,"failed")) case "failed" => ["all"] @@ -20045,6 +20418,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where => ["failed"] [[q::Q, t::Q]] + findRealZero: (UPZ, U, B) -> List REC findRealZero(p, i, incl?) == i case fin => l := realZeros(p, r := i.fin) @@ -20062,6 +20436,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where select_!(s+->keeprec?(ep, s), l) error "findRealZero: should not happpen" + checkBudan : (UP, OFE, OFE, B) -> Union(B, "failed") checkBudan(p, a, b, incl?) == r := retractIfCan(b)@Union(F, "failed") (n := whatInfinity a) ^= 0 => @@ -20083,6 +20458,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where (m = 1) => true -- p has an even number > 0 of roots "failed" + checkDeriv : (UP, OFE, OFE) -> Union(B, "failed") checkDeriv(p, a, b) == (r := retractIfCan(p)@Union(F, "failed")) case F => zero?(r::F) (s := sameSign(p, a, b)) case "failed" => "failed" @@ -20092,11 +20468,13 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where false true + realRoot : UP -> Union(B, "failed") realRoot p == (b := posRoot(p, true)) case "failed" => "failed" b::B => true posRoot(p(p - monomial(1, 1)$UP), true) + sameSign : (UP, OFE, OFE) -> Union(B, "failed") sameSign(p, a, b) == (ea := infeval(p, a)) case "failed" => "failed" (eb := infeval(p, b)) case "failed" => "failed" @@ -20104,6 +20482,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where s::Z > 0 -- returns true if p has a positive root. Include 0 is incl0? is true + posRoot : (UP, B) -> Union(B, "failed") posRoot(p, incl0?) == (z0? := zero?(coefficient(p, 0))) and incl0? => true (v := var p) case "failed" => "failed" @@ -20115,11 +20494,13 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where z0? => true -- p has an even number > 0 of positive roots "failed" + infeval : (UP, OFE) -> Union(F, "failed") infeval(p, a) == zero?(n := whatInfinity a) => p(retract(a)@F) (u := signAround(p, n, sign)) case "failed" => "failed" u::Z::F + var : UP -> Union(Z, "failed") var q == i:Z := 0 (lastCoef := negative leadingCoefficient q) case "failed" => @@ -20239,12 +20620,16 @@ DegreeReductionPackage(R1, R2): Cat == Capsule where (* package DEGRED *) (* + degrees : UP R1 -> List Integer degrees(u: UP R1): List Integer == l: List Integer := [] while u ^= 0 repeat l := concat(degree u,l) u := reductum u l + + reduce : SparseUnivariatePolynomial(R1) -> _ + Record(pol: SparseUnivariatePolynomial(R1),deg: PositiveInteger) reduce(u: UP R1) == g := "gcd"/[d for d in degrees u] u := divideExponents(u, g:PI)::(UP R1) @@ -20252,11 +20637,13 @@ DegreeReductionPackage(R1, R2): Cat == Capsule where import Fraction Integer + rootOfUnity : (I,I) -> RE rootOfUnity(j:I,n:I):RE == j = 0 => 1 arg:RE := 2*j*pi()/(n::RE) cos arg + (-1)**(1/2) * sin arg + expand : (Expression(R2),PositiveInteger) -> List(Expression(R2)) expand(s, g) == g = 1 => [s] [rootOfUnity(i,g)*s**(1/g) for i in 0..g-1] @@ -20780,21 +21167,16 @@ DesingTreePackage(K, import PPFC2 import PolyRing import DesTree - - divisorAtDesingTreeLocal: (BlUpRing , DesTree ) -> DIVISOR - - polyRingToBlUpRing: (PolyRing, BLMET) -> BlUpRing - - makeMono: DesTree -> BlUpRing + -- trouve le diviseur excp. d'un pt inf voisin PRECEDENT ! + -- qV est egal a : 1 + nombre de fois que ce point est repete + -- dans un chaine (le plus un correspond au point d'origine du + -- point dont il est question ici. + -- mp est la multiciplicite du point. + -- cette fonction n'est et ne peut etre qu'utiliser pour + -- calculer le diviseur d'adjonction ( a cause du mp -1). + inBetweenExcpDiv : DesTree -> DIVISOR inBetweenExcpDiv( tr )== - -- trouve le diviseur excp. d'un pt inf voisin PRECEDENT ! - -- qV est egal a : 1 + nombre de fois que ce point est repete - -- dans un chaine (le plus un correspond au point d'origine du - -- point dont il est question ici. - -- mp est la multiciplicite du point. - -- cette fonction n'est et ne peut etre qu'utiliser pour - -- calculer le diviseur d'adjonction ( a cause du mp -1). noeud:= value tr chart:= chartV noeud qV:= quotValuation chart @@ -20803,6 +21185,7 @@ DesingTreePackage(K, mp:= degree expDiv ((qV - 1) * (mp -1)) *$DIVISOR expDiv + polyRingToBlUpRing: (PolyRing, BLMET) -> BlUpRing polyRingToBlUpRing(pol,chart)== zero? pol => 0 lc:= leadingCoefficient pol @@ -20811,6 +21194,7 @@ DesingTreePackage(K, e:= directProduct( vector( ll)$Vector(NNI) )$E2 monomial(lc , e )$BlUpRing + polyRingToBlUpRing( reductum pol, chart ) + affToProj : (AFP, BLMET) -> ProjPt affToProj(pt:AFP, chart:BLMET ):ProjPt== nV:= chartCoord chart d:List(K) := list(pt)$AFP @@ -20821,7 +21205,6 @@ DesingTreePackage(K, projectivePoint( ll )$ProjPt biringToPolyRing: (BlUpRing, BLMET) -> PolyRing - biringToPolyRing(pol,chart)== zero? pol => 0 lc:= leadingCoefficient pol @@ -20835,7 +21218,6 @@ DesingTreePackage(K, monomial(lc , e )$PolyRing + biringToPolyRing( reductum pol, chart ) minus : (NNI,NNI) -> NNI - minus(a,b)== d:=subtractIfCan(a,b) d case "failed" => error "cannot substract a-b if b>a for NNI" @@ -20843,15 +21225,10 @@ DesingTreePackage(K, -- returns the exceptional coordinate function - makeExcpDiv: List DesTree -> DIVISOR - - desingTreeAtPointLocal: InfClsPoint -> DesTree - - subGenus: DesTree -> NNI - lVar:List PolyRing := _ [monomial(1,index(i pretend PI)$OV,1)$PolyRing for i in 1..#symb] + divisorAtDesingTreeLocal: (BlUpRing , DesTree ) -> DIVISOR divisorAtDesingTreeLocal(pol,tr)== -- BLMET has QuadraticTransform ; marche aussi avec -- Hamburger-Noether mais surement moins efficace @@ -20876,6 +21253,7 @@ DesingTreePackage(K, child)_ for child in chtr]) + desingTreeAtPointLocal: InfClsPoint -> DesTree desingTreeAtPointLocal(ipt) == -- crb:PolyRing,pt:ProjPt,lstnV:List(INT),origPoint:ProjPt,actL:K)== -- peut etre est-il preferable, avant d'eclater, de tester @@ -20889,6 +21267,7 @@ DesingTreePackage(K, subTree:List DesTree:= [desingTreeAtPointLocal( iipt ) for iipt in blbl] tree( ipt, subTree )$DesTree + blowUp : InfClsPoint -> List(InfClsPoint) blowUp(ipt)== crb:=curveV ipt pt:= localPointV ipt @@ -20913,23 +21292,25 @@ DesingTreePackage(K, rec(definingExtension),_ new(I)$Symbol )$InfClsPoint for rec in blbl.blUpRec] + makeMono: DesTree -> BlUpRing makeMono(arb)== monomial(1,index(excepCoord(chartV(value(arb))) pretend PI)$OV2,_ 1)$BlUpRing + makeExcpDiv: List DesTree -> DIVISOR makeExcpDiv(lstSsArb)== reduce("+", _ [divisorAtDesingTreeLocal(makeMono(arb),arb) for arb in lstSsArb],0) - adjunctionDivisorForQuadTrans: DesTree -> DIVISOR - adjunctionDivisorForHamburgeNoether: DesTree -> DIVISOR + adjunctionDivisor : DesTree -> DIVISOR adjunctionDivisor( tr )== BLMET has QuadraticTransform => adjunctionDivisorForQuadTrans( tr ) BLMET has HamburgerNoether => adjunctionDivisorForHamburgeNoether( tr ) error _ " The algorithm to compute the adjunction divisor is not defined for the blowing method you have chosen" + adjunctionDivisorForHamburgeNoether: DesTree -> DIVISOR adjunctionDivisorForHamburgeNoether( tr )== noeud:=value tr chtr:= children tr @@ -20940,6 +21321,7 @@ DesingTreePackage(K, reduce("+",[inBetweenExcpDiv( arb ) for arb in chtr ]) +$DIVISOR _ reduce("+",[adjunctionDivisorForHamburgeNoether(arb) for arb in chtr]) + adjunctionDivisorForQuadTrans: DesTree -> DIVISOR adjunctionDivisorForQuadTrans(tr)== noeud:=value(tr) chtr:=children(tr) @@ -20948,11 +21330,13 @@ DesingTreePackage(K, ( minus(multPt,1) pretend INT) *$DIVISOR excpDivV(noeud) +$DIVISOR _ reduce("+",[adjunctionDivisorForQuadTrans(child) for child in chtr]) + divisorAtDesingTree : (PolyRing,DesTree) -> DIVISOR divisorAtDesingTree( pol , tr)== chart:= chartV value(tr) pp:= polyRingToBlUpRing( pol, chart ) divisorAtDesingTreeLocal( pp, tr ) + subGenus: DesTree -> NNI subGenus(tr)== noeud:=value tr mult:=multV(noeud) @@ -20961,6 +21345,7 @@ DesingTreePackage(K, degree(noeud)* ( mult*minus( mult, 1 ) + subMultV( noeud ) ) + reduce("+",[subGenus(ch) for ch in chdr]) + initializeParamOfPlaces : (DesTree,List(PolyRing)) -> Void initializeParamOfPlaces(tr,lpol)== noeud:=value(tr) pt:=localPointV(noeud) @@ -20996,6 +21381,7 @@ DesingTreePackage(K, initializeParamOfPlaces(arb,lpolBlUp) void() + blowUpWithExcpDiv : DesTree -> Void blowUpWithExcpDiv(tr:DesTree)== noeud:=value(tr) pt:=localPointV(noeud) @@ -21007,30 +21393,37 @@ DesingTreePackage(K, setexcpDiv!(noeud,makeExcpDiv( chtr )) void() + fullParamInit : DesTree -> Void fullParamInit(tr)== initializeParamOfPlaces(tr) blowUpWithExcpDiv(tr) void() + initializeParamOfPlaces : DesTree -> Void initializeParamOfPlaces(tr)==initializeParamOfPlaces(tr,lVar) + desingTreeAtPoint : (ProjPt,PolyRing) -> DesTree desingTreeAtPoint(pt,crb)== ipt:= create(pt,crb)$InfClsPoint desingTreeAtPointLocal ipt + genus : PolyRing -> NonNegativeInteger genus(crb)== if BLMET has HamburgerNoether then _ print((" BUG BUG corige le bug GH ---- ")::OutputForm) degCrb:=totalDegree(crb)$PackPoly genusTree(degCrb,desingTree(crb)) + genusNeg : PolyRing -> Integer genusNeg(crb)== degCrb:=totalDegree(crb)$PackPoly genusTreeNeg(degCrb,desingTree(crb)) + desingTree : PolyRing -> List(DesTree) desingTree(crb)== [desingTreeAtPoint(pt,crb) for pt in singularPoints(crb)$PrjAlgPack] + genusTree : (NonNegativeInteger,List(DesTree)) -> NonNegativeInteger genusTree(degCrb,listArbDes)== -- le test suivant est necessaire -- ( meme s'il n'y a pas de point singulier dans ce cas) @@ -21050,6 +21443,7 @@ DesingTreePackage(K, error "Have a nice day" minus(ga,dp) + genusTreeNeg : (NonNegativeInteger,List(DesTree)) -> Integer genusTreeNeg(degCrb,listArbDes)== -- (degCrb <$NNI 3::NNI) => 0 ga:= (degCrb-1)*(degCrb-2) quo$INT 2 @@ -21301,16 +21695,10 @@ DiophantineSolutionPackage(): Cat == Capsule where import I import POLI - -- local function specifications - - initializeGraph: (LPOLI, I) -> Graph - createNode: (I, VI, NI, I) -> Node - findSolutions: (VNI, I, I, I, Graph, B) -> ListSol - verifyMinimality: (VNI, Graph, B) -> B - verifySolution: (VNI, I, I, I, Graph) -> B - - -- exported functions - + dioSolve : Equation(Polynomial(Integer)) -> _ + Record(varOrder: List(Symbol),inhom: _ + Union(List(Vector(NonNegativeInteger)),"failed"),_ + hom: List(Vector(NonNegativeInteger))) dioSolve(eq) == p := lhs(eq) - rhs(eq) n := totalDegree(p) @@ -21333,6 +21721,7 @@ DiophantineSolutionPackage(): Cat == Capsule where -- local functions + initializeGraph: (LPOLI, I) -> Graph initializeGraph(mon, c) == coeffs := vector([first(coefficients(x))$LI for x in mon])$VI k := #coeffs @@ -21340,6 +21729,7 @@ DiophantineSolutionPackage(): Cat == Capsule where n := max(c, reduce(max, coeffs)$VI) [[createNode(i, coeffs, k, 1 - m) for i in m..n], k, 1 - m] + createNode: (I, VI, NI, I) -> Node createNode(ind, coeffs, k, zeroNode) == -- create vertices from node ind to other nodes v := zero(k)$VI @@ -21351,6 +21741,7 @@ DiophantineSolutionPackage(): Cat == Capsule where v.i := zeroNode + ind + coeffs.i [v, true] + findSolutions: (VNI, I, I, I, Graph, B) -> ListSol findSolutions(sol, ind, m, n, graph, flag) == -- return all solutions (paths) from node ind to node zeroNode sols := empty()$ListSol @@ -21378,6 +21769,7 @@ DiophantineSolutionPackage(): Cat == Capsule where sols sols + verifyMinimality: (VNI, Graph, B) -> B verifyMinimality(sol, graph, flag) == -- test whether sol contains a minimal homogeneous solution flag => -- sol is a homogeneous solution @@ -21391,6 +21783,7 @@ DiophantineSolutionPackage(): Cat == Capsule where flag verifySolution(sol, graph.zeroNode, 1, 1, graph) + verifySolution: (VNI, I, I, I, Graph) -> B verifySolution(sol, ind, m, n, graph) == -- test whether sol contains a path from ind to zeroNode flag := true @@ -21522,10 +21915,13 @@ DirectProductFunctions2(dim, A, B): Exports == Implementation where import FiniteLinearAggregateFunctions2(A, VA, B, VB) - map(f, v) == directProduct map(f, v::VA) + map : ((A -> B),DirectProduct(dim,A)) -> DirectProduct(dim,B) + map(f, v) == directProduct map(f, v::VA) - scan(f, v, b) == directProduct scan(f, v::VA, b) + scan : (((A,B) -> B),DirectProduct(dim,A),B) -> DirectProduct(dim,B) + scan(f, v, b) == directProduct scan(f, v::VA, b) + reduce : (((A,B) -> B),DirectProduct(dim,A),B) -> B reduce(f, v, b) == reduce(f, v::VA, b) *) @@ -21666,6 +22062,8 @@ DiscreteLogarithmPackage(M): public == private where (* package DLP *) (* + shanksDiscLogAlgorithm : (M,M,NonNegativeInteger) -> _ + Union(NonNegativeInteger,"failed") shanksDiscLogAlgorithm(logbase,c,p) == limit:Integer:= 30 -- for logarithms up to cyclic groups of order limit a full @@ -21897,14 +22295,20 @@ DisplayPackage: public == private where s : S l : L S - HION : S := " " - HIOFF : S := " " + HION : S := " " + HIOFF : S := " " NEWLINE : S := "%l" + bright : String -> List(String) bright s == [HION,s,HIOFF]$(L S) + + bright : List(String) -> List(String) bright l == cons(HION,append(l,list HIOFF)) + + newLine : () -> String newLine() == NEWLINE + copies : (Integer,String) -> String copies(n : I, s : S) == n < 1 => "" n = 1 => s @@ -21912,12 +22316,14 @@ DisplayPackage: public == private where odd? n => concat [s,t,t] concat [t,t] + center0 : (I,I,S) -> RECLR center0(len : I, wid : I, fill : S) : RECLR == (wid < 1) or (len >= wid) => ["",""]$RECLR m : I := (wid - len) quo 2 t : S := copies(1 + (m quo (sayLength fill)),fill) [t(1..m),t(1..wid-len-m)]$RECLR + center : (String,Integer,String) -> String center(s, wid, fill) == wid < 1 => "" len : I := sayLength s @@ -21926,6 +22332,7 @@ DisplayPackage: public == private where rec : RECLR := center0(len,wid,fill) concat [rec.lhs,s,rec.rhs] + center : (List(String),Integer,String) -> List(String) center(l, wid, fill) == wid < 1 => [""]$(L S) len : I := sayLength l @@ -21933,16 +22340,20 @@ DisplayPackage: public == private where rec : RECLR := center0(len,wid,fill) cons(rec.lhs,append(l,list rec.rhs)) + say : String -> Void say s == sayBrightly$Lisp s void()$Void + say : List(String) -> Void say l == sayBrightly$Lisp l void()$Void + sayLength : String -> Integer sayLength s == #s + sayLength : List(String) -> Integer sayLength l == sum : I := 0 for s in l repeat @@ -22282,15 +22693,10 @@ DistinctDegreeFactorize(F,FP): C == T D:=ModMonic(F,FP) import UnivariatePolynomialSquareFree(F,FP) - --local functions - notSqFr : (FP,FP -> List(FP)) -> List(ParFact) - ddffact : FP -> List(FP) - ddffact1 : (FP,Boolean) -> List fact - ranpol : NNI -> FP - charF : Boolean := characteristic()$F = 2 --construct a random polynomial of random degree < d + ranpol : NNI -> FP ranpol(d:NNI):FP == k1: NNI := 0 while k1 = 0 repeat k1 := random d @@ -22303,6 +22709,7 @@ DistinctDegreeFactorize(F,FP): C == T for j in 0..k1-1 repeat u:=u+monomial(random()$F,j) u + notSqFr : (FP,FP -> List(FP)) -> List(ParFact) notSqFr(m:FP,appl: FP->List(FP)):List(ParFact) == factlist : List(ParFact) :=empty() llf : List FFE @@ -22320,10 +22727,12 @@ DistinctDegreeFactorize(F,FP): C == T -- compute u**k mod v (requires call to setPoly of multiple of v) -- characteristic not equal 2 + exptMod : (FP,NonNegativeInteger,FP) -> FP exptMod(u:FP,k:NNI,v:FP):FP == (reduce(u)$D**k):FP rem v -- compute u**k mod v (requires call to setPoly of multiple of v) -- characteristic equal 2 + trace2PowMod : (FP,NonNegativeInteger,FP) -> FP trace2PowMod(u:FP,k:NNI,v:FP):FP == uu:=u for i in 1..k repeat uu:=(u+uu*uu) rem v @@ -22331,6 +22740,7 @@ DistinctDegreeFactorize(F,FP): C == T -- compute u+u**q+..+u**(q**k) mod v -- (requires call to setPoly of multiple of v) where q=size< F + tracePowMod : (FP,NonNegativeInteger,FP) -> FP tracePowMod(u:FP,k:NNI,v:FP):FP == u1 :D :=reduce(u)$D uu : D := u1 @@ -22340,6 +22750,7 @@ DistinctDegreeFactorize(F,FP): C == T -- compute u**(1+q+..+q**k) rem v where q=#F -- (requires call to setPoly of multiple of v) -- frobenius map is used + normPowMod : (FP,NNI,FP) -> FP normPowMod(u:FP,k:NNI,v:FP):FP == u1 :D :=reduce(u)$D uu : D := u1 @@ -22349,6 +22760,7 @@ DistinctDegreeFactorize(F,FP): C == T --find the factorization of m as product of factors each containing --terms of equal degree . -- if testirr=true the function returns the first factor found + ddffact1 : (FP,Boolean) -> List fact ddffact1(m:FP,testirr:Boolean):List(fact) == p:=size$F dg:NNI :=0 @@ -22375,14 +22787,18 @@ DistinctDegreeFactorize(F,FP): C == T cons([du,u]$fact,ddfact) -- test irreducibility + irreducible? : FP -> Boolean irreducible?(m:FP):Boolean == mf:fact:=first ddffact1(m,true) degree m = mf.deg --export ddfact1 + separateDegrees : FP -> List(Record(deg: NonNegativeInteger,prod: FP)) separateDegrees(m:FP):List(fact) == ddffact1(m,false) --find the complete factorization of m, using the result of ddfact1 + separateFactors : List(Record(deg: NonNegativeInteger,prod: FP)) -> _ + List(FP) separateFactors(distf : List fact) :List FP == ddfact := distf n1:Integer @@ -22416,6 +22832,7 @@ DistinctDegreeFactorize(F,FP): C == T ris --distinct degree algorithm for monic ,square-free polynomial + ddffact : FP -> List(FP) ddffact(m:FP):List(FP)== ddfact:=ddffact1(m,false) empty? ddfact => [m] @@ -22423,44 +22840,41 @@ DistinctDegreeFactorize(F,FP): C == T --factorize a general polynomial with distinct degree algorithm --if test=true no check is executed on square-free + distdfact : (FP,Boolean) -> _ + Record(cont: F,factors: List(Record(irr: FP,pow: Integer))) distdfact(m:FP,test:Boolean):FinalFact == factlist: List(ParFact):= empty() fln : List(FP) :=empty() - --make m monic if (lcm := leadingCoefficient m) ^=1 then m := (inv lcm)*m - --is x**d factor of m? if (d := minimumDegree m)>0 then m := (monicDivide (m,monomial(1,d))).quotient factlist := [[monomial(1,1),d]$ParFact] d:=degree m - --is m constant? d=0 => [lcm,factlist]$FinalFact - --is m linear? d=1 => [lcm,cons([m,d]$ParFact,factlist)]$FinalFact - --m is square-free test => fln := ddffact m factlist := append([[pol,1]$ParFact for pol in fln],factlist) [lcm,factlist]$FinalFact - --factorize the monic,square-free terms factlist:= append(notSqFr(m,ddffact),factlist) [lcm,factlist]$FinalFact --factorize the polynomial m + factor : FP -> Factored(FP) factor(m:FP) == m = 0 => 0 flist := distdfact(m,false) makeFR(flist.cont::FP,[["prime",u.irr,u.pow]$FFE for u in flist.factors]) - --factorize the square free polynomial m + factorSquareFree : FP -> Factored(FP) factorSquareFree(m:FP) == m = 0 => 0 flist := distdfact(m,true) @@ -25454,34 +25868,53 @@ Axiom uses the power series at the zero point: (* package DFSFUN *) (* - polygamma(k,z) == CPSI(k, z)$Lisp + polygamma : (NonNegativeInteger,Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) + polygamma(k,z) == CPSI(k, z)$Lisp - polygamma(k,x) == RPSI(k, x)$Lisp + polygamma : (NonNegativeInteger,DoubleFloat) -> DoubleFloat + polygamma(k,x) == RPSI(k, x)$Lisp - logGamma z == CLNGAMMA(z)$Lisp + logGamma : Complex(DoubleFloat) -> Complex(DoubleFloat) + logGamma z == CLNGAMMA(z)$Lisp - logGamma x == RLNGAMMA(x)$Lisp + logGamma : DoubleFloat -> DoubleFloat + logGamma x == RLNGAMMA(x)$Lisp + besselJ : (DoubleFloat,DoubleFloat) -> DoubleFloat besselJ(v,z) == CBESSELJ(v,z)$Lisp + besselJ : (Complex(DoubleFloat),Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) besselJ(n,x) == RBESSELJ(n,x)$Lisp + besselI : (Complex(DoubleFloat),Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) besselI(v,z) == CBESSELI(v,z)$Lisp + besselI : (DoubleFloat,DoubleFloat) -> DoubleFloat besselI(n,x) == RBESSELI(n,x)$Lisp + hypergeometric0F1 : (Complex(DoubleFloat),Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) hypergeometric0F1(a,z) == CHYPER0F1(a, z)$Lisp + hypergeometric0F1 : (DoubleFloat,DoubleFloat) -> DoubleFloat hypergeometric0F1(n,x) == retract hypergeometric0F1(n::C, x::C) -- All others are defined in terms of these. + digamma : DoubleFloat -> DoubleFloat digamma x == polygamma(0, x) + digamma : Complex(DoubleFloat) -> Complex(DoubleFloat) digamma z == polygamma(0, z) + Beta : (DoubleFloat,DoubleFloat) -> DoubleFloat Beta(x,y) == Gamma(x)*Gamma(y)/Gamma(x+y) + Beta : (Complex(DoubleFloat),Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) Beta(w,z) == Gamma(w)*Gamma(z)/Gamma(w+z) fuzz := (10::R)**(-7) @@ -25489,16 +25922,20 @@ Axiom uses the power series at the zero point: import IntegerRetractions(R) import IntegerRetractions(C) + besselY : (DoubleFloat,DoubleFloat) -> DoubleFloat besselY(n,x) == if integer? n then n := n + fuzz vp := n * pi()$R (cos(vp) * besselJ(n,x) - besselJ(-n,x) )/sin(vp) + besselY : (Complex(DoubleFloat),Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) besselY(v,z) == if integer? v then v := v + fuzz::C vp := v * pi()$C (cos(vp) * besselJ(v,z) - besselJ(-v,z) )/sin(vp) + besselK : (DoubleFloat,DoubleFloat) -> DoubleFloat besselK(n,x) == if integer? n then n := n + fuzz p := pi()$R @@ -25506,6 +25943,8 @@ Axiom uses the power series at the zero point: ahalf:= 1/(2::R) p * ahalf * ( besselI(-n,x) - besselI(n,x) )/sin(vp) + besselK : (Complex(DoubleFloat),Complex(DoubleFloat)) -> _ + Complex(DoubleFloat) besselK(v,z) == if integer? v then v := v + fuzz::C p := pi()$C @@ -25513,24 +25952,28 @@ Axiom uses the power series at the zero point: ahalf:= 1/(2::C) p * ahalf * ( besselI(-v,z) - besselI(v,z) )/sin(vp) + airyAi : DoubleFloat -> DoubleFloat airyAi x == ahalf := recip(2::R)::R athird := recip(3::R)::R eta := 2 * athird * (-x) ** (3*ahalf) (-x)**ahalf * athird * (besselJ(-athird,eta) + besselJ(athird,eta)) + airyAi : Complex(DoubleFloat) -> Complex(DoubleFloat) airyAi z == ahalf := recip(2::C)::C athird := recip(3::C)::C eta := 2 * athird * (-z) ** (3*ahalf) (-z)**ahalf * athird * (besselJ(-athird,eta) + besselJ(athird,eta)) + airyBi : DoubleFloat -> DoubleFloat airyBi x == ahalf := recip(2::R)::R athird := recip(3::R)::R eta := 2 * athird * (-x) ** (3*ahalf) (-x*athird)**ahalf * ( besselJ(-athird,eta) - besselJ(athird,eta) ) + airyBi : Complex(DoubleFloat) -> Complex(DoubleFloat) airyBi z == ahalf := recip(2::C)::C athird := recip(3::C)::C @@ -25652,20 +26095,20 @@ DoubleResultantPackage(F, UP, UPUP, R): Exports == Implementation where import CommuteUnivariatePolynomialCategory(F, UP, UP2) import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) - UP22 : UP -> UP2 - UP23 : UPUP -> UP3 remove0: UP -> UP -- removes the power of x dividing p - remove0 p == primitivePart((p exquo monomial(1, minimumDegree p))::UP) + UP22 : UP -> UP2 UP22 p == map(x+->x::UP, p)$UnivariatePolynomialCategoryFunctions2(F,UP,UP,UP2) + UP23 : UPUP -> UP3 UP23 p == map(x+->UP22(retract(x)@UP),p)_ $UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP2, UP3) + doubleResultant : (R,(UP -> UP)) -> UP doubleResultant(h, derivation) == cd := splitDenominator lift h d := (cd.den exquo (g := gcd(cd.den, derivation(cd.den))))::UP @@ -25917,15 +26360,18 @@ DrawComplex(): Exports == Implementation where -- relative size of the arrow head compared to the length of the arrow arrowScale : SF := (0.125)::SF + arrowAngle: SF := pi()-pi()/(20::SF) -- angle of the arrow head + realSteps: INT := 11 -- the number of steps in the real direction + imagSteps: INT := 11 -- the number of steps in the imaginary direction - clipValue: SF := 10::SF -- the maximum length of a vector to draw -- Add an arrow head to a line segment, which starts at 'p1', ends at 'p2', -- has length 'len', and and angle 'arg'. We pass 'len' and 'arg' as -- arguments since thet were already computed by the calling program + makeArrow : (Point SF,Point SF,SF,SF) -> List List Point SF makeArrow(p1:Point SF, p2:Point SF, len: SF, arg:SF):List List Point SF == c1 := cos(arg + arrowAngle) s1 := sin(arg + arrowAngle) @@ -25938,9 +26384,13 @@ DrawComplex(): Exports == Implementation where [[p1, p2, p3], [p2, p4]] -- clip a value in the interval (-clip...clip) + clipValue: SF := 10::SF -- the maximum length of a vector to draw clipFun(x:SF):SF == min(max(x, -clipValue), clipValue) + drawComplex : ((Complex(DoubleFloat) -> Complex(DoubleFloat)),_ + Segment(DoubleFloat),Segment(DoubleFloat),Boolean) -> _ + ThreeDimensionalViewport drawComplex(f, realRange, imagRange, arrows?) == delReal := (hi(realRange) - lo(realRange))/realSteps::SF delImag := (hi(imagRange) - lo(imagRange))/imagSteps::SF @@ -25982,6 +26432,9 @@ DrawComplex(): Exports == Implementation where real := real + delReal makeViewport3D(space, "Complex Function")$VIEW3D + drawComplexVectorField : _ + ((Complex(DoubleFloat) -> Complex(DoubleFloat)),_ + Segment(DoubleFloat),Segment(DoubleFloat)) -> ThreeDimensionalViewport drawComplexVectorField(f, realRange, imagRange): VIEW3D == -- compute the steps size of the grid delReal := (hi(realRange) - lo(realRange))/realSteps::SF @@ -26015,14 +26468,17 @@ DrawComplex(): Exports == Implementation where makeViewport3D(space, "Complex Vector Field")$VIEW3D -- set the number of steps to use in the real direction + setRealSteps : Integer -> Integer setRealSteps(n) == realSteps := n -- set the number of steps to use in the imaginary direction + setImagSteps : Integer -> Integer setImagSteps(n) == imagSteps := n -- set the maximum value to plot + setClipValue : DoubleFloat -> DoubleFloat setClipValue clip == clipValue := clip @@ -26117,6 +26573,7 @@ DrawNumericHack(R:Join(OrderedSet,IntegralDomain,ConvertibleTo Float)): (* package DRAWHACK *) (* + coerce : SegmentBinding(Expression(R)) -> SegmentBinding(Float) coerce s == map(numeric$Numeric(R),s)$SegmentBindingFunctions2(Expression R, Float) @@ -26378,81 +26835,104 @@ DrawOptionFunctions0(): Exports == Implementation where (* package DROPT0 *) (* + adaptive : (List(DrawOption),Boolean) -> Boolean adaptive(l,s) == (u := option(l, "adaptive"::Symbol)$DrawOptionFunctions1(Boolean)) case "failed" => s u::Boolean + clipBoolean : (List(DrawOption),Boolean) -> Boolean clipBoolean(l,s) == (u := option(l, "clipBoolean"::Symbol)$DrawOptionFunctions1(Boolean)) case "failed" => s u::Boolean + title : (List(DrawOption),String) -> String title(l, s) == (u := option(l, "title"::Symbol)$DrawOptionFunctions1(String)) case "failed" => s u::String + viewpoint : (List(DrawOption),Record(theta: DoubleFloat,_ + phi: DoubleFloat,scale: DoubleFloat,scaleX: DoubleFloat,_ + scaleY: DoubleFloat,scaleZ: DoubleFloat,deltaX: DoubleFloat,_ + deltaY: DoubleFloat)) -> _ + Record(theta: DoubleFloat,phi: DoubleFloat,scale: DoubleFloat,_ + scaleX: DoubleFloat,scaleY: DoubleFloat,scaleZ: DoubleFloat,_ + deltaX: DoubleFloat,deltaY: DoubleFloat) viewpoint(l, vp) == (u := option(l, "viewpoint"::Symbol)$DrawOptionFunctions1(VIEWPT)) case "failed" => vp u::VIEWPT + style : (List(DrawOption),String) -> String style(l, s) == (u := option(l, "style"::Symbol)$DrawOptionFunctions1(String)) case "failed" => s u::String + toScale : (List(DrawOption),Boolean) -> Boolean toScale(l,s) == (u := option(l, "toScale"::Symbol)$DrawOptionFunctions1(Boolean)) case "failed" => s u::Boolean + pointColorPalette : (List(DrawOption),Palette) -> Palette pointColorPalette(l,s) == (u := option(l, "pointColorPalette"::Symbol)$DrawOptionFunctions1(PAL)) case "failed" => s u::PAL + curveColorPalette : (List(DrawOption),Palette) -> Palette curveColorPalette(l,s) == (u := option(l, "curveColorPalette"::Symbol)$DrawOptionFunctions1(PAL)) case "failed" => s u::PAL + ranges : (List(DrawOption),List(Segment(Float))) -> List(Segment(Float)) ranges(l, s) == (u := option(l, "ranges"::Symbol)$DrawOptionFunctions1(RANGE)) case "failed" => s u::RANGE + space : List(DrawOption) -> ThreeSpace(DoubleFloat) space(l) == (u := option(l, "space"::Symbol)$DrawOptionFunctions1(SPACE3)) case "failed" => create3Space()$SPACE3 u::SPACE3 + var1Steps : (List(DrawOption),PositiveInteger) -> PositiveInteger var1Steps(l,s) == (u := option(l, "var1Steps"::Symbol)$DrawOptionFunctions1(PositiveInteger)) case "failed" => s u::PositiveInteger + var2Steps : (List(DrawOption),PositiveInteger) -> PositiveInteger var2Steps(l,s) == (u := option(l, "var2Steps"::Symbol)$DrawOptionFunctions1(PositiveInteger)) case "failed" => s u::PositiveInteger + tubePoints : (List(DrawOption),PositiveInteger) -> PositiveInteger tubePoints(l,s) == (u:= option(l, "tubePoints"::Symbol)$DrawOptionFunctions1(PositiveInteger)) case "failed" => s u::PositiveInteger + tubeRadius : (List(DrawOption),Float) -> Float tubeRadius(l,s) == (u := option(l, "tubeRadius"::Symbol)$DrawOptionFunctions1(Float)) case "failed" => s u::Float + coord : (List(DrawOption),(Point(DoubleFloat) -> Point(DoubleFloat))) -> _ + (Point(DoubleFloat) -> Point(DoubleFloat)) coord(l,s) == (u := option(l, "coord"::Symbol)$DrawOptionFunctions1(POINT->POINT)) case "failed" => s u::(POINT->POINT) + units : (List(DrawOption),List(Float)) -> List(Float) units(l,s) == (u := option(l, "unit"::Symbol)$DrawOptionFunctions1(UNIT)) case "failed" => s @@ -26543,6 +27023,7 @@ DrawOptionFunctions1(S:Type): Exports == Implementation where (* package DROPT1 *) (* + option : (List(DrawOption),Symbol) -> Union(S,"failed") option(l, s) == (u := option(l, s)@Union(Any, "failed")) case "failed" => "failed" retract(u::Any)$AnyFunctions1(S) @@ -28019,16 +28500,7 @@ d01AgentsPackage(): E == I where import ExpertSystemToolsPackage import ExpertSystemContinuityPackage - -- local functions - ocdf2ocefi : OCDF -> OCEFI - rangeOfArgument : (KEDF, NIA) -> DF - continuousAtPoint? : (EFI,EOCEFI) -> Boolean - rand:(SOCDF,INT) -> LDF - eval:(EDF,Symbol,LDF) -> LDF - numberOfSignChanges:LDF -> INT - rangeIsFiniteFunction:NIA -> RTYPE - functionIsContinuousAtEndPointsFunction:NIA -> CTYPE - + changeName : (Symbol,Symbol,Result) -> Result changeName(s:Symbol,t:Symbol,r:Result):Result == a := remove!(s,r)$Result a case Any => @@ -28036,6 +28508,7 @@ d01AgentsPackage(): E == I where r r + commaSeparate : List(String) -> String commaSeparate(l:LST):ST == empty?(l)$LST => "" (#(l) = 1) => concat(l)$ST @@ -28043,6 +28516,7 @@ d01AgentsPackage(): E == I where t := [concat([", ",l.i])$ST for i in 2..#(l)] concat(f,concat(t)$ST)$ST + rand:(SOCDF,INT) -> LDF rand(seg:SOCDF,n:INT):LDF == -- produced a sorted list of random numbers in the given range l:DF := getlo seg @@ -28052,11 +28526,13 @@ d01AgentsPackage(): E == I where r:LDF := [(((random(seed)$INT) :: DF)*s/dseed + l) for i in 1..n] sort(r)$LDF + eval:(EDF,Symbol,LDF) -> LDF eval(f:EDF,var:Symbol,l:LDF):LDF == empty?(l)$LDF => [0$DF] ve := var::EDF [retract(eval(f,equation(ve,u::EDF)$EEDF)$EDF)@DF for u in l] + numberOfSignChanges:LDF -> INT numberOfSignChanges(l:LDF):INT == -- calculates the number of sign changes in a list a := 0$INT @@ -28066,6 +28542,7 @@ d01AgentsPackage(): E == I where a := a + 1 a + rangeOfArgument : (KEDF, NIA) -> DF rangeOfArgument(k: KEDF, args:NIA): DF == Args := copy args Args.fn := arg := first(argument(k)$KEDF)$LEDF @@ -28080,10 +28557,12 @@ d01AgentsPackage(): E == I where e2-e1 0$DF + ocdf2ocefi : OCDF -> OCEFI ocdf2ocefi(r:OCDF):OCEFI == finite?(r)$OCDF => (edf2efi(((retract(r)@DF)$OCDF)::EDF))::OCEFI r pretend OCEFI + continuousAtPoint? : (EFI,EOCEFI) -> Boolean continuousAtPoint?(f:EFI,e:EOCEFI):Boolean == (l := limit(f,e)$PowerSeriesLimitPackage(FI,EFI)) case OCEFI => finite?(l :: OCEFI) @@ -28094,6 +28573,7 @@ d01AgentsPackage(): E == I where -- exported functions + rangeIsFiniteFunction:NIA -> RTYPE rangeIsFiniteFunction(args:NIA): RTYPE == -- rangeIsFinite(x) tests the endpoints of x.range for infinite -- end points. @@ -28109,6 +28589,14 @@ d01AgentsPackage(): E == I where fr = 4 => ["Both top and bottom points are infinite"] error("rangeIsFinite",["this is not a valid range"])$ErrorFunctions + rangeIsFinite : Record(var: Symbol,fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> _ + Union(finite: The range is finite,_ + lowerInfinite: The bottom of range is infinite,_ + upperInfinite: The top of range is infinite,_ + bothInfinite: Both top and bottom points are infinite,_ + notEvaluated: Range not yet evaluated) rangeIsFinite(args:NIA): RTYPE == nia := copy args (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT => @@ -28126,6 +28614,7 @@ d01AgentsPackage(): E == I where insert!(r)$IntegrationFunctionsTable e + functionIsContinuousAtEndPointsFunction:NIA -> CTYPE functionIsContinuousAtEndPointsFunction(args:NIA):CTYPE == v := args.var :: EFI :: OCEFI high:OCEFI := ocdf2ocefi(hi(args.range)) @@ -28138,6 +28627,16 @@ d01AgentsPackage(): E == I where h => ["There is a singularity at the lower end point"] ["There are singularities at both end points"] + functionIsContinuousAtEndPoints : _ + Record(var: Symbol,fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,_ + relerr: DoubleFloat) -> _ + Union(continuous: Continuous at the end points,O + lowerSingular: There is a singularity at the lower end point,_ + upperSingular: There is a singularity at the upper end point,_ + bothSingular: There are singularities at both end points,_ + notEvaluated: End point continuity not yet evaluated) functionIsContinuousAtEndPoints(args:NIA): CTYPE == nia := copy args (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT => @@ -28155,6 +28654,10 @@ d01AgentsPackage(): E == I where insert!(r)$IntegrationFunctionsTable e + functionIsOscillatory : _ + Record(var: Symbol,fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Float functionIsOscillatory(a:NIA):F == args := copy a k := tower(numerator args.fn)$EDF @@ -28170,6 +28673,10 @@ d01AgentsPackage(): E == I where l := eval(args.fn,args.var,l) numberOfSignChanges(l) :: F + singularitiesOf : Record(var: Symbol,fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> _ + Stream(DoubleFloat) singularitiesOf(args:NIA):SDF == nia := copy args (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT => @@ -28513,35 +29020,25 @@ d01WeightsPackage(): E == I where (* package D01WGTS *) (* - score:(EDF,EDF) -> FI kernelIsLog:KEDF -> Boolean - functionIsPolynomial?:EDF -> Boolean - functionIsNthRoot?:(EDF,EDF) -> Boolean - functionIsQuotient:EDF -> Union(EDF,"failed") - findCommonFactor:LEDF -> Union(LEDF,"failed") - findAlgebraicWeight:(NIA,EDF) -> Union(DF,"failed") - exprHasListOfWeightsCosWXorSinWX:(EDF,Symbol) -> LURBODF - exprOfFormCosWXorSinWX:(EDF,Symbol) -> URBODF - bestWeight:LURBODF -> URBODF - weightIn?:(URBODF,LURBODF) -> Boolean - inRest?:(EDF,LEDF)->Boolean - factorIn?:(EDF,LEDF)->Boolean - voo?:(EDF,EDF)->Boolean - kernelIsLog(k:KEDF):Boolean == (name k = (log :: Symbol))@Boolean + factorIn?:(EDF,LEDF)->Boolean factorIn?(a:EDF,l:LEDF):Boolean == for i in 1..# l repeat (a = l.i)@Boolean => return true false + voo?:(EDF,EDF)->Boolean voo?(b:EDF,a:EDF):Boolean == (voo:=isTimes(b)) case LEDF and factorIn?(a,voo) + inRest?:(EDF,LEDF)->Boolean inRest?(a:EDF,l:LEDF):Boolean == every?(x+->voo?(x,a) ,l) + findCommonFactor:LEDF -> Union(LEDF,"failed") findCommonFactor(l:LEDF):Union(LEDF,"failed") == empty?(l)$LEDF => "failed" f := first(l)$LEDF @@ -28552,6 +29049,7 @@ d01WeightsPackage(): E == I where pos "failed" + exprIsLogarithmicWeight : (EDF,EDF,EDF,EDF) -> INT exprIsLogarithmicWeight(f:EDF,Var:EDF,a:EDF,b:EDF):INT == ans := 0$INT k := tower(f)$EDF @@ -28565,6 +29063,10 @@ d01WeightsPackage(): E == I where ans := ans + 2 ans + exprHasLogarithmicWeights : _ + Record(var: Symbol,fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Integer exprHasLogarithmicWeights(args:NIA):INT == ans := 1$INT a := getlo(args.range)$d01AgentsPackage :: EDF @@ -28578,6 +29080,7 @@ d01WeightsPackage(): E == I where ans ans := ans + exprIsLogarithmicWeight(args.fn,Var,a,b) + functionIsQuotient:EDF -> Union(EDF,"failed") functionIsQuotient(expr:EDF):Union(EDF,"failed") == (k := mainKernel expr) case KEDF => expr = inv(f := k :: KEDF :: EDF)$EDF => f @@ -28585,15 +29088,18 @@ d01WeightsPackage(): E == I where "failed" "failed" + functionIsPolynomial?:EDF -> Boolean functionIsPolynomial?(f:EDF):Boolean == (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF + functionIsNthRoot?:(EDF,EDF) -> Boolean functionIsNthRoot?(f:EDF,e:EDF):Boolean == (m := mainKernel f) case "failed" => false ((# (kernels f)) = 1) and (name operator m = (nthRoot :: Symbol))@Boolean and (((argument m).1 = e)@Boolean) + score:(EDF,EDF) -> FI score(f:EDF,e:EDF):FI == ans := 0$FI (t := isTimes f) case LEDF => @@ -28626,10 +29132,16 @@ d01WeightsPackage(): E == I where ans ans + findAlgebraicWeight:(NIA,EDF) -> Union(DF,"failed") findAlgebraicWeight(args:NIA,e:EDF):Union(DF,"failed") == zero?(s := score(args.fn,e)) => "failed" s :: DF + exprHasAlgebraicWeight : _ + Record(var: Symbol,fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> _ + Union(List(DoubleFloat),"failed") exprHasAlgebraicWeight(args:NIA):Union(LDF,"failed") == (f := functionIsContinuousAtEndPoints(args)$d01AgentsPackage) case continuous =>"failed" @@ -28653,6 +29165,11 @@ d01WeightsPackage(): E == I where s => [coerce(h)@DF,0] [coerce(h)@DF,coerce(g)@DF] + exprHasWeightCosWXorSinWX : Record(var: Symbol,_ + fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> _ + Union(Record(op: BasicOperator,w: DoubleFloat),"failed") exprOfFormCosWXorSinWX(f:EDF,var:Symbol): URBODF == l:LKEDF := kernels(f)$EDF # l = 1 => @@ -28670,6 +29187,7 @@ d01WeightsPackage(): E == I where "failed" "failed" + exprHasListOfWeightsCosWXorSinWX:(EDF,Symbol) -> LURBODF exprHasListOfWeightsCosWXorSinWX(f:EDF,var:Symbol): LURBODF == (e := isTimes(f)$EDF) case LEDF => [exprOfFormCosWXorSinWX(u,var) for u in e] @@ -28678,6 +29196,7 @@ d01WeightsPackage(): E == I where [exprOfFormCosWXorSinWX(f,var)] ["failed"] + bestWeight:LURBODF -> URBODF bestWeight(l:LURBODF): URBODF == empty?(l)$LURBODF => "failed" best := first(l)$LURBODF -- best is first in list @@ -28691,12 +29210,14 @@ d01WeightsPackage(): E == I where best := r best + weightIn?:(URBODF,LURBODF) -> Boolean weightIn?(weight:URBODF,listOfWeights:LURBODF):Boolean == n := # listOfWeights for i in 1..n repeat -- cycle through list (weight = listOfWeights.i)@Boolean => return true -- return when found false + exprOfFormCosWXorSinWX:(EDF,Symbol) -> URBODF exprHasWeightCosWXorSinWX(args:NIA):URBODF == ans := empty()$LURBODF f:EDF := numerator(args.fn)$EDF @@ -30306,17 +30827,15 @@ d02AgentsPackage(): E == I where import ExpertSystemToolsPackage - accuracyFactor:ODEA -> F - expenseOfEvaluation:ODEA -> F - eval1:(LEDF,LEEDF) -> LEDF - stiffnessAndStabilityOfODE:ODEA -> RSS intermediateResultsFactor:ODEA -> F - leastStabilityAngle:(LDF,LDF) -> F - intermediateResultsFactor(ode:ODEA):F == resultsRequirement := #(ode.intvals) (1.0-exp(-(resultsRequirement::F)/50.0)$F) + intermediateResultsIF : Record(xinit: DoubleFloat,xend: DoubleFloat,_ + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat),_ + intvals: List(DoubleFloat),g: Expression(DoubleFloat),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Float intermediateResultsIF(o:ODEA):F == ode := copy o (t := showIntensityFunctions(ode)$ODEIntensityFunctionsTable) case ATT => @@ -30332,6 +30851,7 @@ d02AgentsPackage(): E == I where insert!(r)$ODEIntensityFunctionsTable e + accuracyFactor:ODEA -> F accuracyFactor(ode:ODEA):F == accuracyRequirements := convert(ode.abserr)@F if zero?(accuracyRequirements) then @@ -30340,6 +30860,10 @@ d02AgentsPackage(): E == I where n := log10(val)$F (1.0-exp(-(n/(2.0))**2/(15.0))$F) + accuracyIF : Record(xinit: DoubleFloat,xend: DoubleFloat,_ + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat),_ + intvals: List(DoubleFloat),g: Expression(DoubleFloat),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Float accuracyIF(o:ODEA):F == ode := copy o (t := showIntensityFunctions(ode)$ODEIntensityFunctionsTable) case ATT => @@ -30355,10 +30879,15 @@ d02AgentsPackage(): E == I where insert!(r)$ODEIntensityFunctionsTable e + systemSizeIF : Record(xinit: DoubleFloat,xend: DoubleFloat,_ + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat),_ + intvals: List(DoubleFloat),g: Expression(DoubleFloat),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Float systemSizeIF(ode:ODEA):F == n := #(ode.fn) (1.0-exp((-n::F/75.0))$F) + expenseOfEvaluation:ODEA -> F expenseOfEvaluation(o:ODEA):F == -- expense of evaluation of an ODE -- <0.3 inexpensive - 0.5 neutral - >0.7 very expensive @@ -30369,6 +30898,10 @@ d02AgentsPackage(): E == I where ode := copy o.fn expenseOfEvaluation(ode) + expenseOfEvaluationIF : Record(xinit: DoubleFloat,xend: DoubleFloat,_ + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat),_ + intvals: List(DoubleFloat),g: Expression(DoubleFloat),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Float expenseOfEvaluationIF(o:ODEA):F == ode := copy o (t := showIntensityFunctions(ode)$ODEIntensityFunctionsTable) case ATT => @@ -30384,6 +30917,7 @@ d02AgentsPackage(): E == I where insert!(r)$ODEIntensityFunctionsTable e + leastStabilityAngle:(LDF,LDF) -> F leastStabilityAngle(realPartsList:LDF,imagPartsList:LDF):F == complexList := _ [complex(u,v)$CDF for u in realPartsList for v in imagPartsList] @@ -30394,6 +30928,8 @@ d02AgentsPackage(): E == I where empty?(list)$LDF => 0$F convert(first(list)$LDF)@F + stiffnessAndStabilityFactor : Matrix(Expression(DoubleFloat)) -> _ + Record(stiffnessFactor: Float,stabilityFactor: Float) stiffnessAndStabilityFactor(me:MEDF):RSS == -- search first for real eigenvalues of the jacobian (symbolically) -- if the system isn't too big @@ -30433,9 +30969,12 @@ d02AgentsPackage(): E == I where [out,stabilityAngle] -- calculate stiffness ratio [-convert(negRealPartsList.1)@F,stabilityAngle] + eval1:(LEDF,LEEDF) -> LEDF eval1(l:LEDF,e:LEEDF):LEDF == [eval(u,e)$EDF for u in l] + eval : (Matrix(Expression(DoubleFloat)),List(Symbol),_ + Vector(Expression(DoubleFloat))) -> Matrix(Expression(DoubleFloat)) eval(mat:MEDF,symbols:LS,values:VEDF):MEDF == l := listOfLists(mat) ledf := entries(values)$VEDF @@ -30443,30 +30982,34 @@ d02AgentsPackage(): E == I where l := [eval1(w,e) for w in l] matrix l + -- C1 C2 + -- s(C1,C2) = ----------------------- + -- C1 C2 + (1 - C1)(1 - C2) + combineFeatureCompatibility : (Float,Float) -> Float combineFeatureCompatibility(C1:F,C2:F):F == - - -- C1 C2 - -- s(C1,C2) = ----------------------- - -- C1 C2 + (1 - C1)(1 - C2) - C1*C2/((C1*C2)+(1$F-C1)*(1$F-C2)) + combineFeatureCompatibility : (Float,List(Float)) -> Float combineFeatureCompatibility(C1:F,L:LF):F == - empty?(L)$LF => C1 C2 := combineFeatureCompatibility(C1,first(L)$LF) combineFeatureCompatibility(C2,rest(L)$LF) + jacobian : (Vector(Expression(DoubleFloat)),List(Symbol)) -> + + Matrix(Expression(DoubleFloat)) jacobian(v:VEDF,w:LS):Matrix EDF == jacobian(v,w)$MultiVariableCalculusFunctions(S,EDF,VEDF,LS) + sparsityIF : Matrix(Expression(DoubleFloat)) -> Float sparsityIF(m:Matrix EDF):F == l:LEDF :=parts m z:LEDF := [u for u in l | zero?(u)$EDF] ((#z)::F/(#l)::F) + sum : (EDF,EDF) -> EDF sum(a:EDF,b:EDF):EDF == a+b + stiffnessAndStabilityOfODE:ODEA -> RSS stiffnessAndStabilityOfODE(ode:ODEA):RSS == odefns := copy ode.fn ls:LS := [subscript(Y,[coerce(n)])$Symbol for n in 1..# odefns] @@ -30484,6 +31027,12 @@ d02AgentsPackage(): E == I where stiffness := (1.0)-exp(-(ssf.stiffnessFactor)/(500.0)) [stiffness,stability] + stiffnessAndStabilityOfODEIF : _ + Record(xinit: DoubleFloat,xend: DoubleFloat,_ + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat),_ + intvals: List(DoubleFloat),g: Expression(DoubleFloat),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> _ + Record(stiffnessFactor: Float,stabilityFactor: Float) stiffnessAndStabilityOfODEIF(ode:ODEA):RSS == odefn := copy ode (t:=showIntensityFunctions(odefn)$ODEIntensityFunctionsTable) case ATT => @@ -31412,11 +31961,14 @@ d03AgentsPackage(): E == I where import ExpertSystemToolsPackage + sum : (EDF,EDF) -> EDF sum(a:EDF,b:EDF):EDF == a+b + varList : (Symbol,NonNegativeInteger) -> List(Symbol) varList(s:Symbol,n:NonNegativeInteger):LS == [subscript(s,[t::OutputForm]) for t in expand([1..n])$Segment(Integer)] + subscriptedVariables : Expression(DoubleFloat) -> Expression(DoubleFloat) subscriptedVariables(e:EDF):EDF == oldVars:List Symbol := variables(e) o := [a :: EDF for a in oldVars] @@ -31424,12 +31976,22 @@ d03AgentsPackage(): E == I where n := [b :: EDF for b in newVars] subst(e,[a=b for a in o for b in n]) + central? : (DoubleFloat,DoubleFloat,List(Expression(DoubleFloat))) -> _ + Boolean central?(x:DF,y:DF,p:LEDF):Boolean == ls := variables(reduce(sum,p)) le := [equation(u::EDF,v)$EEDF for u in ls for v in [x::EDF,y::EDF]] l := [eval(u,le)$EDF for u in p] max(l.4,l.5) < 20 * max(l.1,max(l.2,l.3)) + elliptic? : _ + Record(pde: List(Expression(DoubleFloat)),_ + constraints: List(Record(start: DoubleFloat,_ + finish: DoubleFloat,grid: NonNegativeInteger,_ + boundaryType: Integer,dStart: Matrix(DoubleFloat),_ + dFinish: Matrix(DoubleFloat))),_ + f: List(List(Expression(DoubleFloat))),st: String,_ + tol: DoubleFloat) -> Boolean elliptic?(args:PDEB):Boolean == (args.st)="elliptic" => true p := args.pde @@ -31778,39 +32340,38 @@ EigenPackage(R) : C == T (* package EP *) (* - PI ==> PositiveInteger + PI ==> PositiveInteger MF := GeneralizedMultivariateFactorize(SE,IndexedExponents SE,R,R,P) UPCF2:= UnivariatePolynomialCategoryFunctions2(P,SUP,F,SUF) ---- Local Functions ---- - tff : (SUF,SE) -> F - fft : (SUF,SE) -> F - charpol : (M,SE) -> F - intRatEig : (F,M,NNI) -> List M - intAlgEig : (ST,M,NNI) -> List M - genEigForm : (EigenForm,M) -> GenEigen ---- next functions needed for defining ModularField ---- + reduction : (SUF,SUF) -> SUF reduction(u:SUF,p:SUF):SUF == u rem p + merge : (SUF,SUF) -> Union(SUF,"failed") merge(p:SUF,q:SUF):Union(SUF,"failed") == p = q => p p = 0 => q q = 0 => p "failed" + exactquo : (SUF,SUF,SUF) -> Union(SUF,"failed") exactquo(u:SUF,v:SUF,p:SUF):Union(SUF,"failed") == val:=extendedEuclidean(v,p,u) val case "failed" => "failed" val.coef1 ---- functions for conversions ---- + fft : (SUF,SE) -> F fft(t:SUF,x:SE):F == n:=degree(t) cf:=monomial(1,x,n)$P :: F cf * leadingCoefficient t + tff : (SUF,SE) -> F tff(p:SUF,x:SE) : F == degree p=0 => leadingCoefficient p r:F:=0$F @@ -31820,6 +32381,7 @@ EigenPackage(R) : C == T r ---- generalized eigenvectors associated to a given eigenvalue --- + genEigForm : (EigenForm,M) -> GenEigen genEigForm(eigen : EigenForm,A:M) : GenEigen == alpha:=eigen.eigval k:=eigen.eigmult @@ -31828,6 +32390,7 @@ EigenPackage(R) : C == T [alpha,generalizedEigenvector(alpha,A,k,g)] ---- characteristic polynomial ---- + charpol : (M,SE) -> F charpol(A:M,x:SE) : F == dimA :PI := (nrows A):PI dimA ^= ncols A => error " The matrix is not square" @@ -31840,14 +32403,19 @@ EigenPackage(R) : C == T -------- EXPORTED FUNCTIONS -------- ---- characteristic polynomial of a matrix A ---- + characteristicPolynomial: Matrix(Fraction(Polynomial(R))) -> Polynomial(R) characteristicPolynomial(A:M):P == x:SE:=new()$SE numer charpol(A,x) ---- characteristic polynomial of a matrix A ---- + characteristicPolynomial : (Matrix(Fraction(Polynomial(R))),Symbol) -> _ + Polynomial(R) characteristicPolynomial(A:M,x:SE) : P == numer charpol(A,x) ---- Eigenvalues of the matrix A ---- + eigenvalues : Matrix(Fraction(Polynomial(R))) -> _ + List(Union(Fraction(Polynomial(R)),SuchThat(Symbol,Polynomial(R)))) eigenvalues(A:M): List Eigenvalue == x:=new()$SE pol:= charpol(A,x) @@ -31862,12 +32430,16 @@ EigenPackage(R) : C == T ---- Eigenvectors belonging to a given eigenvalue ---- ---- the eigenvalue must be exact ---- + eigenvector : (Union(Fraction(Polynomial(R)),_ + SuchThat(Symbol,Polynomial(R))),Matrix(Fraction(Polynomial(R)))) -> _ + List(Matrix(Fraction(Polynomial(R)))) eigenvector(alpha:Eigenvalue,A:M) : List M == alpha case F => intRatEig(alpha::F,A,1$NNI) intAlgEig(alpha::ST,A,1$NNI) ---- Eigenvectors belonging to a given rational eigenvalue ---- ---- Internal function ----- + intRatEig : (F,M,NNI) -> List M intRatEig(alpha:F,A:M,m:NNI) : List M == n:=nrows A B:M := zero(n,n)$M @@ -31878,6 +32450,7 @@ EigenPackage(R) : C == T ---- Eigenvectors belonging to a given algebraic eigenvalue ---- ------ Internal Function ----- + intAlgEig : (ST,M,NNI) -> List M intAlgEig(alpha:ST,A:M,m:NNI) : List M == n:=nrows A MM := ModularField(SUF,SUF,reduction,merge,exactquo) @@ -31897,21 +32470,38 @@ EigenPackage(R) : C == T sol ---- Generalized Eigenvectors belonging to a given eigenvalue ---- + generalizedEigenvector : (Union(Fraction(Polynomial(R)),_ + SuchThat(Symbol,Polynomial(R))),Matrix(Fraction(Polynomial(R))),_ + NonNegativeInteger,NonNegativeInteger) -> _ + List(Matrix(Fraction(Polynomial(R)))) generalizedEigenvector(alpha:Eigenvalue,A:M,k:NNI,g:NNI) : List M == alpha case F => intRatEig(alpha::F,A,(1+k-g)::NNI) intAlgEig(alpha::ST,A,(1+k-g)::NNI) ---- Generalized Eigenvectors belonging to a given eigenvalue ---- + generalizedEigenvector : (Record(eigval: Union(Fraction(Polynomial(R)),_ + SuchThat(Symbol,Polynomial(R))),eigmult: NonNegativeInteger,_ + eigvec: List(Matrix(Fraction(Polynomial(R))))),_ + Matrix(Fraction(Polynomial(R)))) -> _ + List(Matrix(Fraction(Polynomial(R)))) generalizedEigenvector(eigen :EigenForm,A:M) : List M == generalizedEigenvector(eigen.eigval,A,eigen.eigmult,# eigen.eigvec) ---- Generalized Eigenvectors ----- + generalizedEigenvectors : Matrix(Fraction(Polynomial(R))) -> _ + List(Record(eigval: Union(Fraction(Polynomial(R)),_ + SuchThat(Symbol,Polynomial(R))),_ + geneigvec: List(Matrix(Fraction(Polynomial(R)))))) generalizedEigenvectors(A:M) : List GenEigen == n:= nrows A leig:=eigenvectors A [genEigForm(leg,A) for leg in leig] ---- eigenvectors and eigenvalues ---- + eigenvectors : Matrix(Fraction(Polynomial(R))) -> _ + List(Record(eigval: Union(Fraction(Polynomial(R)),_ + SuchThat(Symbol,Polynomial(R))),eigmult: NonNegativeInteger,_ + eigvec: List(Matrix(Fraction(Polynomial(R)))))) eigenvectors(A:M):List(EigenForm) == n:=nrows A x:=new()$SE @@ -33583,66 +34173,58 @@ ElementaryFunction(R, F): Exports == Implementation where (* package EF *) (* - ipi : List F -> F - iexp : F -> F - ilog : F -> F - iiilog : F -> F - isin : F -> F - icos : F -> F - itan : F -> F - icot : F -> F - isec : F -> F - icsc : F -> F - iasin : F -> F - iacos : F -> F - iatan : F -> F - iacot : F -> F - iasec : F -> F - iacsc : F -> F - isinh : F -> F - icosh : F -> F - itanh : F -> F - icoth : F -> F - isech : F -> F - icsch : F -> F - iasinh : F -> F - iacosh : F -> F - iatanh : F -> F - iacoth : F -> F - iasech : F -> F - iacsch : F -> F - dropfun : F -> F - kernel : F -> K - posrem :(Z, Z) -> Z - iisqrt1 : () -> F - valueOrPole : Record(func:F, pole:B) -> F - oppi := operator("pi"::Symbol)$CommonOperators + oplog := operator("log"::Symbol)$CommonOperators + opexp := operator("exp"::Symbol)$CommonOperators + opsin := operator("sin"::Symbol)$CommonOperators + opcos := operator("cos"::Symbol)$CommonOperators + optan := operator("tan"::Symbol)$CommonOperators + opcot := operator("cot"::Symbol)$CommonOperators + opsec := operator("sec"::Symbol)$CommonOperators + opcsc := operator("csc"::Symbol)$CommonOperators + opasin := operator("asin"::Symbol)$CommonOperators + opacos := operator("acos"::Symbol)$CommonOperators + opatan := operator("atan"::Symbol)$CommonOperators + opacot := operator("acot"::Symbol)$CommonOperators + opasec := operator("asec"::Symbol)$CommonOperators + opacsc := operator("acsc"::Symbol)$CommonOperators + opsinh := operator("sinh"::Symbol)$CommonOperators + opcosh := operator("cosh"::Symbol)$CommonOperators + optanh := operator("tanh"::Symbol)$CommonOperators + opcoth := operator("coth"::Symbol)$CommonOperators + opsech := operator("sech"::Symbol)$CommonOperators + opcsch := operator("csch"::Symbol)$CommonOperators + opasinh := operator("asinh"::Symbol)$CommonOperators + opacosh := operator("acosh"::Symbol)$CommonOperators + opatanh := operator("atanh"::Symbol)$CommonOperators + opacoth := operator("acoth"::Symbol)$CommonOperators + opasech := operator("asech"::Symbol)$CommonOperators + opacsch := operator("acsch"::Symbol)$CommonOperators -- Pi is a domain... @@ -33661,10 +34243,12 @@ ElementaryFunction(R, F): Exports == Implementation where if R has TranscendentalFunctionCategory and R has arbitraryPrecision then + pi : () -> F pi() == pi()$R :: F else + pi : () -> F pi() == Pie if R has imaginary: () -> R then @@ -33687,82 +34271,119 @@ ElementaryFunction(R, F): Exports == Implementation where isqrt3 := sqrt(3::F) + iisqrt1 : () -> F iisqrt1() == isqrt1 if R has RadicalCategory and R has arbitraryPrecision then + iisqrt2 : () -> F iisqrt2() == sqrt(2::R)::F + iisqrt3 : () -> F iisqrt3() == sqrt(3::R)::F else + iisqrt2 : () -> F iisqrt2() == isqrt2 + iisqrt3 : () -> F iisqrt3() == isqrt3 + ipi : List F -> F ipi l == pi() + log : F -> F log x == oplog x + exp : F -> F exp x == opexp x + sin : F -> F sin x == opsin x + cos : F -> F cos x == opcos x + tan : F -> F tan x == optan x + cot : F -> F cot x == opcot x + sec : F -> F sec x == opsec x + csc : F -> F csc x == opcsc x + asin : F -> F asin x == opasin x + acos : F -> F acos x == opacos x + atan : F -> F atan x == opatan x + acot : F -> F acot x == opacot x + asec : F -> F asec x == opasec x + acsc : F -> F acsc x == opacsc x + sinh : F -> F sinh x == opsinh x + cosh : F -> F cosh x == opcosh x + tanh : F -> F tanh x == optanh x + coth : F -> F coth x == opcoth x + sech : F -> F sech x == opsech x + csch : F -> F csch x == opcsch x + asinh : F -> F asinh x == opasinh x + acosh : F -> F acosh x == opacosh x + atanh : F -> F atanh x == opatanh x + acoth : F -> F acoth x == opacoth x + asech : F -> F asech x == opasech x + acsch : F -> F acsch x == opacsch x + kernel : F -> K kernel x == retract(x)@K - posrem(n, m) == ((r := n rem m) < 0 => r + m; r) + posrem :(Z, Z) -> Z + posrem(n, m) == ((r := n rem m) < 0 => r + m; r) + valueOrPole : Record(func:F, pole:B) -> F valueOrPole rec == (rec.pole => INV; rec.func) - belong? op == has?(op, "elem") + belong? : BasicOperator -> Boolean + belong? op == has?(op, "elem") + operator : BasicOperator -> BasicOperator operator op == is?(op, "pi"::Symbol) => oppi is?(op, "log"::Symbol) => oplog @@ -33793,6 +34414,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(op, "acsch"::Symbol) => opacsch error "Not an elementary operator" + dropfun : F -> F dropfun x == ((k := retractIfCan(x)@Union(K, "failed")) case "failed") or empty?(argument(k::K)) => 0 @@ -33800,6 +34422,7 @@ ElementaryFunction(R, F): Exports == Implementation where if R has RetractableTo Z then + specialTrigs:(F,List(Record(func: F,pole: Boolean))) -> Union(F,"failed") specialTrigs(x, values) == (r := retractIfCan(y := x/pi())@Union(Fraction Z, "failed")) case "failed" => "failed" @@ -33830,8 +34453,10 @@ ElementaryFunction(R, F): Exports == Implementation where else + specialTrigs:(F,List(Record(func: F,pole: Boolean))) -> Union(F,"failed") specialTrigs(x, values) == "failed" + isin : F -> F isin x == zero? x => 0 y := dropfun x @@ -33851,6 +34476,7 @@ ElementaryFunction(R, F): Exports == Implementation where u case F => u :: F kernel(opsin, x) + icos : F -> F icos x == zero? x => 1 y := dropfun x @@ -33870,6 +34496,7 @@ ElementaryFunction(R, F): Exports == Implementation where u case F => u :: F kernel(opcos, x) + itan : F -> F itan x == zero? x => 0 y := dropfun x @@ -33887,6 +34514,7 @@ ElementaryFunction(R, F): Exports == Implementation where u case F => u :: F kernel(optan, x) + icot : F -> F icot x == zero? x => INV y := dropfun x @@ -33904,6 +34532,7 @@ ElementaryFunction(R, F): Exports == Implementation where u case F => u :: F kernel(opcot, x) + isec : F -> F isec x == zero? x => 1 y := dropfun x @@ -33923,6 +34552,7 @@ ElementaryFunction(R, F): Exports == Implementation where u case F => u :: F kernel(opsec, x) + icsc : F -> F icsc x == zero? x => INV y := dropfun x @@ -33942,6 +34572,7 @@ ElementaryFunction(R, F): Exports == Implementation where u case F => u :: F kernel(opcsc, x) + iasin : F -> F iasin x == zero? x => 0 (x = 1) => pi() / (2::F) @@ -33951,6 +34582,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opcos) => pi() / (2::F) - y kernel(opasin, x) + iacos : F -> F iacos x == zero? x => pi() / (2::F) (x = 1) => 0 @@ -33960,6 +34592,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opcos) => y kernel(opacos, x) + iatan : F -> F iatan x == zero? x => 0 (x = 1) => pi() / (4::F) @@ -33971,6 +34604,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opcot) => pi() / (2::F) - y kernel(opatan, x) + iacot : F -> F iacot x == zero? x => pi() / (2::F) (x = 1) => pi() / (4::F) @@ -33984,6 +34618,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opcot) => y kernel(opacot, x) + iasec : F -> F iasec x == zero? x => INV (x = 1) => 0 @@ -33993,6 +34628,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opcsc) => pi() / (2::F) - y kernel(opasec, x) + iacsc : F -> F iacsc x == zero? x => INV (x = 1) => pi() / (2::F) @@ -34002,6 +34638,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opcsc) => y kernel(opacsc, x) + isinh : F -> F isinh x == zero? x => 0 y := dropfun x @@ -34013,6 +34650,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opacsch) => inv y kernel(opsinh, x) + icosh : F -> F icosh x == zero? x => 1 y := dropfun x @@ -34024,6 +34662,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opacsch) => sqrt(y**2 + 1) / y kernel(opcosh, x) + itanh : F -> F itanh x == zero? x => 0 y := dropfun x @@ -34035,6 +34674,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opacsch) => inv sqrt(y**2 + 1) kernel(optanh, x) + icoth : F -> F icoth x == zero? x => INV y := dropfun x @@ -34046,6 +34686,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opacsch) => sqrt(y**2 + 1) kernel(opcoth, x) + isech : F -> F isech x == zero? x => 1 y := dropfun x @@ -34057,6 +34698,7 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opacsch) => y / sqrt(y**2 + 1) kernel(opsech, x) + icsch : F -> F icsch x == zero? x => INV y := dropfun x @@ -34068,30 +34710,37 @@ ElementaryFunction(R, F): Exports == Implementation where is?(x, opacsch) => y kernel(opcsch, x) + iasinh : F -> F iasinh x == is?(x, opsinh) => first argument kernel x kernel(opasinh, x) + iacosh : F -> F iacosh x == is?(x, opcosh) => first argument kernel x kernel(opacosh, x) + iatanh : F -> F iatanh x == is?(x, optanh) => first argument kernel x kernel(opatanh, x) + iacoth : F -> F iacoth x == is?(x, opcoth) => first argument kernel x kernel(opacoth, x) + iasech : F -> F iasech x == is?(x, opsech) => first argument kernel x kernel(opasech, x) + iacsch : F -> F iacsch x == is?(x, opcsch) => first argument kernel x kernel(opacsch, x) + iexp : F -> F iexp x == zero? x => 1 is?(x, oplog) => first argument kernel x @@ -34116,14 +34765,17 @@ ElementaryFunction(R, F): Exports == Implementation where if (R has imaginary:() -> R) and (R has conjugate: R -> R) then + localReal? : F -> Boolean localReal? x == (u := retractIfCan(x)@Union(R, "failed")) case R and (u::R) = conjugate(u::R) else + localReal? : F -> Boolean localReal? x == true + iiilog : F -> F iiilog x == zero? x => INV (x = 1) => 0 @@ -34134,6 +34786,7 @@ ElementaryFunction(R, F): Exports == Implementation where ilog x ilog x + ilog : F -> F ilog x == ((num1 := ((num := numer x) = 1)) or num = -1) and (den := denom x) ^= 1 and empty? variables x => - kernel(oplog, (num1 => den; -den)::F) @@ -34141,176 +34794,230 @@ ElementaryFunction(R, F): Exports == Implementation where if R has ElementaryFunctionCategory then + iilog : F -> F iilog x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iiilog x log(r::R)::F + iiexp : F -> F iiexp x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iexp x exp(r::R)::F else + iilog : F -> F iilog x == iiilog x + iiexp : F -> F iiexp x == iexp x if R has TrigonometricFunctionCategory then + + iisin : F -> F iisin x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isin x sin(r::R)::F + iicos : F -> F iicos x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icos x cos(r::R)::F + iitan : F -> F iitan x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => itan x tan(r::R)::F + iicot : F -> F iicot x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icot x cot(r::R)::F + iisec : F -> F iisec x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isec x sec(r::R)::F + iicsc : F -> F iicsc x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icsc x csc(r::R)::F else + iisin : F -> F iisin x == isin x + iicos : F -> F iicos x == icos x + iitan : F -> F iitan x == itan x + iicot : F -> F iicot x == icot x + iisec : F -> F iisec x == isec x + iicsc : F -> F iicsc x == icsc x if R has ArcTrigonometricFunctionCategory then + + iiasin : F -> F iiasin x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasin x asin(r::R)::F + iiacos : F -> F iiacos x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacos x acos(r::R)::F + iiatan : F -> F iiatan x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iatan x atan(r::R)::F + iiacot : F -> F iiacot x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacot x acot(r::R)::F + iiasec : F -> F iiasec x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasec x asec(r::R)::F + iiacsc : F -> F iiacsc x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacsc x acsc(r::R)::F else + iiasin : F -> F iiasin x == iasin x + iiacos : F -> F iiacos x == iacos x + iiatan : F -> F iiatan x == iatan x + iiacot : F -> F iiacot x == iacot x + iiasec : F -> F iiasec x == iasec x + iiacsc : F -> F iiacsc x == iacsc x if R has HyperbolicFunctionCategory then + iisinh : F -> F iisinh x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isinh x sinh(r::R)::F + iicosh : F -> F iicosh x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icosh x cosh(r::R)::F + iitanh : F -> F iitanh x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => itanh x tanh(r::R)::F + iicoth : F -> F iicoth x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icoth x coth(r::R)::F + iisech : F -> F iisech x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isech x sech(r::R)::F + iicsch : F -> F iicsch x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icsch x csch(r::R)::F else + iisinh : F -> F iisinh x == isinh x + iicosh : F -> F iicosh x == icosh x + iitanh : F -> F iitanh x == itanh x + iicoth : F -> F iicoth x == icoth x + iisech : F -> F iisech x == isech x + iicsch : F -> F iicsch x == icsch x if R has ArcHyperbolicFunctionCategory then + iiasinh : F -> F iiasinh x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasinh x asinh(r::R)::F + iiacosh : F -> F iiacosh x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacosh x acosh(r::R)::F + iiatanh : F -> F iiatanh x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iatanh x atanh(r::R)::F + iiacoth : F -> F iiacoth x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacoth x acoth(r::R)::F + iiasech : F -> F iiasech x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasech x asech(r::R)::F + iiacsch : F -> F iiacsch x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacsch x acsch(r::R)::F else + iiasinh : F -> F iiasinh x == iasinh x + iiacosh : F -> F iiacosh x == iacosh x + iiatanh : F -> F iiatanh x == iatanh x + iiacoth : F -> F iiacoth x == iacoth x + iiasech : F -> F iiasech x == iasech x + iiacsch : F -> F iiacsch x == iacsch x import BasicOperatorFunctions1(F) @@ -34704,21 +35411,16 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where import DefiniteIntegrationTools(R, F) import FunctionSpaceIntegration(R, F) - polyIfCan : (P, K) -> Union(UP, "failed") - int : (F, SE, OFE, OFE, B) -> U - nopole : (F, SE, K, OFE, OFE) -> U - checkFor0 : (P, K, OFE, OFE) -> Union(B, "failed") - checkSMP : (P, SE, K, OFE, OFE) -> Union(B, "failed") - checkForPole: (F, SE, K, OFE, OFE) -> Union(B, "failed") - posit : (F, SE, K, OFE, OFE) -> Union(B, "failed") - negat : (F, SE, K, OFE, OFE) -> Union(B, "failed") - moreThan : (OFE, Fraction Z) -> Union(B, "failed") if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) and F has SpecialFunctionCategory then import PatternMatchIntegration(R, F) + innerint : _ + (F,Symbol,OrderedCompletion(F),OrderedCompletion(F),Boolean) -> _ + Union(f1: OrderedCompletion(F),f2: List(OrderedCompletion(F)),_ + fail: failed,pole: potentialPole) innerint(f, x, a, b, ignor?) == ((u := int(f, x, a, b, ignor?)) case f1) or (u case f2) or ((v := pmintegrate(f, x, a, b)) case "failed") => u @@ -34726,14 +35428,25 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where else + innerint : _ + (F,Symbol,OrderedCompletion(F),OrderedCompletion(F),Boolean) -> _ + Union(f1: OrderedCompletion(F),f2: List(OrderedCompletion(F)),_ + fail: failed,pole: potentialPole) innerint(f, x, a, b, ignor?) == int(f, x, a, b, ignor?) + integrate : (F,SegmentBinding(OrderedCompletion(F))) -> _ + Union(f1: OrderedCompletion(F),f2: List(OrderedCompletion(F)),_ + fail: failed,pole: potentialPole) integrate(f:F, s:SegmentBinding OFE) == innerint(f, variable s, lo segment s, hi segment s, false) + integrate : (F,SegmentBinding(OrderedCompletion(F)),String) -> _ + Union(f1: OrderedCompletion(F),f2: List(OrderedCompletion(F)),_ + fail: failed,pole: potentialPole) integrate(f:F, s:SegmentBinding OFE, str:String) == innerint(f, variable s, lo segment s, hi segment s, ignore? str) + int : (F, SE, OFE, OFE, B) -> U int(f, x, a, b, ignor?) == a = b => [0::OFE] k := kernel(x)@Kernel(F) @@ -34743,12 +35456,14 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where z::B => error "integrate: pole in path of integration" nopole(f, x, k, a, b) + checkForPole : (F, SE, K, OFE, OFE) -> Union(B, "failed") checkForPole(f, x, k, a, b) == ((u := checkFor0(d := denom f, k, a, b)) case "failed") or (u::B) => u ((u := checkSMP(d, x, k, a, b)) case "failed") or (u::B) => u checkSMP(numer f, x, k, a, b) -- true if p has a zero between a and b exclusive + checkFor0 : (P, K, OFE, OFE) -> Union(B, "failed") checkFor0(p, x, a, b) == (u := polyIfCan(p, x)) case UP => checkForZero(u::UP, a, b, false) (v := isTimes p) case List(P) => @@ -34766,6 +35481,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where "failed" -- returns true if a > b, false if a < b, "failed" if can't decide + moreThan : (OFE, Fraction Z) -> Union(B, "failed") moreThan(a, b) == (r := retractIfCan(a)@Union(F, "failed")) case "failed" => -- infinite whatInfinity(a) > 0 @@ -34774,6 +35490,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where u::Fraction(Z) > b -- true if p has a pole between a and b + checkSMP : (P, SE, K, OFE, OFE) -> Union(B, "failed") checkSMP(p, x, k, a, b) == (u := polyIfCan(p, k)) case UP => false (v := isTimes p) case List(P) => @@ -34817,6 +35534,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where -- value for x in (a,b), false if it is certain that f takes no strictly -- positive value in (a,b), "failed" otherwise -- f must be known to have no poles in (a,b) + posit : (F, SE, K, OFE, OFE) -> Union(B, "failed") posit(f, x, k, a, b) == z := (r:= retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a) @@ -34835,6 +35553,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where -- value for x in (a,b), false if it is certain that f takes no strictly -- negative value in (a,b), "failed" otherwise -- f must be known to have no poles in (a,b) + negat : (F, SE, K, OFE, OFE) -> Union(B, "failed") negat(f, x, k, a, b) == z := (r:= retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a) @@ -34850,6 +35569,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where "failed" -- returns a UP if p is only a poly w.r.t. the kernel x + polyIfCan : (P, K) -> Union(UP, "failed") polyIfCan(p, x) == q := univariate(p, x) ans:UP := 0 @@ -34860,6 +35580,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where ans -- integrate f for x between a and b assuming that f has no pole in between + nopole : (F, SE, K, OFE, OFE) -> U nopole(f, x, k, a, b) == (u := integrate(f, x)) case F => (v := computeInt(k, u::F, a, b, false)) case "failed" => ["failed"] @@ -35206,35 +35927,20 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - upmp : (P, List K) -> P2 - downmp : (P2, List K, List P) -> P - xpart : (F, SY) -> F - smpxpart : (P, SY, List K, List P) -> P - multint : (F, List F, SY) -> F - ulodo : (L, K) -> LQ - firstOrder : (F, F, F, SY) -> REC - rfSolve : (L, F, K, SY) -> U - ratlogsol : (LQ, List RF, K, SY) -> List F - expsols : (LQ, K, SY) -> List F - homosolve : (L, LQ, List RF, K, SY) -> List F - homosolve1 : (L, List F, K, SY) -> List F - norf1 : (L, K, SY, N) -> List F - kovode : (LQ, K, SY) -> List F - doVarParams: (L, F, List F, SY) -> U - localmap : (F -> F, L) -> L - algSolve : (L, F, K, List K, SY) -> U - palgSolve : (L, F, K, K, SY) -> U - lastChance : (L, F, SY) -> U diff := D()$L + smpxpart : (P, SY, List K, List P) -> P smpxpart(p, x, l, lp) == downmp(primitivePart upmp(p, l), l, lp) + downmp : (P2, List K, List P) -> P downmp(p, l, lp) == ground eval(p, l, lp) + homosolve : (L, LQ, List RF, K, SY) -> List F homosolve(lf, op, sols, k, x) == homosolve1(lf, ratlogsol(op,sols,k,x),k,x) -- left hand side has algebraic (not necessarily pure) coefficients + algSolve : (L, F, K, List K, SY) -> U algSolve(op, g, k, l, x) == symbolIfCan(kx := ksec(k, l, x)) case SY => palgSolve(op, g, kx, k, x) has?(operator kx, ALGOP) => @@ -35251,11 +35957,13 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where [eval(f, kz, rec.primelt) for f in rc.basis]] lastChance(op, g, x) + doVarParams: (L, F, List F, SY) -> U doVarParams(eq, g, bas, x) == (u := particularSolution(eq, g, bas, (f1:F):F +-> int(f1, x))) case "failed" => lastChance(eq, g, x) [u::F, bas] + lastChance : (L, F, SY) -> U lastChance(op, g, x) == (degree op)=1 => firstOrder(coefficient(op,0), leadingCoefficient op,g,x) "failed" @@ -35263,16 +35971,19 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where -- solves a0 y + a1 y' = g -- does not check whether there is a solution in the field generated by -- a0, a1 and g + firstOrder : (F, F, F, SY) -> REC firstOrder(a0, a1, g, x) == h := xpart(expint(- a0 / a1, x), x) [h * int((g / h) / a1, x), [h]] -- xpart(f,x) removes any constant not involving x from f + xpart : (F, SY) -> F xpart(f, x) == l := reverse_! varselect(tower f, x) lp := [k::P for k in l] smpxpart(numer f, x, l, lp) / smpxpart(denom f, x, l, lp) + upmp : (P, List K) -> P2 upmp(p, l) == empty? l => p::P2 up := univariate(p, k := first l) @@ -35285,10 +35996,12 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where -- multint(a, [g1,...,gk], x) returns gk -- \int(g(k-1) \int(....g1 \int(a))...) + multint : (F, List F, SY) -> F multint(a, l, x) == for g in l repeat a := g * xpart(int(a, x), x) a + expsols : (LQ, K, SY) -> List F expsols(op, k, x) == (degree op) = 1 => firstOrder(multivariate(coefficient(op, 0), k), @@ -35296,6 +36009,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where [xpart(expint(multivariate(h, k), x), x) for h in ricDsolve(op, ffactor)] -- Finds solutions with rational logarithmic derivative + ratlogsol : (LQ, List RF, K, SY) -> List F ratlogsol(oper, sols, k, x) == bas := [xpart(multivariate(h, k), x) for h in sols] degree(oper) = #bas => bas -- all solutions are found already @@ -35305,6 +36019,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where concat_!([xpart(multivariate(h, k), x) for h in sols], [multint(e, int, x) for e in le]) + homosolve1 : (L, List F, K, SY) -> List F homosolve1(oper, sols, k, x) == zero?(n := (degree(oper) - #sols)::N) => sols -- all solutions found rec := ReduceOrder(oper, sols) @@ -35313,6 +36028,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where -- if the coefficients are rational functions, then the equation does not -- not have a proper 1st-order right factor over the rational functions + norf1 : (L, K, SY, N) -> List F norf1(op, k, x, n) == (n = 1) => firstOrder(coefficient(op, 0),leadingCoefficient op,0,x).basis -- for order > 2, we check that the coeffs are still rational functions @@ -35326,26 +36042,30 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where empty() empty() + kovode : (LQ, K, SY) -> List F kovode(op, k, x) == b := coefficient(op, 1) a := coefficient(op, 2) (u:= kovacic(coefficient(op, 0), b, a, ffactor)) case "failed" => empty() p := map(z1+->multivariate(z1, k), u::UPUP) ba := multivariate(- b / a, k) --- if p has degree 2 (case 2), then it must be squarefree since the --- ode is irreducible over the rational functions, so the 2 roots of p --- are distinct and must yield 2 independent solutions. + -- if p has degree 2 (case 2), then it must be squarefree since the + -- ode is irreducible over the rational functions, so the 2 roots of p + -- are distinct and must yield 2 independent solutions. degree(p) = 2 => [xpart(expint(ba/(2::F) + e, x), x) for e in zerosOf p] --- otherwise take 1 root of p and find the 2nd solution by reduction of order + -- otherwise take 1 root of p and find the 2nd solution + -- by reduction of order y1 := xpart(expint(ba / (2::F) + zeroOf p, x), x) [y1, y1 * xpart(int(expint(ba, x) / y1**2, x), x)] + solve: (L,F,Symbol) -> Union(Record(particular: F,basis: List(F)),"failed") solve(op:L, g:F, x:SY) == empty?(l := vark(coefficients op, x)) => constDsolve(op, g, x) symbolIfCan(k := kmax l) case SY => rfSolve(op, g, k, x) has?(operator k, ALGOP) => algSolve(op, g, k, l, x) lastChance(op, g, x) + ulodo : (L, K) -> LQ ulodo(eq, k) == op:LQ := 0 while eq ^= 0 repeat @@ -35354,6 +36074,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where op -- left hand side has rational coefficients + rfSolve : (L, F, K, SY) -> U rfSolve(eq, g, k, x) == op := ulodo(eq, k) empty? remove_!(k, varselect(kernels g, x)) => -- i.e. rhs is rational @@ -35363,6 +36084,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where [multivariate(rc.particular::RF, k), homosolve(eq, op, rc.basis, k, x)] doVarParams(eq, g, homosolve(eq, op, ratDsolve(op, 0).basis, k, x), x) + solve : (L,F,Symbol,F,List(F)) -> Union(F,"failed") solve(op, g, x, a, y0) == (u := solve(op, g, x)) case "failed" => "failed" hp := h := (u::REC).particular @@ -35379,6 +36101,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where hp := hp + s.i * f hp + localmap : (F -> F, L) -> L localmap(f, op) == ans:L := 0 while op ^= 0 repeat @@ -35387,6 +36110,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where ans -- left hand side has pure algebraic coefficients + palgSolve : (L, F, K, K, SY) -> U palgSolve(op, g, kx, k, x) == rec := palgLODE(op, g, kx, k, x) -- finds solutions in the coef. field rec.particular case "failed" => @@ -35727,27 +36451,26 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where import IntegrationTools(R, F) import NonLinearFirstOrderODESolver(R, F) - getfreelincoeff : (F, K, SY) -> F - getfreelincoeff1: (F, K, List F) -> F - getlincoeff : (F, K) -> F - getcoeff : (F, K) -> UU - parseODE : (F, OP, SY) -> Union(LEQ, NLQ) - parseLODE : (F, List K, UP, SY) -> LEQ - parseSYS : (List F, List OP, SY) -> Union(SYS, "failed") - parseSYSeq : (F, List K, List K, List F, SY) -> Union(ROW, "failed") - + solve : (Equation(F),BasicOperator,Symbol) -> _ + Union(Record(particular: F,basis: List(F)),F,"failed") solve(diffeq:EQ, y:OP, x:SY) == solve(lhs diffeq - rhs diffeq, y, x) + solve : (List(F),List(BasicOperator),Symbol) -> _ + Union(Record(particular: Vector(F),basis: List(Vector(F))),"failed") solve(leq: List EQ, lop: List OP, x:SY) == solve([lhs eq - rhs eq for eq in leq], lop, x) + solve: (Equation(F),BasicOperator,Equation(F),List(F)) -> Union(F,"failed") solve(diffeq:EQ, y:OP, center:EQ, y0:List F) == solve(lhs diffeq - rhs diffeq, y, center, y0) + solve : (Matrix(F),Symbol) -> Union(List(Vector(F)),"failed") solve(m:M, x:SY) == (u := solve(m, new(nrows m, 0), x)) case "failed" => "failed" u.basis + solve : (Matrix(F),Vector(F),Symbol) -> _ + Union(Record(particular: Vector(F),basis: List(Vector(F))),"failed") solve(m:M, v:V, x:SY) == Lx := LinearOrdinaryDifferentialOperator(F, diff x) uu := solve(m, v, (z1,z2) +-> solve(z1, z2, x)_ @@ -35756,6 +36479,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where rec := uu::Record(particular: V, basis: M) [rec.particular, [column(rec.basis, i) for i in 1..ncols(rec.basis)]] + solve : (F,BasicOperator,Equation(F),List(F)) -> Union(F,"failed") solve(diffeq:F, y:OP, center:EQ, y0:List F) == a := rhs center kx:K := kernel(x := retract(lhs(center))@SY) @@ -35773,12 +36497,16 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where p := reductum p solve(op, rec.right, x, a, y0)$ElementaryFunctionLODESolver(R, F, Lx) + solve : (List(Equation(F)),List(BasicOperator),Symbol) -> _ + Union(Record(particular: Vector(F),basis: List(Vector(F))),"failed") solve(leq: List F, lop: List OP, x:SY) == (u := parseSYS(leq, lop, x)) case SYS => rec := u::SYS solve(rec.mat, rec.vec, x) error "solve: not a first order linear system" + solve : (F,BasicOperator,Symbol) -> _ + Union(Record(particular: F,basis: List(F)),F,"failed") solve(diffeq:F, y:OP, x:SY) == (u := parseODE(diffeq, y, x)) case NLQ => rc := u::NLQ @@ -35796,6 +36524,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where uuu::REC -- returns [M, v] s.t. the equations are D x = M x + v + parseSYS : (List F, List OP, SY) -> Union(SYS, "failed") parseSYS(eqs, ly, x) == (n := #eqs) ^= #ly => "failed" m:M := new(n, n, 0) @@ -35811,6 +36540,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where v(rec.index) := rec.rh [m, v] + parseSYSeq : (F, List K, List K, List F, SY) -> Union(ROW, "failed") parseSYSeq(eq, l0, l1, lf, x) == l := [k for k in varselect(kernels eq, x) | is?(k, OPDIFF)] empty? l or not empty? rest l or zero?(n := position(k := first l,l1)) => @@ -35827,6 +36557,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where -- returns either [p, g] where the equation (diffeq) is of the -- form p(D)(y) = g -- or [p, q] such that the equation (diffeq) is of the form p dx + q dy = 0 + parseODE : (F, OP, SY) -> Union(LEQ, NLQ) parseODE(diffeq, y, x) == f := y(x::F) l:List(K) := [retract(f)@K] @@ -35853,6 +36584,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where [diffeq, c] -- returns [p, g] where the equation (diffeq) is of the form p(D)(y) = g + parseLODE : (F, List K, UP, SY) -> LEQ parseLODE(diffeq, l, p, y) == not freeOf?(leadingCoefficient p, y) => error "parseLODE: not a linear ordinary differential equation" @@ -35864,10 +36596,12 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where freeOf?(diffeq, y) => [p, - diffeq] error "parseLODE: not a linear ordinary differential equation" + getfreelincoeff : (F, K, SY) -> F getfreelincoeff(f, k, y) == freeOf?(c := getlincoeff(f, k), y) => c error "getfreelincoeff: not a linear ordinary differential equation" + getfreelincoeff1: (F, K, List F) -> F getfreelincoeff1(f, k, ly) == c := getlincoeff(f, k) for y in ly repeat @@ -35875,11 +36609,13 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where error "getfreelincoeff: not a linear ordinary differential equation" c + getlincoeff : (F, K) -> F getlincoeff(f, k) == (u := getcoeff(f, k)) case "failed" => error "getlincoeff: not an appropriate ordinary differential equation" u::F + getcoeff : (F, K) -> UU getcoeff(f, k) == (r := retractIfCan(univariate(denom f, k))@Union(P, "failed")) case "failed" or degree(p := univariate(numer f, k)) > 1 => "failed" @@ -36138,24 +36874,17 @@ ElementaryFunctionSign(R,F): Exports == Implementation where import PowerSeriesLimitPackage(R, F) import TrigonometricManipulations(R, F) - smpsign : P -> U - sqfrSign: P -> U - termSign: P -> U - kerSign : K -> U - listSign: (List P,Z) -> U - insign : (F,SY,OFE, N) -> U - psign : (F,SY,F,String, N) -> U - ofesign : OFE -> U - overRF : OFE -> Union(ORF, "failed") - + sign : (F,Symbol,OrderedCompletion(F)) -> Union(Integer,"failed") sign(f, x, a) == not real? f => "failed" insign(f, x, a, 0) + sign : (F,Symbol,F,String) -> Union(Integer,"failed") sign(f, x, a, st) == not real? f => "failed" psign(f, x, a, st, 0) + sign : F -> Union(Integer,"failed") sign f == not real? f => "failed" (u := retractIfCan(f)@Union(RF,"failed")) case RF => sign(u::RF) @@ -36181,6 +36910,7 @@ ElementaryFunctionSign(R,F): Exports == Implementation where "failed" "failed" + overRF : OFE -> Union(ORF, "failed") overRF a == (n := whatInfinity a) = 0 => (u := retractIfCan(retract(a)@F)@Union(RF,"failed")) _ @@ -36188,10 +36918,12 @@ ElementaryFunctionSign(R,F): Exports == Implementation where u::RF::ORF n * plusInfinity()$ORF + ofesign : OFE -> U ofesign a == (n := whatInfinity a) ^= 0 => convert(n)@Z sign(retract(a)@F) + insign : (F,SY,OFE, N) -> U insign(f, x, a, m) == m > 10 => "failed" -- avoid infinite loops for now (uf := retractIfCan(f)@Union(RF,"failed")) case RF and @@ -36212,6 +36944,7 @@ ElementaryFunctionSign(R,F): Exports == Implementation where (ul::Z) = (ur::Z) => ul "failed" + psign : (F,SY,F,String, N) -> U psign(f, x, a, st, m) == m > 10 => "failed" -- avoid infinite loops for now f = 0 => 0 @@ -36228,6 +36961,7 @@ ElementaryFunctionSign(R,F): Exports == Implementation where direction(st) * s::Z sign v + smpsign : P -> U smpsign p == (r := retractIfCan(p)@Union(R,"failed")) case R => sign(r::R) (u := sign(retract(unit(s := squareFree p))@R)) case "failed" => @@ -36238,16 +36972,19 @@ ElementaryFunctionSign(R,F): Exports == Implementation where ans := ans * u::Z ans + sqfrSign: P -> U sqfrSign p == (u := termSign first(l := monomials p)) case "failed" => "failed" listSign(rest l, u::Z) + listSign: (List P,Z) -> U listSign(l, s) == for term in l repeat (u := termSign term) case "failed" => return "failed" not(s = u::Z) => return "failed" s + termSign: P -> U termSign term == (us := sign leadingCoefficient term) case "failed" => "failed" for var in (lv := variables term) repeat @@ -36257,6 +36994,7 @@ ElementaryFunctionSign(R,F): Exports == Implementation where return "failed" us::Z + kerSign : K -> U kerSign k == has?(op := operator k, "NEGAT") => -1 has?(op, "POSIT") or is?(op, "pi"::SY) or is?(op,"exp"::SY) or @@ -36768,74 +37506,52 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where import AlgebraicManipulations(R, F) import InnerCommonDenominator(Z, Q, Vector Z, Vector Q) - k2Elem : (K, List SY) -> F - realElem : (F, List SY) -> F - smpElem : (SMP, List SY) -> F - deprel : (List K, K, SY) -> U - rootDep : (List K, K) -> U - qdeprel : (List F, F) -> U - factdeprel : (List K, K) -> U - toR : (List K, F) -> List K - toY : List K -> List F - toZ : List K -> List F - toU : List K -> List F - toV : List K -> List F - ktoY : K -> F - ktoZ : K -> F - ktoU : K -> F - ktoV : K -> F - gdCoef? : (Q, Vector Q) -> Boolean - goodCoef : (Vector Q, List K, SY) -> - Union(Record(index:Z, ker:K), "failed") - tanRN : (Q, K) -> F - localnorm : F -> F - rooteval : (F, List K, K, Q) -> REC - logeval : (F, List K, K, Vector Q) -> REC - expeval : (F, List K, K, Vector Q) -> REC - taneval : (F, List K, K, Vector Q) -> REC - ataneval : (F, List K, K, Vector Q) -> REC - depeval : (F, List K, K, Vector Q) -> REC - expnosimp : (F, List K, K, Vector Q, List F, F) -> REC - tannosimp : (F, List K, K, Vector Q, List F, F) -> REC - rtNormalize : F -> F - rootNormalize0 : F -> REC - rootKernelNormalize: (F, List K, K) -> Union(REC, "failed") - tanSum : (F, List F) -> F - - comb? := F has CombinatorialOpsCategory + comb? := F has CombinatorialOpsCategory mpiover2:F := pi()$F / (-2::F) - realElem(f, l) == smpElem(numer f, l) / smpElem(denom f, l) + realElem : (F, List SY) -> F + realElem(f, l) == smpElem(numer f, l) / smpElem(denom f, l) + realElementary : (F,Symbol) -> F realElementary(f, x) == realElem(f, [x]) - realElementary f == realElem(f, variables f) + realElementary : F -> F + realElementary f == realElem(f, variables f) - toY ker == [func for k in ker | (func := ktoY k) ^= 0] + toY : List K -> List F + toY ker == [func for k in ker | (func := ktoY k) ^= 0] - toZ ker == [func for k in ker | (func := ktoZ k) ^= 0] + toZ : List K -> List F + toZ ker == [func for k in ker | (func := ktoZ k) ^= 0] - toU ker == [func for k in ker | (func := ktoU k) ^= 0] + toU : List K -> List F + toU ker == [func for k in ker | (func := ktoU k) ^= 0] - toV ker == [func for k in ker | (func := ktoV k) ^= 0] + toV : List K -> List F + toV ker == [func for k in ker | (func := ktoV k) ^= 0] - rtNormalize f == rootNormalize0(f).func + rtNormalize : F -> F + rtNormalize f == rootNormalize0(f).func + toR : (List K, F) -> List K toR(ker, x) == select(s+->is?(s, NTHR) and first argument(s) = x, ker) if R has GcdDomain then + tanQ : (Fraction(Integer),F) -> F tanQ(c, x) == tanNa(rootSimp zeroOf tanAn(x, denom(c)::PositiveInteger), numer c) else + tanQ : (Fraction(Integer),F) -> F tanQ(c, x) == tanNa(zeroOf tanAn(x, denom(c)::PositiveInteger), numer c) -- tanSum(c, [a1,...,an]) returns f(c, a1,...,an) such that -- if ai = tan(ui) then f(c, a1,...,an) = tan(c + u1 + ... + un). -- MUST BE CAREFUL FOR WHEN c IS AN ODD MULTIPLE of pi/2 + tanSum : (F, List F) -> F tanSum(c, l) == k := c / mpiover2 -- k = - 2 c / pi, check for odd integer -- tan((2n+1) pi/2 x) = - 1 / tan x @@ -36843,6 +37559,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where - inv tanSum l tanSum concat(tan c, l) + rootNormalize0 : F -> REC rootNormalize0 f == ker := select_!(s+->is?(s, NTHR) and empty? variables first argument s, tower f)$List(K) @@ -36855,6 +37572,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where return [rn.func, concat(rec.kers,rn.kers), concat(rec.vals, rn.vals)] [f, empty(), empty()] + deprel : (List K, K, SY) -> U deprel(ker, k, x) == is?(k, "log"::SY) or is?(k, "exp"::SY) => qdeprel([differentiate(g, x) for g in toY ker], @@ -36867,30 +37585,36 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where factdeprel([x for x in ker | is?(x,"factorial"::SY) and x^=k],k) [true] + ktoY : K -> F ktoY k == is?(k, "log"::SY) => k::F is?(k, "exp"::SY) => first argument k 0 + ktoZ : K -> F ktoZ k == is?(k, "log"::SY) => first argument k is?(k, "exp"::SY) => k::F 0 + ktoU : K -> F ktoU k == is?(k, "atan"::SY) => k::F is?(k, "tan"::SY) => first argument k 0 + ktoV : K -> F ktoV k == is?(k, "tan"::SY) => k::F is?(k, "atan"::SY) => first argument k 0 + smpElem : (SMP, List SY) -> F smpElem(p, l) == map(x+->k2Elem(x, l), y+->y::F, p)_ $PolynomialCategoryLifting(IndexedExponents K, K, R, SMP, F) + k2Elem : (K, List SY) -> F k2Elem(k, l) == ez, iez, tz2: F kf := k::F @@ -36929,6 +37653,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where --The next 5 functions are used by normalize, once a relation is found + depeval : (F, List K, K, Vector Q) -> REC depeval(f, lk, k, v) == is?(k, "log"::SY) => logeval(f, lk, k, v) is?(k, "exp"::SY) => expeval(f, lk, k, v) @@ -36937,6 +37662,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where is?(k, NTHR) => rooteval(f, lk, k, v(minIndex v)) [f, empty(), empty()] + rooteval : (F, List K, K, Q) -> REC rooteval(f, lk, k, n) == nv := nthRoot(x := first argument k, m := retract(n)@Z) l := [r for r in concat(k, toR(lk, x)) | @@ -36944,6 +37670,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where lv := [nv ** (n / (retract(second argument r)@Z::Q)) for r in l] [eval(f, l, lv), l, lv] + ataneval : (F, List K, K, Vector Q) -> REC ataneval(f, lk, k, v) == w := first argument k s := tanSum [tanQ(qelt(v,i), x) @@ -36955,12 +37682,14 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where g := g + h [eval(f, [k], [g]), [k], [g]] + gdCoef? : (Q, Vector Q) -> Boolean gdCoef?(c, v) == for i in minIndex v .. maxIndex v repeat retractIfCan(qelt(v, i) / c)@Union(Z, "failed") case "failed" => return false true + goodCoef: (Vector Q, List K, SY) -> Union(Record(index:Z, ker:K), "failed") goodCoef(v, l, s) == for i in minIndex v .. maxIndex v for k in l repeat is?(k, s) and @@ -36969,6 +37698,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where and gdCoef?(qelt(v, i), v) => return([i, k]) "failed" + taneval : (F, List K, K, Vector Q) -> REC taneval(f, lk, k, v) == u := first argument k fns := toU lk @@ -36983,6 +37713,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where [tanNa(x, - retract(a * v0)@Z) for a in lv for x in toV l])) [eval(f, [rec.ker], [g]), [rec.ker], [g]] + tannosimp : (F, List K, K, Vector Q, List F, F) -> REC tannosimp(f, lk, k, v, fns, c) == every?(x+->is?(x, "tan"::SY), lk) => dd := (d := (cd := splitDenominator v).den)::F @@ -36997,6 +37728,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where for i in minIndex v .. maxIndex v for x in toV lk]) [eval(f, [k], [h]), [k], [h]] + expnosimp : (F, List K, K, Vector Q, List F, F) -> REC expnosimp(f, lk, k, v, fns, g) == every?(x+->is?(x, "exp"::SY), lk) => dd := (d := (cd := splitDenominator v).den)::F @@ -37011,9 +37743,10 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where for i in minIndex v .. maxIndex v for y in fns] * g [eval(f, [k], [h]), [k], [h]] + logeval : (F, List K, K, Vector Q) -> REC logeval(f, lk, k, v) == z := first argument k - c := z / (*/[x**qelt(v, i) + c := z / ( */[x**qelt(v, i) for x in toZ lk for i in minIndex v .. maxIndex v]) -- CHANGED log ktoZ x TO ktoY x -- SINCE WE WANT log exp f TO BE REPLACED BY f. @@ -37021,6 +37754,8 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where for i in minIndex v .. maxIndex v for x in toY lk] + log c [eval(f, [k], [g]), [k], [g]] + rischNormalize : (F,Symbol) -> _ + Record(func: F,kers: List(Kernel(F)),vals: List(F)) rischNormalize(f, v) == empty?(ker := varselect(tower f, v)) => [f, empty(), empty()] first(ker) ^= kernel(v)@K => error "Cannot happen" @@ -37039,21 +37774,25 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where return [rn.func, concat(kk, rn.kers), concat(c.func, rn.vals)] [f, empty(), empty()] + rootNormalize : (F,Kernel(F)) -> F rootNormalize(f, k) == (u := rootKernelNormalize(f, toR(tower f, first argument k), k)) case "failed" => f (u::REC).func + rootKernelNormalize: (F, List K, K) -> Union(REC, "failed") rootKernelNormalize(f, l, k) == (c := rootDep(l, k)) case vec => rooteval(f, l, k, (c.vec)(minIndex(c.vec))) "failed" + localnorm : F -> F localnorm f == for x in variables f repeat f := rischNormalize(f, x).func f + validExponential : (List(Kernel(F)),F,Symbol) -> Union(F,"failed") validExponential(twr, eta, x) == (c := solveLinearlyOverQ(construct([differentiate(g, x) for g in (fns := toY twr)]$List(F))@Vector(F), @@ -37064,16 +37803,19 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where */[exp(yy) ** qelt(v, i) for i in minIndex v .. maxIndex v for yy in fns] * exp g + rootDep : (List K, K) -> U rootDep(ker, k) == empty?(ker := toR(ker, first argument k)) => [true] [new(1,lcm(retract(second argument k)@Z, "lcm"/[retract(second argument r)@Z for r in ker])::Q)$Vector(Q)] + qdeprel : (List F, F) -> U qdeprel(l, v) == (u := solveLinearlyOverQ(construct(l)@Vector(F), v)) case Vector(Q) => [u::Vector(Q)] [true] + expeval : (F, List K, K, Vector Q) -> REC expeval(f, lk, k, v) == y := first argument k fns := toY lk @@ -37090,11 +37832,14 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where if F has CombinatorialOpsCategory then + normalize : F -> F normalize f == rtNormalize localnorm factorials realElementary f + normalize : (F,Symbol) -> F normalize(f, x) == rtNormalize(rischNormalize(factorials(realElementary(f,x),x),x).func) + factdeprel : (List K, K) -> U factdeprel(l, k) == ((r := retractIfCan(n := first argument k)@Union(Z, "failed")) case Z) and (r::Z > 0) => [factorial(r::Z)::F] @@ -37106,8 +37851,10 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where else - normalize f == rtNormalize localnorm realElementary f + normalize : F -> F + normalize f == rtNormalize localnorm realElementary f + normalize : (F,Symbol) -> F normalize(f, x)== rtNormalize(rischNormalize(realElementary(f,x),x).func) *) @@ -37606,31 +38353,10 @@ See the above discussion for why this causes an infinite loop. import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - alglfint : (F, K, List K, SE) -> IR - alglfextint : (F, K, List K, SE, F) -> U2 - alglflimint : (F, K, List K, SE, List F) -> U3 - primextint : (F, SE, K, F) -> U2 - expextint : (F, SE, K, F) -> U2 - primlimint : (F, SE, K, List F) -> U3 - explimint : (F, SE, K, List F) -> U3 - algprimint : (F, K, K, SE) -> IR - algexpint : (F, K, K, SE) -> IR - primint : (F, SE, K) -> IR - expint : (F, SE, K) -> IR - tanint : (F, SE, K) -> IR - prim? : (K, SE) -> Boolean - isx? : (F, SE) -> Boolean - addx : (IR, F) -> IR - cfind : (F, LLG) -> F - lfintegrate0: (F, SE) -> IR - unknownint : (F, SE) -> IR - unkextint : (F, SE, F) -> U2 - unklimint : (F, SE, List F) -> U3 - tryChangeVar: (F, K, SE) -> Union(IR, "failed") - droponex : (F, F, K, F) -> Union(F, "failed") - - prim?(k, x) == is?(k, "log"::SE) or has?(operator k, "prim") + prim? : (K, SE) -> Boolean + prim?(k, x) == is?(k, "log"::SE) or has?(operator k, "prim") + tanint : (F, SE, K) -> IR tanint(f, x, k) == eta' := differentiate(eta := first argument k, x) r1 := @@ -37646,6 +38372,7 @@ See the above discussion for why this causes an infinite loop. -- tries various tricks since the integrand contains -- something not elementary + unknownint : (F, SE) -> IR unknownint(f, x) == ((r := retractIfCan(f)@Union(K, "failed")) case K) and is?(k := r::K, OPDIFF) and @@ -37657,6 +38384,7 @@ See the above discussion for why this causes an infinite loop. zero? differentiate(c := numer(f)::F / da, x) => (c * log a)::IR mkAnswer(0, empty(), [[f, x::F]]) + droponex : (F, F, K, F) -> Union(F, "failed") droponex(f, a, ka, x) == (r := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed" is?(op := operator(k := r::K), OPDIFF) => @@ -37665,21 +38393,25 @@ See the above discussion for why this causes an infinite loop. op [u::F, second arg, z] eval(f, [ka], [x]) + unklimint : (F, SE, List F) -> U3 unklimint(f, x, lu) == for u in lu | u ^= 0 repeat zero? differentiate(c := f * u / differentiate(u, x), x) => [0,[[c,u]]] "failed" + unkextint : (F, SE, F) -> U2 unkextint(f, x, g) == zero?(g' := differentiate(g, x)) => "failed" zero? differentiate(c := f / g', x) => [0, c] "failed" + isx? : (F, SE) -> Boolean isx?(f, x) == (k := retractIfCan(f)@Union(K, "failed")) case "failed" => false (r := symbolIfCan(k::K)) case "failed" => false r::SE = x + alglfint : (F, K, List K, SE) -> IR alglfint(f, k, l, x) == xf := x::F symbolIfCan(kx := ksec(k,l,x)) case SE => addx(palgint(f, kx, k), xf) @@ -37692,6 +38424,7 @@ See the above discussion for why this causes an infinite loop. lfintegrate(eval(f, [kx,k], [(rec.pol1) y, (rec.pol2) y]), x)) unknownint(f, x) + alglfextint : (F, K, List K, SE, F) -> U2 alglfextint(f, k, l, x, g) == symbolIfCan(kx := ksec(k,l,x)) case SE => palgextint(f, kx, k, g) has?(operator kx, ALGOP) => @@ -37706,6 +38439,7 @@ See the above discussion for why this causes an infinite loop. is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL unkextint(f, x, g) + alglflimint : (F, K, List K, SE, List F) -> U3 alglflimint(f, k, l, x, lu) == symbolIfCan(kx := ksec(k,l,x)) case SE => palglimint(f, kx, k, lu) has?(operator kx, ALGOP) => @@ -37727,12 +38461,15 @@ See the above discussion for why this causes an infinite loop. import PatternMatchIntegration(R, F) + lfintegrate : (F,Symbol) -> IntegrationResult(F) lfintegrate(f, x) == intPatternMatch(f, x, lfintegrate0, pmintegrate) else + lfintegrate : (F,Symbol) -> IntegrationResult(F) lfintegrate(f, x) == lfintegrate0(f, x) + lfintegrate0: (F, SE) -> IR lfintegrate0(f, x) == zero? f => 0 xf := x::F @@ -37745,11 +38482,13 @@ See the above discussion for why this causes an infinite loop. has?(operator k, ALGOP) => alglfint(f, k, l, x) unknownint(f, x) + addx : (IR, F) -> IR addx(i, x) == elem? i => i mkAnswer(ratpart i, logpart i, [[ne.integrand, x] for ne in notelem i]) + tryChangeVar: (F, K, SE) -> Union(IR, "failed") tryChangeVar(f, t, x) == z := new()$Symbol g := subst(f / differentiate(t::F, x), [t], [z::F]) @@ -37757,6 +38496,7 @@ See the above discussion for why this causes an infinite loop. map((x1:F):F+->eval(x1, kernel z, t::F), lfintegrate(g, z)) "failed" + algexpint : (F, K, K, SE) -> IR algexpint(f, t, y, x) == (u := tryChangeVar(f, t, x)) case IR => u::IR algint(f, t, y, @@ -37764,6 +38504,7 @@ See the above discussion for why this causes an infinite loop. (x2:F):F +-> differentiate(x2, x), monomial(differentiate(first argument t, x), 1))) + algprimint : (F, K, K, SE) -> IR algprimint(f, t, y, x) == (u := tryChangeVar(f, t, x)) case IR => u::IR algint(f, t, y, @@ -37771,7 +38512,7 @@ See the above discussion for why this causes an infinite loop. (x2:F):F +-> differentiate(x2, x), differentiate(t::F, x)::UP)) - + lfextendedint : (F,Symbol,F) -> Union(Record(ratpart: F,coeff: F),"failed") lfextendedint(f, x, g) == empty?(l := varselect(kernels f, x)) => [x::F * f, 0] symbolIfCan(k := kmax(l)) @@ -37788,6 +38529,9 @@ See the above discussion for why this causes an infinite loop. has?(operator k, ALGOP) => alglfextint(f, k, l, x, g) unkextint(f, x, g) + lflimitedint : (F,Symbol,List(F)) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed") lflimitedint(f, x, lu) == empty?(l := varselect(kernels f, x)) => [x::F * f, empty()] symbolIfCan(k := kmax(l)) case SE => @@ -37799,10 +38543,12 @@ See the above discussion for why this causes an infinite loop. has?(operator k, ALGOP) => alglflimint(f, k, l, x, lu) unklimint(f, x, lu) + lfinfieldint : (F,Symbol) -> Union(F,"failed") lfinfieldint(f, x) == (u := lfextendedint(f, x, 0)) case "failed" => "failed" u.ratpart + primextint : (F, SE, K, F) -> U2 primextint(f, x, k, g) == lk := varselect([a for a in tower f | k ^= a and is?(a, "log"::SE)], x) (u1 := primextendedint(univariate(f, k), @@ -37815,6 +38561,7 @@ See the above discussion for why this causes an infinite loop. (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed" [multivariate(u1.answer, k) + u2.ratpart, u2.coeff] + expextint : (F, SE, K, F) -> U2 expextint(f, x, k, g) == (u1 := expextendedint(univariate(f, k), (x1:UP):UP +-> differentiate(x1, @@ -37829,6 +38576,7 @@ See the above discussion for why this causes an infinite loop. (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed" [multivariate(u1.answer, k) + u2.ratpart, u2.coeff] + primint : (F, SE, K) -> IR primint(f, x, k) == lk := varselect([a for a in tower f | k ^= a and is?(a, "log"::SE)], x) r1 := primintegrate(univariate(f, k), @@ -37837,6 +38585,8 @@ See the above discussion for why this causes an infinite loop. (x3:F):U2 +-> lfextlimint(x3, x, k, lk)) map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x) + lfextlimint : (F,Symbol,Kernel(F),List(Kernel(F))) -> _ + Union(Record(ratpart: F,coeff: F),"failed") lfextlimint(f, x, k, lk) == not((u1 := lfextendedint(f, x, differentiate(k::F, x))) case "failed") => u1 @@ -37851,11 +38601,13 @@ See the above discussion for why this causes an infinite loop. +/[c.coeff * log(c.logand) for c in u2.limitedlogs], cf] "failed" + cfind : (F, LLG) -> F cfind(f, l) == for u in l repeat f = u.logand => return u.coeff 0 + expint : (F, SE, K) -> IR expint(f, x, k) == eta := first argument k r1 := @@ -37868,6 +38620,7 @@ See the above discussion for why this causes an infinite loop. (x7:F,x8:F):U2+->lfextendedint(x7, x, x8))) map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x) + primlimint : (F, SE, K, List F) -> U3 primlimint(f, x, k, lu) == lk := varselect([a for a in tower f | k ^= a and is?(a, "log"::SE)], x) (u1 := @@ -37883,6 +38636,7 @@ See the above discussion for why this causes an infinite loop. [multivariate(u1.answer.mainpart, k) + u2.mainpart, concat(u2.limitedlogs, l)] + explimint : (F, SE, K, List F) -> U3 explimint(f, x, k, lu) == eta := first argument k (u1 := @@ -38342,34 +39096,16 @@ ElementaryRischDE(R, F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - RF2GP: RF -> GP - makeData : (F, SE, K) -> Data - normal0 : (Z, F, F, SE) -> UF - normalise0: (Z, F, F, SE) -> PSOL - normalise : (Z, F, F, F, SE, K, (F, LF) -> U, (F, F) -> UEX) -> PSOL - rischDEalg: (Z, F, F, F, K, LK, SE, (F, LF) -> U, (F, F) -> UEX) -> PSOL - rischDElog: (LK, RF, RF, SE, K, UP->UP,(F,LF)->U,(F,F)->UEX) -> URF - rischDEexp: (LK, RF, RF, SE, K, UP->UP,(F,LF)->U,(F,F)->UEX) -> URF - polyDElog : (LK, UP, UP,UP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UUP - polyDEexp : (LK, UP, UP,UP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UUP - gpolDEexp : (LK, UP, GP,GP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UGP - boundAt0 : (LK, F, Z, Z, SE, K, (F, LF) -> U) -> Z - boundInf : (LK, F, Z, Z, Z, SE, K, (F, LF) -> U) -> Z - logdegrad : (LK, F, UP, Z, SE, K,(F,LF)->U, (F,F) -> UEX) -> UUP - expdegrad : (LK, F, UP, Z, SE, K,(F,LF)->U, (F,F) -> UEX) -> UUP - logdeg : (UP, F, Z, SE, F, (F, LF) -> U, (F, F) -> UEX) -> UUP - expdeg : (UP, F, Z, SE, F, (F, LF) -> U, (F, F) -> UEX) -> UUP - exppolyint: (UP, (Z, F) -> PSOL) -> UUP - RRF2F : RRF -> F - logdiff : (List K, List K) -> List K - tab:AssociationList(F, Data) := table() + RF2GP: RF -> GP RF2GP f == (numer(f)::GP exquo denom(f)::GP)::GP + logdiff : (List K, List K) -> List K logdiff(twr, bad) == [u for u in twr | is?(u, "log"::SE) and not member?(u, bad)] + rischDEalg: (Z, F, F, F, K, LK, SE, (F, LF) -> U, (F, F) -> UEX) -> PSOL rischDEalg(n, nfp, f, g, k, l, x, limint, extint) == symbolIfCan(kx := ksec(k, l, x)) case SE => (u := palgRDE(nfp, f, g, kx, k, @@ -38387,6 +39123,11 @@ ElementaryRischDE(R, F): Exports == Implementation where FAIL -- solve y' + n f'y = g for a rational function y + rischDE : (Integer,F,F,Symbol,((F,List(F)) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed")),_ + ((F,F) -> Union(Record(ratpart: F,coeff: F),"failed"))) -> _ + Record(ans: F,right: F,sol?: Boolean) rischDE(n, f, g, x, limitedint, extendedint) == zero? g => [0, g, true] zero?(nfp := n * differentiate(f, x)) => @@ -38401,6 +39142,7 @@ ElementaryRischDE(R, F): Exports == Implementation where rischDEalg(n, nfp, f, g, k, vl, x, limitedint, extendedint) FAIL + normal0 : (Z, F, F, SE) -> UF normal0(n, f, g, x) == rec := normalise0(n, f, g, x) rec.sol? => rec.ans @@ -38408,6 +39150,7 @@ ElementaryRischDE(R, F): Exports == Implementation where -- solve y' + n f' y = g -- when f' and g are rational functions over a constant field + normalise0: (Z, F, F, SE) -> PSOL normalise0(n, f, g, x) == k := kernel(x)@K if (data1 := search(f, tab)) case "failed" then @@ -38424,6 +39167,7 @@ ElementaryRischDE(R, F): Exports == Implementation where [y, g, true] -- make f weakly normalized, and solve y' + n f' y = g + normalise : (Z, F, F, F, SE, K, (F, LF) -> U, (F, F) -> UEX) -> PSOL normalise(n, nfp, f, g, x, k, limitedint, extendedint) == if (data1:= search(f, tab)) case "failed" then tab.f := data := makeData(f, x, k) @@ -38451,6 +39195,7 @@ ElementaryRischDE(R, F): Exports == Implementation where [multivariate(ans1::RF, k) / p::F, g, true] -- find the n * log(P) appearing in f, where P is in P, n in Z + makeData : (F, SE, K) -> Data makeData(f, x, k) == disasters := empty()$Data fnum := numer f @@ -38467,18 +39212,21 @@ ElementaryRischDE(R, F): Exports == Implementation where disasters := concat([-(n::Z), denom logand], disasters) disasters + rischDElog: (LK, RF, RF, SE, K, UP->UP,(F,LF)->U,(F,F)->UEX) -> URF rischDElog(twr, f, g, x, theta, driv, limint, extint) == (u := monomRDE(f, g, driv)) case "failed" => "failed" (v := polyDElog(twr, u.a, retract(u.b), retract(u.c), x, theta, driv, limint, extint)) case "failed" => "failed" v::UP / u.t + rischDEexp: (LK, RF, RF, SE, K, UP->UP,(F,LF)->U,(F,F)->UEX) -> URF rischDEexp(twr, f, g, x, theta, driv, limint, extint) == (u := monomRDE(f, g, driv)) case "failed" => "failed" (v := gpolDEexp(twr, u.a, RF2GP(u.b), RF2GP(u.c), x, theta, driv, limint, extint)) case "failed" => "failed" convert(v::GP)@RF / u.t::RF + polyDElog : (LK, UP, UP,UP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UUP polyDElog(twr, aa, bb, cc, x, t, driv, limint, extint) == zero? cc => 0 t' := differentiate(t::F, x) @@ -38522,6 +39270,7 @@ ElementaryRischDE(R, F): Exports == Implementation where case "failed" => "failed" w.alpha * u::UP + w.beta + gpolDEexp : (LK, UP, GP,GP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UGP gpolDEexp(twr, a, b, c, x, t, driv, limint, extint) == zero? c => 0 zero? b => @@ -38537,6 +39286,7 @@ ElementaryRischDE(R, F): Exports == Implementation where x, t, driv, limint, extint)) case "failed" => "failed" v::UP::GP * monomial(1, lb) + polyDEexp : (LK, UP, UP,UP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UUP polyDEexp(twr, aa, bb, cc, x, t, driv, limint, extint) == zero? cc => 0 zero? bb => @@ -38559,10 +39309,12 @@ ElementaryRischDE(R, F): Exports == Implementation where case "failed" => "failed" w.alpha * u::UP + w.beta + exppolyint: (UP, (Z, F) -> PSOL) -> UUP exppolyint(p, rischdiffeq) == (u := expintfldpoly(p::GP, rischdiffeq)) case "failed" => "failed" retractIfCan(u::GP)@Union(UP, "failed") + boundInf : (LK, F, Z, Z, Z, SE, K, (F, LF) -> U) -> Z boundInf(twr, f0, da, db, dc, x, t, limitedint) == da < db => dc - db da > db => max(0, dc - da) @@ -38577,6 +39329,7 @@ ElementaryRischDE(R, F): Exports == Implementation where dc - db dc - db + boundAt0 : (LK, F, Z, Z, SE, K, (F, LF) -> U) -> Z boundAt0(twr, f0, nb, nc, x, t, limitedint) == nb ^= 0 => min(0, nc - min(0, nb)) l1 := logdiff(twr, l0 := tower f0) @@ -38592,6 +39345,7 @@ ElementaryRischDE(R, F): Exports == Implementation where -- case a = 1, deg(B) = 0, B <> 0 -- cancellation at infinity is possible + logdegrad : (LK, F, UP, Z, SE, K,(F,LF)->U, (F,F) -> UEX) -> UUP logdegrad(twr, b, c, n, x, t, limitedint, extint) == t' := differentiate(t::F, x) lk1 := logdiff(twr, lk0 := tower(f0 := - b)) @@ -38608,6 +39362,7 @@ ElementaryRischDE(R, F): Exports == Implementation where -- case a = 1, degree(b) = 0, and (exp integrate b) is not in F -- this implies no cancellation at infinity + logdeg : (UP, F, Z, SE, F, (F, LF) -> U, (F, F) -> UEX) -> UUP logdeg(c, f, n, x, t', limitedint, extint) == answr:UP := 0 repeat @@ -38622,6 +39377,7 @@ ElementaryRischDE(R, F): Exports == Implementation where -- case a = 1, deg(B) = 0, B <> 0 -- cancellation at infinity is possible + expdegrad : (LK, F, UP, Z, SE, K,(F,LF)->U, (F,F) -> UEX) -> UUP expdegrad(twr, b, c, n, x, t, limint, extint) == lk1 := logdiff(twr, lk0 := tower(f0 := - b)) (if0 := limint(f0, [first argument u for u in lk1])) @@ -38643,6 +39399,7 @@ ElementaryRischDE(R, F): Exports == Implementation where -- case a = 1, degree(b) = 0, and (exp integrate b) is not a monomial -- this implies no cancellation at infinity + expdeg : (UP, F, Z, SE, F, (F, LF) -> U, (F, F) -> UEX) -> UUP expdeg(c, f, n, x, eta, limitedint, extint) == answr:UP := 0 repeat @@ -38655,6 +39412,7 @@ ElementaryRischDE(R, F): Exports == Implementation where c := reductum c answr := answr + monomial(u.ans, m) + RRF2F : RRF -> F RRF2F rrf == rrf.mainpart + +/[v.coeff*log(v.logand) for v in rrf.limitedlogs] @@ -38788,9 +39546,8 @@ ElementaryRischDESystem(R, F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - basecase : (F, F, F, K) -> ULF - -- solve (y1',y2') + ((0, -nfp), (nfp, 0)) (y1,y2) = (g1, g2), base case + basecase : (F, F, F, K) -> ULF basecase(nfp, g1, g2, k) == (ans := baseRDEsys(univariate(nfp, k), univariate(g1, k), univariate(g2, k))) case "failed" => "failed" @@ -38798,6 +39555,11 @@ ElementaryRischDESystem(R, F): Exports == Implementation where [multivariate(first l, k), multivariate(second l, k)] -- solve (y1',y2') + ((0, -n f'), (n f', 0)) (y1,y2) = (g1, g2) + rischDEsys : (Integer,F,F,F,Symbol,((F,List(F)) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed")),_ + ((F,F) -> Union(Record(ratpart: F,coeff: F),"failed"))) -> _ + Union(List(F),"failed") rischDEsys(n, f, g1, g2, x, limint, extint) == zero? g1 and zero? g2 => [0, 0] zero?(nfp := n * differentiate(f, x)) => @@ -38936,22 +39698,26 @@ EllipticFunctionsUnivariateTaylorSeries(Coef,UTS): import StreamTaylorSeriesOperations Coef UPS==> StreamTaylorSeriesOperations Coef integrate ==> lazyIntegrate - sncndnre:(Coef,L ST,ST,Coef) -> L ST + sncndnre:(Coef,L ST,ST,Coef) -> L ST sncndnre(k,scd,dx,sign) == [integrate(0, scd.2*$UPS scd.3*$UPS dx), _ integrate(1, sign*scd.1*$UPS scd.3*$UPS dx), _ integrate(1,sign*k**2*$UPS scd.1*$UPS scd.2*$UPS dx)] + sncndn : (Stream(Coef),Coef) -> List(Stream(Coef)) sncndn(z,k) == empty? z => [0 :: ST,1 :: ST,1::ST] frst z = 0 => YS(x +-> sncndnre(k,x,deriv z,-1),3) error "ELFUTS:sncndn: constant coefficient should be 0" + sn : (UTS,Coef) -> UTS sn(x,k) == series sncndn.(coefficients x,k).1 + cn : (UTS,Coef) -> UTS cn(x,k) == series sncndn.(coefficients x,k).2 + dn : (UTS,Coef) -> UTS dn(x,k) == series sncndn.(coefficients x,k).3 *) @@ -39026,6 +39792,7 @@ EquationFunctions2(S: Type, R: Type): with (* package EQ2 *) (* + map : ((S -> R),Equation(S)) -> Equation(R) map(fn, eqn) == equation(fn lhs eqn, fn rhs eqn) *) @@ -39218,17 +39985,21 @@ ErrorFunctions() : Exports == Implementation where -- knowing we will never get to this step anyway. "exit" pretend Exit + error : String -> Exit error(s : String) : Exit == doit concat [prefix1,s] + error : List(String) -> Exit error(l : List String) : Exit == s : String := prefix1 for x in l repeat s := concat [s," ",x] doit s + error : (String,String) -> Exit error(fn : String,s : String) : Exit == doit concat [prefix2,fn,": %l ",s] + error : (String,List(String)) -> Exit error(fn : String, l : List String) : Exit == s : String := concat [prefix2,fn,": %l"] for x in l repeat s := concat [s," ",x] @@ -40964,38 +41735,19 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where ------ lcmcij is now lcm of of lc poli and lc polj critPair ==>Record(lcmfij: Expon, lcmcij: Dom, poli:Dpol, polj: Dpol ) + Prinp ==> Record( ci:Dpol,tci:Integer,cj:Dpol,tcj:Integer,c:Dpol, tc:Integer,rc:Dpol,trc:Integer,tH:Integer,tD:Integer) ------ Definition of intermediate functions - strongGbasis: (List(Dpol), Integer, Integer) -> List(Dpol) - eminGbasis: List(Dpol) -> List(Dpol) - ecritT: (critPair ) -> Boolean - ecritM: (Expon, Dom, Expon, Dom) -> Boolean - ecritB: (Expon, Dom, Expon, Dom, Expon, Dom) -> Boolean - ecrithinH: (Dpol, List(Dpol)) -> Boolean - ecritBonD: (Dpol, List(critPair)) -> List(critPair) - ecritMTondd1:(List(critPair)) -> List(critPair) - ecritMondd1:(Expon, Dom, List(critPair)) -> List(critPair) - crithdelH: (Dpol, List(Dpol)) -> List(Dpol) - eupdatF: (Dpol, List(Dpol) ) -> List(Dpol) - updatH: (Dpol, List(Dpol), List(Dpol), List(Dpol) ) -> List(Dpol) - sortin: (Dpol, List(Dpol) ) -> List(Dpol) - eRed: (Dpol, List(Dpol), List(Dpol) ) -> Dpol - ecredPol: (Dpol, List(Dpol) ) -> Dpol - esPol: (critPair) -> Dpol - updatD: (List(critPair), List(critPair)) -> List(critPair) - lepol: Dpol -> Integer - prinshINFO : Dpol -> Void - prindINFO: (critPair, Dpol, Dpol,Integer,Integer,Integer) -> Integer - prinpolINFO: List(Dpol) -> Void - prinb: Integer -> Void ------ MAIN ALGORITHM GROEBNER ------------------------ + euclideanGroebner : List(Dpol) -> List(Dpol) euclideanGroebner( Pol: List(Dpol) ) == eminGbasis(strongGbasis(Pol,0,0)) + euclideanGroebner : (List(Dpol),String) -> List(Dpol) euclideanGroebner( Pol: List(Dpol), xx1: String) == xx1 = "redcrit" => eminGbasis(strongGbasis(Pol,1,0)) @@ -41008,6 +41760,7 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where print(" "::Ex) [] + euclideanGroebner : (List(Dpol),String,String) -> List(Dpol) euclideanGroebner( Pol: List(Dpol), xx1: String, xx2: String) == (xx1 = "redcrit" and xx2 = "info") or (xx1 = "info" and xx2 = "redcrit") => @@ -41025,11 +41778,10 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where ------ calculate basis + strongGbasis: (List(Dpol), Integer, Integer) -> List(Dpol) strongGbasis(Pol: List(Dpol),xx1: Integer, xx2: Integer ) == dd1, D : List(critPair) - --------- create D and Pol - Pol1:= sort((z1:Dpol,z2:Dpol):Boolean +-> (degree z1 > degree z2) or ((degree z1 = degree z2 ) and sizeLess?(leadingCoefficient z2,leadingCoefficient z1)), @@ -41066,9 +41818,6 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where (( z1.lcmfij = z2.lcmfij ) and ( sizeLess?(z1.lcmcij,z2.lcmcij)) ) ,D) xx:= xx2 - - -------- loop - while ^null D repeat D0:= first D ep:=esPol(D0) @@ -41116,10 +41865,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where print(" THE GROEBNER BASIS over EUCLIDEAN DOMAIN"::Ex) H - -------------------------------------- - - --- erase multiple of e in D2 using crit M - + --- erase multiple of e in D2 using crit M + ecritMondd1:(Expon, Dom, List(critPair)) -> List(critPair) ecritMondd1(e: Expon, c: Dom, D2: List(critPair))== null D2 => nil x:= first(D2) @@ -41128,8 +41875,7 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where => ecritMondd1(e, c, rest(D2)) cons(x, ecritMondd1(e, c, rest(D2))) - ------------------------------- - + ecredPol: (Dpol, List(Dpol) ) -> Dpol ecredPol(h: Dpol, F: List(Dpol) ) == h0:Dpol:= 0 null F => h @@ -41137,10 +41883,9 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where h0:= h0 + monomial(leadingCoefficient(h),degree(h)) h:= eRed(red(h), F, F) h0 - ---------------------------- - - --- reduce dd1 using crit T and crit M + --- reduce dd1 using crit T and crit M + ecritMTondd1:(List(critPair)) -> List(critPair) ecritMTondd1(dd1: List(critPair))== null dd1 => nil f1:= first(dd1) @@ -41158,10 +41903,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where cT1 => ecritMTondd1(dd1) cons(f1, ecritMTondd1(dd1)) - ----------------------------- - - --- erase elements in D fullfilling crit B - + --- erase elements in D fullfilling crit B + ecritBonD: (Dpol, List(critPair)) -> List(critPair) ecritBonD(h:Dpol, D: List(critPair))== null D => nil x:= first(D) @@ -41173,10 +41916,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where ecritBonD(h, rest(D)) cons(x, ecritBonD(h, rest(D))) - ----------------------------- - - --- concat F and h and erase multiples of h in F - + --- concat F and h and erase multiples of h in F + eupdatF: (Dpol, List(Dpol) ) -> List(Dpol) eupdatF(h: Dpol, F: List(Dpol)) == null F => nil f1:= first(F) @@ -41184,9 +41925,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where => eupdatF(h, rest(F)) cons(f1, eupdatF(h, rest(F))) - ----------------------------- - --- concat H and h and erase multiples of h in H - + --- concat H and h and erase multiples of h in H + updatH: (Dpol, List(Dpol), List(Dpol), List(Dpol) ) -> List(Dpol) updatH(h: Dpol, H: List(Dpol), Hh: List(Dpol), Hhh: List(Dpol)) == null H => append(Hh,Hhh) h1:= first(H) @@ -41200,9 +41940,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where updatH(h, rest(H), crithdelH(hp,Hh),cons(hp,crithdelH(hp,Hhh))) updatH(h, rest(H), Hh,Hhh) - -------------------------------------------------- - ---- delete elements in cons(h,H) - + ---- delete elements in cons(h,H) + crithdelH: (Dpol, List(Dpol)) -> List(Dpol) crithdelH(h: Dpol, H: List(Dpol))== null H => nil h1:= first(H) @@ -41215,23 +41954,22 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where crithdelH(h,rest(H))) cons(h1, crithdelH(h,rest(H))) + eminGbasis: List(Dpol) -> List(Dpol) eminGbasis(F: List(Dpol)) == null F => nil newbas := eminGbasis rest F cons(ecredPol( first(F), newbas),newbas) - ------------------------------------------------ - --- does h belong to H - + --- does h belong to H + ecrithinH: (Dpol, List(Dpol)) -> Boolean ecrithinH(h: Dpol, H: List(Dpol))== null H => true h1:= first(H) ecritM(degree h1, lc h1, degree h, lc h) => false ecrithinH(h, rest(H)) - ----------------------------- - --- calculate euclidean S-polynomial of a critical pair - + --- calculate euclidean S-polynomial of a critical pair + esPol: (critPair) -> Dpol esPol(p:critPair)== Tij := p.lcmfij fi := p.poli @@ -41242,10 +41980,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where red(fj)*monomial((lij exquo leadingCoefficient(fj))::Dom, subtractIfCan(Tij, degree fj)::Expon) - ---------------------------- - - --- euclidean reduction mod F - + --- euclidean reduction mod F + eRed: (Dpol, List(Dpol), List(Dpol) ) -> Dpol eRed(s: Dpol, H: List(Dpol), Hh: List(Dpol)) == ( s = 0 or null H ) => s f1:= first(H) @@ -41262,10 +41998,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where eRed(red(s) - monomial(q1,e)*reductum(f1), Hh, Hh) eRed(s -(monomial(q1, e)*f1), rest(H), Hh) - ---------------------------- - - --- crit T true, if e1 and e2 are disjoint - + --- crit T true, if e1 and e2 are disjoint + ecritT: (critPair ) -> Boolean ecritT(p: critPair) == pi:= p.poli pj:= p.polj @@ -41273,20 +42007,17 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where cj:= lc pj (p.lcmfij = degree pi + degree pj) and (p.lcmcij = ci*cj) - ---------------------------- - - --- crit M - true, if lcm#2 multiple of lcm#1 - + --- crit M - true, if lcm#2 multiple of lcm#1 + ecritM: (Expon, Dom, Expon, Dom) -> Boolean ecritM(e1: Expon, c1: Dom, e2: Expon, c2: Dom) == en: Union(Expon, "failed") ((en:=subtractIfCan(e2, e1)) case "failed") or ((c2 exquo c1) case "failed") => false true - ---------------------------- - - --- crit B - true, if eik is a multiple of eh and eik ^equal - --- lcm(eh,ei) and eik ^equal lcm(eh,ek) + --- crit B - true, if eik is a multiple of eh and eik ^equal + --- lcm(eh,ei) and eik ^equal lcm(eh,ek) + ecritB: (Expon, Dom, Expon, Dom, Expon, Dom) -> Boolean ecritB(eh:Expon, ch: Dom, ei:Expon, ci: Dom, ek:Expon, ck: Dom) == eik:= sup(ei, ek) cik:= lcm(ci, ck) @@ -41294,17 +42025,13 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where ^ecritM(eik, cik, sup(ei, eh), lcm(ci, ch)) and ^ecritM(eik, cik, sup(ek, eh), lcm(ck, ch)) - ------------------------------- - - --- reduce p1 mod lp - + --- reduce p1 mod lp + euclideanNormalForm : (Dpol,List(Dpol)) -> Dpol euclideanNormalForm(p1: Dpol, lp: List(Dpol))== eRed(p1, lp, lp) - --------------------------------- - - --- insert element in sorted list - + --- insert element in sorted list + sortin: (Dpol, List(Dpol) ) -> List(Dpol) sortin(p1: Dpol, lp: List(Dpol))== null lp => [p1] f1:= first(lp) @@ -41315,6 +42042,7 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where cons(f1,sortin(p1, rest(lp))) cons(p1,lp) + updatD: (List(critPair), List(critPair)) -> List(critPair) updatD(D1: List(critPair), D2: List(critPair)) == null D1 => D2 null D2 => D1 @@ -41323,8 +42051,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where (dl1.lcmfij < dl2.lcmfij) => cons(dl1, updatD(D1.rest, D2)) cons(dl2, updatD(D1, D2.rest)) - ---- calculate number of terms of polynomial - + ---- calculate number of terms of polynomial + lepol: Dpol -> Integer lepol(p1:Dpol)== n: Integer n:= 0 @@ -41333,13 +42061,13 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where p1:= red(p1) n - ---- print blanc lines - + ---- print blanc lines + prinb: Integer -> Void prinb(n: Integer)== for i in 1..n repeat messagePrint(" ") - ---- print reduced critpair polynom - + ---- print reduced critpair polynom + prinshINFO : Dpol -> Void prinshINFO(h: Dpol)== prinb(2) messagePrint(" reduced Critpair - Polynom :") @@ -41347,10 +42075,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where print(h::Ex) prinb(2) - ------------------------------- - - ---- print info string - + ---- print info string + prindINFO: (critPair, Dpol, Dpol,Integer,Integer,Integer) -> Integer prindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer, i2:Integer, n:Integer) == ll: List Prinp @@ -41395,10 +42121,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where prinb(1) n - ------------------------------- - - ---- print the groebner basis polynomials - + ---- print the groebner basis polynomials + prinpolINFO: List(Dpol) -> Void prinpolINFO(pl: List(Dpol))== n:Integer n:= #pl @@ -41515,14 +42239,18 @@ EvaluateCycleIndicators(F):T==C where (* package EVALCYC *) (* - evp:((I->F),PTN)->F fn:I->F + pt:PTN + spol:SPOL RN + i:I + evp:((I->F),PTN)->F evp(fn, pt)== _*/[fn i for i in pt::(L I)] + eval : ((Integer -> F),SymmetricPolynomial(Fraction(Integer))) -> F eval(fn,spol)== if spol=0 then 0 @@ -41859,38 +42587,46 @@ ExpertSystemContinuityPackage(): E == I where import ExpertSystemToolsPackage + functionIsPolynomial? : NIA -> Boolean functionIsPolynomial?(args:NIA):Boolean == -- tests whether the function can be retracted to a polynomial (retractIfCan(args.fn)@Union(PDF,"failed"))$EDF case PDF + isPolynomial? : EDF -> Boolean == isPolynomial?(f:EDF):Boolean == -- tests whether the function can be retracted to a polynomial (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF + isConstant? : EDF -> Boolean isConstant?(f:EDF):Boolean == -- tests whether the fn can be retracted to a constant (DoubleFloat) (retractIfCan(f)@Union(DF,"failed"))$EDF case DF + denominatorIsPolynomial? : NIA -> Boolean denominatorIsPolynomial?(args:NIA):Boolean == -- tests if the denominator can be retracted to polynomial a:= copy args a.fn:=denominator(args.fn) (functionIsPolynomial?(a))@Boolean + denIsPolynomial? : EDF -> Boolean denIsPolynomial?(f:EDF):Boolean == -- tests if the denominator can be retracted to polynomial (isPolynomial?(denominator f))@Boolean + listInRange : (LDF,SOCDF) -> LDF listInRange(l:LDF,range:SOCDF):LDF == -- returns a list with only those elements internal to the range range [t for t in l | in?(t,range)] + loseUntil : (SDF,DF) -> SDF loseUntil(l:SDF,a:DF):SDF == empty?(l)$SDF => l f := first(l)$SDF (abs(f) <= abs(a)) => loseUntil(rest(l)$SDF,a) l + retainUntil : (SDF,DF,DF,Boolean) -> SDF retainUntil(l:SDF,a:DF,b:DF,flag:Boolean):SDF == empty?(l)$SDF => l f := first(l)$SDF @@ -41899,6 +42635,7 @@ ExpertSystemContinuityPackage(): E == I where flag => empty()$SDF retainUntil(rest(l),a,b,true) + streamInRange : (SDF,SOCDF) -> SDF streamInRange(l:SDF,range:SOCDF):SDF == -- returns a stream with only those elements internal to the range range a := getlo(range := dfRange(range)) @@ -41912,6 +42649,7 @@ ExpertSystemContinuityPackage(): E == I where l := loseUntil(l,a) retainUntil(l,a,b,false) + getStream : (Symbol,String) -> SDF getStream(n:Symbol,s:String):SDF == import RS entry?(n,bfKeys()$BasicFunctions)$(List(Symbol)) => @@ -41921,6 +42659,8 @@ ExpertSystemContinuityPackage(): E == I where (s = "ones")@Boolean => c.ones empty()$SDF + polynomialZeros : (Polynomial(Fraction(Integer)),Symbol,_ + Segment(OrderedCompletion(DoubleFloat))) -> List(DoubleFloat) polynomialZeros(fn:PFI,var:Symbol,range:SOCDF):LDF == up := unmakeSUP(univariate(fn)$PFI)$UP(var,FI) range := dfRange(range) @@ -41929,17 +42669,25 @@ ExpertSystemContinuityPackage(): E == I where realZeros(up,r,1/1000000000000000000)$RealZeroPackageQ(UP(var,FI)) listInRange(dflist(ans),range) + functionIsFracPolynomial? : Record(var: Symbol,_ + fn: Expression(DoubleFloat),_ + range: Segment(OrderedCompletion(DoubleFloat)),_ + abserr: DoubleFloat,relerr: DoubleFloat) -> Boolean functionIsFracPolynomial?(args:NIA):Boolean == -- tests whether the function can be retracted to a fraction -- where both numerator and denominator are polynomial (retractIfCan(args.fn)@Union(FPDF,"failed"))$EDF case FPDF + problemPoints : (Expression(DoubleFloat),Symbol,_ + Segment(OrderedCompletion(DoubleFloat))) -> List(DoubleFloat) problemPoints(f:EDF,var:Symbol,range:SOCDF):LDF == (denIsPolynomial?(f))@Boolean => c := retract(edf2efi(denominator(f)))@PFI polynomialZeros(c,var,range) empty()$LDF + zerosOf : (Expression(DoubleFloat),List(Symbol),_ + Segment(OrderedCompletion(DoubleFloat))) -> Stream(DoubleFloat) zerosOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == (u := isQuotient(e)) case EDF => singularitiesOf(u,vars,range) @@ -41989,6 +42737,8 @@ ExpertSystemContinuityPackage(): E == I where concat([zerosOf(u,vars,range) for u in v]) empty()$SDF + singularitiesOf : (Expression(DoubleFloat),List(Symbol),_ + Segment(OrderedCompletion(DoubleFloat))) -> Stream(DoubleFloat) singularitiesOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == (u := isQuotient(e)) case EDF => zerosOf(u,vars,range) @@ -42022,6 +42772,8 @@ ExpertSystemContinuityPackage(): E == I where singularitiesOf(a,vars,range) empty()$SDF + singularitiesOf : (Vector(Expression(DoubleFloat)),List(Symbol),_ + Segment(OrderedCompletion(DoubleFloat))) -> Stream(DoubleFloat) singularitiesOf(v:VEDF,vars:List Symbol,range:SOCDF):SDF == ls := [singularitiesOf(u,vars,range) for u in entries(v)$VEDF] concat(ls)$SDF @@ -42129,6 +42881,7 @@ ExpertSystemContinuityPackage1(A:DF,B:DF): E == I where (* package ESCONT1 *) (* + in? : DoubleFloat -> Boolean in?(p:DF):Boolean == a:Boolean := (p < B)$DF b:Boolean := (A < p)$DF @@ -42637,54 +43390,74 @@ ExpertSystemToolsPackage():E == I where (* package ESTOOLS *) (* + mat : (LDF,NNI) -> MDF mat(a:LDF,n:NNI):MDF == empty?(a)$LDF => zero(1,n)$MDF matrix(list([i for i in a for j in 1..n])$(List LDF))$MDF + f2df : F -> DF f2df(f:F):DF == (convert(f)@DF)$F + ef2edf : EF -> EDF ef2edf(f:EF):EDF == map(f2df,f)$EF2(F,DF) + fi2df : FI -> DF fi2df(f:FI):DF == coerce(f)$DF + ocf2ocdf : OCF -> OCDF ocf2ocdf(a:OCF):OCDF == finite? a => (f2df(retract(a)@F))::OCDF a pretend OCDF + socf2socdf : SOCF -> SOCDF socf2socdf(a:SOCF):SOCDF == segment(ocf2ocdf(lo a),ocf2ocdf(hi a)) + convert : List SOCF -> List SOCDF convert(l:List SOCF):List SOCDF == [socf2socdf a for a in l] + pdf2df : PDF -> DF pdf2df(p:PDF):DF == retract(p)@DF + df2ef : DF -> EF df2ef(a:DF):EF == b := convert(a)@Float coerce(b)$EF + pdf2ef : PDF -> EF pdf2ef(p:PDF):EF == df2ef(pdf2df(p)) + edf2fi : EDF -> FI edf2fi(m:EDF):FI == retract(retract(m)@DF)@FI + edf2df : EDF -> DF edf2df(m:EDF):DF == retract(m)@DF + df2fi : DF -> FI df2fi(r:DF):FI == (retract(r)@FI)$DF + dfRange : SOCDF -> SOCDF dfRange(r:SOCDF):SOCDF == if infinite?(lo(r))$OCDF then r := -(max()$DF :: OCDF)..hi(r)$SOCDF if infinite?(hi(r))$OCDF then r := lo(r)$SOCDF..(max()$DF :: OCDF) r + dflist : (List(Record(left:FI,right:FI))) -> LDF dflist(l:List(Record(left:FI,right:FI))):LDF == [u.left :: DF for u in l] + edf2efi : EDF -> EFI edf2efi(f:EDF):EFI == map(df2fi,f)$EF2(DF,FI) + df2st : DF -> String df2st(n:DF):String == (convert((convert(n)@Float)$DF)@ST)$Float + f2st : F -> String f2st(n:F):String == (convert(n)@ST)$Float + ldf2lst : LDF -> LST ldf2lst(ln:LDF):LST == [df2st f for f in ln] + sdf2lst : SDF -> LST sdf2lst(ln:SDF):LST == explicitlyFinite? ln => m := map(df2st,ln)$StreamFunctions2(DF,ST) @@ -42695,20 +43468,27 @@ ExpertSystemToolsPackage():E == I where entries(m)$SS empty()$LST + df2mf : DF -> MF df2mf(n:DF):MF == (df2fi(n))::MF + ldf2vmf : LDF -> VMF ldf2vmf(l:LDF):VMF == m := [df2mf(n) for n in l] vector(m)$VMF + edf2ef : EDF -> EF edf2ef(e:EDF):EF == map(convert$DF,e)$EF2(DF,Float) + vedf2vef : VEDF -> VEF vedf2vef(vedf:VEDF):VEF == vector([edf2ef e for e in members(vedf)]) + getlo : Segment(OrderedCompletion(DoubleFloat)) -> DoubleFloat getlo(u:SOCDF):DF == retract(lo(u))@DF + gethi : Segment(OrderedCompletion(DoubleFloat)) -> DoubleFloat gethi(u:SOCDF):DF == retract(hi(u))@DF + in? : (DF,SOCDF) -> Boolean in?(p:DF,range:SOCDF):Boolean == top := gethi(range) bottom := getlo(range) @@ -42716,6 +43496,8 @@ ExpertSystemToolsPackage():E == I where b:Boolean := (p > bottom)$DF (a and b)@Boolean + isQuotient : Expression(DoubleFloat) -> _ + Union(Expression(DoubleFloat),"failed") isQuotient(expr:EDF):Union(EDF,"failed") == (k := mainKernel expr) case KEDF => (expr = inv(f := k :: KEDF :: EDF)$EDF)$EDF => f @@ -42723,6 +43505,7 @@ ExpertSystemToolsPackage():E == I where "failed" "failed" + numberOfOperations1 : (EDF,ON) -> ON numberOfOperations1(fn:EDF,numbersSoFar:ON):ON == (u := isQuotient(fn)) case EDF => numbersSoFar := numberOfOperations1(u,numbersSoFar) @@ -42755,12 +43538,16 @@ ExpertSystemToolsPackage():E == I where numbersSoFar := numberOfOperations1(a,numbersSoFar) numbersSoFar + numberOfOperations : Vector(Expression(DoubleFloat)) -> _ + Record(additions: Integer,multiplications: Integer,_ + exponentiations: Integer,functionCalls: Integer) numberOfOperations(ode:VEDF):ON == n:ON := [0,0,0,0] for i in 1..#ode repeat n:ON := numberOfOperations1(ode.i,n) n + expenseOfEvaluation : Vector(Expression(DoubleFloat)) -> Float expenseOfEvaluation(o:VEDF):F == ln:ON := numberOfOperations(o) a := ln.additions @@ -42770,6 +43557,7 @@ ExpertSystemToolsPackage():E == I where n := (a + m + 4*e + 10*e) (1.0-exp((-n::F/288.0))$F) + concat : (Result,Result) -> Result concat(a:Result,b:Result):Result == membersOfa := (members(a)@List(Record(key:Symbol,entry:Any))) membersOfb := (members(b)@List(Record(key:Symbol,entry:Any))) @@ -42777,6 +43565,7 @@ ExpertSystemToolsPackage():E == I where concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any)) construct(allMembers) + concat : List(Result) -> Result concat(l:List Result):Result == import List Result empty? l => empty()$Result @@ -42786,10 +43575,12 @@ ExpertSystemToolsPackage():E == I where else concat(f,concat r) + outputMeasure : Float -> String outputMeasure(m:F):ST == fl:Float := round(m*(f:= 1000.0))/f convert(fl)@ST + measure2Result : Measure -> Result measure2Result(m:Measure):Result == mm := coerce(m.measure)$AnyFunctions1(Float) mmr:Record(key:Symbol,entry:Any) := [bestMeasure@Symbol,mm] @@ -42802,6 +43593,7 @@ ExpertSystemToolsPackage():E == I where meth:Record(key:Symbol,entry:Any):=[method@Symbol,met] construct([meth])$Result + measure2Result : Measure2 -> Result measure2Result(m:Measure2):Result == mm := coerce(m.measure)$AnyFunctions1(Float) mmr:Record(key:Symbol,entry:Any) := [bestMeasure@Symbol,mm] @@ -42816,6 +43608,7 @@ ExpertSystemToolsPackage():E == I where meth:Record(key:Symbol,entry:Any):=[method@Symbol,met] construct([meth])$Result + att2Result : ATT -> Result att2Result(att:ATT):Result == aepc := coerce(att.endPointContinuity)$AnyFunctions1(CTYPE) ar := coerce(att.range)$AnyFunctions1(RTYPE) @@ -42825,6 +43618,7 @@ ExpertSystemToolsPackage():E == I where aar:Record(key:Symbol,entry:Any) := [attributes@Symbol,aaa] construct([aar])$Result + iflist2Result : IFV -> Result iflist2Result(ifv:IFV):Result == ifvs:List String := [concat(["stiffness: ",outputMeasure(ifv.stiffness)]), @@ -42915,6 +43709,7 @@ ExpertSystemToolsPackage1(R1:OR): E == I where (* package ESTOOLS1 *) (* + neglist : List(R1) -> List(R1) neglist(l:List R1):List R1 == [u for u in l | negative?(u)$R1] *) @@ -42998,6 +43793,7 @@ ExpertSystemToolsPackage2(R1:R,R2:R): E == I where (* package ESTOOLS2 *) (* + map : ((R1 -> R2),Matrix(R1)) -> Matrix(R2) map(f:R1->R2,m:Matrix R1):Matrix R2 == matrix([[f u for u in v] for v in listOfLists(m)$(Matrix R1)])_ $(Matrix R2) @@ -43094,10 +43890,12 @@ ExpressionFunctions2(R:OrderedSet, S:OrderedSet): if S has Ring and R has Ring then + map : ((R -> S),Expression(R)) -> Expression(S) map(f, r) == map(f, r)$F2 else + map : ((R -> S),Expression(R)) -> Expression(S) map(f, r) == map(x1 +-> map(f, x1), retract r)$E2 *) @@ -43274,6 +44072,7 @@ coefficient ring, since it will complain otherwise. opcoerce := operator("coerce"::Symbol)$OP + replaceDiffs : (F,BasicOperator,Symbol) -> F replaceDiffs (expr, op, sy) == lk := kernels expr for k in lk repeat @@ -43293,7 +44092,7 @@ coefficient ring, since it will complain otherwise. expr := subst(expr, [k], [opdiff differentiand]) expr - + seriesSolve : (F,BasicOperator,Symbol,List(F)) -> UTSF seriesSolve(expr, op, sy, l) == ex := replaceDiffs(expr, op, sy) f := compiledFunction(ex, name op, sy)$MKF @@ -43386,6 +44185,7 @@ ExpressionSpaceFunctions1(F:ExpressionSpace, S:Type): with (* -- prop contains an evaluation function List S -> S + map : ((F -> S),String,Kernel(F)) -> S map(F2S, prop, k) == args := [F2S x for x in argument k]$List(S) (p := property(operator k, prop)) case None => @@ -43474,6 +44274,7 @@ ExpressionSpaceFunctions2(E:ExpressionSpace, F:ExpressionSpace): with (* package ES2 *) (* + map : ((E -> F),Kernel(E)) -> F map(f, k) == (operator(operator k)$F) [f x for x in argument k]$List(F) @@ -43745,67 +44546,67 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where (* package EXPRODE *) (* - checkCompat: (OP, EQ, EQ) -> F - checkOrder1: (F, OP, K, SY, F) -> F - checkOrderN: (F, OP, K, SY, F, NonNegativeInteger) -> F - checkSystem: (F, List K, List F) -> F - div2exquo : F -> F - smp2exquo : P -> F - k2exquo : K -> F - diffRhs : (F, F) -> F - diffRhsK : (K, F) -> F - findCompat : (F, List EQ) -> F - findEq : (K, SY, List F) -> F - localInteger: F -> F - opelt := operator("elt"::Symbol)$OP + opex := operator("fixedPointExquo"::Symbol)$OP + opint := operator("integer"::Symbol)$OP Rint? := R has IntegerNumberSystem + localInteger: F -> F localInteger n == (Rint? => n; opint n) + diffRhs : (F, F) -> F diffRhs(f, g) == diffRhsK(retract(f)@K, g) + k2exquo : K -> F k2exquo k == is?(op := operator k, "%diff"::Symbol) => error "Improper differential equation" kernel(op, [div2exquo f for f in argument k]$List(F)) + smp2exquo : P -> F smp2exquo p == map(k2exquo,x+->x::F,p)_ $PolynomialCategoryLifting(IndexedExponents K,K, R, P, F) + div2exquo : F -> F div2exquo f == ((d := denom f) = 1) => f opex(smp2exquo numer f, smp2exquo d) -- if g is of the form a * k + b, then return -b/a + diffRhsK : (K, F) -> F diffRhsK(k, g) == h := univariate(g, k) (degree(numer h) <= 1) and ground? denom h => - coefficient(numer h, 0) / coefficient(numer h, 1) error "Improper differential equation" + checkCompat: (OP, EQ, EQ) -> F checkCompat(y, eqx, eqy) == lhs(eqy) =$F y(rhs eqx) => rhs eqy error "Improper initial value" + findCompat : (F, List EQ) -> F findCompat(yx, l) == for eq in l repeat yx =$F lhs eq => return rhs eq error "Improper initial value" + findEq : (K, SY, List F) -> F findEq(k, x, sys) == k := retract(differentiate(k::F, x))@K for eq in sys repeat member?(k, kernels eq) => return eq error "Improper differential equation" + checkOrder1: (F, OP, K, SY, F) -> F checkOrder1(diffeq, y, yx, x, sy) == div2exquo subst(diffRhs(differentiate(yx::F,x),diffeq),[yx],[sy]) + checkOrderN: (F, OP, K, SY, F, NonNegativeInteger) -> F checkOrderN(diffeq, y, yx, x, sy, n) == zero? n => error "No initial value(s) given" m := (minIndex(l := [retract(f := yx::F)@K]$List(K)))::F @@ -43815,34 +44616,45 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where lv := concat(opelt(sy, localInteger(m := m + 1)), lv) div2exquo subst(diffRhs(differentiate(f, x), diffeq), l, lv) + checkSystem: (F, List K, List F) -> F checkSystem(diffeq, yx, lv) == for k in kernels diffeq repeat is?(k, "%diff"::SY) => return div2exquo subst(diffRhsK(k, diffeq), yx, lv) 0 + seriesSolve : (List(Equation(F)),List(BasicOperator),_ + Equation(F),List(Equation(F))) -> Any seriesSolve(l:List EQ, y:List OP, eqx:EQ, eqy:List EQ) == seriesSolve([lhs deq - rhs deq for deq in l]$List(F), y, eqx, eqy) + seriesSolve : (List(F),List(BasicOperator),Equation(F),List(F)) -> Any seriesSolve(l:List EQ, y:List OP, eqx:EQ, y0:List F) == seriesSolve([lhs deq - rhs deq for deq in l]$List(F), y, eqx, y0) + seriesSolve : (List(F),List(BasicOperator),Equation(F),_ + List(Equation(F))) -> Any seriesSolve(l:List F, ly:List OP, eqx:EQ, eqy:List EQ) == seriesSolve(l, ly, eqx, [findCompat(y rhs eqx, eqy) for y in ly]$List(F)) + seriesSolve : (Equation(F),BasicOperator,Equation(F),Equation(F)) -> Any seriesSolve(diffeq:EQ, y:OP, eqx:EQ, eqy:EQ) == seriesSolve(lhs diffeq - rhs diffeq, y, eqx, eqy) + seriesSolve : (Equation(F),BasicOperator,Equation(F),F) -> Any seriesSolve(diffeq:EQ, y:OP, eqx:EQ, y0:F) == seriesSolve(lhs diffeq - rhs diffeq, y, eqx, y0) + seriesSolve : (Equation(F),BasicOperator,Equation(F),List(F)) -> Any seriesSolve(diffeq:EQ, y:OP, eqx:EQ, y0:List F) == seriesSolve(lhs diffeq - rhs diffeq, y, eqx, y0) + seriesSolve : (F,BasicOperator,Equation(F),Equation(F)) -> Any seriesSolve(diffeq:F, y:OP, eqx:EQ, eqy:EQ) == seriesSolve(diffeq, y, eqx, checkCompat(y, eqx, eqy)) + seriesSolve : (F,BasicOperator,Equation(F),F) -> Any seriesSolve(diffeq:F, y:OP, eqx:EQ, y0:F) == x := symbolIfCan(retract(lhs eqx)@K)::SY sy := name y @@ -43851,6 +44663,7 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where center := rhs eqx coerce(ode1(compiledFunction(f, sy)$MKF, y0)$ODE)$A1 + seriesSolve : (F,BasicOperator,Equation(F),List(F)) -> Any seriesSolve(diffeq:F, y:OP, eqx:EQ, y0:List F) == x := symbolIfCan(retract(lhs eqx)@K)::SY sy := new()$SY @@ -43859,6 +44672,7 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where center := rhs eqx coerce(ode(compiledFunction(f, sy)$MKL, y0)$ODE)$A1 + seriesSolve : (List(F),List(BasicOperator),Equation(F),List(F)) -> Any seriesSolve(sys:List F, ly:List OP, eqx:EQ, l0:List F) == x := symbolIfCan(kx := retract(lhs eqx)@K)::SY fsy := (sy := new()$SY)::F @@ -44273,16 +45087,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with -- summation(x:%, n:Symbol) : as opposed to "definite" sum -- product(x:%, n:Symbol) : ditto - ------------------------ - -- Forward declarations. - ------------------------ - - outputOMExpr : (OpenMathDevice, Expression R) -> Void - - ------------------------- - -- Local helper functions - ------------------------- - + outputOMArith1 : (OpenMathDevice,String,List Expression R) -> Void outputOMArith1(dev: OpenMathDevice, sym: String, _ args: List Expression R): Void == OMputApp(dev) @@ -44291,6 +45096,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with OMwrite(dev, arg, false) OMputEndApp(dev) + outputOMLambda : (OpenMathDevice,Expression R,Expression R) -> Void outputOMLambda(dev: OpenMathDevice, ex: Expression R, _ var: Expression R): Void == OMputBind(dev) @@ -44301,6 +45107,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with OMwrite(dev, ex, false) OMputEndBind(dev) + outputOMInterval : (OpenMathDevice,Expression R,Expression R) -> Void outputOMInterval(dev: OpenMathDevice, _ lo: Expression R, hi: Expression R): Void == OMputApp(dev) @@ -44309,6 +45116,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with OMwrite(dev, hi, false) OMputEndApp(dev) + outputOMIntInterval : (OpenMathDevice,Expression R,Expression R) -> Void outputOMIntInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R)_ :Void == OMputApp(dev) @@ -44317,6 +45125,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with OMwrite(dev, hi, false) OMputEndApp(dev) + outputOMBinomial : (OpenMathDevice,List Expression R) -> Void outputOMBinomial(dev: OpenMathDevice, args: List Expression R): Void == not #args=2 => error "Wrong number of arguments to binomial" OMputApp(dev) @@ -44325,10 +45134,12 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with OMwrite(dev, arg, false) OMputEndApp(dev) + outputOMPower : (OpenMathDevice,List Expression R) -> Void outputOMPower(dev: OpenMathDevice, args: List Expression R): Void == not #args=2 => error "Wrong number of arguments to power" outputOMArith1(dev, "power", args) + outputOMDefsum : (OpenMathDevice,List Expression R) -> Void outputOMDefsum(dev: OpenMathDevice, args: List Expression R): Void == #args ^= 5 => error "Unexpected number of arguments to a defsum" OMputApp(dev) @@ -44337,6 +45148,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with outputOMLambda(dev, eval(args.1, args.2, args.3), args.3) OMputEndApp(dev) + outputOMDefprod : (OpenMathDevice,List Expression R) -> Void outputOMDefprod(dev: OpenMathDevice, args: List Expression R): Void == #args ^= 5 => error "Unexpected number of arguments to a defprod" OMputApp(dev) @@ -44345,6 +45157,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with outputOMLambda(dev, eval(args.1, args.2, args.3), args.3) OMputEndApp(dev) + outputOMDefin : (OpenMathDevice,List Expression R) -> Void outputOMDefint(dev: OpenMathDevice, args: List Expression R): Void == #args ^= 5 => error "Unexpected number of arguments to a defint" OMputApp(dev) @@ -44353,6 +45166,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with outputOMLambda(dev, eval(args.1, args.2, args.3), args.3) OMputEndApp(dev) + outputOMInt : (OpenMathDevice,List Expression R) -> Void outputOMInt(dev: OpenMathDevice, args: List Expression R): Void == #args ^= 3 => error "Unexpected number of arguments to a defint" OMputApp(dev) @@ -44360,6 +45174,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with outputOMLambda(dev, eval(args.1, args.2, args.3), args.3) OMputEndApp(dev) + outputOMFunction : (OpenMathDevice,Symbol,List Expression R) -> Void outputOMFunction(dev: OpenMathDevice, op: Symbol, _ args: List Expression R): Void == nargs := #args @@ -44389,6 +45204,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with op = binomial => outputOMBinomial(dev, args) error concat ["No OpenMath definition for function ", string op] + outputOMExpr : (OpenMathDevice,Expression R) -> Void outputOMExpr(dev: OpenMathDevice, ex: Expression R): Void == ground? ex => OMwrite(dev, ground ex, false) not((v := retractIfCan(ex)@Union(Symbol,"failed")) case "failed") => @@ -44427,6 +45243,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with -- Exports ---------- + OMwrite : Expression(R) -> String OMwrite(ex: Expression R): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -44438,6 +45255,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (Expression(R),Boolean) -> String OMwrite(ex: Expression R, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -44451,11 +45269,13 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (OpenMathDevice,Expression(R)) -> Void OMwrite(dev: OpenMathDevice, ex: Expression R): Void == OMputObject(dev) outputOMExpr(dev, ex) OMputEndObject(dev) + OMwrite : (OpenMathDevice,Expression(R),Boolean) -> Void OMwrite(dev: OpenMathDevice, ex: Expression R, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -44887,10 +45707,12 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where any1 := ANY1(UTS(FE,x,a)) coerce(uts :: UTS(FE,x,a))$any1 + taylor : Symbol -> Any taylor(x:SY) == uts := UTS(FE,x,0$FE); any1 := ANY1(uts) coerce(monomial(1,1)$uts)$any1 + taylor : FE -> Any taylor(fcn:FE) == null(vars := variables fcn) => error "taylor: expression has no variables" @@ -44898,6 +45720,7 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where error "taylor: expression has more than one variable" taylor(fcn,(first(vars) :: FE) = 0) + taylor : (FE,NonNegativeInteger) -> Any taylor(fcn:FE,n:NNI) == null(vars := variables fcn) => error "taylor: expression has no variables" @@ -44908,12 +45731,14 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where series := retract(taylor(fcn,(x :: FE) = 0))$any1 coerce(extend(series,n))$any1 + taylor : (FE,Equation(FE)) -> Any taylor(fcn:FE,eq:EQ FE) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" x := xx :: SY; a := rhs eq iTaylor(performSubstitution(fcn,x,a),x,a) + taylor : (FE,Equation(FE),NonNegativeInteger) -> Any taylor(fcn,eq,n) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" @@ -44938,10 +45763,12 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where any1 := ANY1(ULS(FE,x,a)) coerce(ans.%series)$any1 + laurent : Symbol -> Any laurent(x:SY) == uls := ULS(FE,x,0$FE); any1 := ANY1(uls) coerce(monomial(1,1)$uls)$any1 + laurent : FE -> Any laurent(fcn:FE) == null(vars := variables fcn) => error "laurent: expression has no variables" @@ -44949,6 +45776,7 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where error "laurent: expression has more than one variable" laurent(fcn,(first(vars) :: FE) = 0) + laurent : (FE,Integer) -> Any laurent(fcn:FE,n:I) == null(vars := variables fcn) => error "laurent: expression has no variables" @@ -44959,12 +45787,14 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where series := retract(laurent(fcn,(x :: FE) = 0))$any1 coerce(extend(series,n))$any1 + laurent : (FE,Equation(FE)) -> Any laurent(fcn:FE,eq:EQ FE) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" x := xx :: SY; a := rhs eq iLaurent(performSubstitution(fcn,x,a),x,a) + laurent : (FE,Equation(FE),Integer) -> Any laurent(fcn,eq,n) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" @@ -44988,10 +45818,12 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where any1 := ANY1(UPXS(FE,x,a)) coerce(ans.%series)$any1 + puiseux : Symbol -> Any puiseux(x:SY) == upxs := UPXS(FE,x,0$FE); any1 := ANY1(upxs) coerce(monomial(1,1)$upxs)$any1 + puiseux : FE -> Any puiseux(fcn:FE) == null(vars := variables fcn) => error "puiseux: expression has no variables" @@ -44999,6 +45831,7 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where error "puiseux: expression has more than one variable" puiseux(fcn,(first(vars) :: FE) = 0) + puiseux : (FE,Fraction(Integer)) -> Any puiseux(fcn:FE,n:RN) == null(vars := variables fcn) => error "puiseux: expression has no variables" @@ -45009,12 +45842,14 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where series := retract(puiseux(fcn,(x :: FE) = 0))$any1 coerce(extend(series,n))$any1 + puiseux : (FE,Equation(FE)) -> Any puiseux(fcn:FE,eq:EQ FE) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" x := xx :: SY; a := rhs eq iPuiseux(performSubstitution(fcn,x,a),x,a) + puiseux : (FE,Equation(FE),Fraction(Integer)) -> Any puiseux(fcn,eq,n) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" @@ -45040,10 +45875,12 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where any1 := ANY1(UPXS(FE,x,a)) coerce(ans.%series)$any1 + series : Symbol -> Any series(x:SY) == upxs := UPXS(FE,x,0$FE); any1 := ANY1(upxs) coerce(monomial(1,1)$upxs)$any1 + series : FE -> Any series(fcn:FE) == null(vars := variables fcn) => error "series: expression has no variables" @@ -45051,6 +45888,7 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where error "series: expression has more than one variable" series(fcn,(first(vars) :: FE) = 0) + series : (FE,Fraction(Integer)) -> Any series(fcn:FE,n:RN) == null(vars := variables fcn) => error "series: expression has no variables" @@ -45061,12 +45899,14 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where series := retract(series(fcn,(x :: FE) = 0))$any1 coerce(extend(series,n))$any1 + series : (FE,Equation(FE)) -> Any series(fcn:FE,eq:EQ FE) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" x := xx :: SY; a := rhs eq iSeries(performSubstitution(fcn,x,a),x,a) + series : (FE,Equation(FE),Fraction(Integer)) -> Any series(fcn,eq,n) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" @@ -45357,6 +46197,9 @@ ExpressionTubePlot(): Exports == Implementation where --% tubes: variable radius + tubePlot : (Expression(Integer),Expression(Integer),Expression(Integer),_ + (DoubleFloat -> DoubleFloat),Segment(DoubleFloat),_ + (DoubleFloat -> DoubleFloat),Integer,String) -> TubePlot(Plot3D) tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_ tRange:SEG SF,radFcn:SF -> SF,n:I,string:S) == -- check value of n @@ -45420,6 +46263,9 @@ ExpressionTubePlot(): Exports == Implementation where loopList := cons(lps,loopList) tube(parPlot,reverse_! loopList,flag) + tubePlot : (Expression(Integer),Expression(Integer),Expression(Integer),_ + (DoubleFloat -> DoubleFloat),Segment(DoubleFloat),DoubleFloat,Integer) ->_ + TubePlot(Plot3D) tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_ tRange:SEG SF,radFcn:SF -> SF,n:I) == tubePlot(x,y,z,colorFcn,tRange,radFcn,n,"open") @@ -45429,12 +46275,19 @@ ExpressionTubePlot(): Exports == Implementation where project: (SF,SF) -> SF project(x,y) == x + constantToUnaryFunction : DoubleFloat -> (DoubleFloat -> DoubleFloat) constantToUnaryFunction x == s +-> project(x,s) + tubePlot : (Expression(Integer),Expression(Integer),Expression(Integer),_ + (DoubleFloat -> DoubleFloat),Segment(DoubleFloat),DoubleFloat,Integer,_ + String) -> TubePlot(Plot3D) tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_ tRange:SEG SF,rad:SF,n:I,s:S) == tubePlot(x,y,z,colorFcn,tRange,constantToUnaryFunction rad,n,s) + tubePlot : (Expression(Integer),Expression(Integer),Expression(Integer),_ + (DoubleFloat -> DoubleFloat),Segment(DoubleFloat),_ + (DoubleFloat -> DoubleFloat),Integer) -> TubePlot(Plot3D) tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_ tRange:SEG SF,rad:SF,n:I) == tubePlot(x,y,z,colorFcn,tRange,rad,n,"open") @@ -45602,6 +46455,7 @@ Export3D(): with -- return list of indexes -- assumes subnodes are leaves containing index + faceIndex : SubSpace(3,DoubleFloat) -> List NNI faceIndex(subSp: SubSpace(3,DoubleFloat)):List NNI == faceIndexList:List NNI := [] for poly in children(subSp) repeat @@ -45611,6 +46465,7 @@ Export3D(): with -- called if this component contains a single polygon -- write out face information for Wavefront (.OBJ) 3D file format -- one face per line, represented by list of vertex indexes + writePolygon : (TextFile,List SubSpace(3,DoubleFloat)) -> Void writePolygon(f1:TextFile,curves: List SubSpace(3,DoubleFloat)):Void == faceIndexList:List NNI := [] for curve in curves repeat @@ -45627,6 +46482,7 @@ Export3D(): with -- as quad polygons. -- write out face information for Wavefront (.OBJ) 3D file format -- one face per line, represented by list of vertex indexes + writeMesh : (TextFile,List SubSpace(3,DoubleFloat)) -> Void writeMesh(f1:TextFile,curves: List SubSpace(3,DoubleFloat)):Void == meshIndexArray:List List NNI := [] for curve in curves repeat @@ -45646,6 +46502,7 @@ Export3D(): with string((meshIndexArray.i).(j+1))] writeLine!(f1,s) + toString : DoubleFloat -> String toString(d : DoubleFloat) : String == unparse(convert(d)@InputForm) @@ -45655,6 +46512,7 @@ Export3D(): with -- writeObj(subspace(makeObject(x*x-y*y,x=-1..1,y=-1..1)),"myfile.obj") -- colour dimension is ignored -- no normals or texture data is generated + writeObj : (SubSpace(3,DoubleFloat),String) -> Void writeObj(subSp: SubSpace(3,DoubleFloat), filename:String):Void == f1:TextFile:=open(filename::FileName,"output") writeLine!(f1,"# mesh generated by axiom") @@ -46025,17 +46883,27 @@ e04AgentsPackage(): E == I where sumOfSquares2:EFI -> Union(EFI,"failed") nonLinear?:EDF -> Boolean - finiteBound2:(OCDF,DF) -> DF functionType:EDF -> String + finiteBound2:(OCDF,DF) -> DF finiteBound2(a:OCDF,b:DF):DF == not finite?(a) => positive?(a) => b -b retract(a)@DF + finiteBound : (List(OrderedCompletion(DoubleFloat)),DoubleFloat) -> _ + List(DoubleFloat) finiteBound(l:LOCDF,b:DF):LDF == [finiteBound2(i,b) for i in l] + sortConstraints : Record(fn: Expression(DoubleFloat),_ + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)),_ + cf: List(Expression(DoubleFloat)),_ + ub: List(OrderedCompletion(DoubleFloat))) -> _ + Record(fn: Expression(DoubleFloat),init: List(DoubleFloat),_ + lb: List(OrderedCompletion(DoubleFloat)),_ + cf: List(Expression(DoubleFloat)),_ + ub: List(OrderedCompletion(DoubleFloat))) sortConstraints(args:NOA):NOA == Args := copy args c:LEDF := Args.cf @@ -46053,6 +46921,7 @@ e04AgentsPackage(): E == I where swap!(u,n+i-1,n+i)$LOCDF Args + changeNameToObjf : (Symbol,Result) -> Result changeNameToObjf(s:Symbol,r:Result):Result == a := remove!(s,r)$Result a case Any => @@ -46060,10 +46929,15 @@ e04AgentsPackage(): E == I where r r + sum : (EDF,EDF) -> EDF sum(a:EDF,b:EDF):EDF == a+b + variables : Record(lfn: List(Expression(DoubleFloat)),_ + init: List(DoubleFloat)) -> List(Symbol) variables(args:LSA): LS == variables(reduce(sum,(args.lfn))) + sumOfSquares : Expression(DoubleFloat) -> _ + Union(Expression(DoubleFloat),"failed") sumOfSquares(f:EDF):Union(EDF,"failed") == e := edf2efi(f) s:Union(EFI,"failed") := sumOfSquares2(e) @@ -46071,6 +46945,7 @@ e04AgentsPackage(): E == I where map(fi2df,s)$EF2(FI,DF) "failed" + sumOfSquares2 : EFI -> Union(EFI,"failed") sumOfSquares2(f:EFI):Union(EFI,"failed") == p := retractIfCan(f)@Union(PFI,"failed") p case PFI => @@ -46093,6 +46968,7 @@ e04AgentsPackage(): E == I where "failed" "failed" + splitLinear : Expression(DoubleFloat) -> Expression(DoubleFloat) splitLinear(f:EDF):EDF == out := 0$EDF (l := isPlus(f)$EDF) case LEDF => @@ -46102,12 +46978,15 @@ e04AgentsPackage(): E == I where out out + edf2pdf : EDF -> PDF edf2pdf(f:EDF):PDF == (retract(f)@PDF)$EDF + varList : (Expression(DoubleFloat),NonNegativeInteger) -> List(Symbol) varList(e:EDF,n:NNI):LS == s := name(first(variables(edf2pdf(e))$PDF)$LS)$Symbol [subscript(s,[t::OutputForm]) for t in expand([1..n])$Segment(Integer)] + functionType : EDF -> String functionType(f:EDF):String == n := #(variables(f))$EDF p := (retractIfCan(f)@Union(PDF,"failed"))$EDF @@ -46119,6 +46998,7 @@ e04AgentsPackage(): E == I where "non-linear" "non-linear" + simpleBounds? : List(Expression(DoubleFloat)) -> Boolean simpleBounds?(l: LEDF):Boolean == a := true for e in l repeat @@ -46127,14 +47007,19 @@ e04AgentsPackage(): E == I where leave a + simple? : EDF -> Boolean simple?(e:EDF):Boolean == (functionType(e) = "simple")@Boolean + linear? : Expression(DoubleFloat) -> Boolean linear?(e:EDF):Boolean == (functionType(e) = "linear")@Boolean + quadratic? : Expression(DoubleFloat) -> Boolean quadratic?(e:EDF):Boolean == (functionType(e) = "quadratic")@Boolean + nonLinear? : EDF -> Boolean nonLinear?(e:EDF):Boolean == (functionType(e) = "non-linear")@Boolean + linear? : List(Expression(DoubleFloat)) -> Boolean linear?(l: LEDF):Boolean == a := true for e in l repeat @@ -46144,13 +47029,19 @@ e04AgentsPackage(): E == I where leave a + simplePart : LEDF -> LEDF simplePart(l:LEDF):LEDF == [i for i in l | simple?(i)] + linearPart : List(Expression(DoubleFloat)) -> List(Expression(DoubleFloat)) linearPart(l:LEDF):LEDF == [i for i in l | linear?(i)] + nonLinearPart : List(Expression(DoubleFloat)) -> _ + List(Expression(DoubleFloat)) nonLinearPart(l:LEDF):LEDF == [i for i in l | not linear?(i) and not simple?(i)] + linearMatrix : (List(Expression(DoubleFloat)),NonNegativeInteger) -> _ + Matrix(DoubleFloat) linearMatrix(l:LEDF, n:NNI):MDF == empty?(l) => mat([],n) L := linearPart l @@ -46167,9 +47058,17 @@ e04AgentsPackage(): E == I where row := row + 1 M + expenseOfEvaluation : Record(lfn: List(Expression(DoubleFloat)),_ + init: List(DoubleFloat)) -> Float expenseOfEvaluation(o:LSA):F == expenseOfEvaluation(vector(copy o.lfn)$VEDF) + optAttributes : Union(noa: Record(fn: Expression(DoubleFloat),_ + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)),_ + cf: List(Expression(DoubleFloat)),_ + ub: List(OrderedCompletion(DoubleFloat))),_ + lsa: Record(lfn: List(Expression(DoubleFloat)),_ + init: List(DoubleFloat))) -> List(String) optAttributes(o:Union(noa:NOA,lsa:LSA)):List String == o case noa => n := o.noa @@ -46303,6 +47202,8 @@ FactoredFunctions(M:IntegralDomain): Exports == Implementation where (* package FACTFUNC *) (* + nthRoot : (Factored(M),NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: M,radicand: List(M)) nthRoot(ff, n) == coeff:M := 1 radi:List(M) := (((unit ff) = 1) => empty(); [unit ff]) @@ -46318,6 +47219,7 @@ FactoredFunctions(M:IntegralDomain): Exports == Implementation where radi := concat_!(radi, term.factor ** qr.remainder) [n, coeff, radi] + log : Factored(M) -> List(Record(coef: NonNegativeInteger,logand: M)) log ff == ans := unit ff concat([1, unit ff], @@ -46508,6 +47410,7 @@ FactoredFunctions2(R, S): Exports == Implementation where (* package FR2 *) (* + map : ((R -> S),Factored(R)) -> Factored(S) map(func, f) == func(unit f) * _*/[nilFactor(func(g.factor), g.exponent) for g in factors f] @@ -46630,9 +47533,11 @@ FactoredFunctionUtilities(R): Exports == Implementation where fUnion ==> Union("nil", "sqfr", "irred", "prime") FF ==> Record(flg: fUnion, fctr: R, xpnt: Integer) + mergeFactors : (Factored(R),Factored(R)) -> Factored(R) mergeFactors(f,g) == makeFR(unit(f)*unit(g),append(factorList f,factorList g)) + refine : (Factored(R),(R -> Factored(R))) -> Factored(R) refine(f, func) == u := unit(f) l: List FF := empty() @@ -46811,37 +47716,50 @@ FactoringUtilities(E,OV,R,P) : C == T where (* package FACUTIL *) (* + lowerPolynomial : SparseUnivariatePolynomial(P) -> _ + SparseUnivariatePolynomial(R) lowerPolynomial(f:SUP P) : SUP R == zero? f => 0$SUP(R) monomial(ground leadingCoefficient f, degree f)$SUP(R) + lowerPolynomial(reductum f) + raisePolynomial : SparseUnivariatePolynomial(R) -> _ + SparseUnivariatePolynomial(P) raisePolynomial(u:SUP R) : SUP P == zero? u => 0$SUP(P) monomial(leadingCoefficient(u)::P, degree u)$SUP(P) + raisePolynomial(reductum u) + completeEval : (SparseUnivariatePolynomial(P),List(OV),List(R)) -> _ + SparseUnivariatePolynomial(R) completeEval(f:SUP P,lvar:List OV,lval:List R) : SUP R == zero? f => 0$SUP(R) monomial(ground eval(leadingCoefficient f,lvar,lval),degree f)$SUP(R) + completeEval(reductum f,lvar,lval) + degree : (SparseUnivariatePolynomial(P),List(OV)) -> _ + List(NonNegativeInteger) degree(f:SUP P,lvar:List OV) : List NNI == coefs := coefficients f ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar] + variables : SparseUnivariatePolynomial(P) -> List(OV) variables(f:SUP P) : List OV == "setUnion"/[variables cf for cf in coefficients f] if R has FiniteFieldCategory then + ran : Integer -> R ran(k:Z):R == random()$R else + ran : Integer -> R ran(k:Z):R == (random(2*k+1)$Z -k)::R -- Compute the normalized m derivative + normalDeriv : (SparseUnivariatePolynomial(P),Integer) -> _ + SparseUnivariatePolynomial(P) normalDeriv(f:SUP P,m:Z) : SUP P== (n1:Z:=degree f) < m => 0$SUP(P) n1=m => (leadingCoefficient f)::SUP(P) @@ -47049,29 +47967,15 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im (* package FACTEXT *) (* - up2Rat: UP -> SUP(Q) - rat2up: SUP(Q) -> UP - - factRat: UP -> Factored UP - liftPoly: (UP, K) -> UPUP - - liftDefPoly: UP -> UPUP - - norm: (UP, K) -> UP - - factParPert: ( UP,K,K) -> Factored UP - - trans: (UP, K) -> UP - - swapCoefWithVar: ( UP , NNI) -> UPUP - - frRat2frUP: Factored SUP(Q) -> Factored UP - + factor : (SparseUnivariatePolynomial(K),K) -> _ + Factored(SparseUnivariatePolynomial(K)) factor(pol,a)== polSF:= squareFree pol reduce("*" , [ factorSqFree(fr.fctr,a)**(fr.xpnt pretend NNI) _ for fr in factorList polSF] , 1) + factorSqFree : (SparseUnivariatePolynomial(K),K) -> _ + Factored(SparseUnivariatePolynomial(K)) factorSqFree(pol,a)== ratPol:SUP(Q) aa:Q @@ -47094,6 +47998,7 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im L := L * factParPert( G, a, a ) L + factParPert: ( UP,K,K) -> Factored UP factParPert(pol, a, b)== polt:=trans(pol,b) frpol:= factorList factor(polt,a) @@ -47103,6 +48008,7 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im for p in slt for fr in frpol ] reduce("*" , nfrpol) + frRat2frUP: Factored SUP(Q) -> Factored UP frRat2frUP(fr)== frpol:= factorList fr sl:= [ fr.fctr for fr in frpol ] @@ -47111,36 +48017,42 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im for p in slt for fr in frpol ] reduce("*" , nfrpol) + up2Rat: UP -> SUP(Q) up2Rat(pol)== zero?(pol) => 0 d:=degree pol a:Q:= retract(leadingCoefficient pol)@Q monomial(a,d)$SUP(Q) + up2Rat(reductum pol) + rat2up: SUP(Q) -> UP rat2up(pol)== zero?(pol) => 0 d:=degree pol a:K:=(leadingCoefficient pol) :: K monomial(a,d)$UP + rat2up(reductum pol) + trans: (UP, K) -> UP trans(pol,a)== zero? pol => 0 lc:=leadingCoefficient pol d:=degree pol lc*(monomial(1,1)$UP + monomial(-a ,0)$UP)**d + trans(reductum pol ,a) + liftDefPoly: UP -> UPUP liftDefPoly(pol)== zero?(pol) => 0 lc:= leadingCoefficient pol d:= degree pol monomial( monomial(lc,0)$UP , d )$UPUP + liftDefPoly reductum pol + norm: (UP, K) -> UP norm(pol,a)== lpol:=liftPoly(pol,a) defPol:=definingPolynomial a ldefPol:=liftDefPoly defPol resultant(ldefPol,lpol) + swapCoefWithVar: ( UP , NNI) -> UPUP swapCoefWithVar(coef,n)== ground? coef => monomial( monomial( retract coef , n)$SUP(K) , 0)$UPUP @@ -47149,6 +48061,7 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im monomial(monomial(lcoef,n)$SUP(K),d)$UPUP+_ swapCoefWithVar(reductum coef,n ) + liftPoly: (UP, K) -> UPUP liftPoly(pol,a)== zero? pol => 0 lcoef:=leadingCoefficient pol @@ -47348,30 +48261,16 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports == (* package FACTRN *) (* - up2Rat: UP -> SUP(Q) - rat2up: SUP(Q) -> UP - - factRat: UP -> Factored UP - liftPoly: (UP, K) -> UPUP - - liftDefPoly: UP -> UPUP - - norm: (UP, K) -> UP - - factParPert: ( UP,K,K) -> Factored UP - - trans: (UP, K) -> UP - - swapCoefWithVar: ( UP , NNI) -> UPUP - - frRat2frUP: Factored SUP(Q) -> Factored UP - + factor : (SparseUnivariatePolynomial(K),K) -> _ + Factored(SparseUnivariatePolynomial(K)) factor(pol,a)== polSF:= squareFree pol reduce("*" , _ [ factorSqFree(fr.fctr,a)**(fr.xpnt pretend NNI) _ for fr in factorList polSF] , 1) + factorSqFree : (SparseUnivariatePolynomial(K),K) -> _ + Factored(SparseUnivariatePolynomial(K)) factorSqFree(pol,a)== ratPol:SUP(Q) ground? a => @@ -47392,6 +48291,7 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports == L := L * factParPert( G, a, a ) L + factParPert: ( UP,K,K) -> Factored UP factParPert(pol, a, b)== polt:=trans(pol,b) frpol:= factorList factor(polt,a) @@ -47401,6 +48301,7 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports == for p in slt for fr in frpol ] reduce("*" , nfrpol) + frRat2frUP: Factored SUP(Q) -> Factored UP frRat2frUP(fr)== frpol:= factorList fr sl:= [ fr.fctr for fr in frpol ] @@ -47409,18 +48310,21 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports == for p in slt for fr in frpol ] reduce("*" , nfrpol) + up2Rat: UP -> SUP(Q) up2Rat(pol)== zero?(pol) => 0 d:=degree pol a:Q:= retract(leadingCoefficient pol)@Q monomial(a,d)$SUP(Q) + up2Rat(reductum pol) + rat2up: SUP(Q) -> UP rat2up(pol)== zero?(pol) => 0 d:=degree pol a:K:=(leadingCoefficient pol) :: K monomial(a,d)$UP + rat2up(reductum pol) + trans: (UP, K) -> UP trans(pol,a)== zero? pol => 0 lc:=leadingCoefficient pol @@ -47428,18 +48332,21 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports == lc*( monomial(1,1)$UP + monomial(-a,0)$UP )**d + trans(reductum pol , a) + liftDefPoly: UP -> UPUP liftDefPoly(pol)== zero?(pol) => 0 lc:= leadingCoefficient pol d:= degree pol monomial( monomial(lc,0)$UP , d )$UPUP + liftDefPoly reductum pol + norm: (UP, K) -> UP norm(pol,a)== lpol:=liftPoly(pol,a) defPol:=definingPolynomial a ldefPol:=liftDefPoly defPol resultant(ldefPol,lpol) + swapCoefWithVar: ( UP , NNI) -> UPUP swapCoefWithVar(coef,n)== ground? coef => monomial( monomial( retract coef , n)$SUP(K) , 0)$UPUP @@ -47448,6 +48355,7 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports == monomial( monomial(lcoef, n )$SUP(K) , d)$UPUP + _ swapCoefWithVar( reductum coef, n ) + liftPoly: (UP, K) -> UPUP liftPoly(pol,a)== zero? pol => 0 lcoef:=leadingCoefficient pol @@ -47604,6 +48512,7 @@ FGLMIfCanPackage(R,ls): Exports == Implementation where (* package FGLMICPK *) (* + zeroDim? : List Q2 -> Boolean zeroDim?(lq2: List Q2): Boolean == lq2 := groebner(lq2)$groebnerpack2 empty? lq2 => false @@ -47616,10 +48525,12 @@ FGLMIfCanPackage(R,ls): Exports == Implementation where lv := remove(x, lv) empty? lv + zeroDimensional? : List(Polynomial(R)) -> Boolean zeroDimensional?(lq1: List(Q1)): Boolean == lq2: List(Q2) := [pToHdmp(q1)$poltopol for q1 in lq1] zeroDim?(lq2) + fglmIfCan : List(Polynomial(R)) -> Union(List(Polynomial(R)),"failed") fglmIfCan(lq1:List(Q1)): Union(List(Q1),"failed") == lq2: List(Q2) := [pToHdmp(q1)$poltopol for q1 in lq1] lq2 := groebner(lq2)$groebnerpack2 @@ -47628,6 +48539,7 @@ FGLMIfCanPackage(R,ls): Exports == Implementation where lq1 := [dmpToP(q3)$poltopol for q3 in lq3] lq1::Union(List(Q1),"failed") + groebner : List(Polynomial(R)) -> List(Polynomial(R)) groebner(lq1:List(Q1)): List(Q1) == lq2: List(Q2) := [pToHdmp(q1)$poltopol for q1 in lq1] lq2 := groebner(lq2)$groebnerpack2 @@ -47724,6 +48636,7 @@ FindOrderFinite(F, UP, UPUP, R): Exports == Implementation where (* package FORDER *) (* + order : FiniteDivisor(F,UP,UPUP,R) -> NonNegativeInteger order d == dd := d := reduce d for i in 1.. repeat @@ -47819,6 +48732,7 @@ FiniteAbelianMonoidRingFunctions2(E: OrderedAbelianMonoid, (* package FAMR2 *) (* + map : ((R1 -> R2),A1) -> A2 map(f: R1 -> R2, a: A1): A2 == if zero? a then 0$A2 else @@ -47924,6 +48838,8 @@ FiniteDivisorFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2): import FractionalIdealFunctions2(UP1, Fraction UP1, UPUP1, F1, UP2, Fraction UP2, UPUP2, F2) + map : ((R1 -> R2),FiniteDivisor(R1,UP1,UPUP1,F1)) -> _ + FiniteDivisor(R2,UP2,UPUP2,F2) map(f, d) == rec := decompose d divisor map(f, rec.principalPart) + @@ -48241,6 +49157,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, PP := PP * PP rem R return Q + pPowers : PolK -> PrimitiveArray(PolK) pPowers(P : PolK) : PrimitiveArray(PolK) == -- P is monic n := degree(P) result : PrimitiveArray(PolK) := new(n, 1) @@ -48248,6 +49165,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, for i in 2 .. n-1 repeat (Qi := Qi*Q rem P ; result(i) := Qi) return result + pExp : (PolK,PrimitiveArray(PolK)) -> PolK pExp(Q : PolK, Xpowers : PrimitiveArray(PolK)) : PolK == Q' : PolK := 0 while Q ^= 0 repeat @@ -48255,6 +49173,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, Q := reductum(Q) return Q' + pTrace : (PolK,NonNegativeInteger,PolK,PrimitiveArray(PolK)) -> PolK pTrace(Q : PolK, d : NonNegativeInteger, P : PolK, Xpowers : PrimitiveArray(PolK)) : PolK == Q : PolK := Q rem P @@ -48262,6 +49181,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, for i in 1 .. d-1 repeat result := Q + pExp(result, Xpowers) return result rem P + random : NonNegativeInteger -> PolK random(n : NonNegativeInteger) : PolK == repeat if (deg := (random(n)$Integer)::NonNegativeInteger) > 0 then leave @@ -48271,15 +49191,15 @@ FiniteFieldFactorization(K : FiniteFieldCategory, monomial(x, deg) + +/[monomial(random()$K, i) for i in 0 .. deg-1] return result + internalFactorCZ : (PolK,NonNegativeInteger,PrimitiveArray(PolK)) -> _ + List(PolK) internalFactorCZ(P : PolK, -- P monic-squarefree d:NonNegativeInteger, Xpowers:PrimitiveArray(PolK)) : List(PolK) == - listOfFactors : List(PolK) := [P] degree(P) = d => return listOfFactors result : List(PolK) := [] pDim : NonNegativeInteger := d * primeKdim Q : PolK := P - repeat G := pTrace(random(degree(Q)), pDim, Q, Xpowers) if p > 2 then G := exp(G, p', Q) - 1 @@ -48295,6 +49215,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, Q := first(listOfFactors) return result + internalFactorSquareFree : PolK -> List(PolK) internalFactorSquareFree(P : PolK):List(PolK) == -- P is monic-squareFree degree(P) = 1 => [P] result : List(PolK) := [] @@ -48312,6 +49233,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, else if i >= degree(P) quo 2 then return cons(P, result) for j in 1 .. primeKdim repeat S := pExp(S, Xpowers) + internalFactor : (PolK,PolK -> Factored(PolK)) -> Factored(PolK) internalFactor(P:PolK, sqrfree:PolK -> Factored(PolK)) : Factored(PolK) == result : Factored(PolK) if (d := minimumDegree(P)) > 0 then @@ -48328,23 +49250,29 @@ FiniteFieldFactorization(K : FiniteFieldCategory, result:= result * */[primeFactor(Q, x.exponent) for Q in xFactors] return lcP::PolK * result + factorUsingYun : PolK -> Factored(PolK) factorUsingYun(P : PolK) : Factored(PolK) == internalFactor(P, Yun) + factorUsingMusser : PolK -> Factored(PolK) factorUsingMusser(P : PolK) : Factored(PolK) == internalFactor(P, Musser) + factor : PolK -> Factored(PolK) factor(P : PolK) : Factored(PolK) == factorUsingYun(P) + factorSquareFree : PolK -> List(PolK) factorSquareFree(P : PolK) : List(PolK) == degree(P) = 0 => [] discriminant(P) = 0 => error("factorSquareFree : non quadratfrei") if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P return internalFactorSquareFree(P) + factorCantorZassenhaus : (PolK,NonNegativeInteger) -> List(PolK) factorCantorZassenhaus(P : PolK, d : NonNegativeInteger) : List(PolK) == if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P degree(P) = 1 => [P] return internalFactorCZ(P, d, pPowers(P)) + qExp : (PolK,PrimitiveArray(PolK)) -> PolK qExp(Q : PolK, XqPowers : PrimitiveArray(PolK)) : PolK == Q' : PolK := 0 while Q ^= 0 repeat @@ -48352,6 +49280,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, Q := reductum(Q) return Q' + qPowers : (PolK,PolK) -> PrimitiveArray(PolK) qPowers (Xq : PolK, P : PolK) : PrimitiveArray(PolK) == -- Xq = X**q mod P n := degree(P) result : PrimitiveArray(PolK) := new(n, 1) @@ -48359,11 +49288,13 @@ FiniteFieldFactorization(K : FiniteFieldCategory, for i in 2 .. n-1 repeat (Q := Q*Xq rem P ; result(i) := Q) return result + discriminantTest? : PolK -> Boolean discriminantTest?(P : PolK) : Boolean == (delta : K := discriminant(P)) = 0 => true StickelbergerTest : Boolean := (delta ** q' = 1) = even?(degree(P)) return StickelbergerTest + evenCharacteristicIrreducible? : PolK -> Boolean evenCharacteristicIrreducible?(P : PolK) : Boolean == (n := degree(P)) = 0 => false n = 1 => true @@ -48381,6 +49312,7 @@ FiniteFieldFactorization(K : FiniteFieldCategory, return false return true + oddCharacteristicIrreducible? : PolK -> Boolean oddCharacteristicIrreducible?(P : PolK) : Boolean == (n := degree(P)) = 0 => false n = 1 => true @@ -48400,10 +49332,12 @@ FiniteFieldFactorization(K : FiniteFieldCategory, if p = 2 then + irreducible? : PolK -> Boolean irreducible?(P : PolK) : Boolean == evenCharacteristicIrreducible?(P) else + irreducible? : PolK -> Boolean irreducible?(P : PolK) : Boolean == oddCharacteristicIrreducible?(P) *) @@ -48729,6 +49663,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, while q_quo_p > 1 repeat (e := e + 1 ; q_quo_p := q_quo_p quo p) e + initialize() -> Void() initialize(): Void() == q : NonNegativeInteger := size()$K q' : NonNegativeInteger := q quo 2 -- used for odd q : (q-1)/2 @@ -48737,6 +49672,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, while q_quo_p > 1 repeat (e := e + 1 ; q_quo_p := q_quo_p quo p) e + exp : (PolK,NonNegativeInteger,PolK) -> PolK exp(P : PolK, n : NonNegativeInteger, R : PolK) : PolK == PP : PolK := P rem R ; Q : PolK := 1 repeat @@ -48745,6 +49681,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, PP := PP * PP rem R return Q + pPowers : PolK -> PrimitiveArray(PolK) pPowers(P : PolK) : PrimitiveArray(PolK) == -- P is monic n := degree(P) result : PrimitiveArray(PolK) := new(n, 1) @@ -48752,6 +49689,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, for i in 2 .. n-1 repeat (Qi := Qi*Q rem P ; result(i) := Qi) return result + pExp : (PolK,PrimitiveArray(PolK)) -> PolK pExp(Q : PolK, Xpowers : PrimitiveArray(PolK)) : PolK == Q' : PolK := 0 while Q ^= 0 repeat @@ -48759,6 +49697,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, Q := reductum(Q) return Q' + pTrace : (PolK,NonNegativeInteger, PolK,PrimitiveArray(PolK)) -> PolK pTrace(Q : PolK, d : NonNegativeInteger, P : PolK, Xpowers : PrimitiveArray(PolK)) : PolK == Q : PolK := Q rem P @@ -48766,6 +49705,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, for i in 1 .. d-1 repeat result := Q + pExp(result, Xpowers) return result rem P + random : NonNegativeInteger -> PolK random(n : NonNegativeInteger) : PolK == repeat if (deg := (random(n)$Integer)::NonNegativeInteger) > 0 then leave @@ -48775,9 +49715,10 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, monomial(x, deg) + +/[monomial(random()$K, i) for i in 0 .. deg-1] return result + internalFactorCZ : (PolK,NonNegativeInteger,PrimitiveArray(PolK)) -> _ + List(PolK) internalFactorCZ(P : PolK, -- P monic-squarefree d:NonNegativeInteger, Xpowers:PrimitiveArray(PolK)) : List(PolK) == - listOfFactors : List(PolK) := [P] degree(P) = d => return listOfFactors result : List(PolK) := [] @@ -48799,6 +49740,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, Q := first(listOfFactors) return result + internalFactorSquareFree : PolK -> List(PolK) internalFactorSquareFree(P:PolK):List(PolK) == -- P is monic-squareFree degree(P) = 1 => [P] result : List(PolK) := [] @@ -48816,6 +49758,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, else if i >= degree(P) quo 2 then return cons(P, result) for j in 1 .. primeKdim repeat S := pExp(S, Xpowers) + internalFactor : (PolK,PolK -> Factored(PolK)) -> Factored(PolK) internalFactor(P:PolK, sqrfree:PolK -> Factored(PolK)) : Factored(PolK) == result : Factored(PolK) if (d := minimumDegree(P)) > 0 then @@ -48832,25 +49775,31 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, result:=result * */[primeFactor(Q, x.exponent) for Q in xFactors] return lcP::PolK * result + factorUsingYun : PolK -> Factored(PolK) factorUsingYun(P : PolK) : Factored(PolK) == internalFactor(P, Yun) + factorUsingMusser : PolK -> Factored(PolK) factorUsingMusser(P : PolK) : Factored(PolK) == internalFactor(P, Musser) + factor : PolK -> Factored(PolK) factor(P : PolK) : Factored(PolK) == initialize() factorUsingYun(P) + factorSquareFree : PolK -> List(PolK) factorSquareFree(P : PolK) : List(PolK) == degree(P) = 0 => [] discriminant(P) = 0 => error("factorSquareFree : non quadratfrei") if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P return internalFactorSquareFree(P) + factorCantorZassenhaus : (PolK,NonNegativeInteger) -> List(PolK) factorCantorZassenhaus(P : PolK, d : NonNegativeInteger) : List(PolK) == if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P degree(P) = 1 => [P] return internalFactorCZ(P, d, pPowers(P)) + qExp : (PolK,PrimitiveArray(PolK)) -> PolK qExp(Q : PolK, XqPowers : PrimitiveArray(PolK)) : PolK == Q' : PolK := 0 while Q ^= 0 repeat @@ -48858,6 +49807,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, Q := reductum(Q) return Q' + qPowers : (PolK,PolK) -> PrimitiveArray(PolK) qPowers (Xq:PolK, P:PolK) : PrimitiveArray(PolK) == -- Xq = X**q mod P n := degree(P) result : PrimitiveArray(PolK) := new(n, 1) @@ -48865,11 +49815,13 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, for i in 2 .. n-1 repeat (Q := Q*Xq rem P ; result(i) := Q) return result + discriminantTest? : PolK -> Boolean discriminantTest?(P : PolK) : Boolean == (delta : K := discriminant(P)) = 0 => true StickelbergerTest : Boolean := (delta ** q' = 1) = even?(degree(P)) return StickelbergerTest + evenCharacteristicIrreducible? : PolK -> Boolean evenCharacteristicIrreducible?(P : PolK) : Boolean == (n := degree(P)) = 0 => false n = 1 => true @@ -48887,6 +49839,7 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, return false return true + oddCharacteristicIrreducible? : PolK -> Boolean oddCharacteristicIrreducible?(P : PolK) : Boolean == (n := degree(P)) = 0 => false n = 1 => true @@ -48906,10 +49859,12 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory, if p = 2 then + irreducible? : PolK -> Boolean irreducible?(P : PolK) : Boolean == evenCharacteristicIrreducible?(P) else + irreducible? : PolK -> Boolean irreducible?(P : PolK) : Boolean == oddCharacteristicIrreducible?(P) *) @@ -49220,6 +50175,9 @@ FiniteFieldFunctions(GF): Exports == Implementation where (* package FFF *) (* + createLowComplexityNormalBasis : PositiveInteger -> _ + Union(SparseUnivariatePolynomial(GF),_ + Vector(List(Record(value: GF,index: SingleInteger)))) createLowComplexityNormalBasis(n) == (u:=createLowComplexityTable(n)) case "failed" => createNormalPoly(n)$FiniteFieldPolynomialPackage(GF) @@ -49231,6 +50189,8 @@ FiniteFieldFunctions(GF): Exports == Implementation where -- Wassermann A., Konstruktion von Normalbasen, -- Bayreuther Mathematische Schriften 31 (1989),1-9. + createLowComplexityTable : PositiveInteger -> _ + Union(Vector(List(Record(value: GF,index: SingleInteger))),"failed") createLowComplexityTable(n) == q:=size()$GF -- this algorithm works only for prime fields @@ -49295,12 +50255,16 @@ FiniteFieldFunctions(GF): Exports == Implementation where qsetelt_!(multtable,i,copy l)$(V L TERM) multtable + sizeMultiplication : _ + Vector(List(Record(value:GF,index:SingleInteger))) -> NonNegativeInteger sizeMultiplication(m) == s:NNI:=0 for i in 1..#m repeat s := s + #(m.i) s + createMultiplicationTable : SparseUnivariatePolynomial(GF) -> _ + Vector(List(Record(value: GF,index: SingleInteger))) createMultiplicationTable(f:SUP) == sizeGF:NNI:=size()$GF -- the size of the ground field m:PI:=degree(f)$SUP pretend PI @@ -49347,7 +50311,8 @@ FiniteFieldFunctions(GF): Exports == Implementation where qsetelt_!(multtable,i,copy l)$(V L TERM) multtable - + createZechTable : SparseUnivariatePolynomial(GF) -> _ + PrimitiveArray(SingleInteger) createZechTable(f:SUP) == sizeGF:NNI:=size()$GF -- the size of the ground field m:=degree(f)$SUP::PI @@ -49372,6 +50337,8 @@ FiniteFieldFunctions(GF): Exports == Implementation where a:=a * primElement zechlog + createMultiplicationMatrix : _ + Vector(List(Record(value: GF,index: SingleInteger))) -> Matrix(GF) createMultiplicationMatrix(m) == n:NNI:=#m mat:M GF:=zero(n,n)$(M GF) @@ -49798,7 +50765,9 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where -- global variables =================================================== degree1:NNI:= extensionDegree()$F1 + degree2:NNI:= extensionDegree()$F2 + -- the degrees of the last extension -- a necessary condition for the one field being an subfield of @@ -49809,10 +50778,12 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where conMat1to2:M:= zero(degree2,degree1)$M -- conversion Matix for the conversion direction F1 -> F2 + conMat2to1:M:= zero(degree1,degree2)$M -- conversion Matix for the conversion direction F2 -> F1 repType1:=representationType()$F1 + repType2:=representationType()$F2 -- the representation types of the fields @@ -49820,27 +50791,14 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where -- gets false after initialization defPol1:=definingPolynomial()$F1 + defPol2:=definingPolynomial()$F2 -- the defining polynomials of the fields -- functions ========================================================== - compare: (SUP GF,SUP GF) -> Boolean -- compares two polynomials - - convertWRTsameDefPol12: F1 -> F2 - convertWRTsameDefPol21: F2 -> F1 - -- homomorphism if the last extension of F1 and F2 was build up - -- using the same defining polynomials - - convertWRTdifferentDefPol12: F1 -> F2 - convertWRTdifferentDefPol21: F2 -> F1 - -- homomorphism if the last extension of F1 and F2 was build up - -- with different defining polynomials - - initialize: () -> Void - -- computes the conversion matrices - + compare: (SUP GF,SUP GF) -> Boolean compare(g:(SUP GF),f:(SUP GF)) == degree(f)$(SUP GF) >$NNI degree(g)$(SUP GF) => true degree(f)$(SUP GF) <$NNI degree(g)$(SUP GF) => false @@ -49856,6 +50814,8 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where equal=1 => true false + -- computes the conversion matrices + initialize: () -> Void initialize() == -- 1) in the case of equal def. polynomials initialize is called only -- if one of the rep. types is "normal" and the other one is "polynomial" @@ -50020,12 +50980,17 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where init? := false void()$Void + coerce : F1 -> F2 coerce(x:F1) == inGroundField?(x)$F1 => retract(x)$F1 :: F2 -- if x is already in GF then we can use a simple coercion defPol1 =$(SUP GF) defPol2 => convertWRTsameDefPol12(x) convertWRTdifferentDefPol12(x) + + -- homomorphism if the last extension of F1 and F2 was build up + -- using the same defining polynomials + convertWRTsameDefPol12: F1 -> F2 convertWRTsameDefPol12(x:F1) == repType1 = repType2 => x pretend F2 -- same groundfields, same defining polynomials, same @@ -50046,6 +51011,9 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where -- here a conversion matrix is necessary, (see initialize()) represents(conMat1to2 *$(Matrix GF) coordinates(x)$F1)$F2 + -- homomorphism if the last extension of F1 and F2 was build up + -- with different defining polynomials + convertWRTdifferentDefPol12: F1 -> F2 convertWRTdifferentDefPol12(x:F1) == if init? then initialize() -- if we want to convert into a 'smaller' field, we have to test, @@ -50059,12 +51027,14 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where -- the three functions below equal the three functions above up to -- '1' exchanged by '2' in all domain and variable names + coerce : F2 -> F1 coerce(x:F2) == inGroundField?(x)$F2 => retract(x)$F2 :: F1 -- if x is already in GF then we can use a simple coercion defPol1 =$(SUP GF) defPol2 => convertWRTsameDefPol21(x) convertWRTdifferentDefPol21(x) + convertWRTsameDefPol21: F2 -> F1 convertWRTsameDefPol21(x:F2) == repType1 = repType2 => x pretend F1 -- same groundfields, same defining polynomials, @@ -50080,6 +51050,7 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where if init? then initialize() represents(conMat2to1 *$(Matrix GF) coordinates(x)$F2)$F1 + convertWRTdifferentDefPol21: F2 -> F1 convertWRTdifferentDefPol21(x:F2) == if init? then initialize() if degree2 > degree1 then @@ -51127,26 +52098,20 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where sizeGF : PI := size()$GF :: PI + revListToSUP : Repr -> SUP revListToSUP(l:Repr):SUP == newl:Repr := empty() -- cannot use map since copy for Record is an XLAM for t in l repeat newl := cons(copy t, newl) newl pretend SUP + listToSUP : Repr -> SUP listToSUP(l:Repr):SUP == newl:Repr := [copy t for t in l] newl pretend SUP - nextSubset : (L NNI, NNI) -> Union(L NNI, "failed") - -- for a list s of length m with 1 <= s.1 < ... < s.m <= bound, - -- nextSubset(s, bound) yields the immediate successor of s - -- (resp. "failed" if s = [1,...,bound]) - -- where s < t if and only if: - -- (i) #s < #t; or - -- (ii) #s = #t and s < t in the lexicographical order; - -- (we have chosen to fix the signature with NNI instead of PI - -- to avoid coercions in the main functions) - + reducedQPowers : SparseUnivariatePolynomial(GF) -> _ + PrimitiveArray(SparseUnivariatePolynomial(GF)) reducedQPowers(f) == m:PI:=degree(f)$SUP pretend PI m1:I:=m-1 @@ -51171,6 +52136,8 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where qexp.i:=(h:=g) qexp + leastAffineMultiple : SparseUnivariatePolynomial(GF) -> _ + SparseUnivariatePolynomial(GF) leastAffineMultiple(f) == -- [LS] p.112 qexp:=reducedQPowers(f) @@ -51198,6 +52165,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where (coeffVector(1)::SUP) +(+/[monomial(coeffVector.k, _ sizeGF**((k-2)::NNI))$SUP for k in 2..dim]) + numberOfIrreduciblePoly : PositiveInteger -> PositiveInteger numberOfIrreduciblePoly n == -- we compute the number Nq(n) of monic irreducible polynomials -- of degree n over the field GF of order q by the formula @@ -51216,12 +52184,14 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where lastd := d (sum quo n) :: PI + numberOfPrimitivePoly : PositiveInteger -> PositiveInteger numberOfPrimitivePoly n == (eulerPhi((sizeGF ** n) - 1) quo n) :: PI -- [each root of a primitive polynomial of degree n over a field -- with q elements is a generator of the multiplicative group -- of a field of order q**n (definition), and the number of such -- generators is precisely eulerPhi(q**n - 1)] + numberOfNormalPoly : PositiveInteger -> PositiveInteger numberOfNormalPoly n == -- we compute the number Nq(n) of normal polynomials of degree n -- in GF[X], with GF of order q, by the formula @@ -51263,6 +52233,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where ((qe - 1) ** ((eulerPhi(d) quo e) pretend PI) ) pretend PI (q**((n-m) pretend PI) * prod quo n) pretend PI + primitive? : SparseUnivariatePolynomial(GF) -> Boolean primitive? f == -- let GF be a field of order q; a monic polynomial f in GF[X] -- of degree n is primitive over GF if and only if its constant @@ -51292,6 +52263,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where lift(x ** expt)$MM = 1 => return false true + normal? : SparseUnivariatePolynomial(GF) -> Boolean normal? f == -- let GF be a field with q elements; a monic irreducible -- polynomial f in GF[X] of degree n is normal if its roots @@ -51307,6 +52279,15 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where rank(matrix(l)$Matrix(GF)) = n => true false + -- for a list s of length m with 1 <= s.1 < ... < s.m <= bound, + -- nextSubset(s, bound) yields the immediate successor of s + -- (resp. "failed" if s = [1,...,bound]) + -- where s < t if and only if: + -- (i) #s < #t; or + -- (ii) #s = #t and s < t in the lexicographical order; + -- (we have chosen to fix the signature with NNI instead of PI + -- to avoid coercions in the main functions) + nextSubset : (L NNI, NNI) -> Union(L NNI, "failed") nextSubset(s, bound) == m : NNI := #(s) m = 0 => [1] @@ -51335,6 +52316,8 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where s := cons(j, s) -- initial part of s s + nextIrreduciblePoly : SparseUnivariatePolynomial(GF) -> _ + Union(SparseUnivariatePolynomial(GF),"failed") nextIrreduciblePoly f == n : NNI := degree f n = 0 => error "polynomial must have positive degree" @@ -51412,6 +52395,8 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where s1 := rest s1 headpol := cons([0, 0]$Rec, headpol) + nextPrimitivePoly : SparseUnivariatePolynomial(GF) -> _ + Union(SparseUnivariatePolynomial(GF),"failed") nextPrimitivePoly f == n : NNI := degree f n = 0 => error "polynomial must have positive degree" @@ -51531,6 +52516,8 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where c := index(l :: PI)$GF "failed" + nextNormalPoly : SparseUnivariatePolynomial(GF) -> _ + Union(SparseUnivariatePolynomial(GF),"failed") nextNormalPoly f == n : NNI := degree f n = 0 => error "polynomial must have positive degree" @@ -51644,6 +52631,8 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where a := index(l :: PI)$GF "failed" + nextNormalPrimitivePoly : SparseUnivariatePolynomial(GF) -> _ + Union(SparseUnivariatePolynomial(GF),"failed") nextNormalPrimitivePoly f == n : NNI := degree f n = 0 => error "polynomial must have positive degree" @@ -51784,8 +52773,11 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where a := 1$GF "failed" + nextPrimitiveNormalPoly : SparseUnivariatePolynomial(GF) -> _ + Union(SparseUnivariatePolynomial(GF),"failed") nextPrimitiveNormalPoly f == nextNormalPrimitivePoly f + createIrreduciblePoly : PositiveInteger -> SparseUnivariatePolynomial(GF) createIrreduciblePoly n == x := monomial(1,1)$SUP n = 1 => x @@ -51795,6 +52787,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where odd? n => nextIrreduciblePoly(xn + 1) :: SUP nextIrreduciblePoly(xn) :: SUP + createPrimitivePoly : PositiveInteger -> SparseUnivariatePolynomial(GF) createPrimitivePoly n == -- (see also the comments in the code of nextPrimitivePoly) xn := monomial(1,n)$SUP @@ -51830,6 +52823,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where -- coefficients f_i, i = 1,...,n-1 nextPrimitivePoly(xn + monomial(c0, 0)$SUP) :: SUP + createNormalPoly : PositiveInteger -> SparseUnivariatePolynomial(GF) createNormalPoly n == n = 1 => monomial(1,1)$SUP + monomial(-1,0)$SUP -- get a normal polynomial f = X**n + a * X**(n-1) + ... @@ -51842,6 +52836,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where nextNormalPoly(monomial(1,n)$SUP + monomial(-1, (n-1) :: NNI)$SUP) :: SUP + createNormalPrimitivePoly:PositiveInteger -> SparseUnivariatePolynomial(GF) createNormalPrimitivePoly n == xn := monomial(1,n)$SUP n = 1 => xn + monomial(-primitiveElement()$GF, 0)$SUP @@ -51861,8 +52856,10 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where normal? pol and primitive? pol => pol nextNormalPrimitivePoly(pol) :: SUP + createPrimitiveNormalPoly:PositiveInteger -> SparseUnivariatePolynomial(GF) createPrimitiveNormalPoly n == createNormalPrimitivePoly n + random : PositiveInteger -> SparseUnivariatePolynomial(GF) random n == polRepr : Repr := [] n1 : NNI := (n - 1) :: NNI @@ -51871,6 +52868,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where polRepr := cons([i, c]$Rec, polRepr) cons([n, 1$GF]$Rec, polRepr) pretend SUP + random: (PositiveInteger,PositiveInteger) -> SparseUnivariatePolynomial(GF) random(m,n) == if m > n then (m,n) := (n,m) d : NNI := (n - m) :: NNI @@ -52054,6 +53052,7 @@ FiniteFieldPolynomialPackage2(F,GF):Exports == Implementation where -- we use berlekamps trace algorithm -- it is not checked whether the polynomial is irreducible over GF]] + rootOfIrreduciblePoly : SparseUnivariatePolynomial(GF) -> F rootOfIrreduciblePoly(pf) == sizeGF:=size()$GF -- if the polynomial is of degree one, we're ready @@ -52219,6 +53218,7 @@ FiniteFieldSolveLinearPolynomialEquation(F:FiniteFieldCategory, p: FPP import DistinctDegreeFactorize(F,FP) + solveLinearPolynomialEquation:(List(FPP),FPP) -> Union(List(FPP),"failed") solveLinearPolynomialEquation(lp,p) == if (oldlp ^= lp) then -- we have to generate a new table @@ -52398,18 +53398,20 @@ FiniteFieldSquareFreeDecomposition (K : FiniteFieldCategory, (* p : NonNegativeInteger := characteristic()$K + tableOfSquareFreePolynomials := Table (Integer, PolK) + oneYunStep2uple := Record ( simpleDecomposition : tableOfSquareFreePolynomials, gcdOfArgumentAndDerivative : PolK ) + rawMusser : PolK -> Factored(PolK) rawMusser (P : PolK) : Factored(PolK) == Q : PolK := gcd(P, D(P)) A : PolK := P quo Q decomposition : Factored(PolK) := 1 B : PolK - for i in 1 .. repeat if i rem p ^= 0 then B := gcd(A, Q) @@ -52421,17 +53423,18 @@ FiniteFieldSquareFreeDecomposition (K : FiniteFieldCategory, decomposition:=decomposition * rawMusser (charthRoot(Q)::PolK) ** p return decomposition + Musser : PolK -> Factored(PolK) Musser (P : PolK) : Factored(PolK) == degree (P) = 0 => return P::Factored(PolK) if (lcP : K := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P return lcP::PolK * rawMusser (P) + oneYunStep : PolK -> oneYunStep2uple oneYunStep (P : PolK) : oneYunStep2uple == C : PolK := D (P) ; A : PolK := gcd(P, C) gcd_P_P' : PolK := A ; B : PolK := P quo A result : tableOfSquareFreePolynomials := empty () i : Integer := 1 - repeat C := (C quo A) - D(B) if C = 0 then leave @@ -52443,22 +53446,20 @@ FiniteFieldSquareFreeDecomposition (K : FiniteFieldCategory, result (i) := B return [result, gcd_P_P'] + rawYun : PolK -> tableOfSquareFreePolynomials rawYun (P : PolK) : tableOfSquareFreePolynomials == u : oneYunStep2uple := oneYunStep (P) gcd_P_P' : PolK := u.gcdOfArgumentAndDerivative U : tableOfSquareFreePolynomials := u.simpleDecomposition - R : PolK := gcd_P_P' for j in indices (U) repeat for k in 1 .. j-1 repeat R := R quo U(j) if R = 1 then return U V : tableOfSquareFreePolynomials := rawYun (charthRoot (R)::PolK) - result : tableOfSquareFreePolynomials := empty () gcd_Uj_Vk : PolK ; for k in indices (V) repeat -- boucle 1 - for j in indices (U) | not (U(j) = 1) repeat -- boucle 2 gcd_Uj_Vk := gcd (U(j), V(k)) if not (gcd_Uj_Vk = 1) then @@ -52466,15 +53467,13 @@ FiniteFieldSquareFreeDecomposition (K : FiniteFieldCategory, V (k) := V(k) quo gcd_Uj_Vk U (j) := U(j) quo gcd_Uj_Vk if V(k) = 1 then leave - if not (V(k) = 1) then result (p*k):= V (k) - for j in indices (U) | not (U(j) = 1) repeat -- boucle 3 result (j) := U (j) - return result + Yun : PolK -> Factored(PolK) Yun(P : PolK) : Factored(PolK) == degree (P) = 0 => P::Factored(PolK) if (lcP := leadingCoefficient (P)) ^= 1 then P := inv (lcP)*P @@ -52672,6 +53671,7 @@ FiniteLinearAggregateFunctions2(S, A, R, B): if A has ListAggregate(S) then -- A is a list-oid + reduce : (((S,R) -> R),A,R) -> R reduce(fn, l, ident) == empty? l => ident reduce(fn, rest l, fn(first l, ident)) @@ -52679,8 +53679,10 @@ FiniteLinearAggregateFunctions2(S, A, R, B): if B has ListAggregate(R) or not(B has shallowlyMutable) then -- A is a list-oid, and B is either list-oids or not mutable + map : ((S -> R),A) -> B map(f, l) == construct [f s for s in entries l] + scan : (((S,R) -> R),A,R) -> B scan(fn, l, ident) == empty? l => empty() val := fn(first l, ident) @@ -52688,11 +53690,13 @@ FiniteLinearAggregateFunctions2(S, A, R, B): else -- A is a list-oid, B a mutable array-oid + map : ((S -> R),A) -> B map(f, l) == i := minIndex(w := new(#l,NIL$Lisp)$B) for a in entries l repeat (qsetelt_!(w, i, f a); i := inc i) w + scan : (((S,R) -> R),A,R) -> B scan(fn, l, ident) == i := minIndex(w := new(#l,NIL$Lisp)$B) vl := ident @@ -52703,6 +53707,7 @@ FiniteLinearAggregateFunctions2(S, A, R, B): else -- A is an array-oid + reduce : (((S,R) -> R),A,R) -> R reduce(fn, v, ident) == val := ident for i in minIndex v .. maxIndex v repeat @@ -52711,9 +53716,11 @@ FiniteLinearAggregateFunctions2(S, A, R, B): if B has ListAggregate(R) then -- A is an array-oid, B a list-oid + map : ((S -> R),A) -> B map(f, v) == construct [f qelt(v, i) for i in minIndex v .. maxIndex v] + scan : (((S,R) -> R),A,R) -> B scan(fn, v, ident) == w := empty()$B for i in minIndex v .. maxIndex v repeat @@ -52725,12 +53732,14 @@ FiniteLinearAggregateFunctions2(S, A, R, B): if B has shallowlyMutable then -- B is also mutable + map : ((S -> R),A) -> B map(f, v) == w := new(#v,NIL$Lisp)$B for i in minIndex w .. maxIndex w repeat qsetelt_!(w, i, f qelt(v, i)) w + scan : (((S,R) -> R),A,R) -> B scan(fn, v, ident) == w := new(#v,NIL$Lisp)$B vl := ident @@ -52740,9 +53749,11 @@ FiniteLinearAggregateFunctions2(S, A, R, B): else -- B non mutable array-oid + map : ((S -> R),A) -> B map(f, v) == construct [f qelt(v, i) for i in minIndex v .. maxIndex v] + scan : (((S,R) -> R),A,R) -> B scan(fn, v, ident) == w := empty()$B for i in minIndex v .. maxIndex v repeat @@ -52916,12 +53927,10 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where (* package FLASORT *) (* - siftUp : ((S, S) -> B, V, I, I) -> Void - partition: ((S, S) -> B, V, I, I, I) -> I - QuickSort: ((S, S) -> B, V, I, I) -> V - + quickSort : (((S,S) -> Boolean),V) -> V quickSort(l, r) == QuickSort(l, r, minIndex r, maxIndex r) + siftUp : ((S, S) -> B, V, I, I) -> Void siftUp(l, r, i, n) == t := qelt(r, i) while (j := 2*i+1) < n repeat @@ -52932,6 +53941,7 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where i := j else leave + heapSort : (((S,S) -> Boolean),V) -> V heapSort(l, r) == not zero? minIndex r => error "not implemented" n := (#r)::I @@ -52941,6 +53951,7 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where siftUp(l, r, 0, k) r + partition: ((S, S) -> B, V, I, I, I) -> I partition(l, r, i, j, k) == -- partition r[i..j] such that r.s <= r.k <= r.t x := qelt(r, k) @@ -52955,6 +53966,7 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where qsetelt_!(r, j, x) j + QuickSort: ((S, S) -> B, V, I, I) -> V QuickSort(l, r, i, j) == n := j - i if (n = 1) and l(qelt(r, j), qelt(r, i)) then swap_!(r, i, j) @@ -52964,6 +53976,7 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where QuickSort(l, r, i, k - 1) QuickSort(l, r, k + 1, j) + shellSort : (((S,S) -> Boolean),V) -> V shellSort(l, r) == m := minIndex r n := maxIndex r @@ -53097,12 +54110,15 @@ FiniteSetAggregateFunctions2(S, A, R, B): Exports == Implementation where (* package FSAGG2 *) (* + map : ((S -> R),A) -> B map(fn, a) == set(map(fn, parts a)$ListFunctions2(S, R))$B + reduce : (((S,R) -> R),A,R) -> R reduce(fn, a, ident) == reduce(fn, parts a, ident)$ListFunctions2(S, R) + scan : (((S,R) -> R),A,R) -> B scan(fn, a, ident) == set(scan(fn, parts a, ident)$ListFunctions2(S, R))$B @@ -53289,16 +54305,22 @@ FloatingComplexPackage(Par): Cat == Cap where (* -- find the complex zeros of an univariate polynomial -- + complexRoots : (Fraction(Polynomial(Complex(Integer))),Par) -> _ + List(Complex(Par)) complexRoots(q:FPK,eps:Par) : L C Par == p:=numer q complexZeros(univariate p,eps)$ComplexRootPackage(SUP GI, Par) -- find the complex zeros of an univariate polynomial -- + complexRoots : (List(Fraction(Polynomial(Complex(Integer)))),_ + List(Symbol),Par) -> List(List(Complex(Par))) complexRoots(lp:L FPK,lv:L SE,eps:Par) : L L C Par == lnum:=[numer p for p in lp] lden:=[dp for p in lp |(dp:=denom p)^=1] innerSolve(lnum,lden,lv,eps)$INFSP(K,C Par,Par) + complexSolve : (List(Fraction(Polynomial(Complex(Integer)))),Par) -> _ + List(List(Equation(Polynomial(Complex(Par))))) complexSolve(lp:L FPK,eps : Par) : L L EQ P C Par == lnum:=[numer p for p in lp] lden:=[dp for p in lp |(dp:=denom p)^=1] @@ -53308,6 +54330,8 @@ FloatingComplexPackage(Par): Cat == Cap where [[equation(x::(P C Par),r::(P C Par)) for x in lv for r in nres] for nres in innerSolve(lnum,lden,lv,eps)$INFSP(K,C Par,Par)] + complexSolve: (List(Equation(Fraction(Polynomial(Complex(Integer))))),_ + Par) -> List(List(Equation(Polynomial(Complex(Par))))) complexSolve(le:L EQ FPK,eps : Par) : L L EQ P C Par == lp:=[lhs ep - rhs ep for ep in le] lnum:=[numer p for p in lp] @@ -53318,12 +54342,16 @@ FloatingComplexPackage(Par): Cat == Cap where [[equation(x::(P C Par),r::(P C Par)) for x in lv for r in nres] for nres in innerSolve(lnum,lden,lv,eps)$INFSP(K,C Par,Par)] + complexSolve : (Fraction(Polynomial(Complex(Integer))),Par) -> _ + List(Equation(Polynomial(Complex(Par)))) complexSolve(p : FPK,eps : Par) : L EQ P C Par == (mvar := mainVariable numer p ) case "failed" => error "no variable found" x:P C Par:=mvar::SE::(P C Par) [equation(x,val::(P C Par)) for val in complexRoots(p,eps)] + complexSolve:(Equation(Fraction(Polynomial(Complex(Integer)))),Par) ->_ + List(Equation(Polynomial(Complex(Par)))) complexSolve(eq : EQ FPK,eps : Par) : L EQ P C Par == complexSolve(lhs eq - rhs eq,eps) @@ -53507,19 +54535,25 @@ FloatingRealPackage(Par): Cat == Cap where (* package FLOATRP *) (* + makeEq : (L Par,L SE) -> L EQ P Par makeEq(nres:L Par,lv:L SE) : L EQ P Par == [equation(x::(P Par),r::(P Par)) for x in lv for r in nres] -- find the real zeros of an univariate rational polynomial -- + realRoots : (Fraction(Polynomial(Integer)),Par) -> List(Par) realRoots(p:RFI,eps:Par) : L Par == innerSolve1(numer p,eps)$INFSP(I,Par,Par) -- real zeros of the system of polynomial lp -- + realRoots : (List(Fraction(Polynomial(Integer))),List(Symbol),Par) ->_ + List(List(Par)) realRoots(lp:L RFI,lv:L SE,eps: Par) : L L Par == lnum:=[numer p for p in lp] lden:=[dp for p in lp |(dp:=denom p)^=1] innerSolve(lnum,lden,lv,eps)$INFSP(I,Par,Par) + solve : (List(Fraction(Polynomial(Integer))),Par) -> _ + List(List(Equation(Polynomial(Par)))) solve(lp:L RFI,eps : Par) : L L EQ P Par == lnum:=[numer p for p in lp] lden:=[dp for p in lp |(dp:=denom p)^=1] @@ -53529,6 +54563,8 @@ FloatingRealPackage(Par): Cat == Cap where [makeEq(numres,lv) for numres in innerSolve(lnum,lden,lv,eps)$INFSP(I,Par,Par)] + solve : (List(Equation(Fraction(Polynomial(Integer)))),Par) -> _ + List(List(Equation(Polynomial(Par)))) solve(le:L EQ RFI,eps : Par) : L L EQ P Par == lp:=[lhs ep - rhs ep for ep in le] lnum:=[numer p for p in lp] @@ -53539,12 +54575,16 @@ FloatingRealPackage(Par): Cat == Cap where [makeEq(numres,lv) for numres in innerSolve(lnum,lden,lv,eps)$INFSP(I,Par,Par)] + solve : (Fraction(Polynomial(Integer)),Par) -> _ + List(Equation(Polynomial(Par))) solve(p : RFI,eps : Par) : L EQ P Par == (mvar := mainVariable numer p ) case "failed" => error "no variable found" x:P Par:=mvar::SE::(P Par) [equation(x,val::(P Par)) for val in realRoots(p,eps)] + solve : (Equation(Fraction(Polynomial(Integer))),Par) -> _ + List(Equation(Polynomial(Par))) solve(eq : EQ RFI,eps : Par) : L EQ P Par == solve(lhs eq - rhs eq,eps) @@ -53765,6 +54805,7 @@ FortranCodePackage1: Exports == Implementation where import FC + zeroVector : (Symbol,Polynomial(Integer)) -> FortranCode zeroVector(fname:Symbol,n:PIN):FC == ue:Expression(Integer) := 0 i1:Symbol := "I1"::Symbol @@ -53777,6 +54818,7 @@ FortranCodePackage1: Exports == Implementation where fa:FC := forLoop(segbp1,assign(fname,indices,ue)$FC)$FC fa + zeroMatrix: (Symbol,Polynomial(Integer),Polynomial(Integer)) -> FortranCode zeroMatrix(fname:Symbol,m:PIN,n:PIN):FC == ue:Expression(Integer) := 0 i1:Symbol := "I1"::Symbol @@ -53794,6 +54836,8 @@ FortranCodePackage1: Exports == Implementation where fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC fa + zeroMatrix : (Symbol,SegmentBinding(Polynomial(Integer)),_ + SegmentBinding(Polynomial(Integer))) -> FortranCode zeroMatrix(fname:Symbol,segbp1:SBPIN,segbp2:SBPIN):FC == ue:Expression(Integer) := 0 i1:Symbol := variable(segbp1)$SBPIN @@ -53804,6 +54848,7 @@ FortranCodePackage1: Exports == Implementation where fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC fa + zeroSquareMatrix : (Symbol,Polynomial(Integer)) -> FortranCode zeroSquareMatrix(fname:Symbol,n:PIN):FC == ue:Expression(Integer) := 0 i1:Symbol := "I1"::Symbol @@ -53819,6 +54864,7 @@ FortranCodePackage1: Exports == Implementation where fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC fa + identitySquareMatrix : (Symbol,Polynomial(Integer)) -> FortranCode identitySquareMatrix(fname:Symbol,n:PIN):FC == ue:Expression(Integer) := 0 u1:Expression(Integer) := 1 @@ -53994,8 +55040,10 @@ FortranOutputStackPackage() : specification == implementation where -- top value accordingly. fortranOutputStack : Stack String := empty()@(Stack String) + topFortranOutputStack : () -> String topFortranOutputStack():String == string(_$fortranOutputFile$Lisp) + pushFortranOutputStack : FileName -> Void pushFortranOutputStack(fn:FileName):Void == if empty? fortranOutputStack then push!(string(_$fortranOutputFile$Lisp),fortranOutputStack) @@ -54006,6 +55054,7 @@ FortranOutputStackPackage() : specification == implementation where systemCommand concat(["set output fortran quiet ", fn::String])$String void() + pushFortranOutputStack : String -> Void pushFortranOutputStack(fn:String):Void == if empty? fortranOutputStack then push!(string(_$fortranOutputFile$Lisp),fortranOutputStack) @@ -54016,6 +55065,7 @@ FortranOutputStackPackage() : specification == implementation where systemCommand concat(["set output fortran quiet ", fn])$String void() + popFortranOutputStack : () -> Void popFortranOutputStack():Void == if not empty? fortranOutputStack then pop! fortranOutputStack if empty? fortranOutputStack then push!("CONSOLE",fortranOutputStack) @@ -54023,9 +55073,11 @@ FortranOutputStackPackage() : specification == implementation where top fortranOutputStack])$String void() + clearFortranOutputStack : () -> Stack(String) clearFortranOutputStack():Stack String == fortranOutputStack := empty()@(Stack String) + showFortranOutputStack : () -> Stack(String) showFortranOutputStack():Stack String == fortranOutputStack @@ -54189,9 +55241,11 @@ FortranPackage(): Exports == Implementation where legalFortranSourceExtensions : List String := ["f"] + setLegalFortranSourceExtensions : List(String) -> List(String) setLegalFortranSourceExtensions(l:List String):List String == legalFortranSourceExtensions := l + checkExtension : FileName -> String checkExtension(fn : FileName) : String == -- Does it end in a legal extension ? stringFn := fn::String @@ -54199,6 +55253,7 @@ FortranPackage(): Exports == Implementation where error [stringFn,"is not a legal Fortran Source File."] stringFn + outputAsFortran : FileName -> Void outputAsFortran(fn:FileName):Void == source : String := fn::String not readable? fn => @@ -54210,39 +55265,46 @@ FortranPackage(): Exports == Implementation where systemCommand(command)$MoreSystemCommands void()$Void + linkToFortran : (Symbol,List(Union(array: List(Symbol),scalar: Symbol)),_ + List(List(Union(array: List(Symbol),scalar: Symbol))),List(Symbol)) ->_ + SExpression linkToFortran(name:S,args:L U, decls:L L U, res:L(S)):SEX == makeFort(name,args,decls,res,NIL$Lisp,NIL$Lisp)$Lisp + linkToFortran : (Symbol,List(Union(array: List(Symbol),scalar: Symbol)),_ + List(List(Union(array: List(Symbol),scalar: Symbol))),_ + List(Symbol),Symbol) -> SExpression linkToFortran(name:S,args:L U, decls:L L U, res:L(S),returnType:S):SEX == makeFort(name,args,decls,res,returnType,NIL$Lisp)$Lisp + dimensions : FortranType -> SEX dimensions(type:FortranType):SEX == convert([convert(convert(u)@InputForm)@SEX _ for u in dimensionsOf(type)])@SEX + ftype : (S,FortranType) -> SEX ftype(name:S,type:FortranType):SEX == [name,scalarTypeOf(type),dimensions(type),external? type]$Lisp + makeAspList : (S,TheSymbolTable) -> SExpression makeAspList(asp:S,syms:TheSymbolTable):SExpression== symtab : SymbolTable := symbolTableOf(asp,syms) [asp,returnTypeOf(asp,syms),argumentListOf(asp,syms), _ [ftype(u,fortranTypeOf(u,symtab)) for u in parametersOf symtab]]$Lisp + linkToFortran : (Symbol,List(Symbol),TheSymbolTable,List(Symbol)) -> _ + SExpression linkToFortran(name:S,aArgs:L S,syms:TheSymbolTable,res:L S):SEX == arguments : L S := argumentListOf(name,syms)$TheSymbolTable dummies : L S := setDifference(arguments,aArgs) symbolTable:SymbolTable := symbolTableOf(name,syms) symbolList := newTypeLists(symbolTable) rt:Union(fst: FST,void: "void") := returnTypeOf(name,syms)$TheSymbolTable - -- Look for arguments which are subprograms asps :=[makeAspList(u,syms) for u in externalList(symbolTable)$SymbolTable] - rt case fst => - makeFort1(name,arguments,aArgs,dummies,symbolList,_ res,(rt.fst)::S,asps)$Lisp - makeFort1(name,arguments,aArgs,dummies,symbolList,res,NIL$Lisp,asps)$Lisp *) @@ -54342,12 +55404,13 @@ FractionalIdealFunctions2(R1, F1, U1, A1, R2, F2, U2, A2): (* fmap: (F1 -> F2, A1) -> A2 - fmap(f, a) == v := coordinates a represents [f qelt(v, i) for i in minIndex v .. maxIndex v]$Vector(F2) + map : ((R1 -> R2),FractionalIdeal(R1,F1,U1,A1)) -> _ + FractionalIdeal(R2,F2,U2,A2) map(f, i) == b := basis i ideal [fmap(s +-> f(numer s) / f(denom s), qelt(b, j)) @@ -54914,10 +55977,11 @@ $c_{\sigma,\sigma}$. -- ShiftAction(k, l, f) is the CoeffAction appropriate for the shift operator. + ShiftAction : (NonNegativeInteger,NonNegativeInteger,V) -> D ShiftAction(k: NonNegativeInteger, l: NonNegativeInteger, f: V): D == k**l*coefficient(f, k) - + ShiftC : NonNegativeInteger -> List(D) ShiftC(total: NonNegativeInteger): List D == [i::D for i in 0..total-1] @@ -54927,10 +55991,11 @@ $c_{\sigma,\sigma}$. -- q-ShiftAction(k, l, f) is the CoeffAction appropriate for the q-shift operator. + qShiftAction : (D,NonNegativeInteger,NonNegativeInteger,V) -> D qShiftAction(q:D, k: NonNegativeInteger, l: NonNegativeInteger, f: V): D == q**(k*l)*coefficient(f, k) - + qShiftC : (D,NonNegativeInteger) -> List(D) qShiftC(q: D, total: NonNegativeInteger): List D == [q**i for i in 0..total-1] @@ -54941,10 +56006,11 @@ $c_{\sigma,\sigma}$. -- DiffAction(k, l, f) is the CoeffAction appropriate for the differentiation -- operator. + DiffAction : (NonNegativeInteger,NonNegativeInteger,V) -> D DiffAction(k: NonNegativeInteger, l: NonNegativeInteger, f: V): D == coefficient(f, (k-l)::NonNegativeInteger) - + DiffC : NonNegativeInteger -> List(D) DiffC(total: NonNegativeInteger): List D == [0 for i in 1..total] @@ -54955,6 +56021,8 @@ $c_{\sigma,\sigma}$. -- get the coefficient of z^k in the scalar product of p and f, the action -- being defined by coeffAction + generalCoefficient : (((NonNegativeInteger,NonNegativeInteger,V) -> D),_ + Vector(V),NonNegativeInteger,Vector(SparseUnivariatePolynomial(D))) -> D generalCoefficient(coeffAction: CoeffAction, f: Vector V, k: NonNegativeInteger, p: Vector SUP D): D == res: D := 0 @@ -54968,7 +56036,10 @@ $c_{\sigma,\sigma}$. then res := res + coefficient(b, l) * coeffAction(k, l, a) res - + generalInterpolation : _ + (List(D),((NonNegativeInteger,NonNegativeInteger,V) -> D),_ + Vector(V),List(NonNegativeInteger)) ->_ + Matrix(SparseUnivariatePolynomial(D)) generalInterpolation(C: List D, coeffAction: CoeffAction, f: Vector V, eta: List NonNegativeInteger): Matrix SUP D == @@ -54977,12 +56048,12 @@ $c_{\sigma,\sigma}$. (x-1)::NonNegativeInteger, y) fffg(C, c, eta) - - ------------------------------------------------------------------------------- -- general - suitable for functions f - trying all possible degree combinations ------------------------------------------------------------------------------- + nextVector! : (NonNegativeInteger,List NonNegativeInteger) -> _ + Union("failed", List NonNegativeInteger) nextVector!(p: NonNegativeInteger, v: List NonNegativeInteger) : Union("failed", List NonNegativeInteger) == n := #v @@ -55010,12 +56081,16 @@ $c_{\sigma,\sigma}$. v + vectorStream : (NonNegativeInteger,List NonNegativeInteger) -> _ + Stream List NonNegativeInteger vectorStream(p: NonNegativeInteger, v: List NonNegativeInteger) : Stream List NonNegativeInteger == delay next := nextVector!(p, copy v) (next case "failed") => empty()$Stream(List NonNegativeInteger) cons(next, vectorStream(p, next)) + vectorStream2 : (NonNegativeInteger,List NonNegativeInteger) -> + Stream List NonNegativeInteger == delay vectorStream2(p: NonNegativeInteger, v: List NonNegativeInteger) : Stream List NonNegativeInteger == delay next := nextVector!(p, copy v) @@ -55024,12 +56099,22 @@ $c_{\sigma,\sigma}$. (next2 case "failed") => cons(next, empty()) cons(next2, vectorStream2(p, next2)) + generalInterpolation : (List(D),_ + ((NonNegativeInteger,NonNegativeInteger,V) -> D),Vector(V),_ + NonNegativeInteger,NonNegativeInteger) -> _ + Stream(Matrix(SparseUnivariatePolynomial(D))) generalInterpolation(C: List D, coeffAction: CoeffAction, f: Vector V, sumEta: NonNegativeInteger, maxEta: NonNegativeInteger) : Stream Matrix SUP D == -\getchunk{generate an initial degree vector} + sum: Integer := sumEta + entry: Integer + eta: List NonNegativeInteger + := [(if sum < maxEta _ + then (entry := sum; sum := 0) _ + else (entry := maxEta; sum := sum - maxEta); _ + entry::NonNegativeInteger) for i in 1..#f] if #f = 2 then map(x +-> generalInterpolation(C, coeffAction, f, x), cons(eta, vectorStream2(maxEta, eta))) @@ -55052,6 +56137,8 @@ $c_{\sigma,\sigma}$. -- rational interpolation ------------------------------------------------------------------------------- + interpolate : (List(Fraction(D)),List(Fraction(D)),NonNegativeInteger) ->_ + Fraction(SparseUnivariatePolynomial(D)) interpolate(x: List Fraction D, y: List Fraction D, d: NonNegativeInteger) : Fraction SUP D == gx := splitDenominator(x)$InnerCommonDenominator(D, Fraction D, _ @@ -55063,6 +56150,8 @@ $c_{\sigma,\sigma}$. r := interpolate(gx.num, gy.num, d) elt(numer r,monomial(gx.den,1))/(gy.den*elt(denom r, monomial(gx.den,1))) + interpolate : (List(D),List(D),NonNegativeInteger) -> _ + Fraction(SparseUnivariatePolynomial(D)) interpolate(x: List D, y: List D, d: NonNegativeInteger): Fraction SUP D == -- berechne Interpolante mit Graden d und N-d-1 if (N := #x) ~= #y then @@ -55076,8 +56165,9 @@ $c_{\sigma,\sigma}$. if zero?(M.(2,1)) then M.(1,2)/M.(2,2) else M.(1,1)/M.(2,1) - -- a major part of the time is spent here + recurrence : (Matrix SUP D,NonNegativeInteger,NonNegativeInteger,_ + Vector D,D,SUP D,D,Vector D) -> Matrix SUP D recurrence(M: Matrix SUP D, pi: NonNegativeInteger, m: NonNegativeInteger,_ r: Vector D, d: D, z: SUP D, Ck: D, p: Vector D): Matrix SUP D == rPi: D := qelt(r, pi) @@ -55099,6 +56189,9 @@ $c_{\sigma,\sigma}$. M + fffg : (List(D),((NonNegativeInteger,_ + Vector(SparseUnivariatePolynomial(D))) -> D),_ + List(NonNegativeInteger)) -> Matrix(SparseUnivariatePolynomial(D)) fffg(C: List D,c: cFunction, eta: List NonNegativeInteger): Matrix SUP D == -- eta is the vector of degrees. -- We compute M with degrees eta+e_i-1, i=1..m @@ -55134,7 +56227,6 @@ $c_{\sigma,\sigma}$. M := recurrence(M, lambda, m, r, d, z, C.k, p) d := r.lambda etak.lambda := etak.lambda + 1 - M *) @@ -55300,6 +56392,7 @@ FractionFreeFastGaussianFractions(D, V, VF): Exports == Implementation where (* package FFFGF *) (* + multiplyRows! : (Vector D,Matrix SUP D) -> Matrix SUP D multiplyRows!(v: Vector D, M: Matrix SUP D): Matrix SUP D == n := #v for i in 1..n repeat @@ -55308,51 +56401,47 @@ FractionFreeFastGaussianFractions(D, V, VF): Exports == Implementation where M + generalInterpolation : (List(D),_ + ((NonNegativeInteger,NonNegativeInteger,V) -> D),Vector(VF),_ + List(NonNegativeInteger)) -> Matrix(SparseUnivariatePolynomial(D)) generalInterpolation(C: List D, coeffAction: CoeffAction, f: Vector VF, eta: List NNI): Matrix SUP D == n := #f g: Vector V := new(n, 0) den: Vector D := new(n, 0) - for i in 1..n repeat c := coefficients(f.i) den.i := commonDenominator(c)$CommonDenominator(D, F, List F) g.i := map(x +-> retract(x*den.i)@D, f.i)$FAMR2(NNI, Fraction D, VF, D, V) - M := generalInterpolation(C, coeffAction, g, eta)$FFFG(D, V) - -- The following is necessary since I'm multiplying each row with a factor, not -- each column. Possibly I could factor out gcd den, but I'm not sure whether -- this is efficient. - multiplyRows!(den, M) + generalInterpolation : (List(D),_ + ((NonNegativeInteger,NonNegativeInteger,V) -> D),Vector(VF),_ + NonNegativeInteger,NonNegativeInteger) -> _ + Stream(Matrix(SparseUnivariatePolynomial(D))) generalInterpolation(C: List D, coeffAction: CoeffAction, f: Vector VF, sumEta: NNI, maxEta: NNI) : Stream Matrix SUP D == - n := #f g: Vector V := new(n, 0) den: Vector D := new(n, 0) - for i in 1..n repeat c := coefficients(f.i) den.i := commonDenominator(c)$CommonDenominator(D, F, List F) g.i := map(x +-> retract(x*den.i)@D, f.i)$FAMR2(NNI, Fraction D, VF, D, V) - c: cFunction := (x,y) +-> generalCoefficient(coeffAction, g, (x-1)::NNI, y)$FFFG(D, V) - - MS: Stream Matrix SUP D := generalInterpolation(C, coeffAction, g, sumEta, maxEta)$FFFG(D, V) - -- The following is necessary since I'm multiplying each row with a factor, not -- each column. Possibly I could factor out gcd den, but I'm not sure whether -- this is efficient. - map(x +-> multiplyRows!(den, x), MS)$Stream(Matrix SUP D) *) @@ -55438,6 +56527,7 @@ FractionFunctions2(A, B): Exports == Impl where (* package FRAC2 *) (* + map : ((A -> B),Fraction(A)) -> Fraction(B) map(f, r) == map(f, r)$QuotientFieldCategoryFunctions2(A, B, R, S) *) @@ -55535,6 +56625,7 @@ FramedNonAssociativeAlgebraFunctions2(AR,R,AS,S) : Exports == (* package FRNAAF2 *) (* + map : ((R -> S),AR) -> AS map(fn : R -> S, u : AR): AS == rank()$AR > rank()$AS => error("map: ranks of algebras do not fit") vr : V R := coordinates u @@ -56061,57 +57152,70 @@ integrate(D(besselJ(a,x),a),a). (* package FSPECF *) (* - iabs : F -> F - iGamma : F -> F - iBeta : (F, F) -> F - idigamma : F -> F - iiipolygamma: (F, F) -> F - iiiBesselJ : (F, F) -> F - iiiBesselY : (F, F) -> F - iiiBesselI : (F, F) -> F - iiiBesselK : (F, F) -> F - iAiryAi : F -> F - iAiryBi : F -> F + opabs := operator("abs"::Symbol)$CommonOperators + + opGamma := operator("Gamma"::Symbol)$CommonOperators + + opGamma2 := operator("Gamma2"::Symbol)$CommonOperators + + opBeta := operator("Beta"::Symbol)$CommonOperators + + opdigamma := operator("digamma"::Symbol)$CommonOperators - opabs := operator("abs"::Symbol)$CommonOperators - opGamma := operator("Gamma"::Symbol)$CommonOperators - opGamma2 := operator("Gamma2"::Symbol)$CommonOperators - opBeta := operator("Beta"::Symbol)$CommonOperators - opdigamma := operator("digamma"::Symbol)$CommonOperators oppolygamma := operator("polygamma"::Symbol)$CommonOperators - opBesselJ := operator("besselJ"::Symbol)$CommonOperators - opBesselY := operator("besselY"::Symbol)$CommonOperators - opBesselI := operator("besselI"::Symbol)$CommonOperators - opBesselK := operator("besselK"::Symbol)$CommonOperators - opAiryAi := operator("airyAi"::Symbol)$CommonOperators - opAiryBi := operator("airyBi"::Symbol)$CommonOperators - abs x == opabs x + opBesselJ := operator("besselJ"::Symbol)$CommonOperators - Gamma(x) == opGamma(x) + opBesselY := operator("besselY"::Symbol)$CommonOperators - Gamma(a,x) == opGamma2(a,x) + opBesselI := operator("besselI"::Symbol)$CommonOperators - Beta(x,y) == opBeta(x,y) + opBesselK := operator("besselK"::Symbol)$CommonOperators - digamma x == opdigamma(x) + opAiryAi := operator("airyAi"::Symbol)$CommonOperators + + opAiryBi := operator("airyBi"::Symbol)$CommonOperators + + abs : F -> F + abs x == opabs x + + Gamma : F -> F + Gamma(x) == opGamma(x) + Gamma : (F,F) -> F + Gamma(a,x) == opGamma2(a,x) + + Beta : (F,F) -> F + Beta(x,y) == opBeta(x,y) + + digamma : F -> F + digamma x == opdigamma(x) + + polygamma : (F,F) -> F polygamma(k,x)== oppolygamma(k,x) + besselJ : (F,F) -> F besselJ(a,x) == opBesselJ(a,x) - besselY(a,x) == opBesselY(a,x) + besselY : (F,F) -> F + besselY(a,x) == opBesselY(a,x) - besselI(a,x) == opBesselI(a,x) + besselI : (F,F) -> F + besselI(a,x) == opBesselI(a,x) - besselK(a,x) == opBesselK(a,x) + besselK : (F,F) -> F + besselK(a,x) == opBesselK(a,x) - airyAi(x) == opAiryAi(x) + airyAi : F -> F + airyAi(x) == opAiryAi(x) - airyBi(x) == opAiryBi(x) + airyBi : F -> F + airyBi(x) == opAiryBi(x) + belong? : BasicOperator -> Boolean belong? op == has?(op, "special") + operator : BasicOperator -> BasicOperator operator op == is?(op, "abs"::Symbol) => opabs is?(op, "Gamma"::Symbol) => opGamma @@ -56129,39 +57233,50 @@ integrate(D(besselJ(a,x),a),a). error "Not a special operator" -- Could put more unconditional special rules for other functions here + iGamma : F -> F iGamma x == (x = 1) => x kernel(opGamma, x) + iabs : F -> F iabs x == zero? x => 0 is?(x, opabs) => x x < 0 => kernel(opabs, -x) kernel(opabs, x) + iBeta : (F, F) -> F iBeta(x, y) == kernel(opBeta, [x, y]) + idigamma : F -> F idigamma x == kernel(opdigamma, x) + iiipolygamma: (F, F) -> F iiipolygamma(n, x) == kernel(oppolygamma, [n, x]) + iiiBesselJ : (F, F) -> F iiiBesselJ(x, y) == kernel(opBesselJ, [x, y]) + iiiBesselY : (F, F) -> F iiiBesselY(x, y) == kernel(opBesselY, [x, y]) + iiiBesselI : (F, F) -> F iiiBesselI(x, y) == kernel(opBesselI, [x, y]) + iiiBesselK : (F, F) -> F iiiBesselK(x, y) == kernel(opBesselK, [x, y]) + iAiryAi : F -> F iAiryAi x == kernel(opAiryAi, x) + iAiryBi : F -> F iAiryBi x == kernel(opAiryBi, x) - -- Could put more conditional special rules for other functions here if R has abs : R -> R then + iiabs : F -> F iiabs x == (r := retractIfCan(x)@Union(Fraction Polynomial R, "failed")) case "failed" => iabs x @@ -56172,58 +57287,69 @@ integrate(D(besselJ(a,x),a),a). else + iiabs : F -> F iiabs x == iabs x if R has SpecialFunctionCategory then + iiGamma : F -> F iiGamma x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iGamma x Gamma(r::R)::F + iiBeta : List(F) -> F iiBeta l == (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ => iBeta(first l, second l) Beta(r::R, s::R)::F + iidigamma : F -> F iidigamma x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => idigamma x digamma(r::R)::F + iipolygamma : List(F) -> F iipolygamma l == (s:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ (r:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ => iiipolygamma(first l, second l) polygamma(s::R, r::R)::F + iiBesselJ : List(F) -> F iiBesselJ l == (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ => iiiBesselJ(first l, second l) besselJ(r::R, s::R)::F + iiBesselY : List(F) -> F iiBesselY l == (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ => iiiBesselY(first l, second l) besselY(r::R, s::R)::F + iiBesselI : List(F) -> F iiBesselI l == (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ => iiiBesselI(first l, second l) besselI(r::R, s::R)::F + iiBesselK : List(F) -> F iiBesselK l == (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ => iiiBesselK(first l, second l) besselK(r::R, s::R)::F + iiAiryAi : F -> F iiAiryAi x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryAi x airyAi(r::R)::F + iiAiryBi : F -> F iiAiryBi x == (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryBi x airyBi(r::R)::F @@ -56231,6 +57357,7 @@ integrate(D(besselJ(a,x),a),a). else if R has RetractableTo Integer then + iiGamma : F -> F iiGamma x == (r := retractIfCan(x)@Union(Integer, "failed")) case Integer and (r::Integer >= 1) => factorial(r::Integer - 1)::F @@ -56238,24 +57365,34 @@ integrate(D(besselJ(a,x),a),a). else + iiGamma : F -> F iiGamma x == iGamma x + iiBeta : List(F) -> F iiBeta l == iBeta(first l, second l) + iidigamma : F -> F iidigamma x == idigamma x + iipolygamma : List(F) -> F iipolygamma l == iiipolygamma(first l, second l) + iiBesselJ : List(F) -> F iiBesselJ l == iiiBesselJ(first l, second l) + iiBesselY : List(F) -> F iiBesselY l == iiiBesselY(first l, second l) + iiBesselI : List(F) -> F iiBesselI l == iiiBesselI(first l, second l) + iiBesselK : List(F) -> F iiBesselK l == iiiBesselK(first l, second l) + iiAiryAi : F -> F iiAiryAi x == iAiryAi x + iiAiryBi : F -> F iiAiryBi x == iAiryBi x -- Default behaviour is to build a kernel @@ -56292,26 +57429,31 @@ integrate(D(besselJ(a,x),a),a). dm := new()$SE :: F + iBesselJ : (List F,SE) -> F iBesselJ(l: List F, t: SE): F == n := first l; x := second l differentiate(n, t)*kernel(opdiff, [opBesselJ [dm, x], dm, n]) + differentiate(x, t) * ahalf * (besselJ (n-1,x) - besselJ (n+1,x)) + iBesselY : (List F, SE) -> F iBesselY(l: List F, t: SE): F == n := first l; x := second l differentiate(n, t)*kernel(opdiff, [opBesselY [dm, x], dm, n]) + differentiate(x, t) * ahalf * (besselY (n-1,x) - besselY (n+1,x)) + iBesselI : (List F,SE) -> F iBesselI(l: List F, t: SE): F == n := first l; x := second l differentiate(n, t)*kernel(opdiff, [opBesselI [dm, x], dm, n]) + differentiate(x, t)* ahalf * (besselI (n-1,x) + besselI (n+1,x)) + iBesselK : (List F,SE) -> F iBesselK(l: List F, t: SE): F == n := first l; x := second l differentiate(n, t)*kernel(opdiff, [opBesselK [dm, x], dm, n]) - differentiate(x, t)* ahalf * (besselK (n-1,x) + besselK (n+1,x)) + ipolygamma : (List F,SE) -> F ipolygamma(l: List F, x: SE): F == member?(x, variables first l) => error _ @@ -56319,16 +57461,19 @@ integrate(D(besselJ(a,x),a),a). n := first l; y := second l differentiate(y, x)*polygamma(n+1, y) + iBetaGrad1 : List F -> F iBetaGrad1(l: List F): F == x := first l; y := second l Beta(x,y)*(digamma x - digamma(x+y)) + iBetaGrad2 : List F -> F iBetaGrad2(l: List F): F == x := first l; y := second l Beta(x,y)*(digamma y - digamma(x+y)) if F has ElementaryFunctionCategory then + iGamma2 : (List F,SE) -> F iGamma2(l: List F, t: SE): F == a := first l; x := second l differentiate(a, t)*kernel(opdiff, [opGamma2 [dm, x], dm, a]) @@ -56442,6 +57587,7 @@ FunctionFieldCategoryFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2): (* package FFCAT2 *) (* + map : ((R1 -> R2),F1) -> F2 map(f, f1) == reduce(map(f, lift f1)$MultipleMap(R1, UP1, UPUP1, R2, UP2, UPUP2)) @@ -56677,6 +57823,8 @@ FunctionFieldIntegralBasis(R,UP,F): Exports == Implementation where not sizeLess?(1, sing) => return [rb, rbden, rbinv] tfm := ((rb * tfm0 * transpose rb) exquo (rbden * rbden)) :: Mat + integralBasis : () -> _ + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) integralBasis() == n := rank()$F; p := characteristic()$F (not zero? p) and (n >= p) => @@ -56685,6 +57833,8 @@ FunctionFieldIntegralBasis(R,UP,F): Exports == Implementation where sing := squaredFactors disc -- singularities of relative Spec iIntegralBasis(tfm,disc,sing) + localIntegralBasis : R -> _ + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) localIntegralBasis prime == n := rank()$F; p := characteristic()$F (not zero? p) and (n >= p) => @@ -56831,35 +57981,38 @@ FunctionSpaceAssertions(R, F): Exports == Implementation where (* package PMASSFS *) (* - ass : (K, String) -> F - asst : (K, String) -> F mkk : BasicOperator -> F - mkk op == kernel(op, empty()$List(F)) + ass : (K, String) -> F ass(k, s) == has?(op := operator k, s) => k::F mkk assert(copy op, s) + asst : (K, String) -> F asst(k, s) == has?(op := operator k, s) => k::F mkk assert(op, s) + assert : (F,String) -> F assert(x, s) == retractIfCan(x)@Union(Symbol, "failed") case Symbol => asst(retract(x)@K, s) error "assert must be applied to symbols only" + constant : F -> F constant x == retractIfCan(x)@Union(Symbol, "failed") case Symbol => ass(retract(x)@K, PMCONST) error "constant must be applied to symbols only" + optional : F -> F optional x == retractIfCan(x)@Union(Symbol, "failed") case Symbol => ass(retract(x)@K, PMOPT) error "optional must be applied to symbols only" + multiple : F -> F multiple x == retractIfCan(x)@Union(Symbol, "failed") case Symbol => ass(retract(x)@K, PMMULT) @@ -56977,22 +58130,23 @@ FunctionSpaceAttachPredicates(R, F, D): Exports == Implementation where import AnyFunctions1(D -> Boolean) - st : (K, List Any) -> F - preds: K -> List Any - mkk : BasicOperator -> F - + suchThat : (F,(D -> Boolean)) -> F suchThat(p:F, f:D -> Boolean) == suchThat(p, [f]) - mkk op == kernel(op, empty()$List(F)) + mkk : BasicOperator -> F + mkk op == kernel(op, empty()$List(F)) + preds: K -> List Any preds k == (u := property(operator k, PMPRED)) case "failed" => empty() (u::None) pretend List(Any) + st : (K, List Any) -> F st(k, l) == mkk assert(setProperty(copy operator k, PMPRED, concat(preds k, l) pretend None), string(new()$Symbol)) + suchThat : (F,List((D -> Boolean))) -> F suchThat(p:F, l:List(D -> Boolean)) == retractIfCan(p)@Union(Symbol, "failed") case Symbol => st(retract(p)@K, [f::Any for f in l]) @@ -57153,9 +58307,9 @@ FunctionSpaceComplexIntegration(R, F): Exports == Implementation where import InnerTrigonometricManipulations(R, F, FG) K2KG: Kernel F -> Kernel FG - K2KG k == retract(tan F2FG first argument k)@Kernel(FG) + complexIntegrate : (F,Symbol) -> F complexIntegrate(f, x) == removeConstantTerm(complexExpand internalIntegrate(f, x), x) @@ -57163,11 +58317,16 @@ FunctionSpaceComplexIntegration(R, F): Exports == Implementation where and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then import PatternMatchIntegration(R, F) + internalIntegrate0 : (F,Symbol) -> IntegrationResult(F) internalIntegrate0(f, x) == intPatternMatch(f, x, lfintegrate, pmComplexintegrate) - else internalIntegrate0(f, x) == lfintegrate(f, x) + else + internalIntegrate0 : (F,Symbol) -> IntegrationResult(F) + internalIntegrate0(f, x) == lfintegrate(f, x) + + internalIntegrate : (F,Symbol) -> IntegrationResult(F) internalIntegrate(f, x) == f := distribute(f, x::F) any?(x1+->has?(operator x1, "rtrig"), @@ -57288,7 +58447,6 @@ FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where (* smpmap: (R -> S, P) -> B - smpmap(fn, p) == map(x+->map(z+->map(fn, z),x)$ExpressionSpaceFunctions2(A,B), y+->fn(y)::B,p)_ @@ -57297,14 +58455,17 @@ FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where if R has IntegralDomain then if S has IntegralDomain then + map : ((R -> S),A) -> B map(f, x) == smpmap(f, numer x) / smpmap(f, denom x) else + map : ((R -> S),A) -> B map(f, x) == smpmap(f, numer x) * (recip(smpmap(f, denom x))::B) else + map : ((R -> S),A) -> B map(f, x) == smpmap(f, numer x) *) @@ -57514,26 +58675,20 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, SparseMultivariatePolynomial(R, K), F) - K2KG : K -> Kernel FG - postSubst : (F, List F, List K, B, List K, SE) -> F - rinteg : (IR, F, SE, B, B) -> Union(F, List F) - mkPrimh : (F, SE, B, B) -> F - trans? : F -> B - goComplex?: (B, List K, List K) -> B - halfangle : F -> F - Khalf : K -> F - tan2temp : K -> K - optemp:BasicOperator := operator(TANTEMP, 1) - K2KG k == retract(tan F2FG first argument k)@Kernel(FG) + K2KG : K -> Kernel FG + K2KG k == retract(tan F2FG first argument k)@Kernel(FG) + tan2temp : K -> K tan2temp k == kernel(optemp, argument k, height k)$K + trans? : F -> B trans? f == any?(x1+->is?(x1,"log"::SE) or is?(x1,"exp"::SE) or is?(x1,"atan"::SE), operators f)$List(BasicOperator) + mkPrimh : (F, SE, B, B) -> F mkPrimh(f, x, h, comp) == f := real f if comp then f := removeSinSq f @@ -57541,21 +58696,25 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where h and trans? g => htrigs g g + rinteg : (IR, F, SE, B, B) -> Union(F, List F) rinteg(i, f, x, h, comp) == not elem? i => integral(f, x)$F empty? rest(l := [mkPrimh(f, x, h, comp) for f in expand i]) => first l l -- replace tan(a/2)**2 by (1-cos a)/(1+cos a) if tan(a/2) is in ltan + halfangle : F -> F halfangle a == a := 2 * a (1 - cos a) / (1 + cos a) + Khalf : K -> F Khalf k == a := 2 * first argument k sin(a) / (1 + cos a) -- ltan = list of tangents in the integrand after real normalization + postSubst : (F, List F, List K, B, List K, SE) -> F postSubst(f, lv, lk, comp, ltan, x) == for v in lv for k in lk repeat if ((u := retractIfCan(v)@Union(K, "failed")) case K) then @@ -57573,10 +58732,12 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where -- complex for now -- l is the list of all the kernels containing x -- ltan is the list of all the tangents in l + goComplex?: (B, List K, List K) -> B goComplex?(rt, l, ltan) == empty? ltan => rt not empty? rest rest l + integrate : (F,Symbol) -> Union(F,List(F)) integrate(f, x) == not real? f => complexIntegrate(f, x) f := distribute(f, x::F) @@ -57773,15 +58934,17 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where K, R, SparseMultivariatePolynomial(R, K), P) F2P: (F, List SY) -> P - K2P: (K, List SY) -> P - F2P(f, l) == inv(denom(f)::F)*map((k1:K):P+->K2P(k1,l),(r1:R):P+->r1::F::P, numer f) + K2P: (K, List SY) -> P K2P(k, l) == ((v := symbolIfCan k) case SY) and member?(v::SY, l) => v::SY::P k::F::P + primitiveElement : List(F) -> _ + Record(primelt: F,poly: List(SparseUnivariatePolynomial(F)),_ + prim: SparseUnivariatePolynomial(F)) primitiveElement l == u := string(uu := new()$SY) vars := [concat(u, string i)::SY for i in 1..#l] @@ -57797,8 +58960,6 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where K, R, SparseMultivariatePolynomial(R, K), F) F2UP: (UP, K, UP) -> UP - getpoly: (UP, F) -> UP - F2UP(p, k, q) == ans:UP := 0 while not zero? p repeat @@ -57808,6 +58969,10 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where p := reductum p ans + primitiveElement : (F,F) -> _ + Record(primelt: F,pol1: SparseUnivariatePolynomial(F),_ + pol2: SparseUnivariatePolynomial(F),_ + prim: SparseUnivariatePolynomial(F)) if F has ACF primitiveElement(a1, a2) == a := (aa := new()$SY)::F b := (bb := new()$SY)::F @@ -57830,6 +58995,7 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where q := getpoly(r, g) [w, monomial(ic1, 1)$UP - rec.coef2 * ic1 * q, q, rec.prim] + getpoly: (UP, F) -> UP getpoly(r, g) == (degree r = 1) => k := retract(g)@K @@ -57965,14 +59131,14 @@ FunctionSpaceReduce(R, F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, SparseMultivariatePolynomial(R, K), F) - K2Z : K -> F - redmap := table()$AssociationList(K, Z) + newReduc : () -> Void newReduc() == for k in keys redmap repeat remove_!(k, redmap) void + bringDown : (F,Kernel(F)) -> SparseUnivariatePolynomial(Fraction(Integer)) bringDown(f, k) == ff := univariate(f, k) (bc := extendedEuclidean(map(bringDown, denom ff), @@ -57980,9 +59146,11 @@ FunctionSpaceReduce(R, F): Exports == Implementation where error "denominator is 0" (map(bringDown, numer ff) * bc.coef1) rem m + bringDown : F -> Fraction(Integer) bringDown f == retract(eval(f, lk := kernels f, [K2Z k for k in lk]))@Q + K2Z : K -> F K2Z k == has?(operator k, ALGOP) => error "Cannot reduce constant field" (u := search(k, redmap)) case "failed" => @@ -58108,27 +59276,28 @@ FunctionSpaceSum(R, F): Exports == Implementation where import GosperSummationMethod(IndexedExponents K, K, R, SparseMultivariatePolynomial(R, K), F) - innersum: (F, K) -> Union(F, "failed") - notRF? : (F, K) -> Boolean - newk : () -> K - + newk : () -> K newk() == kernel(new()$SE) + sum : (F,SegmentBinding(F)) -> F sum(x:F, s:SegmentBinding F) == k := kernel(variable s)@K (u := innersum(x, k)) case "failed" => summation(x, s) eval(u::F, k, 1 + hi segment s) - eval(u::F, k, lo segment s) + sum : (F,Symbol) -> F sum(x:F, v:SE) == (u := innersum(x, kernel(v)@K)) case "failed" => summation(x,v) u::F + notRF? : (F, K) -> Boolean notRF?(f, k) == for kk in tower f repeat member?(k, tower(kk::F)) and (symbolIfCan(kk) case "failed") => return true false + innersum: (F, K) -> Union(F, "failed") innersum(x, k) == zero? x => 0 notRF?(f := normalize(x / (x1 := eval(x, k, k::F - 1))), k) => @@ -58744,52 +59913,23 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ import FS2UPS -- conversion of functional expressions to Puiseux series import EFUPXS -- partial transcendental funtions on UPXS - ratIfCan : FE -> Union(RN,"failed") - stateSeriesProblem : (S,S) -> Result - stateProblem : (S,S) -> XResult - newElem : FE -> FE - smpElem : SMP -> FE - k2Elem : K -> FE - iExprToXXP : (FE,B) -> XResult - listToXXP : (L FE,B,XXP,(XXP,XXP) -> XXP) -> XResult - isNonTrivPower : FE -> Union(Record(val:FE,exponent:I),"failed") - negativePowerOK? : UPXS -> Boolean - powerToXXP : (FE,I,B) -> XResult - carefulNthRootIfCan : (UPXS,NNI,B) -> Result - nthRootXXPIfCan : (XXP,NNI,B) -> XResult - nthRootToXXP : (FE,NNI,B) -> XResult - genPowerToXXP : (L FE,B) -> XResult - kernelToXXP : (K,B) -> XResult - genExp : (UPXS,B) -> Result - exponential : (UPXS,B) -> XResult - expToXXP : (FE,B) -> XResult - genLog : (UPXS,B) -> Result - logToXXP : (FE,B) -> XResult - applyIfCan : (UPXS -> Union(UPXS,"failed"),FE,S,B) -> XResult - applyBddIfCan : (FE,UPXS -> Union(UPXS,"failed"),FE,S,B) -> XResult - tranToXXP : (K,FE,B) -> XResult - contOnReals? : S -> B - bddOnReals? : S -> B - opsInvolvingX : FE -> L BOP - opInOpList? : (SY,L BOP) -> B - exponential? : FE -> B - productOfNonZeroes? : FE -> B - atancotToXXP : (FE,FE,B,I) -> XResult - ZEROCOUNT : RN := 1000/1 -- number of zeroes to be removed when taking logs or nth roots --% retractions + ratIfCan : FE -> Union(RN,"failed") ratIfCan fcn == retractIfCan(fcn)@Union(RN,"failed") --% 'problems' with conversion + stateSeriesProblem : (S,S) -> Result stateSeriesProblem(function,problem) == -- records the problem which occured in converting an expression -- to a power series [[function,problem]] + stateProblem : (S,S) -> XResult stateProblem(function,problem) == -- records the problem which occured in converting an expression -- to an exponential expansion @@ -58797,6 +59937,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% normalizations + newElem : FE -> FE newElem f == -- rewrites a functional expression; all trig functions are -- expressed in terms of sin and cos; all hyperbolic trig @@ -58805,8 +59946,10 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ -- and log smpElem(numer f) / smpElem(denom f) + smpElem : SMP -> FE smpElem p == map(k2Elem,(x1:R):FE+->x1::FE,p)$PCL + k2Elem : K -> FE k2Elem k == -- rewrites a kernel; all trig functions are -- expressed in terms of sin and cos; all hyperbolic trig @@ -58833,8 +59976,12 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% general conversion function + exprToXXP : (FE,Boolean) -> _ + Union(%expansion: ExponentialExpansion(R,FE,x,cen),_ + %problem: Record(func: String,prob: String)) exprToXXP(fcn,posCheck?) == iExprToXXP(newElem fcn,posCheck?) + iExprToXXP : (FE,B) -> XResult iExprToXXP(fcn,posCheck?) == -- converts a functional expression to an exponential expansion --!! The following line is commented out so that expressions of @@ -58857,6 +60004,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% sums and products + listToXXP : (L FE,B,XXP,(XXP,XXP) -> XXP) -> XResult listToXXP(list,posCheck?,ans,op) == -- converts each element of a list of expressions to an exponential -- expansion and returns the sum of these expansions, when 'op' is + @@ -58871,6 +60019,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% nth roots and integral powers + isNonTrivPower : FE -> Union(Record(val:FE,exponent:I),"failed") isNonTrivPower fcn == -- is the function a power with exponent other than 0 or 1? (expt := isPower fcn) case "failed" => "failed" @@ -58878,6 +60027,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ (power.exponent = 1) => "failed" power + negativePowerOK? : UPXS -> Boolean negativePowerOK? upxs == -- checks the lower order coefficient of a Puiseux series; -- the coefficient may be inverted only if @@ -58898,6 +60048,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ productOfNonZeroes? coef => true false + powerToXXP : (FE,I,B) -> XResult powerToXXP(fcn,n,posCheck?) == -- converts an integral power to an exponential expansion (b := iExprToXXP(fcn,posCheck?)) case %problem => b @@ -58914,6 +60065,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --!! reciprocate the numerator stateProblem("inv","lowest order coefficient involves x") + carefulNthRootIfCan : (UPXS,NNI,B) -> Result carefulNthRootIfCan(ups,n,posCheck?) == -- similar to 'nthRootIfCan', but it is fussy about the series -- it takes as an argument. If 'n' is EVEN and 'posCheck?' @@ -58939,6 +60091,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ stateSeriesProblem("nth root","no nth root") [ans :: UPXS] + nthRootXXPIfCan : (XXP,NNI,B) -> XResult nthRootXXPIfCan(xxp,n,posCheck?) == num := numer xxp; den := denom xxp not zero?(reductum num) or not zero?(reductum den) => @@ -58960,6 +60113,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ monomial(coef,deg) [newNum/newDen] + nthRootToXXP : (FE,NNI,B) -> XResult nthRootToXXP(arg,n,posCheck?) == -- converts an nth root to a power series -- this is not used in the limit package, so the series may @@ -58971,6 +60125,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% general powers f(x) ** g(x) + genPowerToXXP : (L FE,B) -> XResult genPowerToXXP(args,posCheck?) == -- converts a power f(x) ** g(x) to an exponential expansion (logBase := logToXXP(first args,posCheck?)) case %problem => @@ -58984,6 +60139,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% kernels + kernelToXXP : (K,B) -> XResult kernelToXXP(ker,posCheck?) == -- converts a kernel to a power series (sym := symbolIfCan(ker)) case Symbol => @@ -59004,6 +60160,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% exponentials and logarithms + genExp : (UPXS,B) -> Result genExp(ups,posCheck?) == -- If the series has order zero and the constant term a0 of the -- series involves x, the function tries to expand exp(a0) as @@ -59022,6 +60179,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ result case %problem => [exp(ups)] [(result.%series) * exp(ups - monomial(lc,0))] + exponential : (UPXS,B) -> XResult exponential(f,posCheck?) == singPart := truncate(f,0) - (coefficient(f,0) :: UPXS) taylorPart := f - singPart @@ -59029,6 +60187,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ (coef := genExp(taylorPart,posCheck?)) case %problem => [coef.%problem] [monomial(coef.%series,expon)$UPXSSING :: XXP] + expToXXP : (FE,B) -> XResult expToXXP(arg,posCheck?) == (result := iExprToXXP(arg,posCheck?)) case %problem => result xxp := result.%expansion @@ -59036,6 +60195,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ stateProblem("exp","multiply nested exponential") exponential(f,posCheck?) + genLog : (UPXS,B) -> Result genLog(ups,posCheck?) == deg := degree ups if (coef := coefficient(ups,deg)) = 0 then @@ -59062,6 +60222,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ log(coef) + term1 [monomial(logTerm,0)$UPXS + log(ups/lt)] + logToXXP : (FE,B) -> XResult logToXXP(arg,posCheck?) == (result := iExprToXXP(arg,posCheck?)) case %problem => result xxp := result.%expansion @@ -59082,6 +60243,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ --% other transcendental functions + applyIfCan : (UPXS -> Union(UPXS,"failed"),FE,S,B) -> XResult applyIfCan(fcn,arg,fcnName,posCheck?) == -- converts fcn(arg) to an exponential expansion (xxpArg := iExprToXXP(arg,posCheck?)) case %problem => xxpArg @@ -59099,6 +60261,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ contOnReals? fcnName => [fcn(upxs) :: UPXS :: XXP] stateProblem(fcnName,"x in constant coefficient") + applyBddIfCan : (FE,UPXS -> Union(UPXS,"failed"),FE,S,B) -> XResult applyBddIfCan(fe,fcn,arg,fcnName,posCheck?) == -- converts fcn(arg) to a generalized power series, where the -- function fcn is bounded for real values @@ -59120,26 +60283,32 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ BDDFCNS : L S := ["sin","cos","atan","acot"] -- functions which are bounded on the reals + contOnReals? : S -> B contOnReals? fcn == member?(fcn,CONTFCNS) + bddOnReals? : S -> B bddOnReals? fcn == member?(fcn,BDDFCNS) + opsInvolvingX : FE -> L BOP opsInvolvingX fcn == opList := [op for k in tower fcn | unary?(op := operator k) _ and member?(x,variables first argument k)] removeDuplicates opList + opInOpList? : (SY,L BOP) -> B opInOpList?(name,opList) == for op in opList repeat is?(op,name) => return true false + exponential? : FE -> B exponential? fcn == -- is 'fcn' of the form exp(f)? (ker := retractIfCan(fcn)@Union(K,"failed")) case K => is?(ker :: K,"exp" :: Symbol) false + productOfNonZeroes? : FE -> B productOfNonZeroes? fcn == -- is 'fcn' a product of non-zero terms, where 'non-zero' -- means an exponential or a function not involving x @@ -59150,6 +60319,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ return false true + tranToXXP : (K,FE,B) -> XResult tranToXXP(ker,arg,posCheck?) == -- converts op(arg) to a power series for certain functions -- op in trig or hyperbolic trig categories @@ -59179,15 +60349,18 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_ if FE has abs: FE -> FE then + localAbs : FE -> FE localAbs fcn == abs fcn else + localAbs : FE -> FE localAbs fcn == sqrt(fcn * fcn) signOfExpression: FE -> FE signOfExpression arg == localAbs(arg)/arg + atancotToXXP : (FE,FE,B,I) -> XResult atancotToXXP(fe,arg,posCheck?,plusMinus) == -- converts atan(f(x)) to a generalized power series atanFlag : String := "real: right side"; posCheck? : Boolean := true @@ -60053,48 +61226,13 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ (* package FS2UPS *) (* - ratIfCan : FE -> Union(RN,"failed") - carefulNthRootIfCan : (UPS,NNI,B,B) -> Result - stateProblem : (S,S) -> Result - polyToUPS : SUP -> UPS - listToUPS : (L FE,(FE,B,S) -> Result,B,S,UPS,(UPS,UPS) -> UPS)_ - -> Result - isNonTrivPower : FE -> Union(Record(val:FE,exponent:I),"failed") - powerToUPS : (FE,I,B,S) -> Result - kernelToUPS : (K,B,S) -> Result - nthRootToUPS : (FE,NNI,B,S) -> Result - logToUPS : (FE,B,S) -> Result - atancotToUPS : (FE,B,S,I) -> Result - applyIfCan : (UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result - tranToUPS : (K,FE,B,S) -> Result - powToUPS : (L FE,B,S) -> Result - newElem : FE -> FE - smpElem : SMP -> FE - k2Elem : K -> FE - contOnReals? : S -> B - bddOnReals? : S -> B - iExprToGenUPS : (FE,B,S) -> Result - opsInvolvingX : FE -> L BOP - opInOpList? : (SY,L BOP) -> B - exponential? : FE -> B - productOfNonZeroes? : FE -> B - powerToGenUPS : (FE,I,B,S) -> Result - kernelToGenUPS : (K,B,S) -> Result - nthRootToGenUPS : (FE,NNI,B,S) -> Result - logToGenUPS : (FE,B,S) -> Result - expToGenUPS : (FE,B,S) -> Result - expGenUPS : (UPS,B,S) -> Result - atancotToGenUPS : (FE,FE,B,S,I) -> Result - genUPSApplyIfCan : (UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result - applyBddIfCan : (FE,UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result - tranToGenUPS : (K,FE,B,S) -> Result - powToGenUPS : (L FE,B,S) -> Result - ZEROCOUNT : I := 1000 -- number of zeroes to be removed when taking logs or nth roots + ratIfCan : FE -> Union(RN,"failed") ratIfCan fcn == retractIfCan(fcn)@Union(RN,"failed") + carefulNthRootIfCan : (UPS,NNI,B,B) -> Result carefulNthRootIfCan(ups,n,posCheck?,rightOnly?) == -- similar to 'nthRootIfCan', but it is fussy about the series -- it takes as an argument. If 'n' is EVEN and 'posCheck?' @@ -60122,11 +61260,14 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ stateProblem("nth root","no nth root") [ans :: UPS] + stateProblem : (S,S) -> Result stateProblem(function,problem) == -- records the problem which occured in converting an expression -- to a power series [[function,problem]] + exprToUPS : (FE,Boolean,String) -> _ + Union(%series: UPS,%problem: Record(func: String,prob: String)) exprToUPS(fcn,posCheck?,atanFlag) == -- converts a functional expression to a power series --!! The following line is commented out so that expressions of @@ -60149,6 +61290,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ kernelToUPS(ker :: K,posCheck?,atanFlag) error "exprToUPS: neither a sum, product, power, nor kernel" + polyToUPS : SUP -> UPS polyToUPS poly == -- converts a polynomial to a power series zero? poly => 0 @@ -60165,6 +61307,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ poly := reductum poly ans + listToUPS : (L FE,(FE,B,S) -> Result,B,S,UPS,(UPS,UPS) -> UPS) -> Result listToUPS(list,feToUPS,posCheck?,atanFlag,ans,op) == -- converts each element of a list of expressions to a power -- series and returns the sum of these series, when 'op' is + @@ -60177,6 +61320,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ list := rest list [ans] + isNonTrivPower : FE -> Union(Record(val:FE,exponent:I),"failed") isNonTrivPower fcn == -- is the function a power with exponent other than 0 or 1? (expt := isPower fcn) case "failed" => "failed" @@ -60184,6 +61328,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ (power.exponent = 1) => "failed" power + powerToUPS : (FE,I,B,S) -> Result powerToUPS(fcn,n,posCheck?,atanFlag) == -- converts an integral power to a power series (b := exprToUPS(fcn,posCheck?,atanFlag)) case %problem => b @@ -60196,6 +61341,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ error "inverse of series with many leading zero coefficients" [ups ** n] + kernelToUPS : (K,B,S) -> Result kernelToUPS(ker,posCheck?,atanFlag) == -- converts a kernel to a power series (sym := symbolIfCan(ker)) case Symbol => @@ -60218,6 +61364,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ nthRootToUPS(first args,n :: NNI,posCheck?,atanFlag) stateProblem(string name ker,"unknown kernel") + nthRootToUPS : (FE,NNI,B,S) -> Result nthRootToUPS(arg,n,posCheck?,atanFlag) == -- converts an nth root to a power series -- this is not used in the limit package, so the series may @@ -60227,6 +61374,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ ans case %problem => ans [ans.%series] + logToUPS : (FE,B,S) -> Result logToUPS(arg,posCheck?,atanFlag) == -- converts a logarithm log(f(x)) to a power series -- f(x) must have order 0 and if 'posCheck?' is true, @@ -60245,15 +61393,18 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ if FE has abs: FE -> FE then + localAbs : FE -> FE localAbs fcn == abs fcn else + localAbs : FE -> FE localAbs fcn == sqrt(fcn * fcn) signOfExpression: FE -> FE signOfExpression arg == localAbs(arg)/arg + atancotToUPS : (FE,B,S,I) -> Result atancotToUPS(arg,posCheck?,atanFlag,plusMinus) == -- converts atan(f(x)) to a power series (result := exprToUPS(arg,posCheck?,atanFlag)) case %problem => result @@ -60292,6 +61443,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ atan coef [(cc :: UPS) + integrate(plusMinus * differentiate(ups)/(1 + ups*ups))] + applyIfCan : (UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result applyIfCan(fcn,arg,fcnName,posCheck?,atanFlag) == -- converts fcn(arg) to a power series (ups := exprToUPS(arg,posCheck?,atanFlag)) case %problem => ups @@ -60299,6 +61451,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ ans case "failed" => stateProblem(fcnName,"essential singularity") [ans :: UPS] + tranToUPS : (K,FE,B,S) -> Result tranToUPS(ker,arg,posCheck?,atanFlag) == -- converts ker to a power series for certain functions -- in trig or hyperbolic trig categories @@ -60350,6 +61503,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ applyIfCan(acschIfCan,arg,"acsch",posCheck?,atanFlag) stateProblem(string name ker,"unknown kernel") + powToUPS : (L FE,B,S) -> Result powToUPS(args,posCheck?,atanFlag) == -- converts a power f(x) ** g(x) to a power series (logBase := logToUPS(first args,posCheck?,atanFlag)) case %problem => @@ -60364,14 +61518,17 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ -- bounded functions of x are allowed to appear in the coefficients -- of the series. Used for evaluating REAL limits at x = 0. + newElem : FE -> FE newElem f == -- rewrites a functional expression; all trig functions are -- expressed in terms of sin and cos; all hyperbolic trig -- functions are expressed in terms of exp smpElem(numer f) / smpElem(denom f) + smpElem : SMP -> FE smpElem p == map(k2Elem,(x1:R):FE +-> x1::FE,p)$PCL + k2Elem : K -> FE k2Elem k == -- rewrites a kernel; all trig functions are -- expressed in terms of sin and cos; all hyperbolic trig @@ -60397,16 +61554,21 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ BDDFCNS : L S := ["sin","cos","atan","acot"] -- functions which are bounded on the reals + contOnReals? : S -> B contOnReals? fcn == member?(fcn,CONTFCNS) + bddOnReals? : S -> B bddOnReals? fcn == member?(fcn,BDDFCNS) + exprToGenUPS : (FE,Boolean,String) -> _ + Union(%series: UPS,%problem: Record(func: String,prob: String)) exprToGenUPS(fcn,posCheck?,atanFlag) == -- converts a functional expression to a generalized power -- series; "generalized" means that log(x) and bounded functions -- of x are allowed to appear in the coefficients of the series iExprToGenUPS(newElem fcn,posCheck?,atanFlag) + iExprToGenUPS : (FE,B,S) -> Result iExprToGenUPS(fcn,posCheck?,atanFlag) == -- converts a functional expression to a generalized power -- series without first normalizing the expression @@ -60430,22 +61592,26 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ kernelToGenUPS(ker :: K,posCheck?,atanFlag) error "exprToGenUPS: neither a sum, product, power, nor kernel" + opsInvolvingX : FE -> L BOP opsInvolvingX fcn == opList := [op for k in tower fcn | unary?(op := operator k) _ and member?(x,variables first argument k)] removeDuplicates opList + opInOpList? : (SY,L BOP) -> B opInOpList?(name,opList) == for op in opList repeat is?(op,name) => return true false + exponential? : FE -> B exponential? fcn == -- is 'fcn' of the form exp(f)? (ker := retractIfCan(fcn)@Union(K,"failed")) case K => is?(ker :: K,"exp" :: Symbol) false + productOfNonZeroes? : FE -> B productOfNonZeroes? fcn == -- is 'fcn' a product of non-zero terms, where 'non-zero' -- means an exponential or a function not involving x @@ -60456,6 +61622,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ return false true + powerToGenUPS : (FE,I,B,S) -> Result powerToGenUPS(fcn,n,posCheck?,atanFlag) == -- converts an integral power to a generalized power series -- if n < 0 and the lowest order coefficient of the series @@ -60482,6 +61649,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ productOfNonZeroes? coef => [ups ** n] stateProblem("inv","lowest order coefficient involves x") + kernelToGenUPS : (K,B,S) -> Result kernelToGenUPS(ker,posCheck?,atanFlag) == -- converts a kernel to a generalized power series (sym := symbolIfCan(ker)) case Symbol => @@ -60502,6 +61670,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ nthRootToGenUPS(first args,n :: NNI,posCheck?,atanFlag) stateProblem(string name ker,"unknown kernel") + nthRootToGenUPS : (FE,NNI,B,S) -> Result nthRootToGenUPS(arg,n,posCheck?,atanFlag) == -- convert an nth root to a power series -- used for computing right hand limits, so the series may have @@ -60513,6 +61682,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ ans case %problem => ans [ans.%series] + logToGenUPS : (FE,B,S) -> Result logToGenUPS(arg,posCheck?,atanFlag) == -- converts a logarithm log(f(x)) to a generalized power series (result := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem => @@ -60543,12 +61713,14 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ log(coef) + term1 [monomial(logTerm,0) + log(ups/lt)] + expToGenUPS : (FE,B,S) -> Result expToGenUPS(arg,posCheck?,atanFlag) == -- converts an exponential exp(f(x)) to a generalized -- power series (ups := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem => ups expGenUPS(ups.%series,posCheck?,atanFlag) + expGenUPS : (UPS,B,S) -> Result expGenUPS(ups,posCheck?,atanFlag) == -- computes the exponential of a generalized power series. -- If the series has order zero and the constant term a0 of the @@ -60568,6 +61740,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ result case %problem => result [(result.%series) * exp(ups - monomial(lc,0))] + atancotToGenUPS : (FE,FE,B,S,I) -> Result atancotToGenUPS(fe,arg,posCheck?,atanFlag,plusMinus) == -- converts atan(f(x)) to a generalized power series (result := exprToGenUPS(arg,posCheck?,atanFlag)) case %problem => @@ -60611,6 +61784,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ atan coef [(cc :: UPS) + integrate(differentiate(ups)/(1 + ups*ups))] + genUPSApplyIfCan : (UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result genUPSApplyIfCan(fcn,arg,fcnName,posCheck?,atanFlag) == -- converts fcn(arg) to a generalized power series (series := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem => @@ -60626,6 +61800,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ contOnReals? fcnName => [fcn(ups) :: UPS] stateProblem(fcnName,"x in constant coefficient") + applyBddIfCan : (FE,UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result applyBddIfCan(fe,fcn,arg,fcnName,posCheck?,atanFlag) == -- converts fcn(arg) to a generalized power series, where the -- function fcn is bounded for real values @@ -60638,6 +61813,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ (ans := fcn(ups.%series)) case "failed" => [monomial(fe,0)$UPS] [ans :: UPS] + tranToGenUPS : (K,FE,B,S) -> Result tranToGenUPS(ker,arg,posCheck?,atanFlag) == -- converts op(arg) to a power series for certain functions -- op in trig or hyperbolic trig categories @@ -60674,6 +61850,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_ genUPSApplyIfCan(acschIfCan,arg,"acsch",posCheck?,atanFlag) stateProblem(string name ker,"unknown kernel") + powToGenUPS : (L FE,B,S) -> Result powToGenUPS(args,posCheck?,atanFlag) == -- converts a power f(x) ** g(x) to a generalized power series (logBase := logToGenUPS(first args,posCheck?,atanFlag)) case %problem => @@ -60894,35 +62071,35 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP): import AlgFactor(UPA) import RationalFactorize(UPQ) - P2QifCan : PR -> Union(PQ, "failed") - UPQ2UP : (SparseUnivariatePolynomial PQ, F) -> UP - PQ2F : (PQ, F) -> F - ffactor0 : UP -> FR - dummy := kernel(new()$Symbol)$K if F has RetractableTo AN then UPAN2F: UPA -> UP - UPQ2AN: UPQ -> UPA - UPAN2F p == map(x+->x::F, p)$UnivariatePolynomialCategoryFunctions2(AN,UPA,F,UP) + UPQ2AN: UPQ -> UPA UPQ2AN p == map(x+->x::AN, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,AN,UPA) + ffactor : UP -> Factored(UP) ffactor p == (pq := anfactor p) case FRA => map(UPAN2F, pq::FRA)$FactoredFunctions2(UPA, UP) ffactor0 p + anfactor : UP -> _ + Union(Factored(SparseUnivariatePolynomial(AlgebraicNumber)),"failed") anfactor p == (q := UP2ifCan p) case overq => map(UPQ2AN, factor(q.overq))$FactoredFunctions2(UPQ, UPA) q case overan => factor(q.overan) "failed" + UP2ifCan : UP -> _ + Union(overq: SparseUnivariatePolynomial(Fraction(Integer)),_ + overan: SparseUnivariatePolynomial(AlgebraicNumber),failed: Boolean) UP2ifCan p == ansq := 0$UPQ ; ansa := 0$UPA goforq? := true @@ -60951,11 +62128,15 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP): UPQ2F p == map(x+->x::F, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP) + ffactor : UP -> Factored(UP) ffactor p == (pq := qfactor p) case FRQ => map(UPQ2F, pq::FRQ)$FactoredFunctions2(UPQ, UP) ffactor0 p + UP2ifCan : UP -> _ + Union(overq: SparseUnivariatePolynomial(Fraction(Integer)),_ + overan: SparseUnivariatePolynomial(AlgebraicNumber),failed: Boolean) UP2ifCan p == ansq := 0$UPQ while p ^= 0 repeat @@ -60965,6 +62146,7 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP): p := reductum p [ansq] + ffactor0 : UP -> FR ffactor0 p == smp := numer(ep := p(dummy::F)) (q := P2QifCan smp) case "failed" => p::FR @@ -60972,18 +62154,23 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP): )$MRationalFactorize(IndexedExponents K, K, Integer, PQ))$FactoredFunctions2(PQ, UP) + UPQ2UP : (SparseUnivariatePolynomial PQ, F) -> UP UPQ2UP(p, d) == map(x+->PQ2F(x, d), p)$UnivariatePolynomialCategoryFunctions2(PQ, SparseUnivariatePolynomial PQ, F, UP) + PQ2F : (PQ, F) -> F PQ2F(p, d) == map((x:K):F+->x::F, (y:Q):F+->y::F, p)_ $PolynomialCategoryLifting(IndexedExponents K, K, Q, PQ, F) / d + qfactor : UP -> _ + Union(Factored(SparseUnivariatePolynomial(Fraction(Integer))),"failed") qfactor p == (q := UP2ifCan p) case overq => factor(q.overq) "failed" + P2QifCan : PR -> Union(PQ, "failed") P2QifCan p == and/[retractIfCan(c::F)@Union(Q, "failed") case Q for c in coefficients p] => @@ -61226,24 +62413,30 @@ GaloisGroupFactorizationUtilities(R,UP,F): Exports == Implementation where import GaloisGroupUtilities(F) + height : UP -> F height(p:UP):F == infinityNorm(p) + length : UP -> F length(p:UP):F == norm(p,1) + norm : (UP,PositiveInteger) -> F norm(f:UP,p:P):F == n : F := 0 for c in coefficients f repeat n := n+abs(c::F)**p nthRoot(n,p::N) + quadraticNorm : UP -> F quadraticNorm(f:UP):F == norm(f,2) + infinityNorm : UP -> F infinityNorm(f:UP):F == n : F := 0 for c in coefficients f repeat n := max(n,c::F) n + singleFactorBound : UP -> Integer singleFactorBound(p:UP,r:N):Z == -- See [6] n : N := degree p r := max(2,r) @@ -61258,8 +62451,10 @@ GaloisGroupFactorizationUtilities(R,UP,F): Exports == Implementation where den : F := (pi()$F*nf)**(3/8) safeFloor( num/den ) + singleFactorBound : (UP,NonNegativeInteger) -> Integer singleFactorBound(p:UP):Z == singleFactorBound(p,2) -- See [6] + rootBound : UP -> Integer rootBound(p:UP):Z == -- See [4] and [5] n := degree p zero? n => 0 @@ -61280,12 +62475,14 @@ GaloisGroupFactorizationUtilities(R,UP,F): Exports == Implementation where min(1+safeCeiling(b1/lc),min(safeCeiling(2*b2),min(safeCeiling(b3/ (nthRoot(2::F,n)-1)),safeCeiling(b4)))) + beauzamyBound : UP -> Integer beauzamyBound(f:UP):Z == -- See [1] d := degree f zero? d => safeFloor bombieriNorm f safeFloor( (bombieriNorm(f)*(3::F)**(3/4+d/2))/ (2*sqrt(pi()$F*(d::F))) ) + bombieriNorm : (UP,PositiveInteger) -> F bombieriNorm(f:UP,p:P):F == -- See [2] and [3] d := degree f b := abs(coefficient(f,0)::F) @@ -61301,6 +62498,7 @@ GaloisGroupFactorizationUtilities(R,UP,F): Exports == Implementation where b := b+abs(coefficient(f, dd::N)::F)**p/pascalTriangle(d,dd) nthRoot(b,p::N) + bombieriNorm : UP -> F bombieriNorm(f:UP):F == bombieriNorm(f,2) -- See [1] *) @@ -62175,38 +63373,51 @@ GaloisGroupFactorizer(UP): Exports == Implementation where DDFact ==> Record(prime:Z, ddfactors:DDList) -- Distinct Degree Factors HLR ==> Record(plist:List UP, modulo:Z) -- HenselLift Record + factor : (UP,List(NonNegativeInteger),NonNegativeInteger) -> Factored(UP) + factorOfDegree : (PositiveInteger,UP) -> Union(UP,"failed") + mussertrials: P := 5 stopmussertrials: P := 8 usesinglefactorbound: Boolean := true tryfunctionaldecomposition: Boolean := true useeisensteincriterion: Boolean := true + useEisensteinCriterion? : () -> Boolean useEisensteinCriterion?():Boolean == useeisensteincriterion + useEisensteinCriterion : Boolean -> Boolean useEisensteinCriterion(b:Boolean):Boolean == (useeisensteincriterion,b) := (b,useeisensteincriterion) b + tryFunctionalDecomposition? : () -> Boolean tryFunctionalDecomposition?():Boolean == tryfunctionaldecomposition + tryFunctionalDecomposition : Boolean -> Boolean tryFunctionalDecomposition(b:Boolean):Boolean == (tryfunctionaldecomposition,b) := (b,tryfunctionaldecomposition) b + useSingleFactorBound? : () -> Boolean useSingleFactorBound?():Boolean == usesinglefactorbound + useSingleFactorBound : Boolean -> Boolean useSingleFactorBound(b:Boolean):Boolean == (usesinglefactorbound,b) := (b,usesinglefactorbound) b + stopMusserTrials : () -> PositiveInteger stopMusserTrials():P == stopmussertrials + stopMusserTrials : PositiveInteger -> PositiveInteger stopMusserTrials(n:P):P == (stopmussertrials,n) := (n,stopmussertrials) n + musserTrials : () -> PositiveInteger musserTrials():P == mussertrials + musserTrials : PositiveInteger -> PositiveInteger musserTrials(n:P):P == (mussertrials,n) := (n,mussertrials) n @@ -62220,6 +63431,7 @@ GaloisGroupFactorizer(UP): Exports == Implementation where import ModularDistinctDegreeFactorizer(UP) + eisensteinIrreducible? : UP -> Boolean eisensteinIrreducible?(f:UP):Boolean == rf := reductum f c: Z := content rf @@ -62235,6 +63447,8 @@ GaloisGroupFactorizer(UP): Exports == Implementation where (not zero? (tc rem ((p.factor)**2))) then return true false + numberOfFactors : List(Record(factor: UP,degree: Integer)) -> _ + NonNegativeInteger numberOfFactors(ddlist:DDList):N == n: N := 0 d: Z := 0 @@ -62245,17 +63459,21 @@ GaloisGroupFactorizer(UP): Exports == Implementation where n -- local function, returns the a Set of shifted elements + shiftSet : (Set N,N) -> Set N shiftSet(s:Set N,shift:N):Set N == set [ e+shift for e in parts s ] -- local function, returns the "reductum" of an Integer (as chain of bits) + reductum Z -> Z reductum(n:Z):Z == n-shift(1,length(n)-1) -- local function, returns an integer with level lowest bits set to 1 + seed : Z -> Z seed(level:Z):Z == shift(1,level)-1 -- local function, returns the next number (as a chain of bit) for -- factor reconciliation of a given level (which is the number of -- extraneaous factors involved) or "End of level" if not any + nextRecNum : (N,Z,Z) -> Union("End of level",Z) nextRecNum(levels:N,level:Z,n:Z):Union("End of level",Z) == if (l := length n) "End of level" @@ -62264,8 +63482,10 @@ GaloisGroupFactorizer(UP): Exports == Implementation where reductum(n)+shift(seed(b+1),lr) -- local function, return the set of N, 0..n + fullSet : N -> Set N fullSet(n:N):Set N == set [ i for i in 0..n ] + modularFactor : UP -> Record(prime: Integer,factors: List(UP)) modularFactor(p:UP):MFact == not (abs(content(p)) = 1) => error "modularFactor: the polynomial is not primitive." @@ -62301,7 +63521,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where d = dirred => return [0,[p]] -- p is irreducible cprime := nextPrime(cprime) nf := numberOfFactors ddlist - -- choose the one with the smallest number of factors choice := first trials nfc := numberOfFactors(choice.ddfactors) @@ -62314,6 +63533,8 @@ GaloisGroupFactorizer(UP): Exports == Implementation where -- HenselLift$GHENSEL expects the degree 0 factor first [cprime,separateFactors(choice.ddfactors,cprime)] + degreePartition : List(Record(factor: UP,degree: Integer)) -> _ + Multiset(NonNegativeInteger) degreePartition(ddlist:DDList):Multiset N == dp: Multiset N := empty() d: N := 0 @@ -62332,6 +63553,8 @@ GaloisGroupFactorizer(UP): Exports == Implementation where -- positive leading coefficient and non zero trailing coefficient, -- using the overall bound technique. If pdecomp is true then look -- for a functional decomposition of f. + henselFact : (UP,Boolean) -> _ + Record(contp: Integer,factors: List(Record(irr: UP,pow: Integer))) henselfact(f:UP,pdecomp:Boolean):List UP == if brillhartIrreducible? f or (useeisensteincriterion => eisensteinIrreducible? f ; false) @@ -62352,6 +63575,7 @@ GaloisGroupFactorizer(UP): Exports == Implementation where -- local function, returns the complete factorization of its arguments, -- using the single-factor bound technique + completeFactor : (UP,List UP,Z,P,N,Set N) -> List UP completeFactor(f:UP,lf:List UP,cprime:Z,pk:P,r:N,d:Set N):List UP == lc := leadingCoefficient f f0 := coefficient(f,0) @@ -62451,6 +63675,7 @@ GaloisGroupFactorizer(UP): Exports == Implementation where cons(f,ltrue) -- 3rd exit, the last factor was irreducible but not "true" -- local function, returns the set of elements "divided" by an integer + divideSet : (Set N,N) -> Set N divideSet(s:Set N, n:N):Set N == l: List N := [ 0 ] for e in parts s repeat @@ -62461,6 +63686,7 @@ GaloisGroupFactorizer(UP): Exports == Implementation where -- and some differences. f is assumed to be primitive, square-free -- and with positive leading coefficient. If pdecomp is true then -- look for a functional decomposition of f. + btwFactor : (UP,Set N,N,Boolean) -> List UP btwFactor(f:UP,d:Set N,r:N,pdecomp:Boolean):List UP == df := degree f not (max(d) = df) => error "btwFact: Bad arguments" @@ -62519,6 +63745,8 @@ GaloisGroupFactorizer(UP): Exports == Implementation where -- because we assume f with positive leading coefficient lf + makeFR : Record(contp: Integer,_ + factors: List(Record(irr: UP,pow: Integer))) -> Factored(UP) makeFR(flist:FinalFact):Factored UP == ctp := factor flist.contp fflist: List FFE := empty() @@ -62531,6 +63759,7 @@ GaloisGroupFactorizer(UP): Exports == Implementation where import IntegerRoots(Z) -- local function, factorizes a quadratic polynomial + quadratic : UP -> List UP quadratic(p:UP):List UP == a := leadingCoefficient p b := coefficient(p,1) @@ -62546,16 +63775,19 @@ GaloisGroupFactorizer(UP): Exports == Implementation where f: UP := monomial(a,1)+monomial(b,0) cons(f,[(p exquo f)::UP]) + isPowerOf2 : Z -> Boolean isPowerOf2(n:Z): Boolean == n = 1 => true qr: Record(quotient: Z, remainder: Z) := divide(n,2) qr.remainder = 1 => false isPowerOf2 qr.quotient + subMinusX : SUPZ -> UP subMinusX(supPol: SUPZ): UP == minusX: SUPZ := monomial(-1,1)$SUPZ unmakeSUP(elt(supPol,minusX)$SUPZ) + henselFact : (UP,Boolean) -> FinalFact henselFact(f:UP, sqf:Boolean):FinalFact == factorlist: List(ParFact) := empty() -- make m primitive @@ -62611,6 +63843,8 @@ GaloisGroupFactorizer(UP): Exports == Implementation where henselfact(sqff,true)],factorlist) [c,factorlist]$FinalFact + btwFact : (UP,Boolean,Set(NonNegativeInteger),NonNegativeInteger) -> _ + Record(contp: Integer,factors: List(Record(irr: UP,pow: Integer))) btwFact(f:UP, sqf:Boolean, fd:Set N, r:N):FinalFact == d := degree f not(max(fd)=d) => error "btwFact: Bad arguments" @@ -62681,6 +63915,7 @@ GaloisGroupFactorizer(UP): Exports == Implementation where fd := select(x+->x <= maxd,fd) [c,factorlist]$FinalFact + factor : UP -> Factored(UP) factor(f:UP):Factored UP == makeFR usesinglefactorbound => btwFact(f,false,fullSet(degree f),2) @@ -62688,46 +63923,60 @@ GaloisGroupFactorizer(UP): Exports == Implementation where -- local function, returns true if the sum of the elements of the list -- is not the degree. + errorsum? : (N,List N) -> Boolean errorsum?(d:N,ld:List N):Boolean == not (d = +/ld) -- local function, turns list of degrees into a Set + makeSet : List N -> Set N makeSet(ld:List N):Set N == s := set [0] for d in ld repeat s := union(s,shiftSet(s,d)) s + factor : (UP,NonNegativeInteger,NonNegativeInteger) -> Factored(UP) factor(f:UP,ld:List N,r:N):Factored UP == errorsum?(degree f,ld) => error "factor: Bad arguments" makeFR btwFact(f,false,makeSet(ld),r) + factor : (UP,NonNegativeInteger) -> Factored(UP) factor(f:UP,r:N):Factored UP == makeFR btwFact(f,false,fullSet(degree f),r) + factor : (UP,List(NonNegativeInteger)) -> Factored(UP) factor(f:UP,ld:List N):Factored UP == factor(f,ld,2) + factor : (UP,N,N) -> Factored UP factor(f:UP,d:N,r:N):Factored UP == n := (degree f) exquo d n case "failed" => error "factor: Bad arguments" factor(f,new(n::N,d)$List(N),r) + factorSquareFree : UP -> Factored(UP) factorSquareFree(f:UP):Factored UP == makeFR usesinglefactorbound => btwFact(f,true,fullSet(degree f),2) henselFact(f,true) + factorSquareFree : (UP,List(NonNegativeInteger),NonNegativeInteger) -> _ + Factored(UP) factorSquareFree(f:UP,ld:List(N),r:N):Factored UP == errorsum?(degree f,ld) => error "factorSquareFree: Bad arguments" makeFR btwFact(f,true,makeSet(ld),r) + factorSquareFree : (UP,NonNegativeInteger) -> Factored(UP) factorSquareFree(f:UP,r:N):Factored UP == makeFR btwFact(f,true,fullSet(degree f),r) + factorSquareFree : (UP,List(NonNegativeInteger)) -> Factored(UP) factorSquareFree(f:UP,ld:List N):Factored UP == factorSquareFree(f,ld,2) + factorSquareFree:(UP,NonNegativeInteger,NonNegativeInteger) -> Factored(UP) factorSquareFree(f:UP,d:N,r:N):Factored UP == n := (degree f) exquo d n case "failed" => error "factorSquareFree: Bad arguments" factorSquareFree(f,new(n::N,d)$List(N),r) + factorOfDegree : (PositiveInteger,UP,List(NonNegativeInteger),_ + NonNegativeInteger,Boolean) -> Union(UP,"failed") factorOfDegree(d:P,p:UP,ld:List N,r:N,sqf:Boolean):Union(UP,"failed") == dp := degree p errorsum?(dp,ld) => error "factorOfDegree: Bad arguments" @@ -62737,15 +63986,22 @@ GaloisGroupFactorizer(UP): Exports == Implementation where degree(f.irr)=d => return f.irr "failed" + factorOfDegree : (PositiveInteger,UP,List(NonNegativeInteger),_ + NonNegativeInteger) -> Union(UP,"failed") factorOfDegree(d:P,p:UP,ld:List N,r:N):Union(UP,"failed") == factorOfDegree(d,p,ld,r,false) + factorOfDegree : (PositiveInteger,UP,NonNegativeInteger) -> _ + Union(UP,"failed") factorOfDegree(d:P,p:UP,r:N):Union(UP,"failed") == factorOfDegree(d,p,new(degree p,1)$List(N),r,false) + factorOfDegree : (PositiveInteger,UP,List(NonNegativeInteger)) -> _ + Union(UP,"failed") factorOfDegree(d:P,p:UP,ld:List N):Union(UP,"failed") == factorOfDegree(d,p,ld,2,false) + factorOfDegree : (PositiveInteger,UP) -> Union(UP,"failed") factorOfDegree(d:P,p:UP):Union(UP,"failed") == factorOfDegree(d,p,new(degree p,1)$List(N),2,false) @@ -62917,6 +64173,7 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where import Factored UP + factorsOfDegree : (PositiveInteger,Factored(UP)) -> List(UP) factorsOfDegree(d:P,r:Factored UP):List UP == lfact : List UP := empty() for fr in factors r | degree(fr.factor)=(d::N) repeat @@ -62924,6 +64181,7 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where lfact := cons(fr.factor,lfact) lfact + factorOfDegree : (PositiveInteger,Factored(UP)) -> UP factorOfDegree(d:P,r:Factored UP):UP == factor : UP := 0 for i in 1..numberOfFactors r repeat @@ -62931,22 +64189,27 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where if degree(factor)=(d::N) then return factor error "factorOfDegree: Bad arguments" + degreePartition : Factored(UP) -> Multiset(NonNegativeInteger) degreePartition(r:Factored UP):Multiset N == multiset([ degree(nthFactor(r,i)) for i in 1..numberOfFactors r ]) + monic? : UP -> Boolean monic?(p:UP):Boolean == (leadingCoefficient p) = 1 + unvectorise : Vector(R) -> UP unvectorise(v:Vector R):UP == p : UP := 0 for i in 1..#v repeat p := p + monomial(v(i),(i-1)::N) p + reverse : UP -> UP reverse(p:UP):UP == r : UP := 0 n := degree(p) for i in 0..n repeat r := r + monomial(coefficient(p,(n-i)::N),i) r + scaleRoots : (UP,R) -> UP scaleRoots(p:UP,c:R):UP == (c = 1) => p n := degree p @@ -62961,6 +64224,7 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where import UnivariatePolynomialCategoryFunctions2(R,UP,UP, SparseUnivariatePolynomial UP) + shiftRoots : (UP,R) -> UP shiftRoots(p:UP,c:R):UP == elt(map(coerce,p),monomial(1,1)$UP-c::UP)::UP *) @@ -63153,26 +64417,33 @@ GaloisGroupUtilities(R): Exports == Implementation where safetymargin : N := 6 + safeFloor : R -> Integer safeFloor(x:R):Z == if (shift := order(x)-precision()$R+safetymargin) >= 0 then x := x+float(1,shift) retract(floor(x))@Z + safeCeiling : R -> Integer safeCeiling(x:R):Z == if (shift := order(x)-precision()$R+safetymargin) >= 0 then x := x+float(1,shift) retract(ceiling(x))@Z + safetyMargin : NonNegativeInteger -> NonNegativeInteger safetyMargin(n:N):N == (safetymargin,n) := (n,safetymargin) n + safetyMargin : () -> NonNegativeInteger safetyMargin():N == safetymargin pascaltriangle : FlexibleArray(R) := empty() + ncomputed : N := 3 + rangepascaltriangle : N := 216 + pascalTriangle : (NonNegativeInteger,Integer) -> R pascalTriangle(n:N, r:Z):R == negative? r => 0 (d := n-r) < r => pascalTriangle(n,d) @@ -63192,6 +64463,7 @@ GaloisGroupUtilities(R): Exports == Implementation where ncomputed := i pascalTriangle(n,r) + rangePascalTriangle : NonNegativeInteger -> NonNegativeInteger rangePascalTriangle(n:N):N == if n NonNegativeInteger rangePascalTriangle():N == rangepascaltriangle + sizePascalTriangle : () -> NonNegativeInteger sizePascalTriangle():N == #pascaltriangle + fillPascalTriangle : () -> Void fillPascalTriangle():Void == pascalTriangle(rangepascaltriangle,2) *) @@ -63440,16 +64715,19 @@ GaussianFactorizationPackage() : C == T import IntegerFactorizationPackage Z + reduction : (Z,Z) -> Z reduction(u:Z,p:Z):Z == p=0 => u positiveRemainder(u,p) + merge : (Z,Z) -> Union(Z,"failed") merge(p:Z,q:Z):Union(Z,"failed") == p = q => p p = 0 => q q = 0 => p "failed" + exactquo : (Z,Z,Z) -> Union(Z,"failed") exactquo(u:Z,v:Z,p:Z):Union(Z,"failed") == p=0 => u exquo v v rem p = 0 => "failed" @@ -63461,6 +64739,7 @@ GaussianFactorizationPackage() : C == T fact2:ZI:= complex(1,1) ---- find the solution of x**2+1 mod q ---- + findelt : Z -> Z findelt(q:Z) : Z == q1:=q-1 r:=q1 @@ -63479,6 +64758,7 @@ GaussianFactorizationPackage() : C == T s::Z ---- write p, congruent to 1 mod 4, as a sum of two squares ---- + sumsq1 : Z -> List Z sumsq1(p:Z) : List Z == s:= findelt(p) u:=p @@ -63489,6 +64769,7 @@ GaussianFactorizationPackage() : C == T [u,s] ---- factorization of an integer ---- + intfactor : Z -> Factored ZI intfactor(n:Z) : Factored ZI == lfn:= factor n r : List FFE :=[] @@ -63507,6 +64788,7 @@ GaussianFactorizationPackage() : C == T makeFR(unity,r) ---- factorization of a gaussian number ---- + factor : Complex(Integer) -> Factored(Complex(Integer)) factor(m:ZI) : FRZ == m=0 => primeFactor(0,1) a:= real m @@ -63549,11 +64831,13 @@ GaussianFactorizationPackage() : C == T makeFR(unity,result) ---- write p prime like sum of two squares ---- + sumSquares : Integer -> List(Integer) sumSquares(p:Z) : List Z == p=2 => [1,1] p rem 4 ^= 1 => error "no solutions" sumsq1(p) + prime? : Complex(Integer) -> Boolean prime?(a:ZI) : Boolean == n : Z := norm a n=0 => false -- zero @@ -63782,29 +65066,30 @@ GeneralHenselPackage(RP,TP):C == T where (* package GHENSEL *) (* - GenExEuclid: (List(FP),List(FP),FP) -> List(FP) - HenselLift1: (TP,List(TP),List(FP),List(FP),RP,RP,F) -> List(TP) - mQuo: (TP,RP) -> TP - + reduceCoef : (RP,RP) -> RP reduceCoef(c:RP,p:RP):RP == zero? p => c RP is Integer => symmetricRemainder(c,p) c rem p + reduction : (TP,RP) -> TP reduction(u:TP,p:RP):TP == zero? p => u RP is Integer => map(x+->symmetricRemainder(x,p),u) map(x+->x rem p,u) + merge : (RP,RP) -> Union(RP,"failed") merge(p:RP,q:RP):Union(RP,"failed") == p = q => p p = 0 => q q = 0 => p "failed" + modInverse : (RP,RP) -> RP modInverse(c:RP,p:RP):RP == (extendedEuclidean(c,p,1)::Record(coef1:RP,coef2:RP)).coef1 + exactquo : (TP,TP,RP) -> Union(TP,"failed") exactquo(u:TP,v:TP,p:RP):Union(TP,"failed") == invlcv:=modInverse(leadingCoefficient v,p) r:=monicDivide(u,reduction(invlcv*v,p)) @@ -63813,12 +65098,15 @@ GeneralHenselPackage(RP,TP):C == T where FP:=EuclideanModularRing(RP,TP,RP,reduction,merge,exactquo) + mQuo: (TP,RP) -> TP mQuo(poly:TP,n:RP) : TP == map(x+->x quo n,poly) + GenExEuclid: (List(FP),List(FP),FP) -> List(FP) GenExEuclid(fl:List FP,cl:List FP,rhs:FP) :List FP == [clp*rhs rem flp for clp in cl for flp in fl] -- generate the possible factors + genFact : (List TP,List List TP) -> List List TP genFact(fln:List TP,factlist:List List TP) : List List TP == factlist=[] => [[pol] for pol in fln] maxd := +/[degree f for f in fln] quo 2 @@ -63831,6 +65119,7 @@ GeneralHenselPackage(RP,TP):C == T where auxfl := cons(cons(poly,term),auxfl) auxfl + HenselLift1: (TP,List(TP),List(FP),List(FP),RP,RP,F) -> List(TP) HenselLift1(poly:TP,fln:List TP,fl1:List FP,cl1:List FP, prime:RP,Modulus:RP,cinv:RP):List TP == lcp := leadingCoefficient poly @@ -63840,6 +65129,8 @@ GeneralHenselPackage(RP,TP):C == T where vl := GenExEuclid(fl1,cl1,lcinv*rhs) [flp + Modulus*(vlp::TP) for flp in fln for vlp in vl] + HenselLift : (TP,List(TP),RP,PositiveInteger) -> _ + Record(plist: List(TP),modulo: RP) HenselLift(poly:TP,tl1:List TP,prime:RP,bound:PI) == -- convert tl1 constp:TP:=0 @@ -63860,6 +65151,7 @@ GeneralHenselPackage(RP,TP):C == T where if constp^=0 then fln:=cons(constp,fln) [fln,Modulus] + completeHensel : (TP,List(TP),RP,PositiveInteger) -> List(TP) completeHensel(m:TP,tl1:List TP,prime:RP,bound:PI) == hlift:=HenselLift(m,tl1,prime,bound) Modulus:RP:=hlift.modulo @@ -64006,6 +65298,7 @@ GeneralizedMultivariateFactorize(OV,E,S,R,P) : C == T (* package GENMFACT *) (* + factor : P -> Factored(P) factor(p:P) : Factored P == R has FiniteFieldCategory => factor(p)$MultFiniteFactorize(OV,E,R,P) R is Polynomial(S) and S has EuclideanDomain => @@ -64821,37 +66114,46 @@ GeneralPackageForAlgebraicFunctionField( K, -- flags telling such and such is already computed. genusCalc?:Boolean:= false()$Boolean + theGenus:INT:=0 desingTreeCalc?:Boolean:=false()$Boolean + theTree:List DesTree := empty() desingTreeWoFullParamCalc?:Boolean:=false()$Boolean adjDivCalc?:Boolean:=false()$Boolean + theAdjDiv:DIVISOR:=0 singularPointsCalc?:Boolean:=false()$Boolean + lesPtsSing:List(ProjPt):=empty() rationalPointsCalc?:Boolean:=false()$Boolean + lesRatPts:List(ProjPt):=empty() rationalPlacesCalc?:Boolean:=false()$Boolean + lesRatPlcs:List(Plc):=empty() zf:UTSZ:=1$UTSZ + zfCalc : Boolean := false()$Boolean DegOfPlacesFound: List Integer := empty() -- see package IntersectionDivisorPackage + intersectionDivisor : PolyRing -> DIVISOR intersectionDivisor(pol)== if ^(pol =$PolyRing homogenize(pol,1)) then _ error _ "From intersectionDivisor: the input is NOT a homogeneous polynomial" intersectionDivisor(pol,theCurve(),desingTree(),singularPoints()) + lBasis : DIVISOR -> Record(num: List(PolyRing),den: PolyRing) lBasis(divis)== d:=degree divis d < 0 => [[0$PolyRing],1$PolyRing] @@ -64879,7 +66181,8 @@ GeneralPackageForAlgebraicFunctionField( K, lnumer:List PolyRing:=interpolateForms(dg0-divis,dmin) [lnumer,g0] - genus== + genus : () -> NonNegativeInteger + genus == if ^(genusCalc?) then degCrb:=totalDegree(theCurve())$PackPoly theGenus:=genusTreeNeg(degCrb,desingTreeWoFullParam()) @@ -64890,6 +66193,7 @@ GeneralPackageForAlgebraicFunctionField( K, error "Have a nice day" theGenus pretend NNI + genusNeg : () -> Integer genusNeg== if ^(genusCalc?) then degCrb:=totalDegree(theCurve())$PackPoly @@ -64897,14 +66201,16 @@ GeneralPackageForAlgebraicFunctionField( K, genusCalc?:=true()$Boolean theGenus + homogenize : (PolyRing,Integer) -> PolyRing homogenize(pol,n)== homogenize(pol,n)$PackPoly + fPl : (ProjPt,DesTree) -> Boolean fPl(pt:ProjPt,desTr:DesTree):Boolean == nd:=value desTr lpt:=pointV nd pt = lpt - + placesAbove : ProjPt -> List(Plc) placesAbove(pt)== -- verifie si le point est simple, si c'est le cas, -- on retourne la place correpondante @@ -64922,11 +66228,14 @@ GeneralPackageForAlgebraicFunctionField( K, -- les diviseurs exceptionnels. concat [supp excpDivV(l) for l in lvs] + pointDominateBy : Plc -> ProjPt pointDominateBy(pl)== pointDominateBy(pl)$ParamPackFC + reduceForm : (PolyRing,PolyRing) -> PolyRing reduceForm(p1:PolyRing,p2:PolyRing):PolyRing== normalForm(p1,[p2])$GroebnerPackage(K,E,OV,PolyRing) + evalIfCan : (PolyRing,Plc) -> Union(K,"failed") evalIfCan(f:PolyRing,pl:Plc)== u:=reduceForm(f, theCurve() ) zero?(u) => 0 @@ -64936,12 +66245,14 @@ GeneralPackageForAlgebraicFunctionField( K, ord > 0 => 0 coefOfFirstNonZeroTerm pf + eval : (PolyRing,Plc) -> K eval(f:PolyRing,pl:Plc)== eic:=evalIfCan(f,pl) eic case "failed" => _ error "From eval (function at place): its a pole !!!" eic + setCurve : PolyRing -> PolyRing setCurve(pol)== crvLocal:=pol ^(crvLocal =$PolyRing homogenize(crvLocal,1)) => @@ -64950,6 +66261,7 @@ GeneralPackageForAlgebraicFunctionField( K, reset() theCurve() + reset : () -> Void reset == setFoundPlacesToEmpty()$Plc genusCalc?:Boolean:= false()$Boolean @@ -64969,10 +66281,13 @@ GeneralPackageForAlgebraicFunctionField( K, zf:UTSZ:=1$UTSZ zfCalc:Boolean := false$Boolean + foundPlacesOfDeg? : PositiveInteger -> Boolean foundPlacesOfDeg?(i:PositiveInteger):Boolean == ld: List Boolean := [zero?(a rem i) for a in DegOfPlacesFound] entry?(true$Boolean,ld) + findOrderOfDivisor : (DIVISOR,Integer,Integer) -> _ + Record(ord: Integer,num: PolyRing,den: PolyRing,upTo: Integer) findOrderOfDivisor(divis,lb,hb) == ^zero?(degree divis) => error("The divisor is NOT of degre zero !!!!") A:=adjunctionDivisor() @@ -65000,15 +66315,18 @@ GeneralPackageForAlgebraicFunctionField( K, lnumer:List PolyRing:=interpolateForms(dg0-ftry*divis,dmin) [ftry,first lnumer,g0,nhb] + theCurve : () -> PolyRing theCurve== one?(crvLocal) => error "The defining polynomial has not been set yet!" crvLocal + printInfo : List(Boolean) -> Void printInfo(lbool)== printInfo(lbool.2)$ParamPackFC printInfo(lbool.3)$PCS void() + desingTree : () -> List(DesTree) desingTree== theTree:= desingTreeWoFullParam() if ^(desingTreeCalc?) then @@ -65017,6 +66335,7 @@ GeneralPackageForAlgebraicFunctionField( K, desingTreeCalc?:=true()$Boolean theTree + desingTreeWoFullParam : () -> List(DesTree) desingTreeWoFullParam== if ^(desingTreeWoFullParamCalc?) then theTree:=[desingTreeAtPoint(pt,theCurve()) for pt in singularPoints()] @@ -65025,6 +66344,7 @@ GeneralPackageForAlgebraicFunctionField( K, -- compute the adjunction divisor of the curve using adjunctionDivisor -- from DesingTreePackage + adjunctionDivisor : () -> DIVISOR adjunctionDivisor()== if ^(adjDivCalc?) then theAdjDiv:=_ @@ -65034,12 +66354,14 @@ GeneralPackageForAlgebraicFunctionField( K, -- returns the singular points using the function singularPoints -- from ProjectiveAlgebraicSetPackage + singularPoints : () -> List(ProjPt) singularPoints== if ^(singularPointsCalc?) then lesPtsSing:=singularPoints(theCurve()) singularPointsCalc?:=true()$Boolean lesPtsSing + setSingularPoints : List(ProjPt) -> List(ProjPt) setSingularPoints(lspt)== singularPointsCalc?:=true()$Boolean lesPtsSing:= lspt @@ -65049,16 +66371,20 @@ GeneralPackageForAlgebraicFunctionField( K, -- compute the local parametrization of f at the place pl -- (from package ParametrizationPackage) + parametrize : (PolyRing,Plc) -> PCS parametrize(f,pl)==parametrize(f,pl)$ParamPack -- compute the interpolating forms (see package InterpolateFormsPackage) + interpolateForms : (DIVISOR,NonNegativeInteger) -> List(PolyRing) interpolateForms(d,n)== lm:List PolyRing:=listAllMono(n)$PackPoly interpolateForms(d,n,theCurve(),lm) + interpolateFormsForFact : (DIVISOR,List(PolyRing)) -> List(PolyRing) interpolateFormsForFact(d,lm)== interpolateFormsForFact(d,lm)$IntFrmPack + evalIfCan : (PolyRing,PolyRing,Plc) -> Union(K,"failed") evalIfCan(f:PolyRing,g:PolyRing,pl:Plc)== fu:=reduceForm(f,theCurve()) gu:=reduceForm(g,theCurve()) @@ -65074,16 +66400,19 @@ GeneralPackageForAlgebraicFunctionField( K, (ordf - ordg) > 0 => 0 cf * inv cg + eval : (PolyRing,PolyRing,Plc) -> K eval(f:PolyRing,g:PolyRing,pl:Plc)== eic:=evalIfCan(f,g,pl) eic case "failed" => error "From eval (function at place): its a pole" eic + evalIfCan : (Fraction(PolyRing),Plc) -> Union(K,"failed") evalIfCan(u:FRACPOLY,pl:Plc)== f:PolyRing := numer u g:PolyRing := denom u evalIfCan(f,g,pl) + eval : (Fraction(PolyRing),Plc) -> K eval(u:FRACPOLY,pl:Plc)== f:PolyRing := numer u g:PolyRing := denom u @@ -65091,10 +66420,13 @@ GeneralPackageForAlgebraicFunctionField( K, thedeg:PI := 1 + crap : Plc -> Boolean crap(p:Plc):Boolean == degree(p)$Plc = thedeg if K has Finite then + + rationalPlaces : () -> List(Plc) rationalPlaces == K has PseudoAlgebraicClosureOfFiniteFieldCategory => _ placesOfDegree(1$PI) @@ -65110,6 +66442,7 @@ GeneralPackageForAlgebraicFunctionField( K, lesRatPlcs:=foundPlaces()$Plc lesRatPlcs + rationalPoints : () -> List(ProjPt) rationalPoints== if ^(rationalPointsCalc?) then if K has Finite then @@ -65119,12 +66452,14 @@ GeneralPackageForAlgebraicFunctionField( K, error "Can't find rationalPoints when the field is not finite" lesRatPts + ZetaFunction:() -> UnivariateTaylorSeriesCZero(Integer,t) if K has FINITE ZetaFunction() == if not zfCalc then zf:= ZetaFunction(1) zfCalc:= true$Boolean zf + ZetaFunction : PositiveInteger -> UnivariateTaylorSeriesCZero(Integer,t) ZetaFunction(d) == lp:= LPolynomial(d) if K has PseudoAlgebraicClosureOfFiniteFieldCategory then @@ -65142,10 +66477,11 @@ GeneralPackageForAlgebraicFunctionField( K, ivm := 1 lps * ivm + --in index i is the "almost ZetaFunction" summed to i-1. + --Except calculatedSer.1 which is 1 calculatedSer: List UTSZ:= [1] - --in index i is the "almost ZetaFunction" summed to i-1. - --Except calculatedSer.1 which is 1 + numberOfPlacesOfDegreeUsingZeta : PI -> Integer numberOfPlacesOfDegreeUsingZeta(degree:PI): Integer == --is at most called once for each degree. Will calculate the --entries in calculatdSer. @@ -65176,6 +66512,7 @@ GeneralPackageForAlgebraicFunctionField( K, calculatedNP: List Integer := empty() --local variable, in index i is number of places of degree i. + numberOfPlacesOfDegree : PositiveInteger -> Integer numberOfPlacesOfDegree(i:PI): Integer == if zfCalc then if (m := maxIndex(calculatedNP)) < i then @@ -65187,6 +66524,7 @@ GeneralPackageForAlgebraicFunctionField( K, else # placesOfDegree(i) --maybe we should make an improvement in this + placesOfDegree : PositiveInteger -> List(Plc) placesOfDegree(i) == if (not foundPlacesOfDeg?(i)) then if characteristic()$K**i > (2**16 - 1) then @@ -65198,9 +66536,11 @@ GeneralPackageForAlgebraicFunctionField( K, thedeg:= i select(crap(#1), foundPlaces()$Plc) + numberRatPlacesExtDeg : PositiveInteger -> Integer numberRatPlacesExtDeg(extDegree:PI): Integer == numberPlacesDegExtDeg(1,extDegree) + numberPlacesDegExtDeg : (PositiveInteger,PositiveInteger) -> Integer numberPlacesDegExtDeg(degree:PI, extDegree:PI): Integer == res:Integer:=0 m:PI := degree * extDegree @@ -65212,6 +66552,7 @@ GeneralPackageForAlgebraicFunctionField( K, m:= (m - 1) pretend PI res + calculateS : PI -> List Integer calculateS(extDeg:PI): List Integer == g := genus() sizeK:NNI := size()$K ** extDeg @@ -65226,9 +66567,11 @@ GeneralPackageForAlgebraicFunctionField( K, else good:= false()$Boolean S + LPolynomial : () -> SparseUnivariatePolynomial(Integer) LPolynomial(): SparseUnivariatePolynomial Integer == LPolynomial(1) + LPolynomial : PositiveInteger -> SparseUnivariatePolynomial(Integer) LPolynomial(extDeg:PI): SparseUnivariatePolynomial Integer == --when translating to AxiomXL rewrite this function! g := genus() @@ -65267,6 +66610,7 @@ GeneralPackageForAlgebraicFunctionField( K, i:= i + 1 result + classNumber : () -> Integer classNumber():Integer == LPolynomial()(1) @@ -65972,25 +67316,9 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where SUPR ==> SparseUnivariatePolynomial R import UnivariatePolynomialCategoryFunctions2(R,SUPR,P,SUPP) import UnivariatePolynomialCategoryFunctions2(P,SUPP,R,SUPR) - -------- Local Functions -------- - - better : (P,P) -> Boolean - - lift : (SUPR,SUPP,SUPR,List OV,List R) -> Union(SUPP,"failed") - -- lifts first and third arguments as factors of the second - -- fourth is number of variables. - monomContentSup : SUPP -> SUPP - gcdTrivial : (SUPP,SUPP) -> SUPP - gcdSameVariables: (SUPP,SUPP,List OV) -> SUPP - recursivelyGCDCoefficients: (SUPP,List OV,SUPP,List OV) -> SUPP - flatten : (SUPP,List OV) -> SUPP - -- evaluates out all variables in the second - -- argument, leaving a polynomial of the same - -- degree - variables : SUPP -> List OV - ---- JHD's exported functions --- - + gcdPolynomial : (SparseUnivariatePolynomial(P),_ + SparseUnivariatePolynomial(P)) -> SparseUnivariatePolynomial(P) gcdPolynomial(p1:SUPP,p2:SUPP) == zero? p1 => p2 zero? p2 => p1 @@ -66041,6 +67369,8 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where if R has StepThrough then randomCount:R := init() + + randomR : () -> R randomR() == (v:=nextItem(randomCount)) case R => randomCount:=v @@ -66052,9 +67382,11 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where else - randomR() == (random$Integer() rem 100)::R + randomR : () -> R + randomR() == (random$Integer() rem 100)::R ---- JHD's local functions --- + gcdSameVariables: (SUPP,SUPP,List OV) -> SUPP gcdSameVariables(p1:SUPP,p2:SUPP,lv:List OV) == -- two non-trivial primitive (or, at least, we don't care -- about content) @@ -66113,6 +67445,7 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where error "too many evaluations in GCD code" count >= 10 => error "too many evaluations in GCD code" + lift : (SUPR,SUPP,SUPR,List OV,List R) -> Union(SUPP,"failed") lift(gR:SUPR,p:SUPP,cfR:SUPR,lv:List OV,lr:List R) == -- lift the coprime factorisation gR*cfR = (univariate of p) -- where the variables lv have been evaluated at lr @@ -66144,6 +67477,7 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where thisp ^= g*cf => return "failed" g + recursivelyGCDCoefficients: (SUPP,List OV,SUPP,List OV) -> SUPP recursivelyGCDCoefficients(g:SUPP,v:List OV,p:SUPP,pv:List OV) == mv:=first pv -- take each coefficient w.r.t. mv pv:=rest pv -- and recurse on pv as necessary @@ -66160,6 +67494,7 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where pv:=setUnion(pv,setDifference(v,oldv)) g + flatten : (SUPP,List OV) -> SUPP flatten(p1:SUPP,lv:List OV) == #lv = 0 => p1 lr:=[ randomR() for vv in lv] @@ -66168,9 +67503,11 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where lr:=[ randomR() for vv in lv] ans + variables : SUPP -> List OV variables(p1:SUPP) == removeDuplicates ("concat"/[variables u for u in coefficients p1]) + gcdTrivial : (SUPP,SUPP) -> SUPP gcdTrivial(p1:SUPP,p2:SUPP) == -- p1 is non-zero, but has degree zero -- p2 is non-zero @@ -66185,12 +67522,14 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where un? => 1 cp1::SUPP + monomContentSup : SUPP -> SUPP monomContentSup(u:SUPP):SUPP == degree(u) = 0$NonNegativeInteger => 1$SUPP md:= minimumDegree u gcd(sort(better,coefficients u)) * monomial(1$P,md)$SUPP - -- Ordering for gcd purposes + -- Ordering for gcd purposes + better : (P,P) -> Boolean better(p1:P,p2:P):Boolean == ground? p1 => true ground? p2 => false @@ -66471,15 +67810,19 @@ GenerateUnivariatePowerSeries(R,FE): Exports == Implementation where n > m => empty() concat(f(n),genFiniteStream(f,n + 1,m)) + taylor : ((Integer -> FE),Equation(FE)) -> Any taylor(f,eq) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" x := xx :: SY; a := rhs eq coerce(series(genStream(f,0))$UTS(FE,x,a))$ANY1(UTS(FE,x,a)) + taylor : (FE,Symbol,Equation(FE)) -> Any taylor(an:FE,n:SY,eq:EQ FE) == taylor((i:I):FE +-> eval(an,(n::FE) = (i::FE)),eq) + taylor : ((Integer -> FE),Equation(FE),_ + UniversalSegment(NonNegativeInteger)) -> Any taylor(f:I -> FE,eq:EQ FE,seg:SEG NNI) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" @@ -66495,9 +67838,11 @@ GenerateUnivariatePowerSeries(R,FE): Exports == Implementation where uts := uts * monomial(1,n0)$UTS(FE,x,a) coerce(uts)$ANY1(UTS(FE,x,a)) + taylor:(FE,Symbol,Equation(FE),UniversalSegment(NonNegativeInteger)) -> Any taylor(an,n,eq,seg) == taylor((i:I):FE +-> eval(an,(n::FE) = (i::FE)),eq,seg) + laurent : ((Integer -> FE),Equation(FE),UniversalSegment(Integer)) -> Any laurent(f,eq,seg) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "taylor: left hand side must be a variable" @@ -66511,12 +67856,15 @@ GenerateUnivariatePowerSeries(R,FE): Exports == Implementation where uts := series(genStream(f,n0))$UTS(FE,x,a) coerce(laurent(n0,uts)$ULS(FE,x,a))$ANY1(ULS(FE,x,a)) + laurent : (FE,Symbol,Equation(FE),UniversalSegment(Integer)) -> Any laurent(an,n,eq,seg) == laurent((i:I):FE +-> eval(an,(n::FE) = (i::FE)),eq,seg) modifyFcn:(RN -> FE,I,I,I,I) -> FE modifyFcn(f,n0,nn,q,m) == (zero?((m - n0) rem nn) => f(m/q); 0) + puiseux : ((Fraction(Integer) -> FE),Equation(FE),_ + UniversalSegment(Fraction(Integer)),Fraction(Integer)) -> Any puiseux(f,eq,seg,r) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "puiseux: left hand side must be a variable" @@ -66544,23 +67892,33 @@ GenerateUnivariatePowerSeries(R,FE): Exports == Implementation where uls := retract(ulsUnion)$ANY1(ULS(FE,x,a)) coerce(puiseux(1/q,uls)$UPXS(FE,x,a))$ANY1(UPXS(FE,x,a)) + puiseux : (FE,Symbol,Equation(FE),UniversalSegment(Fraction(Integer)),_ + Fraction(Integer)) -> Any puiseux(an,n,eq,r0,m) == puiseux((r:RN):FE+->eval(an,(n::FE) = (r::FE)),eq,r0,m) + series : ((Integer -> FE),Equation(FE)) -> Any series(f:I -> FE,eq:EQ FE) == puiseux(r+->f(numer r),eq,segment 0,1) + series : (FE,Symbol,Equation(FE)) -> Any series(an:FE,n:SY,eq:EQ FE) == puiseux(an,n,eq,segment 0,1) + series : ((Integer -> FE),Equation(FE),UniversalSegment(Integer)) -> Any series(f:I -> FE,eq:EQ FE,seg:SEG I) == ratSeg : SEG RN := map(x+->x::RN,seg)$UniversalSegmentFunctions2(I,RN) puiseux((r:RN):FE+->f(numer r),eq,ratSeg,1) + series : (FE,Symbol,Equation(FE),UniversalSegment(Integer)) -> Any series(an:FE,n:SY,eq:EQ FE,seg:SEG I) == ratSeg : SEG RN := map(i+->i::RN,seg)$UniversalSegmentFunctions2(I,RN) puiseux(an,n,eq,ratSeg,1) + series : ((Fraction(Integer) -> FE),Equation(FE),_ + UniversalSegment(Fraction(Integer)),Fraction(Integer)) -> Any series(f:RN -> FE,eq:EQ FE,seg:SEG RN,r:RN) == puiseux(f,eq,seg,r) + series : (FE,Symbol,Equation(FE),UniversalSegment(Fraction(Integer)),_ + Fraction(Integer)) -> Any series(an:FE,n:SY,eq:EQ FE,seg:SEG RN,r:RN) == puiseux(an,n,eq,seg,r) *) @@ -66843,6 +68201,7 @@ GenExEuclid(R,BP) : C == T if R has multiplicativeValuation then + compBound : (BP,List(BP)) -> NonNegativeInteger compBound(m:BP,listpolys:L BP) : NNI == ldeg:=[degree f for f in listpolys] n:NNI:= (+/[df for df in ldeg]) @@ -66856,36 +68215,43 @@ GenExEuclid(R,BP) : C == T -- a fairly crude Hadamard-style bound for the solution -- based on regarding the problem as a system of linear equations. + compBound : (BP,List(BP)) -> NonNegativeInteger compBound(m:BP,listpolys:L BP) : NNI == "max"/[euclideanSize u for u in coefficients m] + +/["max"/[euclideanSize u for u in coefficients p] for p in listpolys] else + compBound : (BP,List(BP)) -> NonNegativeInteger compBound(m:BP,listpolys:L BP) : NNI == error "attempt to use compBound without a well-understood valuation" if R has IntegerNumberSystem then + reduction : (BP,R) -> BP reduction(u:BP,p:R):BP == p = 0 => u map(x +-> symmetricRemainder(x,p),u) else + reduction : (BP,R) -> BP reduction(u:BP,p:R):BP == p = 0 => u map(x +-> x rem p,u) + merge : (R,R) -> Union(R,"failed") merge(p:R,q:R):Union(R,"failed") == p = q => p p = 0 => q q = 0 => p "failed" + modInverse : (R,R) -> R modInverse(c:R,p:R):R == (extendedEuclidean(c,p,1)::Record(coef1:R,coef2:R)).coef1 + exactquo : (BP,BP,R) -> Union(BP,"failed") exactquo(u:BP,v:BP,p:R):Union(BP,"failed") == invlcv:=modInverse(leadingCoefficient v,p) r:=monicDivide(u,reduction(invlcv*v,p)) @@ -66898,14 +68264,13 @@ GenExEuclid(R,BP) : C == T table:Vector L BP import GeneralHenselPackage(R,BP) - --local functions - makeProducts : L BP -> L BP - liftSol: (L BP,BP,R,R,Vector L BP,BP,NNI) -> Union(L BP,"failed") - + reduceList : (L BP,R) -> L FP reduceList(lp:L BP,lmod:R): L FP ==[reduce(ff,lmod) for ff in lp] + coerceLFP : L FP -> L BP coerceLFP(lf:L FP):L BP == [fm::BP for fm in lf] + liftSol: (L BP,BP,R,R,Vector L BP,BP,NNI) -> Union(L BP,"failed") liftSol(oldsol:L BP,err:BP,lmod:R,lmodk:R, table:Vector L BP,m:BP,bound:NNI):Union(L BP,"failed") == euclideanSize(lmodk) > bound => "failed" @@ -66924,6 +68289,7 @@ GenExEuclid(R,BP) : C == T a:BP:=((fs-m) exquo lmodk1)::BP liftSol(nsol,a,lmod,lmodk1,table,m,bound) + makeProducts : L BP -> L BP makeProducts(listPol:L BP):L BP == #listPol < 2 => listPol #listPol = 2 => reverse listPol @@ -66931,6 +68297,7 @@ GenExEuclid(R,BP) : C == T ll := rest listPol [*/ll,:[f*g for g in makeProducts ll]] + testModulus : (R,List(BP)) -> Boolean testModulus(pmod, listPol) == redListPol := reduceList(listPol, pmod) for pol in listPol for rpol in redListPol repeat @@ -66944,6 +68311,8 @@ GenExEuclid(R,BP) : C == T if R has Field then + tablePow : (NonNegativeInteger,R,List(BP)) -> _ + Union(Vector(List(BP)),"failed") tablePow(mdeg:NNI,pmod:R,listPol:L BP) == multiE:=multiEuclidean(listPol,1$BP) multiE case "failed" => "failed" @@ -66955,6 +68324,7 @@ GenExEuclid(R,BP) : C == T ptable.(mdeg+1):=makeProducts listPol ptable + solveid : (BP,R,Vector(List(BP))) -> Union(List(BP),"failed") solveid(m:BP,pmod:R,table:Vector L BP) : Union(L BP,"failed") == -- Actually, there's no possibility of failure d:=degree m @@ -66966,6 +68336,8 @@ GenExEuclid(R,BP) : C == T else + tablePow : (NonNegativeInteger,R,List(BP)) -> _ + Union(Vector(List(BP)),"failed") tablePow(mdeg:NNI,pmod:R,listPol:L BP) == listP:L FP:= [reduce(pol,pmod) for pol in listPol] multiE:=multiEuclidean(listP,1$FP) @@ -67114,6 +68486,7 @@ GenUFactorize(R) : public == private where -- Factorisation currently fails when algebraic extensions have multiple -- generators. + factorWarning : OutputForm -> Void factorWarning(f:OutputForm):Void == import AnyFunctions1(String) import AnyFunctions1(OutputForm) @@ -67121,6 +68494,8 @@ GenUFactorize(R) : public == private where f::Any, _ ", trying square-free."::Any])$OutputPackage + factor : SparseUnivariatePolynomial(R) -> _ + Factored(SparseUnivariatePolynomial(R)) factor(f:PR) : Factored PR == R is Integer => (factor f)$GaloisGroupFactorizer(PR) R is Fraction Integer => @@ -67509,25 +68884,27 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - mkRat : (F, REC, List K) -> RF - mkRatlx : (F, K, K, F, K, RF) -> RF - quadsubst: (K, K, F, UP) -> Record(diff:F, subs:REC, newk:List K) - kerdiff : (F, F) -> List K - checkroot: (F, List K) -> F - univ : (F, List K, K) -> RF - dummy := kernel(new()$SY)@K - kerdiff(sa, a) == setDifference(kernels sa, kernels a) + kerdiff : (F, F) -> List K + kerdiff(sa, a) == setDifference(kernels sa, kernels a) - checkroot(f, l) == (empty? l => f; rootNormalize(f, first l)) + checkroot: (F, List K) -> F + checkroot(f, l) == (empty? l => f; rootNormalize(f, first l)) - univ(c, l, x) == univariate(checkroot(c, l), x) + univ : (F, List K, K) -> RF + univ(c, l, x) == univariate(checkroot(c, l), x) + univariate : (F,Kernel(F),Kernel(F),SparseUnivariatePolynomial(F)) -> _ + SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F))) univariate(f, x, y, p) == lift(univariate(f, y, p), x) - lift(p, k) == map(x1+->univariate(x1, k), p) + lift : (SparseUnivariatePolynomial(F),Kernel(F)) -> _ + SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F))) + lift(p, k) == map(x1+->univariate(x1, k), p) + palgint0 : (F,Kernel(F),Kernel(F),F,SparseUnivariatePolynomial(F)) -> _ + IntegrationResult(F) palgint0(f, x, y, den, radi) == -- y is a square root so write f as f1 y + f0 and integrate separately ff := univariate(f, x, y, minPoly y) @@ -67558,6 +68935,7 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where -- returns [u(x,y), [h'(u), [x,y], [h(u), g(u)], l] in both cases, -- where l is empty if no new square root was needed, -- l := [k] if k is the new square root kernel that was created. + quadsubst: (K, K, F, UP) -> Record(diff:F, subs:REC, newk:List K) quadsubst(x, y, den, p) == u := dummy::F b := coefficient(p, 1) @@ -67576,25 +68954,39 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where yy := (ux := xx * u + sc) / q [(y::F - sc) / x::F, [- 2 * ux / u2ma, [x ,y], [xx, yy]], kerdiff(sc, c)] + mkRatlx : (F, K, K, F, K, RF) -> RF mkRatlx(f,x,y,t,z,dx) == rat := univariate(eval(f, [x, y], [t, z::F]), z) * dx numer(rat) / denom(rat) + mkRat : (F, REC, List K) -> RF mkRat(f, rec, l) == rat:=univariate(checkroot(rec.coeff * eval(f,rec.var,rec.val), l), dummy) numer(rat) / denom(rat) + palgint0 : (F,Kernel(F),Kernel(F),Kernel(F),F,_ + Fraction(SparseUnivariatePolynomial(F))) -> IntegrationResult(F) palgint0(f, x, y, z, xx, dx) == map(x1+->multivariate(x1, y), integrate mkRatlx(f, x, y, xx, z, dx)) + palgextint0 : (F,Kernel(F),Kernel(F),F,Kernel(F),F,_ + Fraction(SparseUnivariatePolynomial(F))) -> _ + Union(Record(ratpart: F,coeff: F),"failed") palgextint0(f, x, y, g, z, xx, dx) == map(x1+->multivariate(x1, y), extendedint(mkRatlx(f,x,y,xx,z,dx), mkRatlx(g,x,y,xx,z,dx))) + palglimint0 : (F,Kernel(F),Kernel(F),List(F),Kernel(F),F,_ + Fraction(SparseUnivariatePolynomial(F))) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed") palglimint0(f, x, y, lu, z, xx, dx) == map(x1+->multivariate(x1, y), limitedint(mkRatlx(f, x, y, xx, z, dx), [mkRatlx(u, x, y, xx, z, dx) for u in lu])) + palgRDE0 : (F,F,Kernel(F),Kernel(F),((F,F,Symbol) -> _ + Union(F,"failed")),Kernel(F),F,_ + Fraction(SparseUnivariatePolynomial(F))) -> Union(F,"failed") palgRDE0(f, g, x, y, rischde, z, xx, dx) == (u := rischde(eval(f, [x, y], [xx, z::F]), multivariate(dx, z) * eval(g, [x, y], [xx, z::F]), @@ -67602,22 +68994,33 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where eval(u::F, z, y::F) -- given p = sum_i a_i(X) Y^i, returns sum_i a_i(x) y^i + multivariate : _ + (SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F))),_ + Kernel(F),F) -> F multivariate(p, x, y) == (map((x1:RF):F+->multivariate(x1, x), p)$SparseUnivariatePolynomialFunctions2(RF, F)) (y) + palgextint0 : (F,Kernel(F),Kernel(F),F,F,SparseUnivariatePolynomial(F)) ->_ + Union(Record(ratpart: F,coeff: F),"failed") palgextint0(f, x, y, g, den, radi) == pr := quadsubst(x, y, den, radi) map(f1+->f1(pr.diff), extendedint(mkRat(f, pr.subs, pr.newk), mkRat(g, pr.subs, pr.newk))) + palglimint0 : (F,Kernel(F),Kernel(F),List(F),F,_ + SparseUnivariatePolynomial(F)) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed") palglimint0(f, x, y, lu, den, radi) == pr := quadsubst(x, y, den, radi) map(f1+->f1(pr.diff), limitedint(mkRat(f, pr.subs, pr.newk), [mkRat(u, pr.subs, pr.newk) for u in lu])) + palgRDE0 : (F,F,Kernel(F),Kernel(F),((F,F,Symbol) -> _ + Union(F,"failed")),F,SparseUnivariatePolynomial(F)) -> Union(F,"failed") palgRDE0(f, g, x, y, rischde, den, radi) == pr := quadsubst(x, y, den, radi) (u := rischde(checkroot(eval(f, pr.subs.var, pr.subs.val), pr.newk), @@ -67630,6 +69033,8 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where import RationalLODE(F, UP) + palgLODE0: (L,F,Kernel(F),Kernel(F),F,SparseUnivariatePolynomial(F)) ->_ + Record(particular: Union(F,"failed"),basis: List(F)) palgLODE0(eq, g, x, y, den, radi) == pr := quadsubst(x, y, den, radi) d := monomial(univ(inv(pr.subs.coeff), pr.newk, dummy), 1)$LODO @@ -67644,6 +69049,9 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where rec.particular case "failed" => ["failed", bas] [((rec.particular)::RF) (pr.diff), bas] + palgLODE0 : (L,F,Kernel(F),Kernel(F),Kernel(F),F,_ + Fraction(SparseUnivariatePolynomial(F))) -> _ + Record(particular: Union(F,"failed"),basis: List(F)) palgLODE0(eq, g, x, y, kz, xx, dx) == d := monomial(univariate(inv multivariate(dx, kz), kz), 1)$LODO di:LODO := 1 -- will accumulate the powers of d @@ -67814,6 +69222,8 @@ GnuDraw(): Exports == Implementation where (* -- 2-d plotting + gnuDraw : (Expression(Float),SegmentBinding(Float),_ + String,List(DrawOption)) -> Void gnuDraw(f:EF,segbind:SBF,filename:STR,opts:List DROP):Void == import TwoDimensionalViewport, GraphImage, TopLevelDrawFunctions EF f1:TextFile:=open(filename::FileName,"output") @@ -67830,10 +69240,13 @@ GnuDraw(): Exports == Implementation where close! f1 -- default title is "" + gnuDraw : (Expression(Float),SegmentBinding(Float),String) -> Void gnuDraw(f:EF,segbind:SBF,filename:STR):Void == gnuDraw(f,segbind,filename,[title("")$DROP]) -- 3-d plotting + gnuDraw : (Expression(Float),SegmentBinding(Float),_ + SegmentBinding(Float),String,List(DrawOption)) -> Void gnuDraw(f:EF,segbind1:SBF,segbind2:SBF,filename:STR,opts:List DROP):Void == import SubSpace, ThreeSpace DoubleFloat, TopLevelDrawFunctions EF f1:TextFile:=open(filename::FileName,"output") @@ -67851,6 +69264,8 @@ GnuDraw(): Exports == Implementation where close! f1 -- default title is "" + gnuDraw : (Expression(Float),SegmentBinding(Float),_ + SegmentBinding(Float),String) -> Void gnuDraw(f:EF,segbind1:SBF, segbind2:SBF, filename:STR):Void == gnuDraw(f,segbind1,segbind2,filename,[title("")$DROP]) *) @@ -68134,40 +69549,34 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where import PolynomialCategoryQuotientFunctions(E, V, R, P, Q) import LinearSystemMatrixPackage(RQ,Vector RQ,Vector RQ,Matrix RQ) - InnerGospersMethod: (RQ, V, () -> V) -> Union(RQ, "failed") - GosperPQR: (PQ, PQ, V, () -> V) -> List PQ - GosperDegBd: (PQ, PQ, PQ, V, () -> V) -> I - GosperF: (I, PQ, PQ, PQ, V, () -> V) -> Union(RQ, "failed") - linearAndNNIntRoot: (PQ, V) -> Union(I, "failed") - deg0: (PQ, V) -> I -- degree with deg 0 = -1. - pCoef: (PQ, PQ) -> PQ -- pCoef(p, a*b**2) - RF2QIfCan: Q -> Union(RQ, "failed") - UP2QIfCan: P -> Union(PQ,"failed") - RFQ2R : RQ -> Q - PQ2R : PQ -> Q - rat? : R -> Boolean - + deg0: (PQ, V) -> I -- degree with deg 0 = -1. deg0(p, v) == (zero? p => -1; degree(p, v)) - rat? x == retractIfCan(x::P::Q)@Union(RN, "failed") case RN + rat? : R -> Boolean + rat? x == retractIfCan(x::P::Q)@Union(RN, "failed") case RN - RFQ2R f == PQ2R(numer f) / PQ2R(denom f) + RFQ2R : RQ -> Q + RFQ2R f == PQ2R(numer f) / PQ2R(denom f) + PQ2R : PQ -> Q PQ2R p == map(x+->x::P::Q, y+->y::Q, p)$PolynomialCategoryLifting( IndexedExponents V, V, RN, PQ, Q) + GospersMethod : (Q,V,(() -> V)) -> Union(Q,"failed") GospersMethod(aquo, n, newV) == ((q := RF2QIfCan aquo) case "failed") or ((u := InnerGospersMethod(q::RQ, n, newV)) case "failed") => "failed" RFQ2R(u::RQ) + RF2QIfCan: Q -> Union(RQ, "failed") RF2QIfCan f == (n := UP2QIfCan numer f) case "failed" => "failed" (d := UP2QIfCan denom f) case "failed" => "failed" n::PQ / d::PQ + UP2QIfCan: P -> Union(PQ,"failed") UP2QIfCan p == every?(rat?, coefficients p) => map(x +-> x::PQ, @@ -68175,6 +69584,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where $PolynomialCategoryLifting(E, V, R, P, PQ) "failed" + InnerGospersMethod: (RQ, V, () -> V) -> Union(RQ, "failed") InnerGospersMethod(aquo, n, newV) == -- 1. Define coprime polys an,anm1 such that -- an/anm1=a(n)/a(n-1) @@ -68206,6 +69616,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where qn1 := eval(qn,n,n::PQ + 1) qn1/pn * fn + GosperF: (I, PQ, PQ, PQ, V, () -> V) -> Union(RQ, "failed") GosperF(k, pn, qn, rn, n, newV) == mv := newV(); mp := mv::PQ; np := n::PQ fn: PQ := +/[mp**(i+1) * np**i for i in 0..k] @@ -68232,6 +69643,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where vec := soln::Vector RQ (+/[np**i * vec(i + minIndex vec) for i in 0..k])@RQ + GosperPQR: (PQ, PQ, V, () -> V) -> List PQ GosperPQR(an, anm1, n, newV) == np := n::PQ -- polynomial version of n -- Initial guess. @@ -68257,6 +69669,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where -- Find a degree bound for the polynomial f(n) which satisfies -- p(n) = q(n+1)*f(n) - r(n)*f(n-1). + GosperDegBd: (PQ, PQ, PQ, V, () -> V) -> I GosperDegBd(pn, qn, rn, n, newV) == np := n::PQ qnplus1 := eval(qn, n, np+1) @@ -68285,6 +69698,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where k0 case "failed" => k max(k0::I, k) + pCoef: (PQ, PQ) -> PQ -- pCoef(p, a*b**2) pCoef(p, nom) == not monomial? nom => error "pCoef requires a monomial 2nd arg" @@ -68297,6 +69711,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where p := coefficient(up, pow) p + linearAndNNIntRoot: (PQ, V) -> Union(I, "failed") linearAndNNIntRoot(mp, v) == p := univariate(mp, v) degree p ^= 1 => "failed" @@ -68477,30 +69892,42 @@ GraphicsDefaults(): Exports == Implementation where --% functions - clipPointsDefault() == CLIPPOINTSDEFAULT + clipPointsDefault : () -> Boolean + clipPointsDefault() == CLIPPOINTSDEFAULT + drawToScale : () -> Boolean drawToScale() == TOSCALE - clipPointsDefault b == CLIPPOINTSDEFAULT := b + clipPointsDefault : Boolean -> Boolean + clipPointsDefault b == CLIPPOINTSDEFAULT := b + drawToScale : Boolean -> Boolean drawToScale b == TOSCALE := b --% settings from the two-dimensional plot package + adaptive : () -> Boolean adaptive() == adaptive?()$Plot + minPoints : () -> Integer minPoints() == minPoints()$Plot + maxPoints : () -> Integer maxPoints() == maxPoints()$Plot + screenResolution : () -> Integer screenResolution() == screenResolution()$Plot + adaptive : Boolean -> Boolean adaptive b == setAdaptive(b)$Plot + minPoints : Integer -> Integer minPoints n == setMinPoints(n)$Plot + maxPoints : Integer -> Integer maxPoints n == setMaxPoints(n)$Plot + screenResolution : Integer -> Integer screenResolution n == setScreenResolution(n)$Plot *) @@ -68773,10 +70200,11 @@ Graphviz(): Exports == Implementation where \end{chunk} -\begin{chunk}{COQ GRAY} -(* package GRAY *) +\begin{chunk}{COQ GRAPHVIZ} +(* package GRAPHVIZ *) (* + standardDotHeader : () -> List(String) standardDotHeader() == ["digraph graphname {",_ "graph [rankdir=_"LR_" ranksep=_"3.0_"]",_ @@ -68784,6 +70212,7 @@ Graphviz(): Exports == Implementation where "edge [penwidth=_"0.5_" color=_"blue_"];"_ ] + sampleDotGraph : () -> List(String) sampleDotGraph() == ["I1 [fillcolor=_"white_"];",_ "I2 [fillcolor=_"white_"];",_ @@ -68822,6 +70251,7 @@ Graphviz(): Exports == Implementation where "N8 -> O2;"_ ] + writeDotGraph : (List(String),List(String),String) -> Void writeDotGraph(header:HEADER, graph:GRAPH, name:FILENAME):Void == file:TextFile:=open(concat(name,".dot")::FileName,"output") for line in header repeat writeLine!(file,line) @@ -68830,6 +70260,7 @@ Graphviz(): Exports == Implementation where close!(file) void() + dot2eps : String -> Void dot2eps(file) == instr:String:=concat(file,".dot >") outstr:String:=concat(file,".eps") @@ -68837,6 +70268,7 @@ Graphviz(): Exports == Implementation where SYSTEM(command)$Lisp void() + dotview : (String,String) -> Void dotview(viewr,file) == outstr:String:=concat(file,".eps") SYSTEM(concat(viewr,concat(" ",outstr)))$Lisp @@ -69571,38 +71003,43 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where (* package GBF *) (* - import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol) -- next to help compiler to choose correct signatures: - info: Boolean + import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol) + -- signatures of local functions + info: Boolean + ++ newPairs(lp, p) constructs list of critical pairs from the list of + ++ lp of input polynomials and a given further one p. + ++ It uses criteria M and T to reduce the list. newPairs : (L sugarPol, Dpol) -> L critPair - ++ newPairs(lp, p) constructs list of critical pairs from the list of - ++ lp of input polynomials and a given further one p. - ++ It uses criteria M and T to reduce the list. + + ++ updateCritPairs(lcP1,lcP2,p) applies criterion B to lcP1 using + ++ p. Then this list is merged with lcP2. updateCritPairs : (L critPair, L critPair, Dpol) -> L critPair - ++ updateCritPairs(lcP1,lcP2,p) applies criterion B to lcP1 using - ++ p. Then this list is merged with lcP2. + + ++ updateBasis(li,p,deg) every polynomial in li is dropped if + ++ its leading term is a multiple of the leading term of p. + ++ The result is this list enlarged by p. updateBasis : (L sugarPol, Dpol, NNI) -> L sugarPol - ++ updateBasis(li,p,deg) every polynomial in li is dropped if - ++ its leading term is a multiple of the leading term of p. - ++ The result is this list enlarged by p. + + ++ createGroebnerBases(basis, redPols, nonZeroRestrictions, inputPolys, + ++ lcP,listOfBases): This function is used to be called from + ++ groebnerFactorize. + ++ basis: part of a Groebner basis, computed so far + ++ redPols: Polynomials from the ideal to be used for reducing, + ++ we don't throw away polynomials + ++ nonZeroRestrictions: polynomials not zero in the common zeros + ++ of the polynomials in the final (Groebner) basis + ++ inputPolys: assumed to be in descending order + ++ lcP: list of critical pairs built from polynomials of the + ++ actual basis + ++ listOfBases: Collects the (Groebner) bases constructed by this + ++ recursive algorithm at different stages. + ++ we print info messages if info is true createGroebnerBases : (L sugarPol, L Dpol, L Dpol, L Dpol, L critPair,_ L L Dpol, Boolean) -> L L Dpol - ++ createGroebnerBases(basis, redPols, nonZeroRestrictions, inputPolys, - ++ lcP,listOfBases): This function is used to be called from - ++ groebnerFactorize. - ++ basis: part of a Groebner basis, computed so far - ++ redPols: Polynomials from the ideal to be used for reducing, - ++ we don't throw away polynomials - ++ nonZeroRestrictions: polynomials not zero in the common zeros - ++ of the polynomials in the final (Groebner) basis - ++ inputPolys: assumed to be in descending order - ++ lcP: list of critical pairs built from polynomials of the - ++ actual basis - ++ listOfBases: Collects the (Groebner) bases constructed by this - ++ recursive algorithm at different stages. - ++ we print info messages if info is true + createAllFactors: Dpol -> L Dpol ++ factor reduced critpair polynomial @@ -69766,8 +71203,10 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where -- exported functions + factorGroebnerBasis : List(Dpol) -> List(List(Dpol)) factorGroebnerBasis basis == factorGroebnerBasis(basis, false) + factorGroebnerBasis : (List(Dpol),Boolean) -> List(List(Dpol)) factorGroebnerBasis (basis, info) == foundAReducible : Boolean := false for p in basis while not foundAReducible repeat @@ -69784,9 +71223,11 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where we found reducible polynomials and continue splitting")$OUT createGroebnerBases([],[],[],basis,[],[],info) + groebnerFactorize : (List(Dpol),List(Dpol)) -> List(List(Dpol)) groebnerFactorize(basis, nonZeroRestrictions) == groebnerFactorize(basis, nonZeroRestrictions, false) + groebnerFactorize : (List(Dpol),List(Dpol),Boolean) -> List(List(Dpol)) groebnerFactorize(basis, nonZeroRestrictions, info) == basis = [] => [basis] basis := remove((x:Dpol):Boolean +->(x = 0$Dpol),basis) @@ -69797,8 +71238,10 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where basis := sort((x,y) +-> degree x > degree y, basis) createGroebnerBases([],[],nonZeroRestrictions,basis,[],[],info) + groebnerFactorize : List(Dpol) -> List(List(Dpol)) groebnerFactorize(basis) == groebnerFactorize(basis, [], false) + groebnerFactorize : (List(Dpol),Boolean) -> List(List(Dpol)) groebnerFactorize(basis,info) == groebnerFactorize(basis, [], info) *) @@ -70369,14 +71812,20 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where ------ Definition of intermediate functions if Dpol has totalDegree: Dpol -> NonNegativeInteger then + virtualDegree : Dpol -> NonNegativeInteger virtualDegree p == totalDegree p else + virtualDegree : Dpol -> NonNegativeInteger virtualDegree p == 0 ------ ordering of critpairs + critpOrder : (Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol),_ + Record(lcmfij: Expon,totdeg: NonNegativeInteger,poli: Dpol,polj: Dpol))_ + -> Boolean critpOrder(cp1,cp2) == cp1.totdeg < cp2.totdeg => true cp2.totdeg < cp1.totdeg => false @@ -70384,6 +71833,9 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where ------ creating a critical pair + makeCrit : (Record(totdeg: NonNegativeInteger,pol: Dpol),Dpol,_ + NonNegativeInteger) -> Record(lcmfij: Expon,_ + totdeg: NonNegativeInteger,poli: Dpol,polj: Dpol) makeCrit(sp1, p2, totdeg2) == p1 := sp1.pol deg := sup(degree(p1), degree(p2)) @@ -70395,10 +71847,10 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where ------ calculate basis + gbasis : (List(Dpol),Integer,Integer) -> List(Dpol) gbasis(Pol: List(Dpol), xx1: Integer, xx2: Integer ) == D, D1: List(critPair) --------- create D and Pol - Pol1:= sort((z1,z2) +-> degree z1 > degree z2, Pol) basPols:= updatF(hMonic(first Pol1),virtualDegree(first Pol1),[]) Pol1:= rest(Pol1) @@ -70413,8 +71865,6 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where basPols:= updatF(h,toth,basPols) D:= sort(critpOrder, D) xx:= xx2 - -------- loop - redPols := [x.pol for x in basPols] while _^ null D repeat D0:= first D @@ -70451,21 +71901,21 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where messagePrint(" THE GROEBNER BASIS POLYNOMIALS") Pol - -------------------------------------- - - --- erase multiple of e in D2 using crit M - + --- erase multiple of e in D2 using crit M + critMonD1 : (Expon,List(Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol))) -> List(Record(lcmfij: Expon,_ + totdeg: NonNegativeInteger,poli: Dpol,polj: Dpol)) critMonD1(e: Expon, D2: List(critPair))== null D2 => nil x:= first(D2) critM(e, x.lcmfij) => critMonD1(e, rest(D2)) cons(x, critMonD1(e, rest(D2))) - ---------------------------- - - --- reduce D1 using crit T and crit M - - critMTonD1(D1: List(critPair))== + --- reduce D1 using crit T and crit M + critMTonD1 : List(Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol)) -> List(Record(lcmfij: Expon,_ + totdeg: NonNegativeInteger,poli: Dpol,polj: Dpol)) + critMTonD1(D1: List(critPair))== null D1 => nil f1:= first(D1) s1:= #(D1) @@ -70481,10 +71931,10 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where cT1 => critMTonD1(D1) cons(f1, critMTonD1(D1)) - ----------------------------- - - --- erase elements in D fullfilling crit B - + --- erase elements in D fullfilling crit B + critBonD : (Dpol,List(Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol))) -> List(Record(lcmfij: Expon,_ + totdeg: NonNegativeInteger,poli: Dpol,polj: Dpol)) critBonD(h:Dpol, D: List(critPair))== null D => nil x:= first(D) @@ -70492,20 +71942,21 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where critBonD(h, rest(D)) cons(x, critBonD(h, rest(D))) - ----------------------------- - - --- concat F and h and erase multiples of h in F - + --- concat F and h and erase multiples of h in F + updatF : (Dpol,NonNegativeInteger,List(Record(totdeg: NonNegativeInteger,_ + pol: Dpol))) -> List(Record(totdeg: NonNegativeInteger,pol: Dpol)) updatF(h: Dpol, deg:NNI, F: List(sugarPol)) == null F => [[deg,h]] f1:= first(F) critM(degree(h), degree(f1.pol)) => updatF(h, deg, rest(F)) cons(f1, updatF(h, deg, rest(F))) - ----------------------------- - - --- concat ordered critical pair lists D1 and D2 - + --- concat ordered critical pair lists D1 and D2 + updatD : (List(Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol)),List(Record(lcmfij: Expon,_ + totdeg: NonNegativeInteger,poli: Dpol,polj: Dpol))) -> _ + List(Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol)) updatD(D1: List(critPair), D2: List(critPair)) == null D1 => D2 null D2 => D1 @@ -70514,16 +71965,15 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where critpOrder(dl1,dl2) => cons(dl1, updatD(D1.rest, D2)) cons(dl2, updatD(D1, D2.rest)) - ----------------------------- - - --- remove gcd from pair of coefficients - + --- remove gcd from pair of coefficients + gcdCo : (Dom,Dom) -> Record(co1:Dom,co2:Dom) gcdCo(c1:Dom, c2:Dom):Record(co1:Dom,co2:Dom) == d:=gcd(c1,c2) [(c1 exquo d)::Dom, (c2 exquo d)::Dom] - --- calculate S-polynomial of a critical pair - + --- calculate S-polynomial of a critical pair + sPol : Record(lcmfij: Expon,totdeg: NonNegativeInteger,_ + poli: Dpol,polj: Dpol) -> Dpol sPol(p:critPair)== Tij := p.lcmfij fi := p.poli @@ -70532,11 +71982,9 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where reductum(fi)*monomial(cc.co2,subtractIfCan(Tij, degree fi)::Expon) - reductum(fj)*monomial(cc.co1,subtractIfCan(Tij, degree fj)::Expon) - ---------------------------- - - --- reduce critpair polynomial mod F - --- iterative version - + --- reduce critpair polynomial mod F + --- iterative version + redPo : (Dpol,List(Dpol)) -> Record(poly: Dpol,mult: Dom) redPo(s: Dpol, F: List(Dpol)) == m:Dom := 1 Fh := F @@ -70552,43 +72000,35 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where F:= rest F [s,m] + redPol : (Dpol,List(Dpol)) -> Dpol redPol(s: Dpol, F: List(Dpol)) == credPol(redPo(s,F).poly,F) - ---------------------------- - - --- crit T true, if e1 and e2 are disjoint - + --- crit T true, if e1 and e2 are disjoint + critT : Record(lcmfij: Expon,totdeg: NonNegativeInteger,poli: Dpol,_ + polj: Dpol) -> Boolean critT(p: critPair) == p.lcmfij = (degree(p.poli) + degree(p.polj)) - ---------------------------- - - --- crit M - true, if lcm#2 multiple of lcm#1 - + --- crit M - true, if lcm#2 multiple of lcm#1 + critM : (Expon,Expon) -> Boolean critM(e1: Expon, e2: Expon) == en: Union(Expon, "failed") (en:=subtractIfCan(e2, e1)) case Expon - ---------------------------- - - --- crit B - true, if eik is a multiple of eh and eik ^equal - --- lcm(eh,ei) and eik ^equal lcm(eh,ek) - + --- crit B - true, if eik is a multiple of eh and eik ^equal + --- lcm(eh,ei) and eik ^equal lcm(eh,ek) + critB : (Expon,Expon,Expon,Expon) -> Boolean critB(eh:Expon, eik:Expon, ei:Expon, ek:Expon) == critM(eh, eik) and (eik ^= sup(eh, ei)) and (eik ^= sup(eh, ek)) - ---------------------------- - - --- make polynomial monic case Domain a Field - + --- make polynomial monic case Domain a Field + hMonic : Dpol -> Dpol hMonic(p: Dpol) == p= 0 => p -- inv(leadingCoefficient(p))*p primitivePart p - ----------------------------- - - --- reduce all terms of h mod F (iterative version ) - + --- reduce all terms of h mod F (iterative version ) + credPol : (Dpol,List(Dpol)) -> Dpol credPol(h: Dpol, F: List(Dpol) ) == null F => h h0:Dpol:= monomial(leadingCoefficient h, degree h) @@ -70598,19 +72038,15 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where h0:=(hred.mult)*h0 + monomial(leadingCoefficient(h),degree h) h0 - ------------------------------- - - ---- calculate minimal basis for ordered F - + ---- calculate minimal basis for ordered F + minGbasis : List(Dpol) -> List(Dpol) minGbasis(F: List(Dpol)) == null F => nil newbas := minGbasis rest F cons(hMonic credPol( first(F), newbas),newbas) - ------------------------------- - - ---- calculate number of terms of polynomial - + ---- calculate number of terms of polynomial + lepol : Dpol -> Integer lepol(p1:Dpol)== n: Integer n:= 0 @@ -70619,14 +72055,14 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where p1:= reductum(p1) n - ---- print blanc lines - + ---- print blanc lines + prinb : Integer -> Void prinb(n: Integer)== for x in 1..n repeat messagePrint(" ") - ---- print reduced critpair polynom - + ---- print reduced critpair polynom + prinshINFO : Dpol -> Void prinshINFO(h: Dpol)== prinb(2) messagePrint(" reduced Critpair - Polynom :") @@ -70634,10 +72070,9 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where print(h::Ex) prinb(2) - ------------------------------- - - ---- print info string - + ---- print info string + prindINFO : (Record(lcmfij: Expon,totdeg: NonNegativeInteger,poli: Dpol,_ + polj: Dpol),Dpol,Dpol,Integer,Integer,Integer) -> Integer prindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer, i2:Integer, n:Integer) == ll: List Prinp @@ -70683,10 +72118,8 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where prinb(1) n - ------------------------------- - - ---- print the groebner basis polynomials - + ---- print the groebner basis polynomials + prinpolINFO : List(Dpol) -> Void prinpolINFO(pl: List(Dpol))== n:Integer n:= # pl @@ -70701,6 +72134,8 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where messagePrint(" Groebner Basis Polynomials. ") prinb(2) + fprindINFO : (Record(lcmfij: Expon,totdeg: NonNegativeInteger,poli: Dpol,_ + polj: Dpol),Dpol,Dpol,Integer,Integer,Integer,Integer) -> Integer fprindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer, i2:Integer, i3:Integer, n: Integer) == ll: List Prinpp @@ -72255,21 +73690,25 @@ GroebnerPackage(Dom, Expon, VarSet, Dpol): T == C where if Dom has Field then + monicize : Dpol -> Dpol monicize(p: Dpol):Dpol == ((lc := leadingCoefficient p) = 1) => p inv(lc)*p + normalForm : (Dpol,List(Dpol)) -> Dpol normalForm(p : Dpol, l : List(Dpol)) : Dpol == redPol(p,map(monicize,l)) ------ MAIN ALGORITHM GROEBNER ------------------------ + groebner : List(Dpol) -> List(Dpol) groebner( Pol: List(Dpol) ) == Pol=[] => Pol Pol:=[x for x in Pol | x ^= 0] Pol=[] => [0] minGbasis(sort((x,y) +-> degree x > degree y, gbasis(Pol,0,0))) + groebner : (List(Dpol),String) -> List(Dpol) groebner( Pol: List(Dpol), xx1: String) == Pol=[] => Pol Pol:=[x for x in Pol | x ^= 0] @@ -72285,6 +73724,7 @@ GroebnerPackage(Dom, Expon, VarSet, Dpol): T == C where messagePrint(" ") [] + groebner : (List(Dpol),String,String) -> List(Dpol) groebner( Pol: List(Dpol), xx1: String, xx2: String) == Pol=[] => Pol Pol:=[x for x in Pol | x ^= 0] @@ -72572,8 +74012,9 @@ GroebnerSolve(lv,F,R) : C == T nv:NNI:=#lv - ---- test if f is power of a linear mod (rad lpol) ---- - ---- f is monic ---- + ---- test if f is power of a linear mod (rad lpol) ---- + ---- f is monic ---- + testPower : (SUP,OV,L DPoly) -> Union(DPoly,"failed") testPower(uf:SUP,x:OV,lpol:L DPoly) : Union(DPoly,"failed") == df:=degree(uf) trailp:DPoly := coefficient(uf,(df-1)::NNI) @@ -72587,8 +74028,8 @@ GroebnerSolve(lv,F,R) : C == T redPol(g,lpol) ^= 0 => "failed" multivariate(linp,x) - -- is the 0-dimensional ideal I in general position ? -- - ---- internal function ---- + -- is the 0-dimensional ideal I in general position ? -- + testGenPos : (L DPoly,L OV) -> Union(L DPoly,"failed") testGenPos(lpol:L DPoly,lvar:L OV):Union(L DPoly,"failed") == rlpol:=reverse lpol f:=rlpol.first @@ -72606,8 +74047,9 @@ GroebnerSolve(lv,F,R) : C == T else if redPol(f,newlpol)^=0 then return"failed" newlpol - -- change coordinates and out the ideal in general position ---- + genPos : (L DPoly,L OV) -> Record(polys:L HDPoly, lpolys:L DPoly, + coord:L I, univp:HDPoly) genPos(lp:L DPoly,lvar:L OV): Record(polys:L HDPoly, lpolys:L DPoly, coord:L I, univp:HDPoly) == rlvar:=reverse lvar @@ -72626,21 +74068,26 @@ GroebnerSolve(lv,F,R) : C == T testfail:=false [gb,gbt,ranvals,dmpToHdmp(last (gb1::L DPoly))] + genericPosition : (List(DistributedMultivariatePolynomial(lv,F)),_ + List(OrderedVariableList(lv))) -> _ + Record(dpolys: List(DistributedMultivariatePolynomial(lv,F)),_ + coords: List(Integer)) genericPosition(lp:L DPoly,lvar:L OV) == nans:=genPos(lp,lvar) [nans.lpolys, nans.coord] ---- select the univariate factors + select : L L HDPoly -> L L HDPoly select(lup:L L HDPoly) : L L HDPoly == lup=[] => list [] [:[cons(f,lsel) for lsel in select lup.rest] for f in lup.first] ---- in the non generic case, we compute the prime ideals ---- ---- associated to leq, basis is the algebra basis ---- + findCompon : (L HDPoly,L OV) -> L L DPoly findCompon(leq:L HDPoly,lvar:L OV):L L DPoly == teq:=totolex(leq) #teq = #lvar => [teq] - -- ^((teq1:=testGenPos(teq,lvar)) case "failed") => [teq1::L DPoly] gp:=genPos(teq,lvar) lgp:= gp.polys g:HDPoly:=gp.univp @@ -72661,6 +74108,7 @@ GroebnerSolve(lv,F,R) : C == T for lp in result] [ll for ll in ans | ll^=[1]] + zeroDim? : (List HDPoly,L OV) -> Boolean zeroDim?(lp: List HDPoly,lvar:L OV) : Boolean == empty? lp => false n:NNI := #lvar @@ -72674,6 +74122,9 @@ GroebnerSolve(lv,F,R) : C == T empty? lvint1 -- general solve, gives an error if the system not 0-dimensional + groebSolve : (List(DistributedMultivariatePolynomial(lv,F)),_ + List(OrderedVariableList(lv))) -> _ + List(List(DistributedMultivariatePolynomial(lv,F))) groebSolve(leq: L DPoly,lvar:L OV) : L L DPoly == lnp:=[dmpToHdmp(f) for f in leq] leq1:=groebner lnp @@ -72700,6 +74151,9 @@ GroebnerSolve(lv,F,R) : C == T result -- test if the system is zero dimensional + testDim : (List(HomogeneousDistributedMultivariatePolynomial(lv,F)),_ + List(OrderedVariableList(lv))) -> _ + Union(List(HomogeneousDistributedMultivariatePolynomial(lv,F)),"failed") testDim(leq : L HDPoly,lvar : L OV) : Union(L HDPoly,"failed") == leq1:=groebner leq #(leq1) = 1 and first(leq1) = 1 => empty() @@ -75535,6 +76989,7 @@ HallBasis() : Export == Implement where (* package HB *) (* + lfunc : (Integer,Integer) -> Integer lfunc(d,n) == n < 0 => 0 n = 0 => 1 @@ -75546,12 +77001,14 @@ HallBasis() : Export == Implement where sum := sum + m * lfunc(d,m) res := (d**(n::NNI) - sum) quo n + inHallBasis? : (Integer,Integer,Integer,Integer) -> Boolean inHallBasis?(n,i,j,l) == i >= j => false j <= n => true l <= i => true false + generate:(NonNegativeInteger,NonNegativeInteger) -> Vector(List(Integer)) generate(n:NNI,c:NNI) == gens:=n maxweight:=c @@ -75870,30 +77327,23 @@ HeuGcd (BP):C == T NNI ==> NonNegativeInteger Cases ==> Union("gcdprim","gcd","gcdcofactprim","gcdcofact") import ModularDistinctDegreeFactorizer BP - - --local functions - localgcd : List BP -> List BP - constNotZero : BP -> Boolean - height : BP -> PI - genpoly : (Z,PI) -> BP - negShiftz : (Z,PI) -> Z - internal : (Cases,List BP ) -> List BP - constcase : (List NNI ,List BP ) -> List BP - lincase : (List NNI ,List BP ) -> List BP - myNextPrime : ( Z , NNI ) -> Z - + bigPrime:= prevPrime(2**26)$IntegerPrimesPackage(Integer) + myNextPrime : ( Z , NNI ) -> Z myNextPrime(val:Z,bound:NNI) : Z == nextPrime(val)$IntegerPrimesPackage(Z) + constNotZero : BP -> Boolean constNotZero(f : BP ) : Boolean == (degree f = 0) and ^(zero? f) + negShiftz : (Z,PI) -> Z negShiftz(n:Z,Modulus:PI):Z == n < 0 => n:= n+Modulus n > (Modulus quo 2) => n-Modulus n --compute the height of a polynomial + height : BP -> PI height(f:BP):PI == k:PI:=1 while f^=0 repeat @@ -75903,6 +77353,7 @@ HeuGcd (BP):C == T --reconstruct the polynomial from the value-adic representation of --dval. + genpoly : (Z,PI) -> BP genpoly(dval:Z,value:PI):BP == d:=0$BP val:=dval @@ -75913,6 +77364,7 @@ HeuGcd (BP):C == T d --gcd of a list of integers + lintgcd : List(Integer) -> Integer lintgcd(lval:List(Z)):Z == empty? lval => 0$Z member?(1,lval) => 1$Z @@ -75922,15 +77374,18 @@ HeuGcd (BP):C == T val --content for a list of univariate polynomials + content : List(BP) -> List(Integer) content(listf:List BP ):List(Z) == [lintgcd coefficients f for f in listf] --content of a list of polynomials with the relative primitive parts + contprim : List BP -> List(ContPrim) contprim(listf:List BP ):List(ContPrim) == [[c:=lintgcd coefficients f,(f exquo c)::BP]$ContPrim for f in listf] -- one polynomial is constant, remark that they are primitive -- but listf can contain the zero polynomial + constcase : (List NNI ,List BP ) -> List BP constcase(listdeg:List NNI ,listf:List BP ): List BP == lind:=select(constNotZero,listf) empty? lind => @@ -75942,6 +77397,7 @@ HeuGcd (BP):C == T d=1 => cons(1$BP,listf) cons(d::BP,[(lcf quo d)::BP for lcf in lclistf]) + testDivide : (List BP,BP) -> Union(List BP, "failed") testDivide(listf: List BP, g:BP):Union(List BP, "failed") == result:List BP := [] for f in listf repeat @@ -75950,6 +77406,7 @@ HeuGcd (BP):C == T reverse!(result) --one polynomial is linear, remark that they are primitive + lincase : (List NNI ,List BP ) -> List BP lincase(listdeg:List NNI ,listf:List BP ):List BP == n:= position(1,listdeg) g:=listf.n @@ -75961,11 +77418,13 @@ HeuGcd (BP):C == T IMG := InnerModularGcd(Z,BP,67108859,myNextPrime) + mindegpol : (BP,BP) -> BP mindegpol(f:BP, g:BP):BP == degree(g) < degree (f) => g f --local function for the gcd among n PRIMITIVE univariate polynomials + localgcd : List BP -> List BP localgcd(listf:List BP ):List BP == hgt:="min"/[height(f) for f in listf|^zero? f] answr:=2+2*hgt @@ -75992,6 +77451,7 @@ HeuGcd (BP):C == T --internal function:it evaluates the gcd and avoids duplication of --code. + internal : (Cases,List BP ) -> List BP internal(flag:Cases,listf:List BP ):List BP == --special cases listf=[] => [1$BP] @@ -76033,15 +77493,19 @@ HeuGcd (BP):C == T cons(result,ans) --gcd among n PRIMITIVE univariate polynomials + gcdprim : List(BP) -> BP gcdprim (listf:List BP ):BP == first internal("gcdprim",listf) --gcd and cofactors for n PRIMITIVE univariate polynomials + gcdcofactprim : List(BP) -> List(BP) gcdcofactprim(listf:List BP ):List BP == internal("gcdcofactprim",listf) --gcd for n generic univariate polynomials. - gcd(listf:List BP ): BP == first internal("gcd",listf) + gcd : List(BP) -> BP + gcd(listf:List BP ): BP == first internal("gcd",listf) --gcd and cofactors for n generic univariate polynomials. + gcdcofact : List(BP) -> List(BP) gcdcofact (listf:List BP ):List BP == internal("gcdcofact",listf) *) @@ -76503,40 +77967,24 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't import GroebnerPackage(F,Expon,OV,DPoly) import GroebnerPackage(Q,Expon,OV,DPoly1) - ---- Local Functions ----- - genPosLastVar : (FIdeal,List OV) -> GenPos - zeroPrimDecomp : (FIdeal,List OV) -> List(FIdeal) - zeroRadComp : (FIdeal,List OV) -> FIdeal - zerodimcase : (FIdeal,List OV) -> Boolean - is0dimprimary : (FIdeal,List OV) -> Boolean - backGenPos : (FIdeal,List Z,List OV) -> FIdeal - reduceDim : (Fun0,FIdeal,List OV) -> List FIdeal - findvar : (FIdeal,List OV) -> OV - testPower : (SUP,OV,FIdeal) -> Boolean - goodPower : (DPoly,FIdeal) -> Record(spol:DPoly,id:FIdeal) - pushdown : (DPoly,OV) -> DPoly - pushdterm : (DPoly,OV,Z) -> DPoly - pushup : (DPoly,OV) -> DPoly - pushuterm : (DPoly,SE,OV) -> DPoly - pushucoef : (UP,OV) -> DPoly - trueden : (P,SE) -> P - rearrange : (List OV) -> List OV - deleteunit : List FIdeal -> List FIdeal - ismonic : (DPoly,OV) -> Boolean - - MPCFQF ==> MPolyCatFunctions2(OV,Expon,Expon,Q,F,DPoly1,DPoly) + MPCFFQ ==> MPolyCatFunctions2(OV,Expon,Expon,F,Q,DPoly,DPoly1) + convertQF : Q -> F convertQF(a:Q) : F == ((numer a):: F)/((denom a)::F) + + convertFQ : F -> Q convertFQ(a:F) : Q == (ground numer a)/(ground denom a) + internalForm : Ideal -> FIdeal internalForm(I:Ideal) : FIdeal == Id:=generators I nId:=[map(convertQF,poly)$MPCFQF for poly in Id] groebner? I => groebnerIdeal nId ideal nId + externalForm : FIdeal -> Ideal externalForm(I:FIdeal) : Ideal == Id:=generators I nId:=[map(convertFQ,poly)$MPCFFQ for poly in Id] @@ -76544,16 +77992,20 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't ideal nId lvint:=[variable(xx)::OV for xx in vl] + nvint1:=(#lvint-1)::NNI + deleteunit : List FIdeal -> List FIdeal deleteunit(lI: List FIdeal) : List FIdeal == [I for I in lI | _^ element?(1$DPoly,I)] + rearrange : (List OV) -> List OV rearrange(vlist:List OV) :List OV == vlist=[] => vlist sort((z1,z2)+->z1>z2,setDifference(lvint,setDifference(lvint,vlist))) ---- radical of a 0-dimensional ideal ---- + zeroRadComp : (FIdeal,List OV) -> FIdeal zeroRadComp(I:FIdeal,truelist:List OV) : FIdeal == truelist=[] => I Id:=generators I @@ -76584,6 +78036,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't groebnerIdeal(groebner ris) ---- find the power that stabilizes (I:s) ---- + goodPower : (DPoly,FIdeal) -> Record(spol:DPoly,id:FIdeal) goodPower(s:DPoly,I:FIdeal) : Record(spol:DPoly,id:FIdeal) == f:DPoly:=s I:=groebner I @@ -76593,6 +78046,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't ---- is the ideal zerodimensional? ---- ---- the "true variables" are in truelist ---- + zerodimcase : (FIdeal,List OV) -> Boolean zerodimcase(J:FIdeal,truelist:List OV) : Boolean == element?(1,J) => true truelist=[] => true @@ -76609,6 +78063,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't ---- choose the variable for the reduction step ---- --- J groebnerner in gen pos --- + findvar : (FIdeal,List OV) -> OV findvar(J:FIdeal,truelist:List OV) : OV == lmonicvar:List OV :=[] for f in generators J repeat @@ -76619,6 +78074,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't badvar.first ---- function for the "reduction step ---- + reduceDim : (Fun0,FIdeal,List OV) -> List FIdeal reduceDim(flag:Fun0,J:FIdeal,truelist:List OV) : List(FIdeal) == element?(1,J) => [J] zerodimcase(J,truelist) => @@ -76641,6 +78097,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't res1 ---- Primary Decomposition for 0-dimensional ideals ---- + zeroPrimDecomp : (FIdeal,List OV) -> List(FIdeal) zeroPrimDecomp(I:FIdeal,truelist:List OV): List(FIdeal) == truelist=[] => list I newJ:=genPosLastVar(I,truelist);lval:=newJ.changeval; @@ -76659,6 +78116,12 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't ris ---- radical of an Ideal ---- + radical : PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) -> _ + PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) radical(I:Ideal) : Ideal == J:=groebner(internalForm I) truelist:=rearrange("setUnion"/[variables f for f in generators J]) @@ -76669,6 +78132,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't -- the following functions are used to "push" x in the coefficient ring - ---- push x in the coefficient domain for a polynomial ---- + pushdown : (DPoly,OV) -> DPoly pushdown(g:DPoly,x:OV) : DPoly == rf:DPoly:=0$DPoly i:=position(x,lvint) @@ -76679,6 +78143,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't rf ---- push x in the coefficient domain for a term ---- + pushdterm : (DPoly,OV,Z) -> DPoly pushdterm(t:DPoly,x:OV,i:Z):DPoly == n:=degree(t,x) xp:=convert(x)@SE @@ -76687,6 +78152,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't cf * newt::DPoly ---- push back the variable ---- + pushup : (DPoly,OV) -> DPoly pushup(f:DPoly,x:OV) :DPoly == h:=1$P rf:DPoly:=0$DPoly @@ -76702,16 +78168,18 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't f:=g rf + trueden : (P,SE) -> P trueden(c:P,x:SE) : P == degree(c,x) = 0 => 1 c ---- push x back from the coefficient domain for a term ---- + pushuterm : (DPoly,SE,OV) -> DPoly pushuterm(t:DPoly,xp:SE,x:OV):DPoly == pushucoef((univariate(numer leadingCoefficient t,xp)$P), x)* monomial(inv((denom leadingCoefficient t)::F),degree t)$DPoly - + pushucoef : (UP,OV) -> DPoly pushucoef(c:UP,x:OV):DPoly == c = 0 => 0 monomial((leadingCoefficient c)::F::DPoly,x,degree c) + @@ -76719,6 +78187,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't -- is the 0-dimensional ideal I primary ? -- ---- internal function ---- + is0dimprimary : (FIdeal,List OV) -> Boolean is0dimprimary(J:FIdeal,truelist:List OV) : Boolean == element?(1,J) => true Jd:=generators(groebner J) @@ -76740,6 +78209,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't ---- Functions for the General Position step ---- ---- put the ideal in general position ---- + genPosLastVar : (FIdeal,List OV) -> GenPos genPosLastVar(J:FIdeal,truelist:List OV):GenPos == x := last truelist ;lv1:List OV :=remove(x,truelist) ranvals:List(Z):=[(random()$Z rem 23) for vv in lv1] @@ -76750,6 +78220,7 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't ---- convert back the ideal ---- + backGenPos : (FIdeal,List Z,List OV) -> FIdeal backGenPos(I:FIdeal,lval:List Z,truelist:List OV) : FIdeal == lval=[] => I x := last truelist ;lv1:List OV:=remove(x,truelist) @@ -76758,11 +78229,13 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't groebnerIdeal (groebner([(univariate(p,x)).val for p in generators I ])) + ismonic : (DPoly,OV) -> Boolean ismonic(f:DPoly,x:OV) : Boolean == ground? leadingCoefficient(univariate(f,x)) ---- test if f is power of a linear mod (rad J) ---- ---- f is monic ---- + testPower : (SUP,OV,FIdeal) -> Boolean testPower(uf:SUP,x:OV,J:FIdeal) : Boolean == df:=degree(uf) trailp:DPoly := inv(df:Z ::F) *coefficient(uf,(df-1)::NNI) @@ -76771,10 +78244,10 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't g:DPoly:=multivariate(uf-linp,x) inRadical?(g,J) - - ---- Exported Functions ---- - -- is the 0-dimensional ideal I prime ? -- + zeroDimPrime? : PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) -> Boolean zeroDimPrime?(I:Ideal) : Boolean == J:=groebner((genPosLastVar(internalForm I,lvint)).genideal) element?(1,J) => true @@ -76791,11 +78264,20 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't -- is the 0-dimensional ideal I primary ? -- + zeroDimPrimary? : PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) -> Boolean zeroDimPrimary?(J:Ideal):Boolean == is0dimprimary(internalForm J,lvint) ---- Primary Decomposition of I ----- + primaryDecomp : PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) -> _ + List(PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer)))) primaryDecomp(I:Ideal) : List(Ideal) == J:=groebner(internalForm I) truelist:=rearrange("setUnion"/[variables f for f in generators J]) @@ -76803,6 +78285,12 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't [externalForm II for II in reduceDim("zeroPrimDecomp",J,truelist)] ---- contract I to the ring with lvar variables ---- + contract : (PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))),_ + List(OrderedVariableList(vl))) -> PolynomialIdeals(Fraction(Integer),_ + DirectProduct(nv,NonNegativeInteger),OrderedVariableList(vl),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) contract(I:Ideal,lvar: List OV) : Ideal == Id:= generators(groebner I) empty?(Id) => I @@ -83374,10 +84862,14 @@ IntegerLinearDependence(R): Exports == Implementation where import LinearDependence(Z, R) + linearlyDependentOverZ? : Vector(R) -> Boolean linearlyDependentOverZ? v == linearlyDependent? v + linearDependenceOverZ : Vector(R) -> Union(Vector(Integer),"failed") linearDependenceOverZ v == linearDependence v + solveLinearlyOverQ : (Vector(R),R) -> _ + Union(Vector(Fraction(Integer)),"failed") solveLinearlyOverQ(v, c) == solveLinear(v, c) *) @@ -84352,6 +85844,7 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where B: IndexedFlexibleArray(RN,0) := new(1, 1) H: Record(Hn:I,Hv:RN) := [1, 1] + harmonic : Integer -> Fraction(Integer) harmonic n == s:I; h:RN n < 0 => error("harmonic not defined for negative integers") @@ -84361,6 +85854,7 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where H.Hv := h h + fibonacci : Integer -> Integer fibonacci n == n = 0 => 0 n < 0 => (odd? n => 1; -1) * fibonacci(-n) @@ -84372,6 +85866,7 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where if bit?(n,k) then (f1,f2) := (f2,f1+f2) f2 + euler : Integer -> Integer euler n == n < 0 => error "euler not defined for negative integers" odd? n => 0 @@ -84389,6 +85884,7 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where E(i) := -e E(n) + bernoulli : Integer -> Fraction(Integer) bernoulli n == n < 0 => error "bernoulli not defined for negative integers" odd? n => @@ -84408,7 +85904,6 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where B(n) inverse : (I,I) -> I - inverse(a,b) == borg:I:=b c1:I := 1 @@ -84421,12 +85916,14 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where a ^= 1 => error("moduli are not relatively prime") positiveRemainder(c1,borg) + chineseRemainder : (Integer,Integer,Integer,Integer) -> Integer chineseRemainder(x1,m1,x2,m2) == m1 < 0 or m2 < 0 => error "moduli must be positive" x1 := positiveRemainder(x1,m1) x2 := positiveRemainder(x2,m2) x1 + m1 * positiveRemainder(((x2-x1) * inverse(m1,m2)),m2) + jacobi : (Integer,Integer) -> Integer jacobi(a,b) == -- Revised by Clifton Williamson January 1989. -- Previous version returned incorrect answers when b was even. @@ -84466,10 +85963,12 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where a = 0 => 0 j + legendre : (Integer,Integer) -> Integer legendre(a,p) == prime? p => jacobi(a,p) error "characteristic of legendre must be prime" + eulerPhi : Integer -> Integer eulerPhi n == n = 0 => 0 r : RN := 1 @@ -84477,6 +85976,7 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where r := ((entry.factor - 1) /$RN entry.factor) * r numer(n * r) + divisors : Integer -> List(Integer) divisors n == oldList : List Integer := [1] for f in factors factor n repeat @@ -84488,22 +85988,26 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where oldList := newList sort((i1:Integer,i2:Integer):Boolean +-> i1 < i2,oldList) + numberOfDivisors : Integer -> Integer numberOfDivisors n == n = 0 => 0 */[1+entry.exponent for entry in factors factor n] + sumOfDivisors : Integer -> Integer sumOfDivisors n == n = 0 => 0 r : RN := */[(entry.factor**(entry.exponent::NNI + 1)-1)/ (entry.factor-1) for entry in factors factor n] numer r + sumOfKthPowerDivisors : (Integer,NonNegativeInteger) -> Integer sumOfKthPowerDivisors(n,k) == n = 0 => 0 r : RN := */[(entry.factor**(k*entry.exponent::NNI+k)-1)/ (entry.factor**k-1) for entry in factors factor n] numer r + moebiusMu : Integer -> Integer moebiusMu n == n = 1 => 1 t := factor n @@ -85208,29 +86712,42 @@ that is the square of the upper bound of the table range, in this case 9949::I, 9967::I, 9973::I] productSmallPrimes := */smallPrimes + nextSmallPrime := 10007::I + nextSmallPrimeSquared := nextSmallPrime**2 + two := 2::I + tenPowerTwenty:=(10::I)**20 + PomeranceList:= [25326001::I, 161304001::I, 960946321::I, 1157839381::I, -- 3215031751::I, -- has a factor of 151 3697278427::I, 5764643587::I, 6770862367::I, 14386156093::I, 15579919981::I, 18459366157::I, 19887974881::I, 21276028621::I ]::(List I) + PomeranceLimit:=27716349961::I -- replaces (25*10**9) due to Pinch + PinchList:= _ [3215031751::I, 118670087467::I, 128282461501::I, 354864744877::I, 546348519181::I, 602248359169::I, 669094855201::I ] + PinchLimit:= (10**12)::I + PinchList2:= [2152302898747::I, 3474749660383::I] + PinchLimit2:= (10**13)::I + JaeschkeLimit:=341550071728321::I + rootsMinus1:Set I := empty() -- used to check whether we detect too many roots of -1 + count2Order:Vector NonNegativeInteger := new(1,0) -- used to check whether we observe an element of maximal two-order - + primes : (I,I) -> List(I) primes(m, n) == -- computes primes from m to n inclusive using prime? l:List(I) := @@ -85242,9 +86759,7 @@ that is the square of the upper bound of the table range, in this case convert(m)@Integer..convert(n)@Integer by 2 | prime?(k::I)] reverse_! concat_!(ll, l) - rabinProvesComposite : (I,I,I,I,NonNegativeInteger) -> Boolean rabinProvesCompositeSmall : (I,I,I,I,NonNegativeInteger) -> Boolean - rabinProvesCompositeSmall(p,n,nm1,q,k) == -- probability n prime is > 3/4 for each iteration -- for most n this probability is much greater than 3/4 @@ -85261,7 +86776,7 @@ that is the square of the upper bound of the table range, in this case not (t = nm1) => return true false - + rabinProvesComposite : (I,I,I,I,NonNegativeInteger) -> Boolean rabinProvesComposite(p,n,nm1,q,k) == -- probability n prime is > 3/4 for each iteration -- for most n this probability is much greater than 3/4 @@ -85282,46 +86797,38 @@ that is the square of the upper bound of the table range, in this case # rootsMinus1 > 2 => true -- Z/nZ can't be a field false - + prime? : I -> Boolean prime? n == n < two => false n < nextSmallPrime => member?(n, smallPrimes) not (gcd(n, productSmallPrimes) = 1) => false n < nextSmallPrimeSquared => true - nm1 := n-1 q := (nm1) quo two for k in 1.. while not odd? q repeat q := q quo two -- q = (n-1) quo 2**k for largest possible k - n < JaeschkeLimit => rabinProvesCompositeSmall(2::I,n,nm1,q,k) => return false rabinProvesCompositeSmall(3::I,n,nm1,q,k) => return false - n < PomeranceLimit => rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false member?(n,PomeranceList) => return false true - rabinProvesCompositeSmall(7::I,n,nm1,q,k) => return false n < PinchLimit => rabinProvesCompositeSmall(10::I,n,nm1,q,k) => return false member?(n,PinchList) => return false true - rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false rabinProvesCompositeSmall(11::I,n,nm1,q,k) => return false n < PinchLimit2 => member?(n,PinchList2) => return false true - rabinProvesCompositeSmall(13::I,n,nm1,q,k) => return false rabinProvesCompositeSmall(17::I,n,nm1,q,k) => return false true - rootsMinus1:= empty() count2Order := new(k,0) -- vector of k zeroes - mn := minIndex smallPrimes for i in mn+1..mn+10 repeat rabinProvesComposite(smallPrimes i,n,nm1,q,k) => return false @@ -85337,7 +86844,7 @@ that is the square of the upper bound of the table range, in this case rabinProvesComposite(currPrime,n,nm1,q,k) => return false true - + nextPrime : I -> I nextPrime n == -- computes the first prime after n n < two => two @@ -85345,7 +86852,7 @@ that is the square of the upper bound of the table range, in this case while not prime? n repeat n := n + two n - + prevPrime : I -> I prevPrime n == -- computes the first prime before n n < 3::I => error "no primes less than 2" @@ -85443,10 +86950,13 @@ IntegerRetractions(S:RetractableTo(Integer)): with (* package INTRET *) (* - integer s == retract s + integer : S -> Integer + integer s == retract s - integer? s == retractIfCan(s) case Integer + integer? : S -> Boolean + integer? s == retractIfCan(s) case Integer + integerIfCan : S -> Union(Integer,"failed") integerIfCan s == retractIfCan s *) @@ -85653,12 +87163,16 @@ IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where resMod144: List I := [0::I,1::I,4::I,9::I,16::I,25::I,36::I,49::I,_ 52::I,64::I,73::I,81::I,97::I,100::I,112::I,121::I] + two := 2::I - perfectSquare? a == (perfectSqrt a) case I + perfectSquare? : I -> Boolean + perfectSquare? a == (perfectSqrt a) case I + perfectNthPower? : (I,NonNegativeInteger) -> Boolean perfectNthPower?(b, n) == perfectNthRoot(b, n) case I + perfectNthRoot : I -> Record(base: I,exponent: NonNegativeInteger) perfectNthRoot n == -- complexity (log log n)**2 (log n)**2 m:NNI (n = 1) or zero? n or n = -1 => [n, 1] @@ -85671,6 +87185,7 @@ IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where p := convert(nextPrime(p::I))@Integer :: NNI [n, e] + approxNthRoot : (I,NonNegativeInteger) -> I approxNthRoot(a, n) == -- complexity (log log n) (log n)**2 zero? n => error "invalid arguments" (n = 1) => a @@ -85693,15 +87208,18 @@ IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where z := x-y x + perfectNthRoot : (I,NonNegativeInteger) -> Union(I,"failed") perfectNthRoot(b, n) == (r := approxNthRoot(b, n)) ** n = b => r "failed" + perfectSqrt : I -> Union(I,"failed") perfectSqrt a == a < 0 or not member?(a rem (144::I), resMod144) => "failed" (s := approxSqrt a) * s = a => s "failed" + approxSqrt : I -> I approxSqrt a == a < 1 => 0 if (n := length a) > (100::I) then @@ -85827,6 +87345,10 @@ IntegerSolveLinearPolynomialEquation(): C ==T oldtable:Vector List ZP := empty() + solveLinearPolynomialEquation : _ + (List(SparseUnivariatePolynomial(Integer)),_ + SparseUnivariatePolynomial(Integer)) -> _ + Union(List(SparseUnivariatePolynomial(Integer)),"failed") solveLinearPolynomialEquation(lp,p) == if (oldlp ^= lp) then -- we have to generate a new table @@ -86059,6 +87581,7 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where import ModularHermitianRowReduction(R) import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) + diagonalProduct : Matrix(R) -> R diagonalProduct m == ans : R := 1 for i in minRowIndex m .. maxRowIndex m @@ -86066,6 +87589,7 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where ans := ans * qelt(m, i, j) ans + matrixGcd : (Matrix(R),R,NonNegativeInteger) -> R matrixGcd(mat,sing,n) == -- note that 'matrix' is upper triangular; -- no need to do anything below the diagonal @@ -86076,6 +87600,7 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where (d = 1) => return d d + divideIfCan! : (Matrix(R),Matrix(R),R,Integer) -> R divideIfCan_!(matrix,matrixOut,prime,n) == -- note that both 'matrix' and 'matrixOut' will be upper triangular; -- no need to do anything below the diagonal @@ -86085,12 +87610,14 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where qsetelt_!(matrixOut,i,j,a :: R) 1 + leastPower : (NonNegativeInteger,NonNegativeInteger) -> NonNegativeInteger leastPower(p,n) == -- efficiency is not an issue here e : NNI := 1; q := p while q < n repeat (e := e + 1; q := q * p) e + idealiserMatrix : (Matrix(R),Matrix(R)) -> Matrix(R) idealiserMatrix(ideal,idealinv) == -- computes the Order of the ideal n := rank()$F @@ -86105,14 +87632,19 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where bigm(j * n + k + mr,i + mc) := qelt(m,j + mr,k + mc) bigm + idealiser : (Matrix(R),Matrix(R)) -> Matrix(R) idealiser(ideal,idealinv) == bigm := idealiserMatrix(ideal, idealinv) transpose squareTop rowEch bigm + idealiser : (Matrix(R),Matrix(R),R) -> Matrix(R) idealiser(ideal,idealinv,denom) == bigm := (idealiserMatrix(ideal, idealinv) exquo denom)::Mat transpose squareTop rowEchelon(bigm,denom) + moduleSum : (Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)),_ + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R))) -> _ + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) moduleSum(mod1,mod2) == rb1 := mod1.basis; rbden1 := mod1.basisDen; rbinv1 := mod1.basisInv rb2 := mod2.basis; rbden2 := mod2.basisDen; rbinv2 := mod2.basisInv @@ -86281,6 +87813,7 @@ IntegralBasisPolynomialTools(K,R,UP,L): Exports == Implementation where (* package IBPTOOLS *) (* + mapUnivariate : ((L -> K),SparseUnivariatePolynomial(L)) -> R mapUnivariate(f:L -> K,poly:SUP L) == ans : R := 0 while not zero? poly repeat @@ -86288,6 +87821,7 @@ IntegralBasisPolynomialTools(K,R,UP,L): Exports == Implementation where poly := reductum poly ans + mapUnivariate : ((K -> L),R) -> SparseUnivariatePolynomial(L) mapUnivariate(f:K -> L,poly:R) == ans : SUP L := 0 while not zero? poly repeat @@ -86295,6 +87829,8 @@ IntegralBasisPolynomialTools(K,R,UP,L): Exports == Implementation where poly := reductum poly ans + mapUnivariateIfCan : ((L -> Union(K,"failed")),_ + SparseUnivariatePolynomial(L)) -> Union(R,"failed") mapUnivariateIfCan(f,poly) == ans : R := 0 while not zero? poly repeat @@ -86303,6 +87839,8 @@ IntegralBasisPolynomialTools(K,R,UP,L): Exports == Implementation where poly := reductum poly ans + mapMatrixIfCan : ((L -> Union(K,"failed")),_ + Matrix(SparseUnivariatePolynomial(L))) -> Union(Matrix(R),"failed") mapMatrixIfCan(f,mat) == m := nrows mat; n := ncols mat matOut : MAT R := new(m,n,0) @@ -86312,6 +87850,8 @@ IntegralBasisPolynomialTools(K,R,UP,L): Exports == Implementation where qsetelt_!(matOut,i,j,poly :: R) matOut + mapBivariate : ((K -> L),UP) -> _ + SparseUnivariatePolynomial(SparseUnivariatePolynomial(L)) mapBivariate(f,poly) == ans : SUP SUP L := 0 while not zero? poly repeat @@ -86452,28 +87992,35 @@ IntegrationResultFunctions2(E, F): Exports == Implementation where import SparseUnivariatePolynomialFunctions2(E, F) - NEE2F: (E -> F, NEE) -> NEF - LGE2F: (E -> F, LGE) -> LGF NLE2F: (E -> F, NLE) -> NLF + NLE2F(func, r) == [func(r.coeff), func(r.logand)] - NLE2F(func, r) == [func(r.coeff), func(r.logand)] - - NEE2F(func, n) == [func(n.integrand), func(n.intvar)] + NEE2F: (E -> F, NEE) -> NEF + NEE2F(func, n) == [func(n.integrand), func(n.intvar)] + map : ((E -> F),Union(E,"failed")) -> Union(F,"failed") map(func:E -> F, u:UE) == (u case "failed" => "failed"; func(u::E)) + map : ((E -> F),IntegrationResult(E)) -> IntegrationResult(F) map(func:E -> F, ir:IRE) == mkAnswer(func ratpart ir, [LGE2F(func, f) for f in logpart ir], [NEE2F(func, g) for g in notelem ir]) + map : ((E -> F),Union(Record(ratpart: E,coeff: E),"failed")) -> _ + Union(Record(ratpart: F,coeff: F),"failed") map(func:E -> F, u:URE) == u case "failed" => "failed" [func(u.ratpart), func(u.coeff)] + map : ((E -> F),Union(Record(mainpart: E,_ + limitedlogs: List(Record(coeff: E,logand: E))),"failed")) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed") map(func:E -> F, u:UFE) == u case "failed" => "failed" [func(u.mainpart), [NLE2F(func, f) for f in u.limitedlogs]] + LGE2F: (E -> F, LGE) -> LGF LGE2F(func, lg) == [lg.scalar, map(func, lg.coeff), map(func, lg.logand)] @@ -86627,13 +88174,16 @@ IntegrationResultRFToFunction(R): Exports == Implementation where import IntegrationResultToFunction(R, F) toEF: IR -> IntegrationResult F + toEF i == map(z1+->z1::F, i)$IntegrationResultFunctions2(RF, F) - toEF i == map(z1+->z1::F, i)$IntegrationResultFunctions2(RF, F) - - expand i == expand toEF i + expand : IntegrationResult(Fraction(Polynomial(R))) -> List(Expression(R)) + expand i == expand toEF i + complexExpand : IntegrationResult(Fraction(Polynomial(R))) -> Expression(R) complexExpand i == complexExpand toEF i + split : IntegrationResult(Fraction(Polynomial(R))) -> _ + IntegrationResult(Fraction(Polynomial(R))) split i == map(retract, split toEF i)$IntegrationResultFunctions2(F, RF) @@ -86641,15 +88191,20 @@ IntegrationResultRFToFunction(R): Exports == Implementation where import RationalFunctionIntegration(R) + complexIntegrate : (Fraction(Polynomial(R)),Symbol) -> Expression(R) complexIntegrate(f, x) == complexExpand internalIntegrate(f, x) -- do not use real integration if R is complex if R has imaginary: () -> R then + integrate : (Fraction(Polynomial(R)),Symbol) -> _ + Union(Expression(R),List(Expression(R))) if R has CHARZ integrate(f, x) == complexIntegrate(f, x) else + integrate : (Fraction(Polynomial(R)),Symbol) -> _ + Union(Expression(R),List(Expression(R))) if R has CHARZ integrate(f, x) == l := [mkPrim(real g, x) for g in expand internalIntegrate(f, x)] empty? rest l => first l @@ -86941,49 +88496,38 @@ IntegrationResultToFunction(R, F): Exports == Implementation where import AlgebraicManipulations(R, F) import ElementaryFunctionSign(R, F) - IR2F : IR -> F - insqrt : F -> Record(sqrt:REC, sgn:Z) - pairsum : (List F, List F) -> List F - pairprod : (F, List F) -> List F - quadeval : (UP, F, F, F) -> REC - linear : (UP, UP) -> F - tantrick : (F, F) -> F - ilog : (F, F, List K) -> F - ilog0 : (F, F, UP, UP, F) -> F - nlogs : LOG -> List LOG - lg2func : LOG -> List F - quadratic : (UP, UP) -> List F - mkRealFunc : List LOG -> List F - lg2cfunc : LOG -> F - loglist : (Q, UP, UP) -> List LOG - cmplex : (F, UP) -> F - evenRoots : F -> List F - compatible?: (List F, List F) -> Boolean - + cmplex : (F, UP) -> F cmplex(alpha, p) == alpha * log p alpha - IR2F i == retract mkAnswer(ratpart i, empty(), notelem i) + IR2F : IR -> F + IR2F i == retract mkAnswer(ratpart i, empty(), notelem i) - pairprod(x, l) == [x * y for y in l] + pairprod : (F, List F) -> List F + pairprod(x, l) == [x * y for y in l] + evenRoots : F -> List F evenRoots x == [first argument k for k in tower x | is?(k,"nthRoot"::Symbol) and even?(retract(second argument k)@Z) and (not empty? variables first argument k)] + expand : IntegrationResult(F) -> List(F) expand i == j := split i pairsum([IR2F j], mkRealFunc logpart j) + split : IntegrationResult(F) -> IntegrationResult(F) split i == mkAnswer(ratpart i,concat [nlogs l for l in logpart i],notelem i) + complexExpand : IntegrationResult(F) -> F complexExpand i == j := split i IR2F j + +/[lg.scalar::F * lg2cfunc lg for lg in logpart j] -- p = a t^2 + b t + c -- Expands sum_{p(t) = 0} t log(lg(t)) + quadratic : (UP, UP) -> List F quadratic(p, lg) == zero?(delta := (b := coefficient(p, 1))**2 - 4 * (a := coefficient(p,2)) * (p0 := coefficient(p, 0))) => @@ -87006,6 +88550,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where -- returns 2 atan(a/b) or 2 atan(-b/a) whichever looks better -- they differ by a constant so it's ok to do it from an IR + tantrick : (F, F) -> F tantrick(a, b) == retractIfCan(a)@Union(Q, "failed") case Q => 2 * atan(-b/a) 2 * atan(a/b) @@ -87013,6 +88558,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where -- transforms i log((a + i b) / (a - i b)) into a sum of real -- arc-tangents using Rioboo's algorithm -- lk is a list of kernels which are parameters for the integral + ilog : (F, F, List K) -> F ilog(a, b, lk) == l := setDifference(setUnion(variables numer a, variables numer b), setUnion(lk, setUnion(variables denom a, variables denom b))) @@ -87024,6 +88570,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where -- arc-tangents using Rioboo's algorithm -- the arc-tangents will not have k in the denominator -- we always keep upa(k) = a and upb(k) = b + ilog0 : (F, F, UP, UP, F) -> F ilog0(a, b, upa, upb, k) == if degree(upa) < degree(upb) then (upa, upb) := (-upb, upa) @@ -87040,6 +88587,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where bb := -(r.coef1) k tantrick(aa * a + bb * b, g::F) + ilog0(aa,bb,r.coef2,-r.coef1,k) + lg2func : LOG -> List F lg2func lg == zero?(d := degree(p := lg.coeff)) => error "poly has degree 0" (d = 1) => [linear(p, lg.logand)] @@ -87052,9 +88600,11 @@ IntegrationResultToFunction(R, F): Exports == Implementation where lg.logand]) [lg2cfunc lg] + lg2cfunc : LOG -> F lg2cfunc lg == +/[cmplex(alpha, lg.logand) for alpha in zerosOf(lg.coeff)] + mkRealFunc : List LOG -> List F mkRealFunc l == ans := empty()$List(F) for lg in l repeat @@ -87062,11 +88612,13 @@ IntegrationResultToFunction(R, F): Exports == Implementation where ans -- returns a log(b) + linear : (UP, UP) -> F linear(p, lg) == alpha := - coefficient(p, 0) / coefficient(p, 1) alpha * log lg alpha -- returns (c, d) s.t. p(a + b t) = c + d t, where t^2 = delta + quadeval : (UP, F, F, F) -> REC quadeval(p, a, b, delta) == zero? p => [0, 0] bi := c := d := 0$F @@ -87080,6 +88632,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where ai := temp [c, d] + compatible?: (List F, List F) -> Boolean compatible?(lx, ly) == empty? ly => true for x in lx repeat @@ -87087,6 +88640,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where ((s := sign(x*y)) case Z) and (s::Z < 0) => return false true + pairsum : (List F, List F) -> List F pairsum(lx, ly) == empty? lx => ly empty? ly => lx @@ -87100,6 +88654,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where -- returns [[a, b], s] where sqrt(y) = a sqrt(b) and -- s = 1 if b > 0, -1 if b < 0, 0 if the sign of b cannot be determined + insqrt : F -> Record(sqrt:REC, sgn:Z) insqrt y == rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F) ((rec.exponent) = 1) => [[rec.coef * rec.radicand, 1], 1] @@ -87107,6 +88662,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where [[rec.coef, rec.radicand], ((s := sign(rec.radicand)) case "failed" => 0; s::Z)] + nlogs : LOG -> List LOG nlogs lg == [[f.exponent * lg.scalar, f.factor, lg.logand] for f in factors ffactor(primitivePart(lg.coeff) @@ -87325,17 +88881,20 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where (* package INTTOOLS *) (* - better?: (K, K) -> Boolean - - union(l1, l2) == setUnion(l1, l2) + union : (List(Kernel(F)),List(Kernel(F))) -> List(Kernel(F)) + union(l1, l2) == setUnion(l1, l2) + varselect : (List(Kernel(F)),Symbol) -> List(Kernel(F)) varselect(l, x) == [k for k in l | member?(x, variables(k::F))] - ksec(k, l, x) == kmax setUnion(remove(k, l), vark(argument k, x)) + ksec : (Kernel(F),List(Kernel(F)),Symbol) -> Kernel(F) + ksec(k, l, x) == kmax setUnion(remove(k, l), vark(argument k, x)) + vark : (List(F),Symbol) -> List(Kernel(F)) vark(l, x) == varselect(reduce("setUnion",[kernels f for f in l],empty()$List(K)), x) + kmax : List(Kernel(F)) -> Kernel(F) kmax l == ans := first l for k in rest l repeat @@ -87343,6 +88902,7 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where ans -- true if x should be considered before y in the tower + better?: (K, K) -> Boolean better?(x, y) == height(y) ^= height(x) => height(y) < height(x) has?(operator y, ALGOP) or @@ -87350,6 +88910,8 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where and not has?(operator x, ALGOP)) if R has IntegralDomain then + + removeConstantTerm : (F,Symbol) -> F if R has INTDOM removeConstantTerm(f, x) == not freeOf?((den := denom f)::F, x) => f (u := isPlus(num := numer f)) case "failed" => @@ -87361,32 +88923,33 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where ans / den if R has GcdDomain and F has ElementaryFunctionCategory then - psimp : (P, SE) -> Record(coef:Integer, logand:F) - cont : (P, List K) -> P - logsimp : (F, SE) -> F - linearLog?: (K, F, SE) -> Boolean + logsimp : (F, SE) -> F logsimp(f, x) == r1 := psimp(numer f, x) r2 := psimp(denom f, x) g := gcd(r1.coef, r2.coef) g * log(r1.logand ** (r1.coef quo g) / r2.logand ** (r2.coef quo g)) + cont : (P, List K) -> P cont(p, l) == empty? l => p q := univariate(p, first l) cont(unitNormal(leadingCoefficient q).unit * content q, rest l) + linearLog?: (K, F, SE) -> Boolean linearLog?(k, f, x) == is?(k, "log"::SE) and ((u := retractIfCan(univariate(f,k))@Union(UP,"failed")) case UP) and (degree(u::UP) = 1) and not member?(x, variables leadingCoefficient(u::UP)) + mkPrim : (F,Symbol) -> F if F has ELEMFUN and R has GCDDOM mkPrim(f, x) == lg := [k for k in kernels f | linearLog?(k, f, x)] eval(f, lg, [logsimp(first argument k, x) for k in lg]) + psimp : (P, SE) -> Record(coef:Integer, logand:F) psimp(p, x) == (u := isExpt(p := ((p exquo cont(p, varselect(variables p, x)))::P))) case "failed" => [1, p::F] @@ -87395,6 +88958,10 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then + intPatternMatch : (F,Symbol,((F,Symbol) -> _ + IntegrationResult(F)),((F,Symbol) -> _ + Union(Record(special: F,integrand: F),"failed"))) -> _ + IntegrationResult(F) intPatternMatch(f, x, int, pmint) == ir := int(f, x) empty?(l := notelem ir) => ir @@ -87494,6 +89061,7 @@ InternalPrintPackage(): Exports == Implementation where (* package IPRNTPK *) (* + iprint : String -> Void iprint(s:String) == PRINC(coerce(s)@Symbol)$Lisp FORCE_-OUTPUT()$Lisp @@ -87743,6 +89311,7 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen (* package IRURPK *) (* + checkRur : (TS,List(TS)) -> Boolean checkRur(ts: TS, lts: List TS): Boolean == f0 := last(ts)::P z := mvar(f0) @@ -87758,6 +89327,7 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen return false (dts =$N dlts)@Boolean + convert : (P,B) -> TS convert(p:P,sqfr?:B):TS == -- if sqfr? ASSUME p is square-free newts: TS := empty() @@ -87765,6 +89335,7 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen p := squareFreePart(p) internalAugment(p,newts) + prepareRur : TS -> List LPWT prepareRur(ts: TS): List LPWT == not purelyAlgebraic?(ts)$TS => error "rur$IRURPK: #1 is not zero-dimensional" @@ -87788,6 +89359,7 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen toSave := cons([lp,ts],toSave) toSave + makeMonic : (V,P,P,TS,P,B) -> TS makeMonic(z:V,c:P,r:P,ts:TS,s:P,univ?:B): TS == --ASSUME r is a irreducible univariate polynomial in z --ASSUME c and s only depends on z and mvar(s) @@ -87807,9 +89379,11 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen newts := internalAugment(p,newts) internalAugment(s,newts) + next : Z -> Z next(lambda:Z):Z == if lambda < 0 then lambda := - lambda + 1 else lambda := - lambda + makeLinearAndMonic : (P,V,TS,B,B,B) -> List TS makeLinearAndMonic(p: P, xi: V, ts: TS, univ?:B, check?: B, info?: B): _ List TS == -- if check? THEN some VERIFICATIONS are performed @@ -87853,6 +89427,7 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen toSee := cons([f0,next(lambda),ts]$WIP,toSee) toSave + rur : (TS,Boolean) -> List(TS) rur (ts: TS,univ?:Boolean): List TS == toSee: List LPWT := prepareRur(ts) toSave: List TS := [] @@ -88128,16 +89703,7 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ import PolyRing import PCS - sbSpcOfCurve: (NNI,PolyRing) -> List(List(K)) - - exponant2monomial: List(NNI) -> PolyRing - - crtV: (List(K),List(INT),NNI) -> List(K) - - createLinSys: (List Plc, List INT,List PolyRing) -> Matrix(K) - - createLinSysWOVectorise: (List Plc, List INT,List PolyRing) -> Matrix(K) - + basisOfInterpolateFormsForFact: (DIVISOR,List(PolyRing)) -> List(Vector(K)) basisOfInterpolateFormsForFact(divis,lm)== -- permet d'intepoler un diviseur qui n'est pas rationnel. -- La partie non rationel @@ -88157,11 +89723,12 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ zeroMat:Matrix(K):=zero(1,#lm)$Matrix(K) nullSpace zeroMat + interpolateForms: (DIVISOR,NonNegativeInteger,PolyRing,List(PolyRing)) ->_ + List(PolyRing) interpolateForms(divis,d,laCrb,lm)== -- ppsol contiendra la base des formes interpolant le diviseur divis -- mieux vaut prendre divOfZero de divis ? ppsol:= basisOfInterpolateForms(divis,lm) - psol:List(List(K)):=[entries(vec) for vec in ppsol] mpsol:=psol sbspc:List(List(K)) @@ -88170,13 +89737,12 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ -- qui sont un multiple de la courbe sbspc:=sbSpcOfCurve(d,laCrb) mpsol:=quotVecSpaceBasis(psol,sbspc)$LinesOpPack(K) - empty?(mpsol) => [0] - rowEchmpsol:=rowEchelon(matrix(mpsol)$Matrix(K)) npsol:=listOfLists(rowEchmpsol) [reduce("+",[a*f for a in ll for f in lm]) for ll in npsol] + interpolateFormsForFact : (DIVISOR,List(PolyRing)) -> List(PolyRing) interpolateFormsForFact(divis,lm)== -- ppsol contiendra la base des formes interpolant le diviseur divis ppsol:= basisOfInterpolateFormsForFact(divis,lm) @@ -88187,6 +89753,7 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ npsol:=listOfLists(rowEchmpsol) [reduce("+",[a*f for a in ll for f in lm]) for ll in npsol] + createLinSys: (List Plc, List INT,List PolyRing) -> Matrix(K) createLinSys(lstOfPlc,lstOfv,lm)== lplsT:=[ [parametrize(f,pl)$ParamPack for f in lm]_ for pl in lstOfPlc] @@ -88199,6 +89766,7 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ for v in lstOfv]) linSys + createLinSysWOVectorise: (List Plc, List INT,List PolyRing) -> Matrix(K) createLinSysWOVectorise(lstOfPlc,lstOfv,lm)== lplsT:=[ [parametrize(f,pl)$ParamPack for f in lm]_ for pl in lstOfPlc] @@ -88211,6 +89779,7 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ for v in lstOfv]) linSys + basisOfInterpolateForms : (DIVISOR,List(PolyRing)) -> List(Vector(K)) basisOfInterpolateForms(divis,lm)== lstOfPlc:= supp divis lstOfv:= [coefficient(pl,divis) for pl in lstOfPlc] @@ -88227,12 +89796,14 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ listMonoPols:List(PolyRing):=[monomial(1,vv,1) for vv in listVar] + crtV: (List(K),List(INT),NNI) -> List(K) crtV(lcoef,lpos,l)== vvv:List(K):=[0 for i in 1..l] for c in lcoef for p in lpos repeat setelt(vvv,p,c) vvv + sbSpcOfCurve: (NNI,PolyRing) -> List(List(K)) sbSpcOfCurve(m,laCrb)== d:=totalDegree(laCrb)$PackPoly lm:List(PolyRing):=listAllMono(m)$PackPoly @@ -88253,7 +89824,7 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_ raugmat:=rank(augmat) rmat=raugmat - + exponant2monomial: List(NNI) -> PolyRing exponant2monomial(lexp)== reduce("*",[m**e for m in listMonoPols for e in lexp]) @@ -88426,6 +89997,8 @@ IntersectionDivisorPackage(K,symb,PolyRing,E,ProjPt, PCS,Plc,DIVISOR,_ (* package INTDIVP *) (* + intersectionDivisor : (PolyRing,PolyRing,List(DesTree),List(ProjPt)) ->_ + DIVISOR intersectionDivisor(pol,curve,ltr,listOfSingPt)== intDeg:Integer:= (totalDegree(pol)$PackPoly * _ totalDegree(curve)$PackPoly) pretend Integer @@ -88466,6 +90039,7 @@ IntersectionDivisorPackage(K,symb,PolyRing,E,ProjPt, PCS,Plc,DIVISOR,_ print("Of course its the machine that make the mistake !!!!!" :: OF) theDivisor + placesOfDegree : (PositiveInteger,PolyRing,List(ProjPt)) -> Void placesOfDegree(d, curve, singPts) == --Return the number of places of degree i of the functionfield, no --constant field extension @@ -88599,12 +90173,11 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where import DistinctDegreeFactorize(GF, SUP) - getIrredPoly : (Z, N) -> SUP - qAdicExpansion: Z -> SUP - p := characteristic()$GF :: N + q := size()$GF :: N + qAdicExpansion: Z -> SUP qAdicExpansion(z : Z): SUP == -- expands z as a sum of powers of q, with coefficients in GF -- z = HornerEval(qAdicExpansion z,q) @@ -88614,6 +90187,7 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where zero?(qr.quotient) => r r + monomial(1, 1) * qAdicExpansion(qr.quotient) + getIrredPoly : (Z, N) -> SUP getIrredPoly(start : Z, n : N) : SUP == -- idea is to iterate over possibly irreducible monic polynomials -- until we find an irreducible one. The obviously reducible ones @@ -88630,6 +90204,7 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where zero? pol => error "no irreducible poly found" pol + generateIrredPoly : PositiveInteger -> SparseUnivariatePolynomial(GF) generateIrredPoly(n : N) : SUP == -- want same poly every time (n = 1) => monomial(1, 1)$SUP @@ -89010,44 +90585,10 @@ IrrRepSymNatPackage(): public == private where columns : NNI := 0 -- # of columns of standard tableau aId : M I := new(1,1,0) - -- declaration of local functions - + -- computes aId, the inverse of the matrix + -- (signum(k,l,id))_1 <= k,l <= flambda, where id + -- denotes the identity permutation aIdInverse : () -> Void - -- computes aId, the inverse of the matrix - -- (signum(k,l,id))_1 <= k,l <= flambda, where id - -- denotes the identity permutation - - alreadyComputed? : L I -> Void - -- test if the last calling of an exported function concerns - -- the same partition lambda as the previous call - - listPermutation : PERM I -> L I -- should be in Permutation - -- converts a permutation pi into the list - -- [pi(1),pi(2),..,pi(n)] - - signum : (NNI, NNI, L I) -> I - -- if there exists a vertical permutation v of the tableau - -- tl := pi o younglist(l) (l-th standard tableau) - -- and a horizontal permutation h of the tableau - -- tk := younglist(k) (k-th standard tableau) such that - -- v o tl = h o tk, - -- then - -- signum(k,l,pi) = sign(v), - -- otherwise - -- signum(k,l,pi) = 0. - - sumPartition : L I -> NNI - -- checks if lambda is a proper partition and results in - -- the sum of the entries - - testPermutation : L I -> NNI - -- testPermutation(pi) checks if pi is an element of S_n, - -- the set of permutations of the set {1,2,...,n}. - -- If not, an error message will occur, if yes it replies n. - - -- definition of local functions - - aIdInverse() == aId := new(flambda,flambda,0) for k in 1..flambda repeat @@ -89068,6 +90609,9 @@ IrrRepSymNatPackage(): public == private where aId(i::NNI,k:NNI) := aId(i::NNI,k::NNI) + aId(i::NNI,j:NNI) * aId(j::NNI,k::NNI) + -- test if the last calling of an exported function concerns + -- the same partition lambda as the previous call + alreadyComputed? : L I -> Void alreadyComputed?(lambda) == if not(lambda = oldlambda) then oldlambda := lambda @@ -89079,12 +90623,25 @@ IrrRepSymNatPackage(): public == private where flambda := #younglist aIdInverse() -- side effect: creates actual aId + -- converts a permutation pi into the list + -- [pi(1),pi(2),..,pi(n)] + listPermutation : PERM I -> L I -- should be in Permutation listPermutation(pi) == li : L I := nil$(L I) for k in n..1 by -1 repeat li := cons(eval(pi,k)$(PERM I),li) li + -- if there exists a vertical permutation v of the tableau + -- tl := pi o younglist(l) (l-th standard tableau) + -- and a horizontal permutation h of the tableau + -- tk := younglist(k) (k-th standard tableau) such that + -- v o tl = h o tk, + -- then + -- signum(k,l,pi) = sign(v), + -- otherwise + -- signum(k,l,pi) = 0. + signum : (NNI, NNI, L I) -> I signum(numberOfRowTableau, numberOfColumnTableau,pi) == rowtab : M I := copy younglist numberOfRowTableau columntab : M I := copy younglist numberOfColumnTableau @@ -89093,7 +90650,6 @@ IrrRepSymNatPackage(): public == private where end : B := false endk : B ctrl : B - -- k-loop for all rows of tableau rowtab k : NNI := 1 while (k <= rows) and (not end) repeat @@ -89146,6 +90702,9 @@ IrrRepSymNatPackage(): public == private where -- end of k-loop sign + -- checks if lambda is a proper partition and results in + -- the sum of the entries + sumPartition : L I -> NNI sumPartition(lambda) == ok : B := true prev : I := first lambda @@ -89158,6 +90717,10 @@ IrrRepSymNatPackage(): public == private where error("No proper partition ") sum::NNI + -- testPermutation(pi) checks if pi is an element of S_n, + -- the set of permutations of the set {1,2,...,n}. + -- If not, an error message will occur, if yes it replies n. + testPermutation : L I -> NNI testPermutation(pi : L I) : NNI == ok : B := true n : I := 0 @@ -89176,6 +90739,7 @@ IrrRepSymNatPackage(): public == private where -- definitions of exported functions + dimensionOfIrreducibleRepresentation : List(Integer) -> NonNegativeInteger dimensionOfIrreducibleRepresentation(lambda) == nn : I := sumPartition(lambda)::I --also checks whether lambda dd : I := 1 --is a partition @@ -89189,6 +90753,8 @@ IrrRepSymNatPackage(): public == private where dd := dd * (lambda.i + lambdaprime.j - i - j + 1) (factorial(nn)$ICF quo dd)::NNI + irreducibleRepresentation : (List(Integer),Permutation(Integer)) -> _ + Matrix(Integer) irreducibleRepresentation(lambda:(L I),pi:(PERM I)) == nn : NNI := sumPartition(lambda) alreadyComputed?(lambda) @@ -89201,6 +90767,7 @@ IrrRepSymNatPackage(): public == private where aPi(k,l) := signum(k,l,piList) aId * aPi + irreducibleRepresentation : List(Integer) -> List(Matrix(Integer)) irreducibleRepresentation(lambda) == listperm : L PERM I := nil$(L PERM I) li : L I := nil$(L I) @@ -89217,6 +90784,8 @@ IrrRepSymNatPackage(): public == private where cons(cycle([1,2])$(PERM I),listperm) irreducibleRepresentation(lambda,listperm) + irreducibleRepresentation: (List(Integer),List(Permutation(Integer))) ->_ + List(Matrix(Integer)) irreducibleRepresentation(lambda:(L I),listperm:(L PERM I)) == sumPartition(lambda) alreadyComputed?(lambda) @@ -89375,18 +90944,14 @@ InverseLaplaceTransform(R, F): Exports == Implementation where (* package INVLAPLA *) (* - -- local ops -- - ilt : (F,Symbol,Symbol) -> Union(F,"failed") - ilt1 : (RF,F) -> F - iltsqfr : (RF,F) -> F - iltirred: (UP,UP,F) -> F - freeOf?: (UP,Symbol) -> Boolean - + inverseLaplace : (F,Symbol,Symbol) -> Union(F,"failed") inverseLaplace(expr,ivar,ovar) == ilt(expr,ivar,ovar) + freeOf?: (UP,Symbol) -> Boolean freeOf?(p:UP,v:Symbol) == "and"/[freeOf?(c,v) for c in coefficients p] + ilt : (F,Symbol,Symbol) -> Union(F,"failed") ilt(expr,var,t) == expr = 0 => 0 r := univariate(expr,kernel(var)) @@ -89400,22 +90965,24 @@ InverseLaplaceTransform(R, F): Exports == Implementation where hintpac := TranscendentalHermiteIntegration(F, UP) + ilt1 : (RF,F) -> F ilt1(r,t) == r = 0 => 0 rsplit := HermiteIntegrate(r, differentiate)$hintpac -t*ilt1(rsplit.answer,t) + iltsqfr(rsplit.logpart,t) + iltsqfr : (RF,F) -> F iltsqfr(r,t) == r = 0 => 0 p:=numer r q:=denom r - -- ql := [qq.factor for qq in factors factor q] ql := [qq.factor for qq in factors squareFree q] # ql = 1 => iltirred(p,q,t) nl := multiEuclidean(ql,p)::List(UP) +/[iltirred(a,b,t) for a in nl for b in ql] -- q is irreducible, monic, degree p < degree q + iltirred: (UP,UP,F) -> F iltirred(p,q,t) == degree q = 1 => cp := coefficient(p,0) @@ -89527,8 +91094,10 @@ KernelFunctions2(R:OrderedSet, S:OrderedSet): with import BasicOperatorFunctions1(R) + constantKernel : R -> Kernel(S) constantKernel r == kernel(constantOperator r, nil(), 1) + constantIfCan : Kernel(S) -> Union(R,"failed") constantIfCan k == constantOpIfCan operator k *) @@ -89688,9 +91257,8 @@ Kovacic(F, UP): Exports == Impl where import RationalRicDE(F, UP) - case2 : (RF, LF, UP -> Factored UP) -> Union(SUP, "failed") - cannotCase2?: LF -> Boolean - + kovacic : (Fraction(UP),Fraction(UP),Fraction(UP)) -> _ + Union(SparseUnivariatePolynomial(Fraction(UP)),"failed") kovacic(a0, a1, a2) == kovacic(a0, a1, a2, squareFree) -- it is assumed here that a2 y'' + a1 y' + a0 y is already irreducible @@ -89698,6 +91266,8 @@ Kovacic(F, UP): Exports == Impl where -- does NOT have rational solutions (so we don't check case 1 of Kovacic's -- algorithm) -- currently only check case 2, not 3 + kovacic: (Fraction(UP),Fraction(UP),Fraction(UP),(UP -> Factored(UP))) ->_ + Union(SparseUnivariatePolynomial(Fraction(UP)),"failed") kovacic(a0, a1, a2, ezfactor) == -- transform first the equation to the form y'' = r y -- which makes the Galois group unimodular @@ -89716,6 +91286,7 @@ Kovacic(F, UP): Exports == Impl where -- of the associated Riccati equation in a quadratic extension -- lf is the squarefree factorisation of denom(r) and is used to -- check the necessary condition + case2 : (RF, LF, UP -> Factored UP) -> Union(SUP, "failed") case2(r, lf, ezfactor) == cannotCase2? lf => "failed" -- build the symmetric square of the operator L = y'' - r y @@ -89735,6 +91306,7 @@ Kovacic(F, UP): Exports == Impl where -- returns true if case 2 cannot have solutions -- the necessary condition is that there is either a factor with -- exponent 2 or odd exponent > 2 + cannotCase2?: LF -> Boolean cannotCase2? lf == for rec in lf repeat rec.exponent = 2 or (odd?(rec.exponent) and rec.exponent > 2) => @@ -90015,22 +91587,13 @@ LaplaceTransform(R, F): Exports == Implementation where import FunctionSpaceIntegration(R, F) import TrigonometricManipulations(R, F) - locallaplace : (F, SE, F, SE, F) -> F - lapkernel : (F, SE, F, F) -> Union(F, "failed") - intlaplace : (F, F, F, SE, F) -> Union(F, "failed") - isLinear : (F, SE) -> Union(Record(const:F, nconst:F), "failed") - mkPlus : F -> Union(List F, "failed") - dvlap : (List F, SE) -> F - tdenom : (F, F) -> Union(F, "failed") - atn : (F, SE) -> Union(Record(coef:F, deg:PI), "failed") - aexp : (F, SE) -> Union(Record(coef:F, coef1:F, coef0:F), "failed") - algebraic? : (F, SE) -> Boolean - oplap := operator("laplace"::Symbol, 3)$BasicOperator + laplace : (F,Symbol,Symbol) -> F laplace(f,t,s) == locallaplace(complexElementary(f,t),t,t::F,s,s::F) -- returns true if the highest kernel of f is algebraic over something + algebraic? : (F, SE) -> Boolean algebraic?(f, t) == l := varselect(kernels f, t) m:N := reduce(max, [height k for k in l], 0)$List(N) @@ -90042,6 +91605,7 @@ LaplaceTransform(R, F): Exports == Implementation where -- note that x is not necessarily l.3 -- if x = l.3, then there is no use recomputing the laplace transform, -- it will remain formal anyways + dvlap : (List F, SE) -> F dvlap(l, x) == l1 := first l l2 := second l @@ -90051,6 +91615,7 @@ LaplaceTransform(R, F): Exports == Implementation where -- returns [b, c] iff f = c * t + b -- and b and c do not involve t + isLinear : (F, SE) -> Union(Record(const:F, nconst:F), "failed") isLinear(f, t) == ff := univariate(f, kernel(t)@K) ((d := retractIfCan(denom ff)@Union(F, "failed")) case "failed") @@ -90060,6 +91625,7 @@ LaplaceTransform(R, F): Exports == Implementation where "failed" -- returns [a, n] iff f = a * t**n + atn : (F, SE) -> Union(Record(coef:F, deg:PI), "failed") atn(f, t) == if ((v := isExpt f) case Record(var:K, exponent:Integer)) then w := v::Record(var:K, exponent:Integer) @@ -90081,6 +91647,7 @@ LaplaceTransform(R, F): Exports == Implementation where -- returns [a, c, b] iff f = a * exp(c * t + b) -- and b and c do not involve t + aexp : (F, SE) -> Union(Record(coef:F, coef1:F, coef0:F), "failed") aexp(f, t) == is?(f, "exp"::SE) => (v := isLinear(first argument(retract(f)@K),t)) case "failed" => @@ -90107,16 +91674,19 @@ LaplaceTransform(R, F): Exports == Implementation where w.exponent * rec.coef0] "failed" + mkPlus : F -> Union(List F, "failed") mkPlus f == (u := isPlus numer f) case "failed" => "failed" d := denom f [p / d for p in u::List(SparseMultivariatePolynomial(R, K))] -- returns g if f = g/t + tdenom : (F, F) -> Union(F, "failed") tdenom(f, t) == (denom f exquo numer t) case "failed" => "failed" t * f + intlaplace : (F, F, F, SE, F) -> Union(F, "failed") intlaplace(f, ss, g, v, vv) == is?(g, oplap) or ((i := integrate(g, v)) case List(F)) => "failed" (u:=limit(i::F,equation(vv::OFE,plusInfinity()$OFE)$EQ)) case OFE => @@ -90125,6 +91695,7 @@ LaplaceTransform(R, F): Exports == Implementation where "failed" "failed" + lapkernel : (F, SE, F, F) -> Union(F, "failed") lapkernel(f, t, tt, ss) == (k := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed" empty?(arg := argument(k::K)) => "failed" @@ -90147,34 +91718,30 @@ LaplaceTransform(R, F): Exports == Implementation where -- Below we try to apply one of the texbook rules for computing -- Laplace transforms, either reducing problem to simpler cases -- or using one of known base cases + locallaplace : (F, SE, F, SE, F) -> F locallaplace(f, t, tt, s, ss) == zero? f => 0 (f = 1) => inv ss - -- laplace(f(t)/t,t,s) -- = integrate(laplace(f(t),t,v), v = s..%plusInfinity) (x := tdenom(f, tt)) case F => g := locallaplace(x::F, t, tt, vv := new()$SE, vvv := vv::F) (x := intlaplace(f, ss, g, vv, vvv)) case F => x::F oplap(f, tt, ss) - -- Use linearity (u := mkPlus f) case List(F) => +/[locallaplace(g, t, tt, s, ss) for g in u::List(F)] (rec := splitConstant(f, t)).const ^= 1 => rec.const * locallaplace(rec.nconst, t, tt, s, ss) - -- laplace(t^n*f(t),t,s) = (-1)^n*D(laplace(f(t),t,s), s, n)) (v := atn(f, t)) case Record(coef:F, deg:PI) => vv := v::Record(coef:F, deg:PI) is?(la := locallaplace(vv.coef, t, tt, s, ss), oplap) => oplap(f,tt,ss) (-1$Integer)**(vv.deg) * differentiate(la, s, vv.deg) - -- Complex shift rule (w := aexp(f, t)) case Record(coef:F, coef1:F, coef0:F) => ww := w::Record(coef:F, coef1:F, coef0:F) exp(ww.coef0) * locallaplace(ww.coef,t,tt,s,ss - ww.coef1) - -- Try base cases (x := lapkernel(f, t, tt, ss)) case F => x::F @@ -91347,6 +92914,7 @@ LazardSetSolvingPackage(R,E,V,P,TS,ST): Exports == Implementation where (* package LAZM3PK *) (* + convert : ST -> TS convert(st: ST): TS == ts: TS := empty() lp: LP := members(st)$ST @@ -91355,6 +92923,7 @@ LazardSetSolvingPackage(R,E,V,P,TS,ST): Exports == Implementation where ts := internalAugment(p,ts)$TS ts + squareFree : TS -> List ST squareFree(ts: TS): List ST == empty? ts => [empty()$ST] lp: LP := members(ts)$TS @@ -91373,6 +92942,7 @@ LazardSetSolvingPackage(R,E,V,P,TS,ST): Exports == Implementation where toSee := toSave toSave + normalizeIfCan : ST -> ST normalizeIfCan(ts: ST): ST == empty? ts => ts lp: LP := members(ts)$ST @@ -91393,6 +92963,7 @@ LazardSetSolvingPackage(R,E,V,P,TS,ST): Exports == Implementation where newts := internalAugment(p,newts)$ST newts + zeroSetSplit : (List(P),Boolean) -> List(ST) zeroSetSplit(lp:List(P), clos?:B): List ST == -- if clos? then SOLVE in the closure sense toSee: Split := zeroSetSplit(lp, clos?)$TS @@ -91579,9 +93150,7 @@ LeadingCoefDetermination(OV,E,Z,P) : C == T (* package LEADCDET *) (* - distribute: (Z,List(BP),List(P),List(Z),List(OV),List(Z)) -> LeadFact - checkpow : (Z,Z) -> NNI - + polCase : (Z,NonNegativeInteger,List(Z)) -> Boolean polCase(d:Z,nk:NNI,lval:List(Z)):Boolean == -- d is the product of the content lc m (case polynomial) -- and the cont of the polynomial evaluated @@ -91598,6 +93167,7 @@ LeadingCoefDetermination(OV,E,Z,P) : C == T distlist := append(distlist,[q]) true + checkpow : (Z,Z) -> NNI checkpow(a:Z,b:Z) : NonNegativeInteger == qt: Union(Z,"failed") for i in 0.. repeat @@ -91605,6 +93175,7 @@ LeadingCoefDetermination(OV,E,Z,P) : C == T if qt case "failed" then return i b:=qt::Z + distribute: (Z,List(BP),List(P),List(Z),List(OV),List(Z)) -> LeadFact distribute(contm:Z,unilist:List(BP),pl:List(P),vl:List(Z), lvar:List(OV),lval:List(Z)): LeadFact == d,lcp : Z @@ -91619,6 +93190,10 @@ LeadingCoefDetermination(OV,E,Z,P) : C == T if contm ^=1 then for i in 1..nf repeat pl.i := contm*pl.i [pl,contm,unilist]$LeadFact + distFact : (Z,List(SparseUnivariatePolynomial(Z)),_ + Record(contp: Z,factors: List(Record(irr: P,pow: Integer))),_ + List(Z),List(OV),List(Z)) -> Union(Record(polfac: List(P),_ + correct: Z,corrfact: List(SparseUnivariatePolynomial(Z))),"failed") distFact(contm:Z,unilist:List(BP),plead:FinalFact, vl:List(Z),lvar:List(OV),lval:List(Z)):Union(LeadFact,"failed") == h:NonNegativeInteger @@ -95381,6 +96956,7 @@ LexTriangularPackage(R,ls): Exports == Implementation where (* package LEXTRIPK *) (* + trueVariables : List(P) -> List Symbol trueVariables(lp: List(P)): List Symbol == lv: List V := variables([lp]$PS) truels: List Symbol := [] @@ -95388,12 +96964,18 @@ LexTriangularPackage(R,ls): Exports == Implementation where if member?(variable(s)::V, lv) then truels := cons(s,truels) reverse truels + zeroDimensional? : _ + List(NewSparseMultivariatePolynomial(R,OrderedVariableList(ls)))->Boolean zeroDimensional?(lp:List(P)): Boolean == truels: List Symbol := trueVariables(lp) fglmpack := FGLMIfCanPackage(R,truels) lq1: List(Q1) := [p::Q1 for p in lp] zeroDimensional?(lq1)$fglmpack + fglmIfCan : List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))) -> _ + Union(List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))),"failed") fglmIfCan(lp:List(P)): Union(List(P), "failed") == truels: List Symbol := trueVariables(lp) fglmpack := FGLMIfCanPackage(R,truels) @@ -95403,6 +96985,9 @@ LexTriangularPackage(R,ls): Exports == Implementation where lp := [retract(q1)$P for q1 in (foo :: List(Q1))] lp::Union(List(P), "failed") + groebner : List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))) -> List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))) groebner(lp:List(P)): List(P) == truels: List Symbol := trueVariables(lp) fglmpack := FGLMIfCanPackage(R,truels) @@ -95410,6 +96995,8 @@ LexTriangularPackage(R,ls): Exports == Implementation where lq1 := groebner(lq1)$fglmpack lp := [retract(q1)$P for q1 in lq1] + lexTriangular : (List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))),Boolean) -> List(RegularChain(R,ls)) lexTriangular(base: List(P), norm?: Boolean): List(TS) == base := sort(infRittWu?,base) base := remove(zero?, base) @@ -95448,12 +97035,19 @@ LexTriangularPackage(R,ls): Exports == Implementation where toSee := cons([newlp, us]$LpWTS, toSee) algebraicSort(toSave)$quasicomppackTS + zeroSetSplit : (List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))),Boolean) -> List(RegularChain(R,ls)) zeroSetSplit(lp:List(P), norm?:B): List TS == bar := fglmIfCan(lp) bar case "failed" => error "zeroSetSplit$LEXTRIPK: #1 not zero-dimensional" lexTriangular(bar::(List P),norm?) + squareFreeLexTriangular : (List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))),Boolean) -> _ + List(SquareFreeRegularTriangularSet(R,_ + IndexedExponents(OrderedVariableList(ls)),OrderedVariableList(ls),_ + NewSparseMultivariatePolynomial(R,OrderedVariableList(ls)))) squareFreeLexTriangular(base: List(P), norm?: Boolean): List(ST) == base := sort(infRittWu?,base) base := remove(zero?, base) @@ -95491,6 +97085,11 @@ LexTriangularPackage(R,ls): Exports == Implementation where toSee := cons([newlp, us]$LpWST, toSee) algebraicSort(toSave)$quasicomppackST + zeroSetSplit : (List(NewSparseMultivariatePolynomial(R,_ + OrderedVariableList(ls))),Boolean) -> _ + List(SquareFreeRegularTriangularSet(R,_ + IndexedExponents(OrderedVariableList(ls)),OrderedVariableList(ls),_ + NewSparseMultivariatePolynomial(R,OrderedVariableList(ls)))) zeroSetSplit(lp:List(P), norm?:B): List ST == bar := fglmIfCan(lp) bar case "failed" => @@ -95638,16 +97237,17 @@ LinearDependence(S, R): Exports == Implementation where (* aNonZeroSolution: Matrix S -> Union(Vector S, "failed") - aNonZeroSolution m == every?(zero?, v := first nullSpace m) => "failed" v + linearlyDependent? : Vector(R) -> Boolean linearlyDependent? v == zero?(n := #v) => true (n = 1) => zero?(v(minIndex v)) positive? nullity reducedSystem transpose v + linearDependence : Vector(R) -> Union(Vector(S),"failed") linearDependence v == zero?(n := #v) => empty() (n = 1) => @@ -95657,6 +97257,7 @@ LinearDependence(S, R): Exports == Implementation where if S has Field then + solveLinear : (Vector(R),R) -> Union(Vector(S),"failed") solveLinear(v:Vector R, c:R):Union(Vector S, "failed") == zero? c => new(#v, 0) empty? v => "failed" @@ -95666,6 +97267,8 @@ LinearDependence(S, R): Exports == Implementation where else + solveLinear : (Vector(R),R) -> _ + Union(Vector(Fraction(S)),"failed") solveLinear(v:Vector R, c:R):Union(Vector Q, "failed") == zero? c => new(#v, 0) empty? v => "failed" @@ -95871,27 +97474,24 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where dd := D()$L - expsol : (L, UP -> List F, UP -> Factored UP) -> Union(RF, "failed") - expsols : (L, UP -> List F, UP -> Factored UP, Boolean) -> List RF - opeval : (L, L) -> L - recurfactor: (L, L, UP -> List F, UP -> Factored UP, Boolean) -> List L - rfactor : (L, L, UP -> List F, UP -> Factored UP, Boolean) -> List L - rightFactor: (L, NonNegativeInteger, UP -> List F, UP -> Factored UP) - -> Union(L, "failed") - innerFactor: (L, UP -> List F, UP -> Factored UP, Boolean) -> List L - + factor : (LinearOrdinaryDifferentialOperator1(Fraction(UP)),_ + (UP -> List(F))) -> _ + List(LinearOrdinaryDifferentialOperator1(Fraction(UP))) factor(l, zeros) == innerFactor(l, zeros, squareFree, true) + expsol : (L, UP -> List F, UP -> Factored UP) -> Union(RF, "failed") expsol(l, zeros, ezfactor) == empty?(sol := expsols(l, zeros, ezfactor, false)) => "failed" first sol + expsols : (L, UP -> List F, UP -> Factored UP, Boolean) -> List RF expsols(l, zeros, ezfactor, all?) == sol := [differentiate(f)/f for f in ratDsolve(l, 0).basis | f ^= 0] not(all? or empty? sol) => sol concat(sol, ricDsolve(l, zeros, ezfactor)) -- opeval(l1, l2) returns l1(l2) + opeval : (L, L) -> L opeval(l1, l2) == ans:L := 0 l2n:L := 1 @@ -95900,11 +97500,13 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where l2n := l2 * l2n ans + recurfactor: (L, L, UP -> List F, UP -> Factored UP, Boolean) -> List L recurfactor(l, r, zeros, ezfactor, adj?) == q := rightExactQuotient(l, r)::L if adj? then q := adjoint q innerFactor(q, zeros, ezfactor, true) + rfactor : (L, L, UP -> List F, UP -> Factored UP, Boolean) -> List L rfactor(op, r, zeros, ezfactor, adj?) == degree r > 1 or not ((leadingCoefficient r) = 1) => recurfactor(op, r, zeros, ezfactor, adj?) @@ -95912,6 +97514,7 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where map_!((z:L):L+->opeval(z,r), recurfactor(op1, dd, zeros, ezfactor, adj?)) -- r1? is true means look for 1st-order right-factor also + innerFactor: (L, UP -> List F, UP -> Factored UP, Boolean) -> List L innerFactor(l, zeros, ezfactor, r1?) == (n := degree l) <= 1 => [l] ll := adjoint l @@ -95922,6 +97525,8 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where return concat(adjoint(u::L), rfactor(ll, u::L, zeros,ezfactor,true)) [l] + rightFactor: (L, NonNegativeInteger, UP -> List F, UP -> Factored UP) + -> Union(L, "failed") rightFactor(l, n, zeros, ezfactor) == (n = 1) => (u := expsol(l, zeros, ezfactor)) case "failed" => "failed" @@ -95929,12 +97534,12 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where "failed" if F has AlgebraicallyClosedField then - zro1: UP -> List F + zro : (UP, UP -> Factored UP) -> List F - zro(p, ezfactor) == concat [zro1(r.factor) for r in factors ezfactor p] + zro1: UP -> List F zro1 p == [zeroOf(map((z1:F):F+->z1,p)_ $UnivariatePolynomialCategoryFunctions2(F, UP, @@ -95944,17 +97549,25 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where import AlgFactor UP + factor : LinearOrdinaryDifferentialOperator1(Fraction(UP)) -> _ + List(LinearOrdinaryDifferentialOperator1(Fraction(UP))) factor l == innerFactor(l,(p:UP):List(F)+->zro(p,factor),factor,true) + factor1 : LinearOrdinaryDifferentialOperator1(Fraction(UP)) -> _ + List(LinearOrdinaryDifferentialOperator1(Fraction(UP))) factor1 l == innerFactor(l,(p:UP):List(F)+->zro(p,factor),factor,false) else + factor : LinearOrdinaryDifferentialOperator1(Fraction(UP)) -> _ + List(LinearOrdinaryDifferentialOperator1(Fraction(UP))) factor l == innerFactor(l,(p:UP):List(F)+->zro(p,squareFree),squareFree,true) + factor1 : LinearOrdinaryDifferentialOperator1(Fraction(UP)) -> _ + List(LinearOrdinaryDifferentialOperator1(Fraction(UP))) factor1 l == innerFactor(l,(p:UP):List(F)+->zro(p,squareFree),squareFree,false) @@ -96132,17 +97745,16 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where import IntegerCombinatoricFunctions var1 := new()$Symbol + var2 := new()$Symbol nonTrivial?: Vector A -> Boolean - applyLODO : (L, V) -> P - killer : (P, N, List V, List P, A -> A) -> L - vec2LODO : Vector A -> L - nonTrivial? v == any?((x1:A):Boolean +-> x1 ^= 0, v)$Vector(A) - vec2LODO v == +/[monomial(v.i, (i-1)::N) for i in 1..#v] + vec2LODO : Vector A -> L + vec2LODO v == +/[monomial(v.i, (i-1)::N) for i in 1..#v] + symmetricPower : (L,NonNegativeInteger,(A -> A)) -> L symmetricPower(l, m, diff) == u := var1::V; n := degree l un := differentiate(u, n) @@ -96158,6 +97770,7 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where -- satisfy some differential equations, which can be seen as the rewrite -- rules lvar --> lval) -- diff is the derivation to use + killer : (P, N, List V, List P, A -> A) -> L killer(u, m, lvar, lval, diff) == lu:List P := [u] for q in 0..m repeat @@ -96168,6 +97781,7 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where lu := concat_!(lu, [u]) error "killer: no linear dependence found" + symmetricProduct : (L,L,(A -> A)) -> L symmetricProduct(l1, l2, diff) == u := var1::V; v := var2::V n1 := degree l1; n2 := degree l2 @@ -96176,6 +97790,7 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where b := applyLODO(inv(- leadingCoefficient l2) * reductum l2, v) killer(u::P * v::P, n1 * n2, [un, vn], [a, b], diff) + directSum : (L,L,(A -> A)) -> L directSum(l1, l2, diff) == u := var1::V; v := var2::V n1 := degree l1; n2 := degree l2 @@ -96184,6 +97799,7 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where b := applyLODO(inv(- leadingCoefficient l2) * reductum l2, v) killer(u::P + v::P, n1 + n2, [un, vn], [a, b], diff) + applyLODO : (L, V) -> P applyLODO(l, v) == p:P := 0 while l ^= 0 repeat @@ -96319,6 +97935,9 @@ LinearPolynomialEquationByFractions(R:PolynomialFactorizationExplicit): with r case "failed" => "failed" monomial(c,degree pF) + r + solveLinearPolynomialEquationByFractions : _ + (List(SparseUnivariatePolynomial(R)),SparseUnivariatePolynomial(R)) -> _ + Union(List(SparseUnivariatePolynomial(R)),"failed") solveLinearPolynomialEquationByFractions(lp,pp) == lpF:List SupF:=[map((x:R):F +-> x@R::F,u) for u in lp] pF:SupF:=map((x:R):F +-> x::F,pp) @@ -96460,14 +98079,12 @@ LinearSystemFromPowerSeriesPackage(K,PCS):P==T where (* package LISYSER *) (* - finiteSeries2ListOfTerms: PCS -> List TERM - finiteSeries2ListOfTermsStream: SER -> List TERM - finiteSeries2ListOfTermsStream(s)== empty?(s) => empty() cons(frst s , finiteSeries2ListOfTermsStream(rst(s))) + finiteSeries2LinSys : (List(PCS),Integer) -> Matrix(K) finiteSeries2LinSys(ls,n)== ll:List K:= [0$K] lZero:=new(#ls pretend NonNegativeInteger,ll)$List(List(K)) @@ -96475,6 +98092,7 @@ LinearSystemFromPowerSeriesPackage(K,PCS):P==T where tMat:=transpose matrix [finiteSeries2Vector(s,n) for s in ls] rowEchWoZeroLines(tMat)$LOpPack + finiteSeries2LinSysWOVectorise : (List(PCS),Integer) -> Matrix(K) finiteSeries2LinSysWOVectorise(ls,n)== ll:List K:= [0$K] lZero:=new(#ls pretend NonNegativeInteger,ll)$List(List(K)) @@ -96482,10 +98100,12 @@ LinearSystemFromPowerSeriesPackage(K,PCS):P==T where tMat:=transpose matrix [finiteSeries2Vector(s,n) for s in ls] rowEchWoZeroLinesWOVectorise(tMat)$LOpPack + finiteSeries2ListOfTerms: PCS -> List TERM finiteSeries2ListOfTerms(s)== ss:SER:= s :: SER finiteSeries2ListOfTermsStream(ss) + finiteSeries2Vector : (PCS,Integer) -> List(K) finiteSeries2Vector(ins,n)== lZero:=new((n pretend NonNegativeInteger),0)$List(K) s:= removeFirstZeroes ins @@ -96651,17 +98271,22 @@ LinearSystemMatrixPackage(F, Row, Col, M): Cat == Capsule where (* package LSMP *) (* - systemMatrix : (M, Col) -> M - aSolution : M -> PartialV - -- rank theorem + hasSolution? : (M,Col) -> Boolean hasSolution?(A, b) == rank A = rank systemMatrix(A, b) + + systemMatrix : (M, Col) -> M systemMatrix(m, v) == horizConcat(m, -(v::M)) - rank(A, b) == rank systemMatrix(A, b) + + rank : (M,Col) -> NonNegativeInteger + rank(A, b) == rank systemMatrix(A, b) + + particularSolution : (M,Col) -> Union(Col,"failed") particularSolution(A, b) == aSolution rowEchelon systemMatrix(A,b) -- m should be in row-echelon form. -- last column of m is -(right-hand-side of system) + aSolution : M -> PartialV aSolution m == nvar := (ncols m - 1)::N rk := maxRowIndex m @@ -96683,6 +98308,7 @@ LinearSystemMatrixPackage(F, Row, Col, M): Cat == Capsule where qsetelt_!(sol, j+minIndex sol, - qelt(m, v.j, maxColIndex m)) sol + solve:(M,Col) -> Record(particular: Union(Col,"failed"),basis: List(Col)) solve(A:M, b:Col) == -- Special case for homogeneous systems. every?(zero?, b) => [new(ncols A, 0), nullSpace A] @@ -96692,6 +98318,8 @@ LinearSystemMatrixPackage(F, Row, Col, M): Cat == Capsule where nullSpace subMatrix(m, minRowIndex m, maxRowIndex m, minColIndex m, maxColIndex m - 1)] + solve : (M,List(Col)) -> _ + List(Record(particular: Union(Col,"failed"),basis: List(Col))) solve(A:M, l:List Col) == null l => [[new(ncols A, 0), nullSpace A]] nl := (sol0 := solve(A, first l)).basis @@ -96838,19 +98466,32 @@ LinearSystemMatrixPackage1(F): Cat == Capsule where (* package LSMP1 *) (* + solve : (Matrix(F),Vector(F)) -> _ + Record(particular: Union(Vector(F),"failed"),basis: List(Vector(F))) solve(m : M, c: Col): Both == solve(m,c)$LSMP + solve : (List(List(F)),Vector(F)) -> _ + Record(particular: Union(Vector(F),"failed"),basis: List(Vector(F))) solve(ll : LL, c: Col): Both == solve(matrix(ll)$M,c)$LSMP + solve : (Matrix(F),List(Vector(F))) -> _ + List(Record(particular: Union(Vector(F),_ + "failed"),basis: List(Vector(F)))) solve(m : M, l : List Col): List Both == solve(m, l)$LSMP + solve : (List(List(F)),List(Vector(F))) -> _ + List(Record(particular: Union(Vector(F),_ + "failed"),basis: List(Vector(F)))) solve(ll : LL, l : List Col): List Both == solve(matrix(ll)$M, l)$LSMP + particularSolution : (Matrix(F),Vector(F)) -> Union(Vector(F),"failed") particularSolution (m : M, c : Col): PartialV == particularSolution(m, c)$LSMP + hasSolution? : (Matrix(F),Vector(F)) -> Boolean hasSolution?(m :M, c : Col): Boolean == hasSolution?(m, c)$LSMP + rank : (Matrix(F),Vector(F)) -> NonNegativeInteger rank(m : M, c : Col): N == rank(m, c)$LSMP *) @@ -96969,13 +98610,7 @@ LinearSystemPolynomialPackage(R, E, OV, P): Cat == Capsule where \begin{chunk}{COQ LSPP} (* package LSPP *) (* - - ---- Local Functions ---- - poly2vect: (P, List OV) -> Record(coefvec: V F, reductum: F) - intoMatrix: (List P, List OV) -> Record(mat: M F, vec: V F) - - poly2vect(p : P, vs : List OV) : Record(coefvec: V F, reductum: F) == coefs := new(#vs, 0)$(V F) for v in vs for i in 1.. while p ^= 0 repeat @@ -96985,6 +98620,7 @@ LinearSystemPolynomialPackage(R, E, OV, P): Cat == Capsule where p := p - monomial(c,v, 1) [coefs, p :: F] + intoMatrix: (List P, List OV) -> Record(mat: M F, vec: V F) intoMatrix(ps : List P, vs : List OV ) : Record(mat: M F, vec: V F) == m := zero(#ps, #vs)$M(F) v := new(#ps, 0)$V(F) @@ -96995,6 +98631,9 @@ LinearSystemPolynomialPackage(R, E, OV, P): Cat == Capsule where v.i := - r.reductum [m, v] + linSolve : (List(P),List(OV)) -> _ + Record(particular: Union(Vector(Fraction(P)),"failed"),_ + basis: List(Vector(Fraction(P)))) linSolve(ps, vs) == r := intoMatrix(ps, vs) solve(r.mat, r.vec)$LinearSystemMatrixPackage(F,V F,V F,M F) @@ -97396,6 +99035,7 @@ LinGroebnerPackage(lv,F) : C == T lvar :=[variable(yx)::OV for yx in lv] + reduceRow : (MF,VF,Integer,Vector(Integer)) -> VF reduceRow(M:MF, v : VF, lastRow: Integer, pivots: Vector(Integer)) : VF == a1:F := 1 b:F := 0 @@ -97412,6 +99052,7 @@ LinGroebnerPackage(lv,F) : C == T a1 := b v + rRedPol : (HDPoly,List HDPoly) -> Record(poly:HDPoly, mult:F) rRedPol(f:HDPoly, B:List HDPoly):Record(poly:HDPoly, mult:F) == gm := redPo(f,B) gm.poly = 0 => gm @@ -97420,6 +99061,8 @@ LinGroebnerPackage(lv,F) : C == T [ggm.mult*(gm.poly - gg) + ggm.poly, ggm.mult*gm.mult] ----- transform the total basis B in lex basis ----- + totolex : List(HomogeneousDistributedMultivariatePolynomial(lv,F)) -> _ + List(DistributedMultivariatePolynomial(lv,F)) totolex(B : List HDPoly) : List DPoly == result:List DPoly :=[] ltresult:List DPoly :=[] @@ -97471,14 +99114,21 @@ LinGroebnerPackage(lv,F) : C == T nBasis:=cons(firstmon,nBasis) result ----- Compute the univariate polynomial for x -----oldBasis is a total degree Groebner basis + ---- Compute the univariate polynomial for x + ----oldBasis is a total degree Groebner basis + minPol : (List(HomogeneousDistributedMultivariatePolynomial(lv,F)),_ + OrderedVariableList(lv)) -> _ + HomogeneousDistributedMultivariatePolynomial(lv,F) minPol(oldBasis:List HDPoly,x:OV) :HDPoly == algBasis:= computeBasis oldBasis minPol(oldBasis,algBasis,x) ----- Compute the univariate polynomial for x ----- oldBasis is total Groebner, algBasis is the basis as algebra + ---- Compute the univariate polynomial for x + ---- oldBasis is total Groebner, algBasis is the basis as algebra + minPol : (List(HomogeneousDistributedMultivariatePolynomial(lv,F)),_ + List(HomogeneousDistributedMultivariatePolynomial(lv,F)), + OrderedVariableList(lv)) -> _ + HomogeneousDistributedMultivariatePolynomial(lv,F) minPol(oldBasis:List HDPoly,algBasis:List HDPoly,x:OV) :HDPoly == nvp:HDPoly:=x::HDPoly f:=1$HDPoly @@ -97513,14 +99163,18 @@ LinGroebnerPackage(lv,F) : C == T pivots(i) := j setRow_!(linmat,i,lm) ------ transform a DPoly in a HDPoly ----- + ----- transform a DPoly in a HDPoly ----- + transform : DistributedMultivariatePolynomial(lv,F) -> _ + HomogeneousDistributedMultivariatePolynomial(lv,F) transform(dpol:DPoly) : HDPoly == dpol=0 => 0$HDPoly monomial(leadingCoefficient dpol, directProduct(degree(dpol)::VV)$HDP)$HDPoly + transform(reductum dpol) ------ compute the basis for the vector space determined by B ----- + ----- compute the basis for the vector space determined by B ----- + computeBasis:List(HomogeneousDistributedMultivariatePolynomial(lv,F)) -> _ + List(HomogeneousDistributedMultivariatePolynomial(lv,F)) computeBasis(B:List HDPoly) : List HDPoly == mB:List HDPoly:=[monomial(1$F,degree f)$HDPoly for f in B] result:List HDPoly := [1$HDPoly] @@ -97529,7 +99183,11 @@ LinGroebnerPackage(lv,F) : C == T result:=concat(result,part) result ------ internal function for computeBasis ----- + ----- internal function for computeBasis ----- + intcompBasis : (OrderedVariableList(lv),_ + List(HomogeneousDistributedMultivariatePolynomial(lv,F)),_ + List(HomogeneousDistributedMultivariatePolynomial(lv,F))) -> _ + List(HomogeneousDistributedMultivariatePolynomial(lv,F)) intcompBasis(x:OV,lr:List HDPoly,mB : List HDPoly):List HDPoly == lr=[] => lr part:List HDPoly :=[] @@ -97538,8 +99196,10 @@ LinGroebnerPackage(lv,F) : C == T if redPo(g,mB).poly^=0 then part:=concat(g,part) concat(part,intcompBasis(x,part,mB)) ------ coordinate of f with respect to the basis B ----- ------ f is a reduced polynomial ----- + ----- coordinate of f with respect to the basis B ----- + ----- f is a reduced polynomial ----- + coord : (HomogeneousDistributedMultivariatePolynomial(lv,F),_ + List(HomogeneousDistributedMultivariatePolynomial(lv,F))) -> Vector(F) coord(f:HDPoly,B:List HDPoly) : VF == ndim := #B vv:VF:=new(ndim,0$F)$VF @@ -97552,12 +99212,18 @@ LinGroebnerPackage(lv,F) : C == T f := rf vv ------ reconstruct the polynomial from its coordinate ----- + ----- reconstruct the polynomial from its coordinate ----- + anticoord : (List(F),DistributedMultivariatePolynomial(lv,F),_ + List(DistributedMultivariatePolynomial(lv,F))) -> _ + DistributedMultivariatePolynomial(lv,F) anticoord(vv:List F,mf:DPoly,B:List DPoly) : DPoly == for f in B for c in vv repeat (mf:=mf-c*f) mf ------ choose the next monom ----- + ----- choose the next monom ----- + choosemon : (DistributedMultivariatePolynomial(lv,F),_ + List(DistributedMultivariatePolynomial(lv,F))) -> _ + DistributedMultivariatePolynomial(lv,F) choosemon(mf:DPoly,nB:List DPoly) : DPoly == nB = [] => ((lvar.last)::DPoly)*mf for x in reverse lvar repeat @@ -97568,7 +99234,10 @@ LinGroebnerPackage(lv,F) : C == T mf := (mf exquo (xx ** dx))::DPoly mf ------ put B in general position, B is Groebner ----- + ----- put B in general position, B is Groebner ----- + linGenPos : List(HomogeneousDistributedMultivariatePolynomial(lv,F)) -> _ + Record(gblist: List(DistributedMultivariatePolynomial(lv,F)),_ + gvlist: List(Integer)) linGenPos(B : List HDPoly) : LVals == result:List DPoly :=[] ltresult:List DPoly :=[] @@ -97628,6 +99297,9 @@ LinGroebnerPackage(lv,F) : C == T ----- given a basis of a zero-dimensional ideal, ----- performs a random change of coordinates ----- computes a Groebner basis for the lex ordering + groebgen : List(DistributedMultivariatePolynomial(lv,F)) -> _ + Record(glbase: List(DistributedMultivariatePolynomial(lv,F)),_ + glval: List(Integer)) groebgen(L:List DPoly) : cLVars == xn:=lvar.last val := xn::DPoly @@ -97823,6 +99495,7 @@ LinesOpPack(K):P==T where matl:=vertConcat(matl,subMatl) rowEchelon matl + rowEchWoZeroLines : Matrix(K) -> Matrix(K) rowEchWoZeroLines(m)== mm:=localRowEchelon m ll:=listOfLists mm @@ -97832,6 +99505,7 @@ LinesOpPack(K):P==T where empty?(llll) => matrix [lZero] matrix llll + rowEchWoZeroLinesWOVectorise : Matrix(K) -> Matrix(K) rowEchWoZeroLinesWOVectorise(m)== mm:=rowEchelon m ll:=listOfLists mm @@ -97841,12 +99515,14 @@ LinesOpPack(K):P==T where empty?(llll) => matrix [lZero] matrix llll + quotVecSpaceBasis : (List(List(K)),List(List(K))) -> List(List(K)) quotVecSpaceBasis(l2,l1)== redBasis:=reduceRow(concat(l1,l2)) tempRes:=rest(redBasis,#l1) allZero:=new(#l1.1,0$K) [l for l in tempRes | ^(l=allZero)] + reduceRowOnList : (List(K),List(List(K))) -> List(List(K)) reduceRowOnList(line,listOfLine)== frsNonNul:Integer:=position(^zero?(#1),line) ^(frsNonNul > 0) => listOfLine @@ -97855,9 +99531,11 @@ LinesOpPack(K):P==T where newLine:=[inva*c for c in line] [reduceLineOverLine(newLine,l,l.frsNonNul) for l in listOfLine] + reduceLineOverLine : (List(K),List(K),K) -> List(K) reduceLineOverLine(l1,l2,b)== [c2 - b*c1 for c2 in l2 for c1 in l1] + reduceRow : List(List(K)) -> List(List(K)) reduceRow(m:List(List(K)))== n:=#m mcopy:List(List(K)):=copy m @@ -98147,59 +99825,90 @@ LiouvillianFunction(R, F): Exports == Implementation where (* package LF *) (* - iei : F -> F - isi : F -> F - ici : F -> F - ierf : F -> F - ili : F -> F - ili2 : F -> F - iint : List F -> F - eqint : (K,K) -> Boolean - dvint : (List F, SE) -> F - dvdint : (List F, SE) -> F - ddint : List F -> O - integrand : List F -> F - dummy := new()$SE :: F opint := operator("integral"::Symbol)$CommonOperators + opdint := operator("%defint"::Symbol)$CommonOperators + opei := operator("Ei"::Symbol)$CommonOperators + opli := operator("li"::Symbol)$CommonOperators + opsi := operator("Si"::Symbol)$CommonOperators + opci := operator("Ci"::Symbol)$CommonOperators + opli2 := operator("dilog"::Symbol)$CommonOperators + operf := operator("erf"::Symbol)$CommonOperators + opfis := operator("fresnelS"::Symbol)$CommonOperators + opfic := operator("fresnelC"::Symbol)$CommonOperators - Si x == opsi x - Ci x == opci x - Ei x == opei x - erf x == operf x - li x == opli x - dilog x == opli2 x - fresnelS x == opfis x - fresnelC x == opfic x + Si : F -> F + Si x == opsi x - belong? op == has?(op, "prim") - isi x == kernel(opsi, x) - ici x == kernel(opci, x) - ierf x == (zero? x => 0; kernel(operf, x)) - ili2 x == ((x = 1) => INV; kernel(opli2, x)) - ifis(x:F):F == (zero? x => 0; kernel(opfis,x)) - ific(x:F):F == (zero? x => 0; kernel(opfic,x)) - integrand l == eval(first l, retract(second l)@K, third l) + Ci : F -> F + Ci x == opci x + + Ei : F -> F + Ei x == opei x + + erf : F -> F + erf x == operf x + + li : F -> F + li x == opli x + + dilog : F -> F + dilog x == opli2 x + + fresnelS : F -> F + fresnelS x == opfis x + + fresnelC : F -> F + fresnelC x == opfic x + + belong? : BasicOperator -> Boolean + belong? op == has?(op, "prim") + + isi : F -> F + isi x == kernel(opsi, x) + + ici : F -> F + ici x == kernel(opci, x) + + ierf : F -> F + ierf x == (zero? x => 0; kernel(operf, x)) + + ili2 : F -> F + ili2 x == ((x = 1) => INV; kernel(opli2, x)) + + ifis : F -> F + ifis(x:F):F == (zero? x => 0; kernel(opfis,x)) + + ific : F -> F + ific(x:F):F == (zero? x => 0; kernel(opfic,x)) + + integrand : List F -> F + integrand l == eval(first l, retract(second l)@K, third l) + + integral : (F,Symbol) -> F integral(f:F, x:SE) == opint [eval(f, k:=kernel(x)$K, dummy), dummy, k::F] + iint : List F -> F iint l == zero? first l => 0 kernel(opint, l) + ddint : List F -> O ddint l == int(integrand(l)::O * hconcat("d"::SE::O, third(l)::O), third(rest l)::O, third(rest rest l)::O) + eqint : (K,K) -> Boolean eqint(k1,k2) == a1:=argument k1 a2:=argument k2 @@ -98209,12 +99918,13 @@ LiouvillianFunction(R, F): Exports == Implementation where if res then return res res:= (a1.3 = a2.3) and (subst(a1.1,[retract(a1.2)@K],[a2.2]) = a2.1) + dvint : (List F, SE) -> F dvint(l, x) == k := retract(second l)@K differentiate(third l, x) * integrand l + opint [differentiate(first l, x), second l, third l] - + dvdint : (List F, SE) -> F dvdint(l, x) == x = retract(y := third l)@SE => 0 k := retract(d := second l)@K @@ -98222,20 +99932,24 @@ LiouvillianFunction(R, F): Exports == Implementation where - differentiate(g := third rest l, x) * eval(f, k, g) + opdint [differentiate(f, x), d, y, g, h] + integral : (F,SegmentBinding(F)) -> F integral(f:F, s: SegmentBinding F) == x := kernel(variable s)$K opdint [eval(f,x,dummy), dummy, x::F, lo segment s, hi segment s] + ili : F -> F ili x == x = 1 => INV is?(x, "exp"::Symbol) => Ei first argument(retract(x)@K) kernel(opli, x) + iei : F -> F iei x == x = 0 => INV is?(x, "log"::Symbol) => li first argument(retract(x)@K) kernel(opei, x) + operator : BasicOperator -> BasicOperator operator op == is?(op, "integral"::Symbol) => opint is?(op, "%defint"::Symbol) => opdint @@ -98250,35 +99964,53 @@ LiouvillianFunction(R, F): Exports == Implementation where error "Not a Liouvillian operator" evaluate(opei, iei)$BasicOperatorFunctions1(F) + evaluate(opli, ili) + evaluate(opsi, isi) + evaluate(opci, ici) + evaluate(operf, ierf) + evaluate(opli2, ili2) + evaluate(opfis, ifis) + evaluate(opfic, ific) + evaluate(opint, iint) + derivative(opsi, (z1:F):F +-> sin(z1) / z1) + derivative(opci, (z1:F):F +-> cos(z1) / z1) + derivative(opei, (z1:F):F +-> exp(z1) / z1) + derivative(opli, (z1:F):F +-> inv log(z1)) + derivative(operf, (z1:F):F +-> 2 * exp(-(z1**2)) / sqrt(pi())) + derivative(opli2, (z1:F):F +-> log(z1) / (1 - z1)) + derivative(opfis, (z1:F):F +-> sin(z1**2)) + derivative(opfic, (z1:F):F +-> cos(z1**2)) + setProperty(opint,SPECIALEQUAL,eqint@((K,K) -> Boolean) pretend None) + setProperty(opint,SPECIALDIFF,dvint@((List F,SE) -> F) pretend None) + setProperty(opdint,SPECIALDIFF,dvdint@((List F,SE)->F) pretend None) + setProperty(opdint, SPECIALDISP, ddint@(List F -> O) pretend None) if R has ConvertibleTo INP then - inint : List F -> INP - indint: List F -> INP - pint : List INP -> INP pint l == convert concat(convert("integral"::SE)@INP, l) + inint : List F -> INP inint l == r2:= convert( [convert("::"::SE)@INP, @@ -98286,6 +100018,7 @@ LiouvillianFunction(R, F): Exports == Implementation where convert("Symbol"::SE)@INP]@List INP)@INP pint [convert(integrand l)@INP, r2] + indint: List F -> INP indint l == pint [convert(integrand l)@INP, convert concat(convert("="::SE)@INP, @@ -98295,6 +100028,7 @@ LiouvillianFunction(R, F): Exports == Implementation where convert(third rest rest l)@INP])])] setProperty(opint, SPECIALINPUT, inint@(List F -> INP) pretend None) + setProperty(opdint, SPECIALINPUT, indint@(List F -> INP) pretend None) *) @@ -98405,10 +100139,13 @@ ListFunctions2(A:Type, B:Type): public == private where (* package LIST2 *) (* + map : ((A -> B),List(A)) -> List(B) map(f, l) == map(f, l)$O2 + scan : (((A,B) -> B),List(A),B) -> List(B) scan(f, l, b) == scan(f, l, b)$O2 + reduce : (((A,B) -> B),List(A),B) -> B reduce(f, l, b) == reduce(f, l, b)$O2 *) @@ -98499,6 +100236,7 @@ ListFunctions3(A:Type, B:Type, C:Type): public == private where (* package LIST3 *) (* + map : (((A,B) -> C),List(A),List(B)) -> List(C) map(fn : (A,B) -> C, la : LA, lb : LB): LC == empty?(la) or empty?(lb) => empty()$LC concat(fn(first la, first lb), map(fn, rest la, rest lb)) @@ -98658,18 +100396,24 @@ ListToMap(A:SetCategory, B:Type): Exports == Implementation where (* package LIST2MAP *) (* - match(la, lb) == (z1:A):B +-> match(la, lb, z1) + match : (List(A),List(B)) -> (A -> B) + match(la, lb) == (z1:A):B +-> match(la, lb, z1) - match(la:LA, lb:LB, a:A) == lb.position(a, la) + match : (List(A),List(B),A) -> B + match(la:LA, lb:LB, a:A) == lb.position(a, la) - match(la:LA, lb:LB, b:B) == (z1:A):B +-> match(la, lb, z1, b) + match : (List(A),List(B),B) -> (A -> B) + match(la:LA, lb:LB, b:B) == (z1:A):B +-> match(la, lb, z1, b) + match : (List(A),List(B),(A -> B)) -> (A -> B) match(la:LA, lb:LB, f:AB) == (z1:A):B +-> match(la, lb, z1, f) + match : (List(A),List(B),A,B) -> B match(la:LA, lb:LB, a:A, b:B) == (p := position(a, la)) < minIndex(la) => b lb.p + match : (List(A),List(B),A,(A -> B)) -> B match(la:LA, lb:LB, a:A, f:AB) == (p := position(a, la)) < minIndex(la) => f a lb.p @@ -98990,33 +100734,12 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ import PolyRing import PPFC1 import PackPoly - - valuationAndMore: (UPUP,UPUP) -> _ - Record(ord:Integer,value:K,fnc:UPUP,crv:UPUP) - - localize2: (PolyRing,ProjPt,PolyRing,Integer) -> _ - Record(fnc2:UPUP,crv2:UPUP) - - coerceToUPUP: (PolyRing,List Integer) -> UPUP - - paramAtOrigin: (UPUP,UPUP,Integer) -> PCS - - strictTransform: (UPUP,NNI) -> UPUP - - translate: (UPUP,K) -> UPUP - - constant: UPUP -> K - - intCoord: UPUP -> K - - localMultiplicity: UPUP -> NNI - - mapDegree: (NNI,NNI,NNI) -> NNI - + listVar:List(OV):= [index(i::PI)$OV for i in 1..#symb] listMonoPols:List(PolyRing):=listVariable() + pointDominateBy : Plc -> ProjPt pointDominateBy(pl)== lpl:List PCS:=localParam(pl) empty? lpl => _ @@ -99024,6 +100747,7 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ lK:List K:=[ findCoef(s,0) for s in lpl] projectivePoint(lK) + localParamOfSimplePt : (ProjPt,PolyRing,Integer) -> List(PCS) localParamOfSimplePt(pt,curve,nV)== mult:NNI:=multiplicity(curve,pt,nV) ^one?(mult) => _ @@ -99031,6 +100755,7 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ lcl:=[localize2(var,pt,curve,nV) for var in listMonoPols] [paramAtOrigin(l.fnc2,l.crv2,0) for l in lcl] + pointToPlace : (ProjPt,PolyRing) -> Plc pointToPlace(pt,curve)== -- define the chart for strictTransform (of simple point) nV:Integer:=lastNonNull pt @@ -99054,16 +100779,20 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ localVarForPrintInfo:Boolean:=false()$Boolean + printInfo : () -> Boolean printInfo()==localVarForPrintInfo + printInfo : Boolean -> Boolean printInfo(flag)==localVarForPrintInfo:=flag + mapDegree: (NNI,NNI,NNI) -> NNI mapDegree(n,mx,m)== dd:=(n+mx-m) dd < 0 => _ error "LPARSPT:mapDegree called by PARAMP:strictTransform failed" dd pretend NNI + strictTransform: (UPUP,NNI) -> UPUP strictTransform(pol,m)== zero?(pol) => 0 tc:=leadingCoefficient pol @@ -99076,19 +100805,23 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ trY: (K,NonNegativeInteger) -> UPUP trY(a,n)== (monomial(monomial(a,0)$UP,0)$UPUP + Y)**n + translate: (UPUP,K) -> UPUP translate(pol,a)== zero?(pol) => 0 tc:=leadingCoefficient pol tk:= degree pol trY(a,tk) * tc + translate(reductum pol, a) + constant: UPUP -> K constant(pol)==coefficient(coefficient(pol,0)$UPUP,0)$UP + intCoord: UPUP -> K intCoord(pol)== coefY:=coefficient(coefficient(pol,1)$UPUP,0)$UP cnst:=constant(pol) -cnst * inv coefY + localMultiplicity: UPUP -> NNI localMultiplicity(pol)== zero?(pol) => error "Cannot compute the multiplicity for 0" redPol:= reductum pol @@ -99098,6 +100831,7 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ zero?(redPol) => m min( m, localMultiplicity(redPol)) + coerceToUPUP: (PolyRing,List Integer) -> UPUP coerceToUPUP(pol,chart)== zero?(pol) => 0 lExp:=parts degree pol @@ -99108,6 +100842,8 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ coerceToUPUP(reductum(pol),chart) -- testing this function. See paramPack for original version. + valuationAndMore: (UPUP,UPUP) -> _ + Record(ord:Integer,value:K,fnc:UPUP,crv:UPUP) valuationAndMore(f:UPUP,curve:UPUP)== -- this function evaluate the function f at the origin -- which must be a simple point on the curve define by "curve" @@ -99122,6 +100858,7 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ val:= constant(f2) [multPtf, val, f2, newCurve] + paramAtOrigin: (UPUP,UPUP,Integer) -> PCS paramAtOrigin(f:UPUP,curve:UPUP,ex:Integer)== delay -- this function must be -- called for parametrization a the origin @@ -99136,6 +100873,8 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ newCurve:=firstTerm.crv series(od+ex,coef,paramAtOrigin(newU,newCurve,ex+od)) + localize : (PolyRing,ProjPt,PolyRing,Integer) -> _ + Record(fnc: PolyRing,crv: PolyRing,chart: List(Integer)) localize(f:PolyRing,pt:ProjPt,curve:PolyRing,nV:Integer)== curveT:=translateToOrigin(curve,pt,nV) ft:=translateToOrigin(f,pt,nV) @@ -99162,6 +100901,8 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_ crt:=concat(reverse(sc),nV) [ft,curveT,crt] + localize2: (PolyRing,ProjPt,PolyRing,Integer) -> _ + Record(fnc2:UPUP,crv2:UPUP) localize2(f:PolyRing,pt:ProjPt,curve:PolyRing,nV:Integer)== recBlowUp:=localize(f,pt,curve,nV) f2:=coerceToUPUP(recBlowUp.fnc,recBlowUp.chart) @@ -99278,11 +101019,12 @@ MakeBinaryCompiledFunction(S, D1, D2, I):Exports == Implementation where import MakeFunction(S) func: (SY, D1, D2) -> I - func(name, x, y) == FUNCALL(name, x, y, NIL$Lisp)$Lisp + binaryFunction : Symbol -> ((D1,D2) -> I) binaryFunction name == (d1:D1,d2:D2):I +-> func(name, d1, d2) + compiledFunction : (S,Symbol,Symbol) -> ((D1,D2) -> I) compiledFunction(e, x, y) == t := [devaluate(D1)$Lisp, devaluate(D2)$Lisp]$List(InputForm) binaryFunction compile(function(e, declare DI, x, y), t) @@ -99482,35 +101224,31 @@ MakeFloatCompiledFunction(S): Exports == Implementation where import MakeUnaryCompiledFunction(S, SF, SF) import MakeBinaryCompiledFunction(S, SF, SF, SF) - streq? : (INF, String) -> Boolean - streqlist?: (INF, List String) -> Boolean - gencode : (String, List INF) -> INF - mkLisp : INF -> Union(INF, "failed") - mkLispList: List INF -> Union(List INF, "failed") - mkDefun : (INF, List INF) -> INF - mkLispCall: INF -> INF - mkPretend : INF -> INF - mkCTOR : INF -> INF - lsf := convert([convert("DoubleFloat"::Symbol)@INF]$List(INF))@INF - streq?(s, st) == s = convert(st::Symbol)@INF + streq? : (INF, String) -> Boolean + streq?(s, st) == s = convert(st::Symbol)@INF - gencode(s, l) == convert(concat(convert(s::Symbol)@INF, l))@INF + gencode : (String, List INF) -> INF + gencode(s, l) == convert(concat(convert(s::Symbol)@INF, l))@INF + streqlist?: (INF, List String) -> Boolean streqlist?(s, l) == member?(string symbol s, l) + mkPretend : INF -> INF mkPretend form == convert([convert("pretend"::Symbol), form, lsf]$List(INF))@INF + mkCTOR : INF -> INF mkCTOR form == convert([convert("C-TO-R"::Symbol), form]$List(INF))@INF - + mkLispCall: INF -> INF mkLispCall name == convert([convert("$elt"::Symbol), convert("Lisp"::Symbol), name]$List(INF))@INF + mkDefun : (INF, List INF) -> INF mkDefun(s, lv) == name := convert(new()$Symbol)@INF fun := convert([convert("DEFUN"::Symbol), name, convert lv, @@ -99519,6 +101257,8 @@ MakeFloatCompiledFunction(S): Exports == Implementation where if _$compileDontDefineFunctions$Lisp then COMPILE(name)$Lisp name + makeFloatFunction : (S,Symbol,Symbol) -> _ + ((DoubleFloat,DoubleFloat) -> DoubleFloat) makeFloatFunction(f, x, y) == (u := mkLisp(convert(f)@INF)) case "failed" => compiledFunction(f, x, y) @@ -99529,6 +101269,7 @@ MakeFloatCompiledFunction(S): Exports == Implementation where interpret function(spadform, [x, y], spadname) binaryFunction compile(spadname, t) + makeFloatFunction : (S,Symbol) -> (DoubleFloat -> DoubleFloat) makeFloatFunction(f, var) == (u := mkLisp(convert(f)@INF)) case "failed" => compiledFunction(f, var) @@ -99539,6 +101280,7 @@ MakeFloatCompiledFunction(S): Exports == Implementation where interpret function(spadform, [var], spadname) unaryFunction compile(spadname, t) + mkLispList: List INF -> Union(List INF, "failed") mkLispList l == ans := nil()$List(INF) for s in l repeat @@ -99546,6 +101288,7 @@ MakeFloatCompiledFunction(S): Exports == Implementation where ans := concat(u::INF, ans) reverse_! ans + mkLisp : INF -> Union(INF, "failed") mkLisp s == atom? s => s op := first(l := destruct s) @@ -99852,12 +101595,16 @@ MakeFunction(S:ConvertibleTo InputForm): Exports == Implementation where (* package MKFUNC *) (* - function(s, name) == function(s, name, nil()) + function : (S,Symbol) -> Symbol + function(s, name) == function(s, name, nil()) + function : (S,Symbol,Symbol) -> Symbol function(s:S, name:SY, x:SY) == function(s, name, [x]) - function(s, name, x, y) == function(s, name, [x, y]) + function : (S,Symbol,Symbol,Symbol) -> Symbol + function(s, name, x, y) == function(s, name, [x, y]) + function : (S,Symbol,List(Symbol)) -> Symbol function(s:S, name:SY, args:List SY) == interpret function(convert s, args, name)$InputForm name @@ -99939,6 +101686,7 @@ MakeRecord(S: Type, T: Type): public == private where (* package MKRECORD *) (* + makeRecord : (S,T$) -> Record(part1: S,part2: T$) makeRecord(s: S, t: T) == [s,t]$Record(part1: S, part2: T) @@ -100050,11 +101798,12 @@ MakeUnaryCompiledFunction(S, D, I): Exports == Implementation where import MakeFunction(S) func: (SY, D) -> I - func(name, x) == FUNCALL(name, x, NIL$Lisp)$Lisp + unaryFunction : Symbol -> (D -> I) unaryFunction name == (d1:D):I +-> func(name, d1) + compiledFunction : (S,Symbol) -> (D -> I) compiledFunction(e:S, x:SY) == t := [convert([devaluate(D)$Lisp]$List(InputForm)) ]$List(InputForm) @@ -100152,10 +101901,12 @@ MappingPackageInternalHacks1(A: SetCategory): MPcat == MPdef where (* package MAPHACK1 *) (* + iter : ((A -> A),NonNegativeInteger,A) -> A iter(g,n,x) == for i in 1..n repeat x := g x -- g(g(..(x)..)) x + recur : (((NonNegativeInteger,A) -> A),NonNegativeInteger,A) -> A recur(g,n,x) == for i in 1..n repeat x := g(i,x) -- g(n,g(n-1,..g(1,x)..)) x @@ -100245,9 +101996,11 @@ MappingPackageInternalHacks2(A: SetCategory, C: SetCategory):_ (* package MAPHACK2 *) (* - arg1(a, c) == a + arg1 : (A,C) -> A + arg1(a, c) == a - arg2(a, c) == c + arg2 : (A,C) -> C + arg2(a, c) == c *) @@ -100327,7 +102080,8 @@ MappingPackageInternalHacks3(A: SetCategory, B: SetCategory, C: SetCategory):_ (* package MAPHACK3 *) (* - comp(g,h,x) == g h x + comp : ((B -> C),(A -> B),A) -> C + comp(g,h,x) == g h x *) @@ -100878,16 +102632,20 @@ MappingPackage1(A:SetCategory): MPcat == MPdef where faa: A -> A f0a: ()-> A - nullary a == a + nullary : A -> (() -> A) + nullary a == a - coerce a == nullary a + coerce : A -> (() -> A) + coerce a == nullary a + fixedPoint : (A -> A) -> A fixedPoint faa == g0 := GENSYM()$Lisp g1 := faa g0 EQ(g0, g1)$Lisp => error "All points are fixed points" GEQNSUBSTLIST([g0]$Lisp, [g1]$Lisp, g1)$Lisp + fixedPoint : ((List(A) -> List(A)),Integer) -> List(A) fixedPoint(fll, n) == g0 := [(GENSYM()$Lisp):A for i in 1..n] g1 := fll g0 @@ -100896,10 +102654,13 @@ MappingPackage1(A:SetCategory): MPcat == MPdef where GEQNSUBSTLIST(g0, g1, g1)$Lisp -- Composition and recursion. - id a == a + id : A -> A + id a == a - g**n == (a1:A):A +-> iter(g, n, a1) + ?**? : ((A -> A),NonNegativeInteger) -> (A -> A) + g**n == (a1:A):A +-> iter(g, n, a1) + recur : ((NonNegativeInteger,A) -> A) -> ((NonNegativeInteger,A) -> A) recur fnaa == (n1:NNI,a2:A):A +-> recur(fnaa, n1, a2) *) @@ -101419,13 +103180,17 @@ MappingPackage2(A:SetCategory, C:SetCategory): MPcat == MPdef where fac: A -> C faac: (A,A)->C - const c == (a1:A):C +-> arg2(a1, c) + const : C -> (A -> C) + const c == (a1:A):C +-> arg2(a1, c) + curry : ((A -> C),A) -> (() -> C) curry(fac, a) == fac a + constant : (() -> C) -> (A -> C) constant f0c == (a1:A):C +-> arg2(a1, f0c()) - diag faac == (a1:A):C +-> faac(a1, a1) + diag : ((A,A) -> C) -> (A -> C) + diag faac == (a1:A):C +-> faac(a1, a1) *) @@ -101973,21 +103738,27 @@ MappingPackage3(A:SetCategory, B:SetCategory, C:SetCategory):_ fab: A -> B fabc: (A,B)->C faac: (A,A)->C - + -- Fix left and right arguments as constants. + curryRight : (((A,B) -> C),B) -> (A -> C) curryRight(fabc,b) == (a:A):C +-> fabc(a,b) + curryLeft : (((A,B) -> C),A) -> (B -> C) curryLeft(fabc,a) == (b:B):C +-> fabc(a,b) -- Add left and right arguments which are ignored. + constantRight : (A -> C) -> ((A,B) -> C) constantRight fac == (a:A, b:B):C +-> fac a + constantLeft : (B -> C) -> ((A,B) -> C) constantLeft fbc == (a:A, b:B):C +-> fbc b -- Combinators to rearrange arguments. + twist : ((A,B) -> C) -> ((B,A) -> C) twist fabc == (b:B, a:A):C +-> fabc(a,b) -- Functional composition + ?*? : ((B -> C),(A -> B)) -> (A -> C) fbc*fab == (a:A):C +-> comp(fbc,fab,a) *) @@ -102350,21 +104121,30 @@ MappingPackage4(A:SetCategory, B:Ring): faei ==> (A -> Expression(Integer)) + funcAdd : (fab,fab,A) -> B funcAdd(g:fab,h:fab,x:A):B == ((g x) + (h x))$B + ?+? : ((A -> B),(A -> B)) -> (A -> B) (a:fab)+(b:fab) == c +-> funcAdd(a,b,c) + funcSub : (fab,fab,A) -> B funcSub(g:fab,h:fab,x:A):B == ((g x) - (h x))$B + ?-? : ((A -> B),(A -> B)) -> (A -> B) (a:fab)-(b:fab) == c +-> funcSub(a,b,c) + funcMul : (fab,fab,A) -> B funcMul(g:fab,h:fab,x:A):B == ((g x) * (h x))$B + ?*? : ((A -> B),(A -> B)) -> (A -> B) (a:fab)*(b:fab) == c +-> funcMul(a,b,c) + funcDiv : (faei,faei,A) -> Expression(Integer) funcDiv(g:faei,h:faei,x:A):Expression(Integer) == ((g x) / (h x))$Expression(Integer) + ?/? : ((A -> Expression(Integer)),(A -> Expression(Integer))) -> _ + (A -> Expression(Integer)) (a:faei)/(b:faei) == c +-> funcDiv(a,b,c) *) @@ -102497,6 +104277,7 @@ MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ minc ==> minColIndex maxc ==> maxColIndex + map : ((R1 -> R2),M1) -> M2 map(f:(R1->R2),m:M1):M2 == ans : M2 := new(nrows m,ncols m,0) for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat @@ -102504,6 +104285,7 @@ MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ qsetelt_!(ans,k,l,f qelt(m,i,j)) ans + map : ((R1 -> Union(R2,"failed")),M1) -> Union(M2,"failed") map(f:(R1 -> (Union(R2,"failed"))),m:M1):Union(M2,"failed") == ans : M2 := new(nrows m,ncols m,0) for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat @@ -102512,6 +104294,7 @@ MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ qsetelt_!(ans,k,l,r::R2) ans + reduce : (((R1,R2) -> R2),M1,R2) -> R2 reduce(f,m,ident) == s := ident for i in minr(m)..maxr(m) repeat @@ -102638,20 +104421,24 @@ MatrixCommonDenominator(R, Q): Exports == Implementation where import ListFunctions2(Q, R) import MatrixCategoryFunctions2(Q,VQ,VQ,Matrix Q,R,VR,VR,Matrix R) + clearDenominator : Matrix(Q) -> Matrix(R) clearDenominator m == d := commonDenominator m map(x +-> numer(d*x), m) + splitDenominator : Matrix(Q) -> Record(num: Matrix(R),den: R) splitDenominator m == d := commonDenominator m [map(x +-> numer(d*x), m), d] if R has GcdDomain then + commonDenominator : Matrix(Q) -> R commonDenominator m == lcm map(denom, parts m) else + commonDenominator : Matrix(Q) -> R commonDenominator m == reduce("*",map(denom, parts m),1)$List(R) *) @@ -103114,6 +104901,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where return ans pos := not pos; rl := cons(j,rl); j := first l; l := rest l + minordet : M -> R minordet x == (ndim := nrows x) ^= (ncols x) => error "determinant: matrix must be square" @@ -103127,6 +104915,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where minorDet(x, 2**ndim - 2, [i for i in 0..n1], 0, v) -- elementary operation of first kind: exchange two rows -- + elRow1! : (M,Integer,Integer) -> M elRow1!(m:M,i:I,j:I) : M == vec:=row(m,i) setRow!(m,i,row(m,j)) @@ -103135,6 +104924,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where -- elementary operation of second kind: add to row i-- -- a*row j (i^=j) -- + elRow2! : (M,R,Integer,Integer) -> M elRow2!(m : M,a:R,i:I,j:I) : M == vec:= map((r1:R):R +-> a*r1,row(m,j)) vec:=map("+",row(m,i),vec) @@ -103143,6 +104933,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where -- elementary operation of second kind: add to column i -- -- a*column j (i^=j) -- + elColumn2! : (M,R,Integer,Integer) -> M elColumn2!(m : M,a:R,i:I,j:I) : M == vec:= map((r1:R):R +-> a*r1,column(m,j)) vec:=map("+",column(m,i),vec) @@ -103152,6 +104943,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where if R has IntegralDomain then -- Fraction-Free Gaussian Elimination + fractionFreeGauss! : M -> M fractionFreeGauss! x == (ndim := nrows x) = 1 => x ans := b := 1$R @@ -103187,6 +104979,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where x -- + lastStep : M -> M lastStep(x:M) : M == ndim := nrows x minR := minRowIndex x; maxR := maxRowIndex x @@ -103205,6 +104998,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where iCol:=iCol-1 subMatrix(x,minR,maxR,maxC1,exCol) + invertIfCan : M -> Union(M,"failed") invertIfCan(y) == (nr:=nrows y) ^= (ncols y) => error "invertIfCan: matrix must be square" @@ -103212,6 +105006,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where (den:=recip(adjRec.detMat)) case "failed" => "failed" den::R * adjRec.adjMat + adjoint : M -> Record(adjMat: M,detMat: R) adjoint(y) == (nr:=nrows y) ^= (ncols y) => error "adjoint: matrix must be square" maxR := maxRowIndex y @@ -103230,22 +105025,29 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where FLA2 ==> FiniteLinearAggregateFunctions2(R, VR, R, Col) MAT2 ==> MatrixCategoryFunctions2(R,Row,Col,M,R,VR,VR,Matrix R) + rowEchelon : M -> M rowEchelon y == rowEchelon(y)$IMATLIN - rank y == rank(y)$IMATLIN + rank : M -> NonNegativeInteger + rank y == rank(y)$IMATLIN - nullity y == nullity(y)$IMATLIN + nullity : M -> NonNegativeInteger + nullity y == nullity(y)$IMATLIN + determinant : M -> R determinant y == determinant(y)$IMATLIN - inverse y == inverse(y)$IMATLIN + inverse : M -> Union(M,"failed") + inverse y == inverse(y)$IMATLIN if Col has shallowlyMutable then + nullSpace : M -> List(Col) nullSpace y == nullSpace(y)$IMATLIN else + nullSpace : M -> List(Col) nullSpace y == [map((r1:R):R +-> r1, v)$FLA2 for v in nullSpace(map((r2:R):R +-> r2, y)$MAT2)$MMATLIN] @@ -103258,13 +105060,16 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where M2 ==> Matrix QF IMATQF ==> InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2) + nullSpace : M -> List(Col) nullSpace m == nullSpace(m)$IMATQF + determinant : M -> R determinant y == (nrows y) ^= (ncols y) => error "determinant: matrix must be square" fm:=fractionFreeGauss!(copy y) fm(maxRowIndex fm,maxColIndex fm) + rank : M -> NonNegativeInteger rank x == y := (rk := nrows x) > (rh := ncols x) => @@ -103278,12 +105083,14 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where rk := (rk - 1) :: NonNegativeInteger rk :: NonNegativeInteger + nullity : M -> NonNegativeInteger nullity x == (ncols x - rank x) :: NonNegativeInteger if R has EuclideanDomain then if R has IntegerNumberSystem then + normalizedDivide : (R,R) -> Record(quotient: R,remainder: R) normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == qr := divide(n, d) qr.remainder >= 0 => qr @@ -103297,9 +105104,11 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where else + normalizedDivide : (R,R) -> Record(quotient: R,remainder: R) normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == divide(n, d) + rowEchelon : M -> M rowEchelon y == x := copy y minR := minRowIndex x; maxR := maxRowIndex x @@ -103329,12 +105138,10 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where val2 := -a1 * qelt(x,i,k1) + b1 * qelt(x,k,k1) qsetelt_!(x,i,k1,val1); qsetelt_!(x,k,k1,val2) qsetelt_!(x,i,j,d); qsetelt_!(x,k,j,0) - un := unitNormal qelt(x,i,j) qsetelt_!(x,i,j,un.canonical) if un.associate ^= 1 then for jj in (j+1)..maxC repeat qsetelt_!(x,i,jj,un.associate * qelt(x,i,jj)) - xij := qelt(x,i,j) for k in minR..(i-1) repeat qelt(x,k,j) = 0 => "next k" @@ -103345,7 +105152,10 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where i := i + 1 x - else determinant x == minordet x + else + + determinant : M -> R + determinant x == minordet x *) @@ -105921,6 +107731,7 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where -- Custom function to expand Segment(PositiveInteger) into -- List(PositiveInteger). This operation is not supported by the -- overly restrictive library implementation. + expand : SPI -> LPI expand(spi : SPI) : LPI == lr := empty()$LPI l : PI := lo spi @@ -105937,29 +107748,37 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where l := (l + inc) pretend PI reverse! lr + element : (M,PositiveInteger,PositiveInteger) -> M element(A, r, c) == matrix([[A(r,c)]]) + aRow : (M,PositiveInteger) -> M aRow(A:M, r:PI) : M == subMatrix(A, r, r, minc A, maxc A) + rows : (M,List(PositiveInteger)) -> M rows(A:M, lst:LPI) : M == ls := [aRow(A, r) for r in lst] reduce(vertConcat, ls) + rows : (M,Segment(PositiveInteger)) -> M rows(A:M, si:SPI) : M == rows(A, expand(si)) + aColumn : (M,PositiveInteger) -> M aColumn(A:M, c:PI) : M == subMatrix(A, minr A, maxr A, c, c) + columns : (M,List(PositiveInteger)) -> M columns(A:M, lst:LPI) : M == ls := [aColumn(A,c) for c in lst] reduce(horizConcat, ls) + columns : (M,Segment(PositiveInteger)) -> M columns(A:M, si:SPI) : M == columns(A, expand(si)) + diagonalMatrix : (M,Integer) -> M diagonalMatrix(A, n) == nr := nrows(A) nc := ncols(A) @@ -105978,37 +107797,46 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where qsetelt!(B, sr+i, sc+i, A(sr+i, sc+i)) B + diagonalMatrix : M -> M diagonalMatrix(A) == diagonalMatrix(A, 0) + bandMatrix : (M,List(Integer)) -> M bandMatrix(A:M, ln:LI) : M == -- Really inefficient reduce("+", [diagonalMatrix(A,d) for d in ln]) + bandMatrix : (M,Segment(Integer)) -> M bandMatrix(A:M, si:SI) : M == bandMatrix(A, expand(si)) + subMatrix : (M,List(PositiveInteger),List(PositiveInteger)) -> M subMatrix(A:M, lr:LPI, lc:LPI) : M == -- Really inefficient lle := [[ element(A,r,c) for c in lc] for r in lr] blockConcat(lle) + subMatrix : (M,Segment(PositiveInteger),Segment(PositiveInteger)) -> M subMatrix(A:M, sr:SPI, sc:SPI) : M == subMatrix(A, low sr, high sr, low sc, high sc) -- Stack matrices + horizConcat : List(M) -> M horizConcat(LA) == reduce(horizConcat, LA) + vertConcat : List(M) -> M vertConcat(LA) == reduce(vertConcat, LA) + blockConcat : List(List(M)) -> M blockConcat(LLA: List List M) : M == reduce(vertConcat, [reduce(horizConcat, LA) for LA in LLA]) -- Split matrices + vertSplit : (M,PositiveInteger) -> List(M) vertSplit(A:M, r:PI) : List M == dr := nrows(A) exquo r dr case "failed" => error "split does not result in an equal division" @@ -106017,6 +107845,7 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where mac := maxc A [ subMatrix(A, mir+i*dr, mir+(i+1)*dr-1, mic, mac) for i in 0..(r-1) ] + vertSplit : (M,List(PositiveInteger)) -> List(M) vertSplit(A:M, lr:LPI) : List M == reduce("+", lr) ~= nrows(A) => _ error "split does not result in proper partition" @@ -106027,6 +107856,7 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where result := _ [ subMatrix(A, mir+l(i-1), mir+l(i)-1, mic, mac) for i in 2..#l ] + horizSplit : (M,PositiveInteger) -> List(M) horizSplit(A:M, c:PI) : List M == dc := ncols(A) exquo c dc case "failed" => error "split does not result in an equal division" @@ -106035,6 +107865,7 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where mic := minc A [ subMatrix(A, mir, mar, mic+i*dc, mic+(i+1)*dc-1) for i in 0..(c-1) ] + horizSplit : (M,List(PositiveInteger)) -> List(M) horizSplit(A:M, lc:LPI) : List M == reduce("+", lc) ~= ncols(A) => _ error "split does not result in proper partition" @@ -106045,15 +107876,20 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where result := _ [ subMatrix(A, mir, mar, mic+l(i-1), mic+l(i)-1) for i in 2..#l ] + blockSplit : (M,PositiveInteger,PositiveInteger) -> List(List(M)) blockSplit(A:M, nr:PI, nc:PI) : List List M == [ horizSplit(X, nc) for X in vertSplit(A, nr) ] + blockSplit : (M,List(PositiveInteger),PositiveInteger) -> List(List(M)) blockSplit(A:M, lr:LPI, nc:PI) : List List M == [ horizSplit(X, nc) for X in vertSplit(A, lr) ] + blockSplit : (M,PositiveInteger,List(PositiveInteger)) -> List(List(M)) blockSplit(A:M, nr:PI, lc:LPI) : List List M == [ horizSplit(X, lc) for X in vertSplit(A, nr) ] + blockSplit : (M,List(PositiveInteger),List(PositiveInteger)) -> _ + List(List(M)) blockSplit(A:M, lr:LPI, lc:LPI) : List List M == [ horizSplit(X, lc) for X in vertSplit(A, lr) ] @@ -106152,14 +107988,14 @@ MergeThing(S:OrderedSet): Exports == Implementation where (* package MTHING *) (* - mergeDifference1: (List S,S,List S) -> List S - + mergeDifference : (List(S),List(S)) -> List(S) mergeDifference(x,y) == null x or null y => x mergeDifference1(x,y.first,y.rest) x.first=y.first => x.rest x + mergeDifference1: (List S,S,List S) -> List S mergeDifference1(x,fy,ry) == rx := x while not null rx repeat @@ -106386,6 +108222,7 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where import SPACE3 -- local functions + numberCheck : Point SF -> Void numberCheck(nums:Point SF):Void == -- this function checks to see that the small floats are -- actually just that - rather than complex numbers or @@ -106399,15 +108236,24 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where "An unexpected complex number was encountered in the calculations." makePt:(SF,SF,SF,SF) -> POINT - makePt(x,y,z,c) == point(l : List SF := [x,y,z,c]) + ptFunc : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + ((DoubleFloat,DoubleFloat) -> DoubleFloat), + ((DoubleFloat,DoubleFloat) -> DoubleFloat), + ((DoubleFloat,DoubleFloat,DoubleFloat) -> DoubleFloat)) -> _ + ((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)) ptFunc(f,g,h,c) == (z1:SF,z2:SF):POINT +-> x := f(z1,z2); y := g(z1,z2); z := h(z1,z2) makePt(x,y,z,c(x,y,z)) -- parameterized equations of two variables + meshPar2Var : (ThreeSpace(DoubleFloat), + ((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + Segment(DoubleFloat), + Segment(DoubleFloat), + List(DrawOption)) -> ThreeSpace(DoubleFloat) meshPar2Var(sp,ptFun,uSeg,vSeg,opts) == -- the issue of open and closed needs to be addressed, here, we are -- defaulting to open (which is probably the correct default) @@ -106446,14 +108292,25 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where mesh(space,llp,lProp,aProp) space + meshPar2Var : (((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + Segment(DoubleFloat), + Segment(DoubleFloat), + List(DrawOption)) -> ThreeSpace(DoubleFloat) meshPar2Var(ptFun,uSeg,vSeg,opts) == sp := create3Space() meshPar2Var(sp,ptFun,uSeg,vSeg,opts) zCoord: (SF,SF,SF) -> SF - zCoord(x,y,z) == z + meshPar2Var : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + ((DoubleFloat,DoubleFloat) -> DoubleFloat), + ((DoubleFloat,DoubleFloat) -> DoubleFloat), + Union(((DoubleFloat,DoubleFloat,DoubleFloat) -> _ + DoubleFloat),undefined), + Segment(DoubleFloat), + Segment(DoubleFloat), + List(DrawOption)) -> ThreeSpace(DoubleFloat) meshPar2Var(xFun,yFun,zFun,colorFun,uSeg,vSeg,opts) == -- the color function should be parameterized by (u,v) as well, -- not (x,y,z) but we also want some sort of consistency and so @@ -106466,6 +108323,10 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where meshPar2Var(ptFunc(xFun,yFun,zFun,zCoord),uSeg,vSeg,opts) -- explicit equations of two variables + meshFun2Var : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + Union(((DoubleFloat,DoubleFloat,DoubleFloat) -> DoubleFloat),undefined),_ + Segment(DoubleFloat),Segment(DoubleFloat),List(DrawOption)) -> _ + ThreeSpace(DoubleFloat) meshFun2Var(zFun,colorFun,xSeg,ySeg,opts) == -- here, we construct the data for a function of two variables meshPar2Var((z1:SF,z2:SF):SF +-> z1, @@ -106768,20 +108629,25 @@ ModularDistinctDegreeFactorizer(U):C == T where \begin{chunk}{COQ MDDFACT} (* package MDDFACT *) (* - + + + reduction : (U,I) -> U reduction(u:U,p:I):U == zero? p => u map((i1:I):I +-> positiveRemainder(i1,p),u) + merge : (I,I) -> Union(I,"failed") merge(p:I,q:I):Union(I,"failed") == p = q => p p = 0 => q q = 0 => p "failed" + modInverse : (I,I) -> I modInverse(c:I,p:I):I == (extendedEuclidean(c,p,1)::Record(coef1:I,coef2:I)).coef1 + exactquo : (U,U,I) -> Union(U,"failed") exactquo(u:U,v:U,p:I):Union(U,"failed") == invlcv:=modInverse(leadingCoefficient v,p) r:=monicDivide(u,reduction(invlcv*v,p)) @@ -106791,24 +108657,18 @@ ModularDistinctDegreeFactorizer(U):C == T where EMR := EuclideanModularRing(Integer,U,Integer, reduction,merge,exactquo) - probSplit2:(EMR,EMR,I) -> Union(List EMR,"failed") - trace:(EMR,I,EMR) -> EMR - ddfactor:EMR -> L EMR - ddfact:EMR -> DDList - sepFact1:DDRecord -> L EMR - sepfact:DDList -> L EMR - probSplit:(EMR,EMR,I) -> Union(L EMR,"failed") - makeMonic:EMR -> EMR - exptmod:(EMR,I,EMR) -> EMR - + lc :EMR -> I lc(u:EMR):I == leadingCoefficient(u::U) + degree : EMR) -> I degree(u:EMR):I == degree(u::U) + makeMonic:EMR -> EMR makeMonic(u) == modInverse(lc(u),modulus(u)) * u i:I + exptmod:(EMR,I,EMR) -> EMR exptmod(u1,i,u2) == i < 0 => error("negative exponentiation not allowed for exptMod") ans:= 1$EMR @@ -106818,17 +108678,21 @@ ModularDistinctDegreeFactorizer(U):C == T where u1:= (u1 * u1) rem u2 ans + exptMod : (U,Integer,U,Integer) -> U exptMod(a,i,b,q) == ans:= exptmod(reduce(a,q),i,reduce(b,q)) ans::U + ddfactor:EMR -> L EMR ddfactor(u) == if (c:= lc(u)) ^= 1$I then u:= makeMonic(u) ans:= sepfact(ddfact(u)) cons(c::EMR,[makeMonic(f) for f in ans | degree(f) > 0]) + gcd : (U,U,Integer) -> U gcd(u,v,q) == gcd(reduce(u,q),reduce(v,q))::U + factor : (U,Integer) -> List(U) factor(u,q) == v:= reduce(u,q) dv:= reduce(differentiate(u),q) @@ -106837,6 +108701,7 @@ ModularDistinctDegreeFactorizer(U):C == T where ans:= ddfactor v [f::U for f in ans] + ddfact:EMR -> DDList ddfact(u) == p:=modulus u w:= reduce(monomial(1,1)$U,p) @@ -106856,28 +108721,35 @@ ModularDistinctDegreeFactorizer(U):C == T where d > (degree(u):I quo 2) => return [[c::EMR,0$I],[u,degree(u)],:ans] + ddFact : (U,Integer) -> List(Record(factor: U,degree: Integer)) ddFact(u,q) == ans:= ddfact(reduce(u,q)) [[(dd.factor)::U,dd.degree]$UDDRecord for dd in ans]$UDDList + linears : (U,Integer) -> U linears(u,q) == uu:=reduce(u,q) m:= reduce(monomial(1,1)$U,q) gcd(exptmod(m,q,uu)-m,uu)::U + sepfact:DDList -> L EMR sepfact(factList) == "append"/[sepFact1(f) for f in factList] + separateFactors : (List(Record(factor: U,degree: Integer)),Integer) -> _ + List(U) separateFactors(uddList,q) == ans:= sepfact [[reduce(udd.factor,q),udd.degree]$DDRecord for udd in uddList]$DDList [f::U for f in ans] + decode : (Integer,Integer,U) -> U decode(s:Integer, p:Integer, x:U):U == s

s::U qr := divide(s,p) qr.remainder :: U + x*decode(qr.quotient, p, x) + sepFact1:DDRecord -> L EMR sepFact1(f) == u:= f.factor p:=modulus u @@ -106919,6 +108791,7 @@ ModularDistinctDegreeFactorizer(U):C == T where x:= y ** (degree(x) + 1) [c * first(ans),:rest(ans)] + probSplit:(EMR,EMR,I) -> Union(L EMR,"failed") probSplit(u,t,d) == (p:=modulus(u)) = 2 => probSplit2(u,t,d) f1:= gcd(u,t) @@ -106929,12 +108802,14 @@ ModularDistinctDegreeFactorizer(U):C == T where g = u => "failed" [f1,f2,(u quo g)] + probSplit2:(EMR,EMR,I) -> Union(List EMR,"failed") probSplit2(u,t,d) == f:= gcd(u,trace(t,d,u)) f = 1 => "failed" degree u = degree f => "failed" [1,f,u quo f] + trace:(EMR,I,EMR) -> EMR trace(t,d,u) == p:=modulus(t) d:= d - 1 @@ -107257,19 +109132,12 @@ ModularHermitianRowReduction(R): Exports == Implementation where (* package MHROWRED *) (* - order : (R, R) -> Z - vconc : (M, R) -> M - non0 : (V, Z) -> Union(REC, "failed") nonzero?: V -> Boolean - mkMat : (M, List Z) -> M - diagSubMatrix: M -> Union(Record(val:R, mat:M), "failed") - determinantOfMinor: M -> R - enumerateBinomial: (List Z, Z, Z) -> List Z - nonzero? v == any?(s +-> s ^= 0, v) -- returns [a, i, rown] if v = [0,...,0,a,0,...,0] -- where a <> 0 and i is the index of a, "failed" otherwise. + non0 : (V, Z) -> Union(REC, "failed") non0(v, rown) == ans:REC allZero:Boolean := true @@ -107284,6 +109152,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where -- returns a matrix made from the non-zero rows of x whose row number -- is not in l + mkMat : (M, List Z) -> M mkMat(x, l) == empty?(ll := [parts row(x, i) for i in minRowIndex x .. maxRowIndex x | @@ -107294,6 +109163,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where -- returns [m, d] where m = x with the zero rows and the rows of -- the diagonal of d removed, if x has a diagonal submatrix of d's, -- "failed" otherwise. + diagSubMatrix: M -> Union(Record(val:R, mat:M), "failed") diagSubMatrix x == l := [u::REC for i in minRowIndex x .. maxRowIndex x | (u := non0(row(x, i), i)) case REC] @@ -107305,6 +109175,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where -- returns a non-zero determinant of a minor of x of rank equal to -- the number of columns of x, if there is one, 0 otherwise + determinantOfMinor: M -> R determinantOfMinor x == -- do not compute a modulus for square matrices, since this is as -- expensive as the Hermite reduction itself @@ -107321,6 +109192,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where -- /n\ -- where 1 <= i <= | | -- \m/ + enumerateBinomial: (List Z, Z, Z) -> List Z enumerateBinomial(l, m, i) == m1 := minIndex l - 1 zero?(m := m - 1) => [l(m1 + i)] @@ -107330,15 +109202,18 @@ ModularHermitianRowReduction(R): Exports == Implementation where i := i - b error "Should not happen" + rowEch : Matrix(R) -> Matrix(R) rowEch x == (u := diagSubMatrix x) case "failed" => zero?(d := determinantOfMinor x) => rowEchelon x rowEchelon(x, d) rowEchelon(u.mat, u.val) + vconc : (M, R) -> M vconc(y, m) == vertConcat(diagonalMatrix new(ncols y, m)$V, map(s +-> s rem m, y)) + order : (R, R) -> Z order(m, p) == zero? m => -1 for i in 0.. repeat @@ -107347,6 +109222,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where if R has IntegerNumberSystem then + normalizedDivide : (R,R) -> Record(quotient: R,remainder: R) normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == qr := divide(n, d) qr.remainder >= 0 => qr @@ -107359,15 +109235,18 @@ ModularHermitianRowReduction(R): Exports == Implementation where qr else + normalizedDivide : (R,R) -> Record(quotient: R,remainder: R) normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == divide(n, d) + rowEchLocal : (Matrix(R),R) -> Matrix(R) rowEchLocal(x,p) == (u := diagSubMatrix x) case "failed" => zero?(d := determinantOfMinor x) => rowEchelon x rowEchelonLocal(x, d, p) rowEchelonLocal(u.mat, u.val, p) + rowEchelonLocal : (Matrix(R),R,R) -> Matrix(R) rowEchelonLocal(y, m, p) == m := p**(order(m,p)::NonNegativeInteger) x := vconc(y, m) @@ -107411,10 +109290,12 @@ ModularHermitianRowReduction(R): Exports == Implementation where if R has Field then + rowEchelon : (Matrix(R),R) -> Matrix(R) rowEchelon(y, m) == rowEchelon vconc(y, m) else + rowEchelon : (Matrix(R),R) -> Matrix(R) rowEchelon(y, m) == x := vconc(y, m) nrows := maxRowIndex x @@ -107542,6 +109423,7 @@ MonoidRingFunctions2(R,S,M) : Exports == Implementation where (* package MRF2 *) (* + map : ((R -> S),MonoidRing(R,M)) -> MonoidRing(S,M) map(fn, u) == res : MonoidRing(S,M) := 0 for te in terms u repeat @@ -107690,14 +109572,18 @@ MonomialExtensionTools(F, UP): Exports == Implementation where (* package MONOTOOL *) (* + normalDenom : (Fraction(UP),(UP -> UP)) -> UP normalDenom(f, derivation) == split(denom f, derivation).normal + split : (UP,(UP -> UP)) -> Record(normal: UP,special: UP) split(p, derivation) == pbar := (gcd(p, derivation p) exquo gcd(p, differentiate p))::UP zero? degree pbar => [p, 1] rec := split((p exquo pbar)::UP, derivation) [rec.normal, pbar * rec.special] + splitSquarefree : (UP,(UP -> UP)) -> _ + Record(normal: Factored(UP),special: Factored(UP)) splitSquarefree(p, derivation) == s:Factored(UP) := 1 n := s @@ -107710,6 +109596,8 @@ MonomialExtensionTools(F, UP): Exports == Implementation where if not ground? h then n := n * sqfrFactor(h, rec.exponent) [n, unit(q) * s] + decompose : (Fraction(UP),(UP -> UP)) -> _ + Record(poly: UP,normal: Fraction(UP),special: Fraction(UP)) decompose(f, derivation) == qr := divide(numer f, denom f) -- rec.normal * rec.special = denom f @@ -107806,6 +109694,7 @@ MoreSystemCommands: public == private where (* package MSYSCMD *) (* + systemCommand : String -> Void systemCommand cmd == doSystemCommand(cmd)$Lisp *) @@ -107931,6 +109820,7 @@ MPolyCatPolyFactorizer(E,OV,R,PPR) : C == T import PushVariables(R,E,OV,PPR) ---- factorization of p ---- + factor : PPR -> Factored(PPR) factor(p:PPR) : Factored PPR == ground? p => nilFactor(p,1) c := content p @@ -108160,6 +110050,7 @@ MPolyCatRationalFunctionFactorizer(E,OV,R,PRF) : C == T (* ---- factorization of p ---- + factor : PRF -> Factored(PRF) factor(p:PRF) : Factored PRF == truelist:List OV :=variables p tp:=totalfract(p) @@ -108195,6 +110086,7 @@ MPolyCatRationalFunctionFactorizer(E,OV,R,PRF) : C == T -- the following functions are used to "push" x in the coefficient ring - ---- push x in the coefficient domain for a polynomial ---- + pushdown : (PRF,OV) -> PRF pushdown(g:PRF,x:OV) : PRF == ground? g => g rf:PRF:=0$PRF @@ -108205,12 +110097,14 @@ MPolyCatRationalFunctionFactorizer(E,OV,R,PRF) : C == T rf ---- push x in the coefficient domain for a term ---- + pushdterm : (SparseUnivariatePolynomial(PRF),OV) -> PRF pushdterm(t:UPRF,x:OV):PRF == n:=degree(t) cf:=monomial(1,convert x,n)$P :: F cf * leadingCoefficient t ---- push back the variable ---- + pushup : (PRF,OV) -> PRF pushup(f:PRF,x:OV) :PRF == ground? f => pushuconst(retract f,x) v:=mainVariable(f)::OV @@ -108218,20 +110112,21 @@ MPolyCatRationalFunctionFactorizer(E,OV,R,PRF) : C == T multivariate(map((y:PRF):PRF +-> pushup(y,x),g),v) ---- push x back from the coefficient domain ---- + pushuconst : (Fraction(Polynomial(R)),OV) -> PRF pushuconst(r:F,x:OV):PRF == xs:SE:=convert x degree(denom r,xs)>0 => error "bad polynomial form" inv((denom r)::F)*pushucoef(univariate(numer r,xs),x) - + pushucoef : (SparseUnivariatePolynomial(Polynomial(R)),OV) -> PRF pushucoef(c:UP,x:OV):PRF == c = 0 => 0 monomial((leadingCoefficient c)::F::PRF,x,degree c) + pushucoef(reductum c,x) - ---- write p with a common denominator ---- + totalfract : PRF -> Record(sup: Polynomial(R),inf: Polynomial(R)) totalfract(p:PRF) : QuoForm == p=0 => [0$P,1$P]$QuoForm for x in variables p repeat p:=pushdown(p,x) @@ -108344,12 +110239,12 @@ MPolyCatFunctions2(VarSet,E1,E2,R,S,PR,PS) : public == private where (* supMap: (R -> S, SUPR) -> SUPS - supMap(fn : R -> S, supr : SUPR): SUPS == supr = 0 => monomial(fn(0$R) :: PS,0)$SUPS c : PS := map(fn,leadingCoefficient supr)$% monomial(c,degree supr)$SUPS + supMap(fn, reductum supr) + map : ((R -> S),PR) -> PS map(fn : R -> S, pr : PR): PS == varu : Union(VarSet,"failed") := mainVariable pr varu case "failed" => -- have a constant @@ -108449,6 +110344,7 @@ MPolyCatFunctions3(Vars1,Vars2,E1,E2,R,PR1,PR2): C == T where (* package MPC3 *) (* + map : ((Vars1 -> Vars2),PR1) -> PR2 map(f:Vars1 -> Vars2, p:PR1):PR2 == (x1 := mainVariable p) case "failed" => c:R:=(retract p) @@ -108576,14 +110472,19 @@ MRationalFactorize(E,OV,R,P) : C == T MFACT ==> MultivariateFactorize(OV,IE,R,MPR) UPCF2 ==> UnivariatePolynomialCategoryFunctions2 + numer1 : FR -> MPR numer1(c:FR): MPR == (numer c) :: MPR + numer2 : P -> MPR numer2(pol:P) : MPR == map(coerce,numer1,pol)$PCLFRR + coerce1 : R -> P coerce1(d:R) : P == (d::FR)::P + coerce2 : MPR -> P coerce2(pp:MPR) :P == map(coerce,coerce1,pp)$PCLRFR + factor : P -> Factored(P) factor(p:P) : Factored P == pden:R:=lcm([denom c for c in coefficients p]) pol :P:= (pden::FR)*p @@ -109134,33 +111035,14 @@ MultFiniteFactorize(OV,E,F,PG) : C == T NewOrd ==> Record(npol:SUP P,nvar:L OV,newdeg:L NNI) Valuf ==> Record(inval:L L R,unvfact:L SUP R,lu:R,complead:L R) - ---- Local Functions ---- - ran : Z -> R - mFactor : (P,Z) -> MFinalFact - supFactor : (SUP P,Z) -> SUPFinalFact - mfconst : (SUP P,Z,L OV,L NNI) -> L SUP P - mfpol : (SUP P,Z,L OV,L NNI) -> L SUP P - varChoose : (P,L OV,L NNI) -> NewOrd - simplify : (P,Z,L OV,L NNI) -> MFinalFact - intChoose : (SUP P,L OV,R,L P,L L R) -> Valuf - pretest : (P,NNI,L OV,L R) -> FinalFact - checkzero : (SUP P,SUP R) -> Boolean - pushdcoef : PG -> P - pushdown : (PG,OV) -> P - pushupconst : (R,OV) -> PG - pushup : (P,OV) -> PG - norm : L SUP R -> Integer - constantCase : (P,L MParFact) -> MFinalFact - pM : L SUP R -> R - intfact : (SUP P,L OV,L NNI,MFinalFact,L L R) -> L SUP P - basicVar:OV:=NIL$Lisp pretend OV -- variable for the basic step - + convertPUP : MFinalFact -> SUPFinalFact convertPUP(lfg:MFinalFact): SUPFinalFact == [lfg.contp,[[lff.irr ::SUP P,lff.pow]$SUParFact for lff in lfg.factors]]$SUPFinalFact + supFactor : (SUP P,Z) -> SUPFinalFact supFactor(um:SUP P,dx:Z) : SUPFinalFact == degree(um)=0 => convertPUP(mFactor(ground um,dx)) lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um] @@ -109208,6 +111090,8 @@ MultFiniteFactorize(OV,E,F,PG) : C == T [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R, factorlist]$SUPFinalFact + factor : SparseUnivariatePolynomial(PG) -> _ + Factored(SparseUnivariatePolynomial(PG)) factor(um:SUP PG):Factored SUP PG == lv:List OV:=variables um ld:=degree(um,lv) @@ -109216,10 +111100,11 @@ MultFiniteFactorize(OV,E,F,PG) : C == T cm:=map((p1:PG):P+->pushdown(p1,basicVar),um)$UPCF2(PG,SUP PG,P,SUP P) flist := supFactor(cm,dx) pushupconst(flist.contp,basicVar)::SUP(PG) * - (*/[primeFactor( + ( */[primeFactor( map((p1:P):PG+->pushup(p1,basicVar),u.irr)$UPCF2(P,SUP P,PG,SUP PG), u.pow) for u in flist.factors]) + mFactor : (P,Z) -> MFinalFact mFactor(m:P,dx:Z) : MFinalFact == ground?(m) => constantCase(m,empty()) lvar:L OV:= variables m @@ -109234,7 +111119,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T om:=pushup(m,basicVar) sqfacs:=squareFree(om) lcont := pushdown(unit sqfacs,basicVar) - ---- Factorize the content ---- if ground? lcont then flead:=constantCase(lcont,empty()) @@ -109277,7 +111161,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T for lcterm in mFactor(pc,dx).factors repeat factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist) ldeg:= degree(ffactor,lvar) - -- should be unitNormal if unified, but for now it is easier lcum:F:= leadingCoefficient leadingCoefficient leadingCoefficient um @@ -109293,6 +111176,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T flead.factors:= factorlist flead + pM : L SUP R -> R pM(lum:L SUP R) : R == x := monomial(1,1)$R for i in 1..size()$F repeat @@ -109306,12 +111190,13 @@ MultFiniteFactorize(OV,E,F,PG) : C == T if testModulus(p, lum)$GenExEuclid(R, SUP R) then return p ---- push x in the coefficient domain for a term ---- + pushdcoef : PG -> P pushdcoef(t:PG):P == map((f1:F):R+->coerce(f1)$R,t)$MPolyCatFunctions2(OV,E, IndexedExponents OV,F,R,PG,P) - ---- internal function, for testing bad cases ---- + intfact : (SUP P,L OV,L NNI,MFinalFact,L L R) -> L SUP P intfact(um:SUP P,lvar: L OV,ldeg:L NNI, tleadpol:MFinalFact,ltry:L L R): L SUP P == polcase:Boolean:=(not empty? tleadpol.factors ) @@ -109350,6 +111235,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T -- the following functions are used to "push" x in the coefficient ring - ---- push back the variable ---- + pushup : (P,OV) -> PG pushup(f:P,x:OV) :PG == ground? f => pushupconst((retract f)@R,x) rr:PG:=0 @@ -109362,6 +111248,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T rr ---- push x in the coefficient domain for a polynomial ---- + pushdown : (PG,OV) -> P pushdown(g:PG,x:OV) : P == ground? g => ((retract g)@F)::R::P rf:P:=0$P @@ -109373,6 +111260,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T rf ---- push x back from the coefficient domain ---- + pushupconst : (R,OV) -> PG pushupconst(r:R,x:OV):PG == ground? r => (retract r)@F ::PG rr:PG:=0 @@ -109382,11 +111270,13 @@ MultFiniteFactorize(OV,E,F,PG) : C == T rr -- This function has to be added to Eucliden domain + ran : Z -> R ran(k1:Z) : R == --if R case Integer then random()$R rem (2*k1)-k1 --else +/[monomial(random()$F,i)$R for i in 0..k1] + checkzero : (SUP P,SUP R) -> Boolean checkzero(u:SUP P,um:SUP R) : Boolean == u=0 => um =0 um = 0 => false @@ -109394,6 +111284,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T false --- Choose the variable of least degree --- + varChoose : (P,L OV,L NNI) -> NewOrd varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd == k:="min"/[d for d in ldeg] k=degree(m,first lvar) => @@ -109404,9 +111295,11 @@ MultFiniteFactorize(OV,E,F,PG) : C == T lvar:=cons(x,delete(lvar,i)) [univariate(m,x),lvar,ldeg]$NewOrd + norm : L SUP R -> Integer norm(lum: L SUP R): Integer == "max"/[degree lup for lup in lum] --- Choose the values to reduce to the univariate case --- + intChoose : (SUP P,L OV,R,L P,L L R) -> Valuf intChoose(um:SUP P,lvar:L OV,clc:R,plist:L P,ltry:L L R) : Valuf == -- declarations degum:NNI := degree um @@ -109425,7 +111318,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T newunifact : L SUP R:=empty() leadtest:=true --- the lc test with polCase has to be performed int:L R:=empty() - -- New sets of values are chosen until we find twice the -- same number of "univariate" factors:the set smaller in modulo is -- is chosen. @@ -109491,14 +111383,14 @@ MultFiniteFactorize(OV,E,F,PG) : C == T nfatt := nf [cons(int,ltry),unifact,lffc,leadcomp]$Valuf - + constantCase : (P,L MParFact) -> MFinalFact constantCase(m:P,factorlist:List MParFact) : MFinalFact == lunm:=distdfact((retract m)@R,false)$DistinctDegreeFactorize(F,R) [(lunm.cont)::R, append(factorlist, [[(pp.irr)::P,pp.pow] for pp in lunm.factors])]$MFinalFact ---- The polynomial has mindeg>0 ---- - + simplify : (P,Z,L OV,L NNI) -> MFinalFact simplify(m:P,dm:Z,lvar:L OV,lmdeg:L NNI):MFinalFact == factorlist:L MParFact:=empty() pol1:P:= 1$P @@ -109514,6 +111406,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T flead ---- m square-free,primitive,lc constant ---- + mfconst : (SUP P,Z,L OV,L NNI) -> L SUP P mfconst(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P == nsign:Boolean factfin:L SUP P:=empty() @@ -109526,11 +111419,13 @@ MultFiniteFactorize(OV,E,F,PG) : C == T intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty()) --- m is square-free,primitive,lc is a polynomial --- + mfpol : (SUP P,Z,L OV,L NNI) -> L SUP P mfpol(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P == dist : LeadFact tleadpol:=mFactor(leadingCoefficient um,dm) intfact(um,lvar,ldeg,tleadpol,empty()) + factor : PG -> Factored(PG) factor(m:PG):Factored PG == lv:=variables m lv=empty() => makeFR(m,empty() ) @@ -109541,7 +111436,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T cm:=pushdown(m,basicVar) flist := mFactor(cm,dx) pushupconst(flist.contp,basicVar) * - (*/[primeFactor(pushup(u.irr,basicVar),u.pow) + ( */[primeFactor(pushup(u.irr,basicVar),u.pow) for u in flist.factors]) *) @@ -109641,9 +111536,9 @@ MultipleMap(R1,UP1,UPUP1,R2,UP2,UPUP2): Exports == Implementation where import UnivariatePolynomialCategoryFunctions2(R1, UP1, R2, UP2) rfmap: (R1 -> R2, Q1) -> Q2 - rfmap(f, q) == map(f, numer q) / map(f, denom q) + map : ((R1 -> R2),UPUP1) -> UPUP2 map(f, p) == map(x +-> rfmap(f,x), p)$UnivariatePolynomialCategoryFunctions2(Q1, UPUP1, Q2, UPUP2) @@ -109858,11 +111753,6 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where setelt(bandM,iw,j,D(v,[xlist(j),xlist(j+iw-1)])) ) ) bandM - jacobian(vf,xflas) == - xlist:List(S) := parts(xflas) - i: PI - matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)]) - bandedJacobian(vf,xflas,kl,ku) == xlist:List(S) := parts(xflas) j,iw: PI @@ -109885,14 +111775,17 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where (* package MCALCFN *) (* + localGradient : (F,List(S)) -> Vector(F) localGradient(v:F,xlist:List(S)):Vector(F) == vector([D(v,x) for x in xlist]) + gradient : (F,FLAS) -> Vector(F) gradient(v,xflas) == --xlist:List(S) := [xflas(i) for i in 1 .. maxIndex(xflas)] xlist:List(S) := parts(xflas) localGradient(v,xlist) + localDivergence : (Vector(F),List(S)) -> F localDivergence(vf:Vector(F),xlist:List(S)):F == i: PI n: NNI @@ -109903,6 +111796,7 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) ans + divergence : (FLAF,FLAS) -> F divergence(vf,xflas) == xlist:List(S) := parts(xflas) i: PI @@ -109914,20 +111808,24 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) ans + laplacian : (F,FLAS) -> F laplacian(v,xflas) == xlist:List(S) := parts(xflas) gv:Vector(F) := localGradient(v,xlist) localDivergence(gv,xlist) + hessian : (F,FLAS) -> Matrix(F) hessian(v,xflas) == xlist:List(S) := parts(xflas) matrix([[D(v,[x,y]) for x in xlist] for y in xlist]) + jacobian : (FLAF,FLAS) -> Matrix(F) jacobian(vf,xflas) == xlist:List(S) := parts(xflas) i: PI matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)]) + bandedHessian : (F,FLAS,NonNegativeInteger) -> Matrix(F) bandedHessian(v,xflas,k) == xlist:List(S) := parts(xflas) j,iw: PI @@ -109941,11 +111839,8 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where setelt(bandM,iw,j,D(v,[xlist(j),xlist(j+iw-1)])) ) ) bandM - jacobian(vf,xflas) == - xlist:List(S) := parts(xflas) - i: PI - matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)]) - + bandedJacobian : (FLAF,FLAS,NonNegativeInteger,NonNegativeInteger) -> _ + Matrix(F) bandedJacobian(vf,xflas,kl,ku) == xlist:List(S) := parts(xflas) j,iw: PI @@ -110072,6 +111967,7 @@ MultivariateFactorize(OV,E,R,P) : C == T (* package MULTFACT *) (* + factor : P -> Factored(P) factor(p:P) : Factored P == R is Fraction Integer => factor(p)$MRationalFactorize(E,OV,Integer,P) @@ -110081,6 +111977,8 @@ MultivariateFactorize(OV,E,R,P) : C == T factor(p)$MPolyCatRationalFunctionFactorizer(E,OV,Integer,P) factor(p,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P) + factor : SparseUnivariatePolynomial(P) -> _ + Factored(SparseUnivariatePolynomial(P)) factor(up:USP) : Factored USP == factor(up,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P) @@ -110372,14 +112270,10 @@ MultivariateLifting(E,OV,R,P) : C == T DetCoef ==> Record(deter:L SUP,dterm:L VTerm,nfacts:L BP, nlead:L P) - --- local functions --- - normalDerivM : (P,Z,OV) -> P - normalDeriv : (SUP,Z) -> SUP - subslead : (SUP,P) -> SUP - subscoef : (SUP,L Term) -> SUP - maxDegree : (SUP,OV) -> NonNegativeInteger - - + corrPoly : (SparseUnivariatePolynomial(P),List(OV),List(R),_ + List(NonNegativeInteger),List(SparseUnivariatePolynomial(P)),_ + Vector(List(SparseUnivariatePolynomial(R))),R) -> _ + Union(List(SparseUnivariatePolynomial(P)),"failed") corrPoly(m:SUP,lvar:L OV,fval:L R,ld:L NNI,flist:L SUP, table:Table,pmod:R):Union(L SUP,"failed") == -- The correction coefficients are evaluated recursively. @@ -110417,6 +112311,12 @@ MultivariateLifting(E,OV,R,P) : C == T diff:=diff- +/[listcong.i*beta.i for i in 1..np]*pol lcoef + lifting1 : (SparseUnivariatePolynomial(P),List(OV),_ + List(SparseUnivariatePolynomial(P)),List(R),List(P),_ + List(List(Record(expt: NonNegativeInteger,pcoef: P))),_ + List(NonNegativeInteger),_ + Vector(List(SparseUnivariatePolynomial(R))),R) -> _ + Union(List(SparseUnivariatePolynomial(P)),"failed") lifting1(m:SUP,lvar:L OV,plist:L SUP,vlist:L R,tlist:L P,_ coeflist:L VTerm,listdeg:L NNI,table:Table,pmod:R)_ :Union(L SUP,"failed") == @@ -110446,7 +112346,6 @@ MultivariateLifting(E,OV,R,P) : C == T ldeg := cons(degj,ldeg) subsvar:=cons(x,subsvar) subsval:=cons(v,subsval) - --substitute the determined coefficients if testp then if j NonNegativeInteger maxDegree(um:SUP,x:OV):NonNegativeInteger == ans:NonNegativeInteger:=0 while um ^= 0 repeat @@ -110488,6 +112388,10 @@ MultivariateLifting(E,OV,R,P) : C == T um:=reductum um ans + lifting : (SparseUnivariatePolynomial(P),List(OV),_ + List(SparseUnivariatePolynomial(R)),List(R),List(P),_ + List(NonNegativeInteger),R) -> _ + Union(List(SparseUnivariatePolynomial(P)),"failed") lifting(um:SUP,lvar:L OV,plist:L BP,vlist:L R, tlist:L P,listdeg:L NNI,pmod:R):Union(L SUP,"failed") == -- The factors of m (multivariate) are determined, when the @@ -110513,9 +112417,11 @@ MultivariateLifting(E,OV,R,P) : C == T -- normalDerivM(f,m,x) = the normalized (divided by m!) m-th -- derivative with respect to x of the multivariate polynomial f + normalDerivM : (P,Z,OV) -> P normalDerivM(g:P,m:Z,x:OV) : P == multivariate(normalDeriv(univariate(g,x),m),x) + normalDeriv : (SUP,Z) -> SUP normalDeriv(f:SUP,m:Z) : SUP == (n1:Z:=degree f) < m => 0$SUP n1=m => leadingCoefficient f :: SUP @@ -110531,10 +112437,12 @@ MultivariateLifting(E,OV,R,P) : C == T n:=degree f ris + subslead : (SUP,P) -> SUP subslead(m:SUP,pol:P):SUP == dm:NNI:=degree m monomial(pol,dm)+reductum m + subscoef : (SUP,L Term) -> SUP subscoef(um:SUP,lterm:L Term):SUP == dm:NNI:=degree um new:=monomial(leadingCoefficient um,dm) @@ -110964,6 +112872,10 @@ MultivariateSquareFree (E,OV,R,P) : C == T where ---- Are the univariate square-free decompositions consistent? ---- ---- new square-free algorithm for primitive polynomial ---- + nsqfree : (SparseUnivariatePolynomial(P),List(OV),List(List(R))) -> _ + Record(unitPart: P,_ + suPart: List(Record(factor: SparseUnivariatePolynomial(P),_ + exponent: Integer))) nsqfree(oldf:SUP,lvar:List(OV),ltry:List List R) : squareForm == f:=oldf univPol := intChoose(f,lvar,ltry) @@ -111024,6 +112936,8 @@ MultivariateSquareFree (E,OV,R,P) : C == T where lpfact.exponent:=(lpfact.exponent)-exp0 [((retract f) exquo ctf)::P,sqdec]$squareForm + squareFree : SparseUnivariatePolynomial(P) -> _ + Factored(SparseUnivariatePolynomial(P)) squareFree(f:SUP) : Factored SUP == degree f =0 => fu:=squareFree retract f @@ -111046,6 +112960,7 @@ MultivariateSquareFree (E,OV,R,P) : C == T where for fu in partSq.suPart],lfs) makeFR((unit lcSq * partSq.unitPart) ::SUP,lfs) + squareFree : P -> Factored(P) squareFree(f:P) : Factored P == ground? f => makeFR(f,[]) --- the polynomial is constant --- lvar:List(OV):=variables(f) @@ -111083,6 +112998,10 @@ MultivariateSquareFree (E,OV,R,P) : C == T where -- Choose the integer for the evaluation. -- -- If the polynomial is square-free the function returns upol=1. -- + intChoose : (SparseUnivariatePolynomial(P),List(OV),List(List(R))) -> _ + Record(upol: SparseUnivariatePolynomial(R),Lval: List(R),_ + Lfact: List(Record(factor: SparseUnivariatePolynomial(R),_ + exponent: Integer)),ctpol: R) intChoose(f:SUP,lvar:List(OV),ltry:List List R):Choice == degf:= degree f try:NNI:=0 @@ -111103,11 +113022,9 @@ MultivariateSquareFree (E,OV,R,P) : C == T where degree f0 ^=degf => "new integer" ctf:=content f0 lfact:List(FFE):=factors(squareFree((f0 exquo (ctf:R)::BP)::BP)) - ---- the univariate polynomial is square-free ---- if #lfact=1 and (lfact.1).exponent=1 then return [1$BP,lval,lfact,1$R]$Choice - d0:=compdegd lfact ---- inizialize lfact1 ---- try=0 => @@ -111128,6 +113045,7 @@ MultivariateSquareFree (E,OV,R,P) : C == T where d1:=d0 ---- Choose the leading coefficient for the lifting ---- + coefChoose : (Integer,Factored(P)) -> P coefChoose(exp:Z,sqlead:Factored(P)) : P == lcoef:P:=unit(sqlead) for term in factors(sqlead) repeat @@ -111138,18 +113056,23 @@ MultivariateSquareFree (E,OV,R,P) : C == T where lcoef ---- Construction of the polynomials for the lifting ---- + consnewpol : (SparseUnivariatePolynomial(P),SparseUnivariatePolynomial(R),_ + Integer) -> Record(pol: SparseUnivariatePolynomial(P),_ + polval: SparseUnivariatePolynomial(R)) consnewpol(g:SUP,g0:BP,deg:Z):Twopol == deg=1 => [g,g0]$Twopol deg:=deg-1 [normalDeriv(g,deg),normDeriv2(g0,deg)]$Twopol ---- lift the univariate square-free factor ---- + lift : (SparseUnivariatePolynomial(P),SparseUnivariatePolynomial(R),_ + SparseUnivariatePolynomial(R),P,List(OV),List(NonNegativeInteger),_ + List(R)) -> Union(List(SparseUnivariatePolynomial(P)),"failed") lift(ud:SUP,g0:BP,g1:BP,lcoef:P,lvar:List(OV), ldeg:List(NNI),lval:List(R)) : Union(List SUP,"failed") == leadpol:Boolean:=false lcd:P:=leadingCoefficient ud leadlist:List(P):=empty() - if ^ground?(leadingCoefficient ud) then leadpol:=true ud:=lcoef*ud @@ -111165,6 +113088,7 @@ MultivariateSquareFree (E,OV,R,P) : C == T where [primitivePart p0,primitivePart p1] ---- the polynomial is univariate ---- + univcase : (P,OV) -> Factored(P) univcase(f:P,x:OV) : Factored(P) == uf := univariate f cf:=content uf @@ -111174,12 +113098,16 @@ MultivariateSquareFree (E,OV,R,P) : C == T where [["sqfr",multivariate(term.factor,x),term.exponent] for term in factors result]) + compdegd : List(Record(factor: SparseUnivariatePolynomial(R),_ + exponent: Integer)) -> Integer compdegd(lfact:List(FFE)) : Z == ris:Z:=0 for pfact in lfact repeat ris:=ris+(pfact.exponent -1)*degree pfact.factor ris + normDeriv2 : (SparseUnivariatePolynomial(R),Integer) -> _ + SparseUnivariatePolynomial(R) normDeriv2(f:BP,m:Z) : BP == (n1:Z:=degree f) < m => 0$BP n1=m => (leadingCoefficient f)::BP @@ -111195,6 +113123,8 @@ MultivariateSquareFree (E,OV,R,P) : C == T where n:=degree f ris + myDegree : (SparseUnivariatePolynomial(P),List(OV),NonNegativeInteger) -> _ + List(NonNegativeInteger) myDegree(f:SUP,lvar:List OV,exp:NNI) : List NNI== [n quo exp for n in degree(f,lvar)] @@ -116693,6 +118623,7 @@ NagEigenPackage(): Exports == Implementation where import AnyFunctions1(DoubleFloat) + f02aaf : (Integer,Integer,Matrix(DoubleFloat),Integer) -> Result f02aaf(iaArg:Integer,nArg:Integer,aArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -116708,6 +118639,7 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02abf : (Matrix(DoubleFloat),Integer,Integer,Integer,Integer) -> Result f02abf(aArg:Matrix DoubleFloat,iaArg:Integer,nArg:Integer,_ ivArg:Integer,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -116725,6 +118657,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02adf : (Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f02adf(iaArg:Integer,ibArg:Integer,nArg:Integer,_ aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -116742,6 +118676,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02aef : (Integer,Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f02aef(iaArg:Integer,ibArg:Integer,nArg:Integer,_ ivArg:Integer,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -116764,6 +118700,7 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02aff : (Integer,Integer,Matrix(DoubleFloat),Integer) -> Result f02aff(iaArg:Integer,nArg:Integer,aArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -116780,6 +118717,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02agf : (Integer,Integer,Integer,Integer,Matrix(DoubleFloat),Integer) ->_ + Result f02agf(iaArg:Integer,nArg:Integer,ivrArg:Integer,_ iviArg:Integer,aArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -116800,6 +118739,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02ajf : (Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f02ajf(iarArg:Integer,iaiArg:Integer,nArg:Integer,_ arArg:Matrix DoubleFloat,aiArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -116820,6 +118761,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02akf : (Integer,Integer,Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f02akf(iarArg:Integer,iaiArg:Integer,nArg:Integer,_ ivrArg:Integer,iviArg:Integer,arArg:Matrix DoubleFloat,_ aiArg:Matrix DoubleFloat,ifailArg:Integer): Result == @@ -116842,6 +118785,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02awf : (Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f02awf(iarArg:Integer,iaiArg:Integer,nArg:Integer,_ arArg:Matrix DoubleFloat,aiArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -116864,6 +118809,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02axf : (Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),Integer,_ + Integer,Integer,Integer,Integer) -> Result f02axf(arArg:Matrix DoubleFloat,iarArg:Integer,aiArg:Matrix DoubleFloat,_ iaiArg:Integer,nArg:Integer,ivrArg:Integer,_ iviArg:Integer,ifailArg:Integer): Result == @@ -116887,6 +118834,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02bbf : (Integer,Integer,DoubleFloat,DoubleFloat,Integer,Integer,_ + Matrix(DoubleFloat),Integer) -> Result f02bbf(iaArg:Integer,nArg:Integer,albArg:DoubleFloat,_ ubArg:DoubleFloat,mArg:Integer,ivArg:Integer,_ aArg:Matrix DoubleFloat,ifailArg:Integer): Result == @@ -116912,6 +118861,8 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02bjf : (Integer,Integer,Integer,DoubleFloat,Boolean,Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result f02bjf(nArg:Integer,iaArg:Integer,ibArg:Integer,_ eps1Arg:DoubleFloat,matvArg:Boolean,ivArg:Integer,_ aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ @@ -116938,6 +118889,10 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02fjf : (Integer,Integer,DoubleFloat,Integer,Integer,Integer,Integer,_ + Integer,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp27(DOT)),_ + Union(fn: FileName,fp: Asp28(IMAGE))) -> Result f02fjf(nArg:Integer,kArg:Integer,tolArg:DoubleFloat,_ novecsArg:Integer,nrxArg:Integer,lworkArg:Integer,_ lrworkArg:Integer,liworkArg:Integer,mArg:Integer,_ @@ -116981,6 +118936,10 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02fjf : (Integer,Integer,DoubleFloat,Integer,Integer,Integer,Integer,_ + Integer,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp27(DOT)),_ + Union(fn: FileName,fp: Asp28(IMAGE)),FileName) -> Result f02fjf(nArg:Integer,kArg:Integer,tolArg:DoubleFloat,_ novecsArg:Integer,nrxArg:Integer,lworkArg:Integer,_ lrworkArg:Integer,liworkArg:Integer,mArg:Integer,_ @@ -117024,6 +118983,9 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02wef : (Integer,Integer,Integer,Integer,Integer,Boolean,Integer,_ + Boolean,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer) -> Result f02wef(mArg:Integer,nArg:Integer,ldaArg:Integer,_ ncolbArg:Integer,ldbArg:Integer,wantqArg:Boolean,_ ldqArg:Integer,wantpArg:Boolean,ldptArg:Integer,_ @@ -117049,7 +119011,6 @@ NagEigenPackage(): Exports == Implementation where max(mArg**2+5*(mArg - 1),2) zero? ncolbArg => max(2*(mArg - 1),1) max(3*(mArg - 1),1) - [(invokeNagman(NIL$Lisp,_ "f02wef",_ ["m"::S,"n"::S,"lda"::S,"ncolb"::S,"ldb"::S_ @@ -117073,6 +119034,9 @@ NagEigenPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f02xef : (Integer,Integer,Integer,Integer,Integer,Boolean,Integer,_ + Boolean,Integer,Matrix(Complex(DoubleFloat)),_ + Matrix(Complex(DoubleFloat)),Integer) -> Result f02xef(mArg:Integer,nArg:Integer,ldaArg:Integer,_ ncolbArg:Integer,ldbArg:Integer,wantqArg:Boolean,_ ldqArg:Integer,wantpArg:Boolean,ldphArg:Integer,_ @@ -126432,6 +128396,8 @@ NagFittingPackage(): Exports == Implementation where import AnyFunctions1(String) + e02adf : (Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result e02adf(mArg:Integer,kplus1Arg:Integer,nrowsArg:Integer,_ xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ wArg:Matrix DoubleFloat,_ @@ -126456,6 +128422,7 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02aef : (Integer,Matrix(DoubleFloat),DoubleFloat,Integer) -> Result e02aef(nplus1Arg:Integer,aArg:Matrix DoubleFloat,xcapArg:DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -126471,6 +128438,10 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02agf : (Integer,Integer,Integer,DoubleFloat,DoubleFloat,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,_ + Matrix(Integer),Integer,Integer,Integer) -> Result e02agf(mArg:Integer,kplus1Arg:Integer,nrowsArg:Integer,_ xminArg:DoubleFloat,xmaxArg:DoubleFloat,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,wArg:Matrix DoubleFloat,mfArg:Integer,_ @@ -126501,6 +128472,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02ahf : (Integer,DoubleFloat,DoubleFloat,Matrix(DoubleFloat),Integer,_ + Integer,Integer,Integer,Integer) -> Result e02ahf(np1Arg:Integer,xminArg:DoubleFloat,xmaxArg:DoubleFloat,_ aArg:Matrix DoubleFloat,ia1Arg:Integer,laArg:Integer,_ iadif1Arg:Integer,ladifArg:Integer,ifailArg:Integer): Result == @@ -126520,6 +128493,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02ajf : (Integer,DoubleFloat,DoubleFloat,Matrix(DoubleFloat),Integer,_ + Integer,DoubleFloat,Integer,Integer,Integer) -> Result e02ajf(np1Arg:Integer,xminArg:DoubleFloat,xmaxArg:DoubleFloat,_ aArg:Matrix DoubleFloat,ia1Arg:Integer,laArg:Integer,_ qatm1Arg:DoubleFloat,iaint1Arg:Integer,laintArg:Integer,_ @@ -126540,6 +128515,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02akf : (Integer,DoubleFloat,DoubleFloat,Matrix(DoubleFloat),Integer,_ + Integer,DoubleFloat,Integer) -> Result e02akf(np1Arg:Integer,xminArg:DoubleFloat,xmaxArg:DoubleFloat,_ aArg:Matrix DoubleFloat,ia1Arg:Integer,laArg:Integer,_ xArg:DoubleFloat,ifailArg:Integer): Result == @@ -126559,6 +128536,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02baf : (Integer,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result e02baf(mArg:Integer,ncap7Arg:Integer,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,wArg:Matrix DoubleFloat,_ lamdaArg:Matrix DoubleFloat,ifailArg:Integer): Result == @@ -126581,6 +128560,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02bbf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),DoubleFloat,_ + Integer) -> Result e02bbf(ncap7Arg:Integer,lamdaArg:Matrix DoubleFloat,_ cArg:Matrix DoubleFloat,xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -126596,6 +128577,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02bcf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),DoubleFloat,_ + Integer,Integer) -> Result e02bcf(ncap7Arg:Integer,lamdaArg:Matrix DoubleFloat,_ cArg:Matrix DoubleFloat,_ xArg:DoubleFloat,leftArg:Integer,ifailArg:Integer): Result == @@ -126615,6 +128598,7 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02bdf: (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result e02bdf(ncap7Arg:Integer,lamdaArg:Matrix DoubleFloat,_ cArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -126631,6 +128615,10 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02bef : (String,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,Integer,Integer,Integer,_ + Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),_ + Matrix(Integer)) -> Result e02bef(startArg:String,mArg:Integer,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,wArg:Matrix DoubleFloat,sArg:DoubleFloat,_ nestArg:Integer,lwrkArg:Integer,nArg:Integer,_ @@ -126658,6 +128646,10 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02daf : (Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(Integer),Integer,Integer,Integer,_ + DoubleFloat,Matrix(DoubleFloat),Integer) -> Result e02daf(mArg:Integer,pxArg:Integer,pyArg:Integer,_ xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ fArg:Matrix DoubleFloat,_ @@ -126689,6 +128681,11 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02dcf : (String,Integer,Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,Integer,Integer,Integer,_ + Integer,Integer,Matrix(DoubleFloat),Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(Integer),Integer) -> Result e02dcf(startArg:String,mxArg:Integer,xArg:Matrix DoubleFloat,_ myArg:Integer,yArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ sArg:DoubleFloat,nxestArg:Integer,nyestArg:Integer,_ @@ -126724,6 +128721,10 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02ddf : (String,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),DoubleFloat,Integer,_ + Integer,Integer,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result e02ddf(startArg:String,mArg:Integer,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ wArg:Matrix DoubleFloat,_ @@ -126759,6 +128760,9 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02def : (Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result e02def(mArg:Integer,pxArg:Integer,pyArg:Integer,_ xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ lamdaArg:Matrix DoubleFloat,_ @@ -126785,6 +128789,9 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02dff : (Integer,Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer,Integer,Integer) -> Result e02dff(mxArg:Integer,myArg:Integer,pxArg:Integer,_ pyArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ lamdaArg:Matrix DoubleFloat,muArg:Matrix DoubleFloat,_ @@ -126812,6 +128819,8 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02gaf : (Integer,Integer,Integer,DoubleFloat,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result e02gaf(mArg:Integer,laArg:Integer,nplus2Arg:Integer,_ tolerArg:DoubleFloat,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -126833,6 +128842,9 @@ NagFittingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e02zaf : (Integer,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,_ + Integer,Integer) -> Result e02zaf(pxArg:Integer,pyArg:Integer,lamdaArg:Matrix DoubleFloat,_ muArg:Matrix DoubleFloat,mArg:Integer,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,npointArg:Integer,nadresArg:Integer,_ @@ -132109,6 +134121,8 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where import AnyFunctions1(Matrix Integer) + f04adf : (Integer,Matrix(Complex(DoubleFloat)),Integer,Integer,Integer,_ + Integer,Matrix(Complex(DoubleFloat)),Integer) -> Result f04adf(iaArg:Integer,bArg:Matrix Complex DoubleFloat,ibArg:Integer,_ nArg:Integer,mArg:Integer,icArg:Integer,_ aArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == @@ -132129,6 +134143,8 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04arf : (Integer,Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),_ + Integer) -> Result f04arf(iaArg:Integer,bArg:Matrix DoubleFloat,nArg:Integer,_ aArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -132144,6 +134160,8 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04asf : (Integer,Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),_ + Integer) -> Result f04asf(iaArg:Integer,bArg:Matrix DoubleFloat,nArg:Integer,_ aArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -132161,6 +134179,8 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04atf : (Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),Integer,_ + Integer,Integer) -> Result f04atf(aArg:Matrix DoubleFloat,iaArg:Integer,bArg:Matrix DoubleFloat,_ nArg:Integer,iaaArg:Integer,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -132178,6 +134198,9 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where aArg::Any,bArg::Any])@List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04axf : (Integer,Matrix(DoubleFloat),Integer,Matrix(Integer),_ + Matrix(Integer),Integer,Matrix(Integer),Matrix(DoubleFloat)) ->_ + Result f04axf(nArg:Integer,aArg:Matrix DoubleFloat,licnArg:Integer,_ icnArg:Matrix Integer,ikeepArg:Matrix Integer,mtypeArg:Integer,_ idispArg:Matrix Integer,rhsArg:Matrix DoubleFloat): Result == @@ -132198,6 +134221,8 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04faf : (Integer,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f04faf(jobArg:Integer,nArg:Integer,dArg:Matrix DoubleFloat,_ eArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -132214,6 +134239,8 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04jgf : (Integer,Integer,Integer,DoubleFloat,Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result f04jgf(mArg:Integer,nArg:Integer,nraArg:Integer,_ tolArg:DoubleFloat,lworkArg:Integer,aArg:Matrix DoubleFloat,_ bArg:Matrix DoubleFloat,ifailArg:Integer): Result == @@ -132236,6 +134263,10 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04maf : (Integer,Integer,Matrix(DoubleFloat),Integer,Matrix(Integer),_ + Integer,Matrix(Integer),Matrix(DoubleFloat),Matrix(Integer),_ + Matrix(Integer),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(Integer),Integer) -> Result f04maf(nArg:Integer,nzArg:Integer,avalsArg:Matrix DoubleFloat,_ licnArg:Integer,irnArg:Matrix Integer,lirnArg:Integer,_ icnArg:Matrix Integer,wkeepArg:Matrix DoubleFloat,_ @@ -132264,14 +134295,18 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04mbf : (Integer,Matrix(DoubleFloat),Boolean,DoubleFloat,Integer,_ + Integer,Integer,Integer,DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp28(APROD)),_ + Union(fn: FileName,fp: Asp34(MSOLVE))) -> Result f04mbf(nArg:Integer,bArg:Matrix DoubleFloat,preconArg:Boolean,_ shiftArg:DoubleFloat,itnlimArg:Integer,msglvlArg:Integer,_ lrworkArg:Integer,liworkArg:Integer,rtolArg:DoubleFloat,_ ifailArg:Integer,aprodArg:Union(fn:FileName,fp:Asp28(APROD)),_ msolveArg:Union(fn:FileName,fp:Asp34(MSOLVE))): Result == --- if both asps are AXIOM generated we do not need lrwork liwork --- and will set to 1. --- else believe the user but check that they are >0. + -- if both asps are AXIOM generated we do not need lrwork liwork + -- and will set to 1. + -- else believe the user but check that they are >0. if (aprodArg case fp) and (msolveArg case fp) then lrworkArg:=1 @@ -132315,6 +134350,9 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04mcf : (Integer,Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),_ + Matrix(Integer),Integer,Matrix(DoubleFloat),Integer,Integer,_ + Integer,Integer) -> Result f04mcf(nArg:Integer,alArg:Matrix DoubleFloat,lalArg:Integer,_ dArg:Matrix DoubleFloat,nrowArg:Matrix Integer,irArg:Integer,_ bArg:Matrix DoubleFloat,nrbArg:Integer,iselctArg:Integer,_ @@ -132336,6 +134374,10 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where bArg::Any ])@List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f04qaf : (Integer,Integer,DoubleFloat,DoubleFloat,DoubleFloat,_ + DoubleFloat,Integer,Integer,Integer,Integer,_ + Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp30(APROD))) -> Result f04qaf(mArg:Integer,nArg:Integer,dampArg:DoubleFloat,_ atolArg:DoubleFloat,btolArg:DoubleFloat,conlimArg:DoubleFloat,_ itnlimArg:Integer,msglvlArg:Integer,lrworkArg:Integer,_ @@ -132518,13 +134560,10 @@ NAGLinkSupportPackage() : exports == implementation where (* package NAGSP *) (* - makeAs: (Symbol,Symbol) -> Symbol - changeVariables: (Expression Integer,Symbol) -> Expression Integer - changeVariablesF: (Expression Float,Symbol) -> Expression Float - import String import Symbol + checkPrecision : () -> Boolean checkPrecision():Boolean == (_$fortranPrecision$Lisp = "single"::Symbol) and _ (_$nagEnforceDouble$Lisp) => @@ -132535,6 +134574,7 @@ NAGLinkSupportPackage() : exports == implementation where true false + restorePrecision : () -> Void restorePrecision():Void == systemCommand("set fortran precision single")$MoreSystemCommands if _$nagMessages$Lisp then @@ -132545,20 +134585,26 @@ NAGLinkSupportPackage() : exports == implementation where counter : Integer := 0 + getUniqueId : () -> String getUniqueId():String == if uniqueId = "" then uniqueId := concat(getEnv("HOST")$Lisp,getEnv("SPADNUM")$Lisp) concat(uniqueId,string (counter:=counter+1)) + fortranCompilerName : () -> String fortranCompilerName() == string _$fortranCompilerName$Lisp + fortranLinkerArgs : () -> String fortranLinkerArgs() == string _$fortranLibraries$Lisp + aspFilename : String -> String aspFilename(f:String):String == concat ["/tmp/",f,getUniqueId(),".f"] + dimensionsOf : (Symbol,Matrix(DoubleFloat)) -> SExpression dimensionsOf(u:Symbol,m:Matrix DoubleFloat):SExpression == [u,nrows m,ncols m]$Lisp + dimensionsOf : (Symbol,Matrix(Integer)) -> SExpression dimensionsOf(u:Symbol,m:Matrix Integer):SExpression == [u,nrows m,ncols m]$Lisp @@ -136911,6 +138957,8 @@ NagIntegrationPackage(): Exports == Implementation where import AnyFunctions1(Matrix DoubleFloat) + d01ajf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,Integer,_ + Integer,Integer,Union(fn: FileName,fp: Asp1(F))) -> Result d01ajf(aArg:DoubleFloat,bArg:DoubleFloat,epsabsArg:DoubleFloat,_ epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_ ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == @@ -136936,6 +138984,8 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01akf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,Integer,_ + Integer,Integer,Union(fn: FileName,fp: Asp1(F))) -> Result d01akf(aArg:DoubleFloat,bArg:DoubleFloat,epsabsArg:DoubleFloat,_ epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_ ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == @@ -136961,6 +139011,9 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01alf : (DoubleFloat,DoubleFloat,Integer,Matrix(DoubleFloat),_ + DoubleFloat,DoubleFloat,Integer,Integer,Integer,_ + Union(fn: FileName,fp: Asp1(F))) -> Result d01alf(aArg:DoubleFloat,bArg:DoubleFloat,nptsArg:Integer,_ pointsArg:Matrix DoubleFloat,epsabsArg:DoubleFloat,_ epsrelArg:DoubleFloat,_ @@ -136989,6 +139042,8 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01amf : (DoubleFloat,Integer,DoubleFloat,DoubleFloat,Integer,Integer,_ + Integer,Union(fn: FileName,fp: Asp1(F))) -> Result d01amf(boundArg:DoubleFloat,infArg:Integer,epsabsArg:DoubleFloat,_ epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_ ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == @@ -137014,6 +139069,9 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01anf : (DoubleFloat,DoubleFloat,DoubleFloat,Integer,DoubleFloat,_ + DoubleFloat,Integer,Integer,Integer,_ + Union(fn: FileName,fp: Asp1(G))) -> Result d01anf(aArg:DoubleFloat,bArg:DoubleFloat,omegaArg:DoubleFloat,_ keyArg:Integer,epsabsArg:DoubleFloat,epsrelArg:DoubleFloat,_ lwArg:Integer,liwArg:Integer,ifailArg:Integer,_ @@ -137041,6 +139099,9 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01apf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,Integer,_ + DoubleFloat,DoubleFloat,Integer,Integer,Integer,_ + Union(fn: FileName,fp: Asp1(G))) -> Result d01apf(aArg:DoubleFloat,bArg:DoubleFloat,alfaArg:DoubleFloat,_ betaArg:DoubleFloat,keyArg:Integer,epsabsArg:DoubleFloat,_ epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_ @@ -137068,6 +139129,8 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01aqf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,_ + Integer,Integer,Integer,Union(fn: FileName,fp: Asp1(G))) -> Result d01aqf(aArg:DoubleFloat,bArg:DoubleFloat,cArg:DoubleFloat,_ epsabsArg:DoubleFloat,epsrelArg:DoubleFloat,lwArg:Integer,_ liwArg:Integer,ifailArg:Integer,_ @@ -137095,6 +139158,8 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01asf : (DoubleFloat,DoubleFloat,Integer,DoubleFloat,Integer,Integer,_ + Integer,Integer,Union(fn: FileName,fp: Asp1(G))) -> Result d01asf(aArg:DoubleFloat,omegaArg:DoubleFloat,keyArg:Integer,_ epsabsArg:DoubleFloat,limlstArg:Integer,lwArg:Integer,_ liwArg:Integer,ifailArg:Integer,_ @@ -137126,6 +139191,7 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01bbf: (DoubleFloat,DoubleFloat,Integer,Integer,Integer,Integer) -> Result d01bbf(aArg:DoubleFloat,bArg:DoubleFloat,itypeArg:Integer,_ nArg:Integer,gtypeArg:Integer,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -137144,6 +139210,9 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01fcf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,_ + DoubleFloat,Integer,Integer,Integer,_ + Union(fn: FileName,fp: Asp4(FUNCTN))) -> Result d01fcf(ndimArg:Integer,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ maxptsArg:Integer,epsArg:DoubleFloat,lenwrkArg:Integer,_ minptsArg:Integer,ifailArg:Integer,_ @@ -137171,6 +139240,7 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01gaf: (Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,Integer) -> Result d01gaf(xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,nArg:Integer,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -137186,6 +139256,9 @@ NagIntegrationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d01gbf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,_ + DoubleFloat,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp4(FUNCTN))) -> Result d01gbf(ndimArg:Integer,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_ maxclsArg:Integer,epsArg:DoubleFloat,lenwrkArg:Integer,_ minclsArg:Integer,wrkstrArg:Matrix DoubleFloat,ifailArg:Integer,_ @@ -140410,6 +142483,8 @@ NagInterpolationPackage(): Exports == Implementation where import AnyFunctions1(DoubleFloat) + e01baf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,_ + Integer,Integer) -> Result e01baf(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ lckArg:Integer,lwrkArg:Integer,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -140430,6 +142505,7 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01bef: (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result e01bef(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -140445,6 +142521,8 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01bff : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),Integer) -> Result e01bff(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ dArg:Matrix DoubleFloat,mArg:Integer,pxArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -140464,6 +142542,8 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01bgf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer,Matrix(DoubleFloat),Integer) -> Result e01bgf(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ dArg:Matrix DoubleFloat,mArg:Integer,pxArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -140483,6 +142563,8 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01bhf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,DoubleFloat,Integer) -> Result e01bhf(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ dArg:Matrix DoubleFloat,aArg:DoubleFloat,bArg:DoubleFloat,_ ifailArg:Integer): Result == @@ -140501,6 +142583,8 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01daf : (Integer,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result e01daf(mxArg:Integer,myArg:Integer,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -140527,6 +142611,8 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01saf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result e01saf(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ fArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -140544,6 +142630,9 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01sbf : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(Integer),Matrix(DoubleFloat),_ + DoubleFloat,DoubleFloat,Integer) -> Result e01sbf(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ fArg:Matrix DoubleFloat,triangArg:Matrix Integer,_ gradsArg:Matrix DoubleFloat,_ @@ -140566,6 +142655,9 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01sef : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer,Integer,DoubleFloat,DoubleFloat,_ + Integer) -> Result e01sef(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ fArg:Matrix DoubleFloat,nwArg:Integer,nqArg:Integer,_ rnwArg:DoubleFloat,rnqArg:DoubleFloat,ifailArg:Integer): Result == @@ -140588,6 +142680,9 @@ NagInterpolationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e01sff : (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,Matrix(DoubleFloat),_ + DoubleFloat,DoubleFloat,Integer) -> Result e01sff(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ fArg:Matrix DoubleFloat,rnwArg:DoubleFloat,_ fnodesArg:Matrix DoubleFloat,_ @@ -141841,7 +143936,7 @@ NagLapack(): Exports == Implementation where import AnyFunctions1(String) import AnyFunctions1(Matrix Integer) - + f07adf : (Integer,Integer,Integer,Matrix(DoubleFloat)) -> Result f07adf(mArg:Integer,nArg:Integer,ldaArg:Integer,_ aArg:Matrix DoubleFloat): Result == [(invokeNagman(NIL$Lisp,_ @@ -141858,6 +143953,8 @@ NagLapack(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f07aef : (String,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Matrix(Integer),Integer,Matrix(DoubleFloat)) -> Result f07aef(transArg:String,nArg:Integer,nrhsArg:Integer,_ aArg:Matrix DoubleFloat,ldaArg:Integer,ipivArg:Matrix Integer,_ ldbArg:Integer,bArg:Matrix DoubleFloat): Result == @@ -141878,6 +143975,7 @@ NagLapack(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f07fdf : (String,Integer,Integer,Matrix(DoubleFloat)) -> Result f07fdf(uploArg:String,nArg:Integer,ldaArg:Integer,_ aArg:Matrix DoubleFloat): Result == [(invokeNagman(NIL$Lisp,_ @@ -141894,6 +143992,8 @@ NagLapack(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f07fef : (String,Integer,Integer,Matrix(DoubleFloat),Integer,Integer,_ + Matrix(DoubleFloat)) -> Result f07fef(uploArg:String,nArg:Integer,nrhsArg:Integer,_ aArg:Matrix DoubleFloat,ldaArg:Integer,ldbArg:Integer,_ bArg:Matrix DoubleFloat): Result == @@ -146357,6 +148457,9 @@ NagMatrixOperationsPackage(): Exports == Implementation where import AnyFunctions1(Matrix Complex DoubleFloat) import AnyFunctions1(Matrix Integer) + f01brf : (Integer,Integer,Integer,Integer,DoubleFloat,Boolean,Boolean,_ + List(Boolean),Matrix(DoubleFloat),Matrix(Integer),_ + Matrix(Integer),Integer) -> Result f01brf(nArg:Integer,nzArg:Integer,licnArg:Integer,_ lirnArg:Integer,pivotArg:DoubleFloat,lblockArg:Boolean,_ growArg:Boolean,abortArg:List Boolean,aArg:Matrix DoubleFloat,_ @@ -146386,6 +148489,9 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01bsf : (Integer,Integer,Integer,Matrix(Integer),Matrix(Integer),_ + Matrix(Integer),Matrix(Integer),Boolean,DoubleFloat,Boolean,_ + Matrix(Integer),Matrix(DoubleFloat),Integer) -> Result f01bsf(nArg:Integer,nzArg:Integer,licnArg:Integer,_ ivectArg:Matrix Integer,jvectArg:Matrix Integer,icnArg:Matrix Integer,_ ikeepArg:Matrix Integer,growArg:Boolean,etaArg:DoubleFloat,_ @@ -146414,6 +148520,9 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01maf : (Integer,Integer,Integer,Integer,List(Boolean),_ + Matrix(DoubleFloat),Matrix(Integer),Matrix(Integer),_ + DoubleFloat,DoubleFloat,Integer) -> Result f01maf(nArg:Integer,nzArg:Integer,licnArg:Integer,_ lirnArg:Integer,abortArg:List Boolean,avalsArg:Matrix DoubleFloat,_ irnArg:Matrix Integer,icnArg:Matrix Integer,droptlArg:DoubleFloat,_ @@ -146442,6 +148551,8 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01mcf : (Integer,Matrix(DoubleFloat),Integer,Matrix(Integer),_ + Integer) -> Result f01mcf(nArg:Integer,avalsArg:Matrix DoubleFloat,lalArg:Integer,_ nrowArg:Matrix Integer,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -146458,6 +148569,7 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01qcf : (Integer,Integer,Integer,Matrix(DoubleFloat),Integer) -> Result f01qcf(mArg:Integer,nArg:Integer,ldaArg:Integer,_ aArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -146474,6 +148586,9 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01qdf : (String,String,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Matrix(DoubleFloat),Integer,Integer,Matrix(DoubleFloat),_ + Integer) -> Result f01qdf(transArg:String,wheretArg:String,mArg:Integer,_ nArg:Integer,aArg:Matrix DoubleFloat,ldaArg:Integer,_ zetaArg:Matrix DoubleFloat,ncolbArg:Integer,ldbArg:Integer,_ @@ -146496,6 +148611,8 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01qef : (String,Integer,Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result f01qef(wheretArg:String,mArg:Integer,nArg:Integer,_ ncolqArg:Integer,ldaArg:Integer,zetaArg:Matrix DoubleFloat,_ aArg:Matrix DoubleFloat,ifailArg:Integer): Result == @@ -146517,6 +148634,8 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01rcf : (Integer,Integer,Integer,Matrix(Complex(DoubleFloat)),Integer) ->_ + Result f01rcf(mArg:Integer,nArg:Integer,ldaArg:Integer,_ aArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -146531,6 +148650,9 @@ NagMatrixOperationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01rdf : (String,String,Integer,Integer,Matrix(Complex(DoubleFloat)),_ + Integer,Matrix(Complex(DoubleFloat)),Integer,Integer,_ + Matrix(Complex(DoubleFloat)),Integer) -> Result f01rdf(transArg:String,wheretArg:String,mArg:Integer,_ nArg:Integer,aArg:Matrix Complex DoubleFloat,ldaArg:Integer,_ thetaArg:Matrix Complex DoubleFloat,ncolbArg:Integer,ldbArg:Integer,_ @@ -146552,6 +148674,9 @@ NagMatrixOperationsPackage(): Exports == Implementation where thetaArg::Any,bArg::Any ])@List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + f01ref : (String,Integer,Integer,Integer,Integer,_ + Matrix(Complex(DoubleFloat)),Matrix(Complex(DoubleFloat)),_ + Integer) -> Result f01ref(wheretArg:String,mArg:Integer,nArg:Integer,_ ncolqArg:Integer,ldaArg:Integer,thetaArg:Matrix Complex DoubleFloat,_ aArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == @@ -156358,7 +158483,10 @@ NagOptimisationPackage(): Exports == Implementation where import AnyFunctions1(Matrix DoubleFloat) import AnyFunctions1(Matrix Integer) - + e04dgf : (Integer,DoubleFloat,DoubleFloat,Integer,DoubleFloat,Boolean,_ + DoubleFloat,DoubleFloat,Integer,Integer,Integer,Integer,_ + Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp49(OBJFUN))) -> Result e04dgf(nArg:Integer,esArg:DoubleFloat,fuArg:DoubleFloat,_ itArg:Integer,linArg:DoubleFloat,listArg:Boolean,_ maArg:DoubleFloat,opArg:DoubleFloat,prArg:Integer,_ @@ -156395,6 +158523,8 @@ NagOptimisationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04fdf : (Integer,Integer,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp50(LSFUN1))) -> Result e04fdf(mArg:Integer,nArg:Integer,liwArg:Integer,_ lwArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer,_ lsfun1Arg:Union(fn:FileName,fp:Asp50(LSFUN1))): Result == @@ -156419,6 +158549,8 @@ NagOptimisationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04gcf : (Integer,Integer,Integer,Integer,Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp19(LSFUN2))) -> Result e04gcf(mArg:Integer,nArg:Integer,liwArg:Integer,_ lwArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer,_ lsfun2Arg:Union(fn:FileName,fp:Asp19(LSFUN2))): Result == @@ -156442,6 +158574,9 @@ NagOptimisationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04jaf : (Integer,Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,_ + Union(fn: FileName,fp: Asp24(FUNCT1))) -> Result e04jaf(nArg:Integer,iboundArg:Integer,liwArg:Integer,_ lwArg:Integer,blArg:Matrix DoubleFloat,buArg:Matrix DoubleFloat,_ xArg:Matrix DoubleFloat,ifailArg:Integer,_ @@ -156469,6 +158604,10 @@ NagOptimisationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04mbf : (Integer,Integer,Integer,Integer,Integer,Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Boolean,Integer,Integer,_ + Matrix(DoubleFloat),Integer) -> Result e04mbf(itmaxArg:Integer,msglvlArg:Integer,nArg:Integer,_ nclinArg:Integer,nctotlArg:Integer,nrowaArg:Integer,_ aArg:Matrix DoubleFloat,blArg:Matrix DoubleFloat,_ @@ -156499,6 +158638,12 @@ NagOptimisationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04naf : (Integer,Integer,Integer,Integer,Integer,Integer,Integer,_ + Integer,DoubleFloat,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Boolean,Boolean,Boolean,Integer,Integer,_ + Matrix(DoubleFloat),Matrix(Integer),Integer,_ + Union(fn: FileName,fp: Asp20(QPHESS))) -> Result e04naf(itmaxArg:Integer,msglvlArg:Integer,nArg:Integer,_ nclinArg:Integer,nctotlArg:Integer,nrowaArg:Integer,_ nrowhArg:Integer,ncolhArg:Integer,bigbndArg:DoubleFloat,_ @@ -156548,6 +158693,16 @@ NagOptimisationPackage(): Exports == Implementation where istateArg::Any ])@List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04ucf : (Integer,Integer,Integer,Integer,Integer,Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer,Integer,Boolean,DoubleFloat,Integer,DoubleFloat,_ + DoubleFloat,Boolean,DoubleFloat,DoubleFloat,DoubleFloat,_ + DoubleFloat,Boolean,Integer,Integer,Integer,Integer,Integer,_ + DoubleFloat,DoubleFloat,DoubleFloat,Integer,Integer,Integer,_ + Integer,Integer,Matrix(Integer),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer,Union(fn: FileName,fp: Asp55(CONFUN)),_ + Union(fn: FileName,fp: Asp49(OBJFUN))) -> Result e04ucf(nArg:Integer,nclinArg:Integer,ncnlnArg:Integer,_ nrowaArg:Integer,nrowjArg:Integer,nrowrArg:Integer,_ aArg:Matrix DoubleFloat,blArg:Matrix DoubleFloat,_ @@ -156625,6 +158780,8 @@ NagOptimisationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + e04ycf : (Integer,Integer,Integer,DoubleFloat,Matrix(DoubleFloat),_ + Integer,Matrix(DoubleFloat),Integer) -> Result e04ycf(jobArg:Integer,mArg:Integer,nArg:Integer,_ fsumsqArg:DoubleFloat,sArg:Matrix DoubleFloat,lvArg:Integer,_ vArg:Matrix DoubleFloat,ifailArg:Integer): Result == @@ -161700,7 +163857,10 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where import AnyFunctions1(String) import AnyFunctions1(Matrix DoubleFloat) - + d02bbf : (DoubleFloat,Integer,Integer,Integer,DoubleFloat,_ + Matrix(DoubleFloat),DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp7(FCN)),_ + Union(fn: FileName,fp: Asp8(OUTPUT))) -> Result d02bbf(xendArg:DoubleFloat,mArg:Integer,nArg:Integer,_ irelabArg:Integer,xArg:DoubleFloat,yArg:Matrix DoubleFloat,_ tolArg:DoubleFloat,ifailArg:Integer,_ @@ -161731,6 +163891,10 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02bhf : (DoubleFloat,Integer,Integer,DoubleFloat,DoubleFloat,_ + Matrix(DoubleFloat),DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp9(G)),_ + Union(fn: FileName,fp: Asp7(FCN))) -> Result d02bhf(xendArg:DoubleFloat,nArg:Integer,irelabArg:Integer,_ hmaxArg:DoubleFloat,xArg:DoubleFloat,yArg:Matrix DoubleFloat,_ tolArg:DoubleFloat,ifailArg:Integer,_ @@ -161760,6 +163924,10 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02cjf : (DoubleFloat,Integer,Integer,DoubleFloat,String,DoubleFloat,_ + Matrix(DoubleFloat),Integer,Union(fn: FileName,fp: Asp9(G)),_ + Union(fn: FileName,fp: Asp7(FCN)),_ + Union(fn: FileName,fp: Asp8(OUTPUT))) -> Result d02cjf(xendArg:DoubleFloat,mArg:Integer,nArg:Integer,_ tolArg:DoubleFloat,relabsArg:String,xArg:DoubleFloat,_ yArg:Matrix DoubleFloat,ifailArg:Integer,_ @@ -161799,6 +163967,12 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02ejf : (DoubleFloat,Integer,Integer,String,Integer,DoubleFloat,_ + Matrix(DoubleFloat),DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp9(G)),_ + Union(fn: FileName,fp: Asp7(FCN)),_ + Union(fn: FileName,fp: Asp31(PEDERV)),_ + Union(fn: FileName,fp: Asp8(OUTPUT))) -> Result d02ejf(xendArg:DoubleFloat,mArg:Integer,nArg:Integer,_ relabsArg:String,iwArg:Integer,xArg:DoubleFloat,_ yArg:Matrix DoubleFloat,tolArg:DoubleFloat,ifailArg:Integer,_ @@ -161846,6 +164020,10 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02gaf : (Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,DoubleFloat,_ + DoubleFloat,DoubleFloat,Integer,Integer,Integer,_ + Matrix(DoubleFloat),Integer,Integer,_ + Union(fn: FileName,fp: Asp7(FCN))) -> Result d02gaf(uArg:Matrix DoubleFloat,vArg:Matrix DoubleFloat,nArg:Integer,_ aArg:DoubleFloat,bArg:DoubleFloat,tolArg:DoubleFloat,_ mnpArg:Integer,lwArg:Integer,liwArg:Integer,_ @@ -161877,6 +164055,11 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02gbf : (DoubleFloat,DoubleFloat,Integer,DoubleFloat,Integer,Integer,_ + Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer,Integer,_ + Union(fn: FileName,fp: Asp77(FCNF)),_ + Union(fn: FileName,fp: Asp78(FCNG))) -> Result d02gbf(aArg:DoubleFloat,bArg:DoubleFloat,nArg:Integer,_ tolArg:DoubleFloat,mnpArg:Integer,lwArg:Integer,_ liwArg:Integer,cArg:Matrix DoubleFloat,dArg:Matrix DoubleFloat,_ @@ -161914,6 +164097,10 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02kef : (Matrix(DoubleFloat),Integer,Integer,DoubleFloat,Integer,_ + Integer,DoubleFloat,DoubleFloat,Matrix(DoubleFloat),Integer,_ + Integer,Union(fn: FileName,fp: Asp10(COEFFN)),_ + Union(fn: FileName,fp: Asp80(BDYVAL))) -> Result d02kef(xpointArg:Matrix DoubleFloat,mArg:Integer,kArg:Integer,_ tolArg:DoubleFloat,maxfunArg:Integer,matchArg:Integer,_ elamArg:DoubleFloat,delamArg:DoubleFloat,hmaxArg:Matrix DoubleFloat,_ @@ -161957,6 +164144,10 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02kef : (Matrix(DoubleFloat),Integer,Integer,DoubleFloat,Integer,_ + Integer,DoubleFloat,DoubleFloat,Matrix(DoubleFloat),Integer,_ + Integer,Union(fn: FileName,fp: Asp10(COEFFN)),_ + Union(fn: FileName,fp: Asp80(BDYVAL)),FileName,FileName) -> Result d02kef(xpointArg:Matrix DoubleFloat,mArg:Integer,kArg:Integer,_ tolArg:DoubleFloat,maxfunArg:Integer,matchArg:Integer,_ elamArg:DoubleFloat,delamArg:DoubleFloat,hmaxArg:Matrix DoubleFloat,_ @@ -162001,6 +164192,11 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d02raf : (Integer,Integer,Integer,Integer,DoubleFloat,Integer,Integer,_ + Integer,Integer,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp41(FCN,JACOBF,JACEPS)),_ + Union(fn: FileName,fp: Asp42(G,JACOBG,JACGEP))) -> Result d02raf(nArg:Integer,mnpArg:Integer,numbegArg:Integer,_ nummixArg:Integer,tolArg:DoubleFloat,initArg:Integer,_ iyArg:Integer,ijacArg:Integer,lworkArg:Integer,_ @@ -164057,6 +166253,9 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where import Union(fn:FileName,fp:Asp73(PDEF)) import Union(fn:FileName,fp:Asp74(BNDY)) + d03edf : (Integer,Integer,Integer,Integer,DoubleFloat,Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer) -> Result d03edf(ngxArg:Integer,ngyArg:Integer,ldaArg:Integer,_ maxitArg:Integer,accArg:DoubleFloat,ioutArg:Integer,_ aArg:Matrix DoubleFloat,rhsArg:Matrix DoubleFloat,_ @@ -164080,6 +166279,10 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d03eef : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,Integer,_ + Integer,Integer,String,Integer,_ + Union(fn: FileName,fp: Asp73(PDEF)),_ + Union(fn: FileName,fp: Asp74(BNDY))) -> Result d03eef(xminArg:DoubleFloat,xmaxArg:DoubleFloat,yminArg:DoubleFloat,_ ymaxArg:DoubleFloat,ngxArg:Integer,ngyArg:Integer,_ ldaArg:Integer,schemeArg:String,ifailArg:Integer,_ @@ -164112,6 +166315,12 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + d03faf : (DoubleFloat,DoubleFloat,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,DoubleFloat,Integer,Integer,_ + Matrix(DoubleFloat),Matrix(DoubleFloat),DoubleFloat,_ + DoubleFloat,Integer,Integer,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),DoubleFloat,Integer,Integer,Integer,_ + ThreeDimensionalMatrix(DoubleFloat),Integer) -> Result d03faf(xsArg:DoubleFloat,xfArg:DoubleFloat,lArg:Integer,_ lbdcndArg:Integer,bdxsArg:Matrix DoubleFloat,_ bdxfArg:Matrix DoubleFloat,_ @@ -165072,6 +167281,7 @@ NagPolynomialRootsPackage(): Exports == Implementation where import AnyFunctions1(Integer) import AnyFunctions1(Boolean) + c02aff : (Matrix(DoubleFloat),Integer,Boolean,Integer) -> Result c02aff(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -165089,6 +167299,7 @@ NagPolynomialRootsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c02agf : (Matrix(DoubleFloat),Integer,Boolean,Integer) -> Result c02agf(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -166335,6 +168546,8 @@ NagRootFindingPackage(): Exports == Implementation where import AnyFunctions1(Matrix DoubleFloat) import AnyFunctions1(Integer) + c05adf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp1(F))) -> Result c05adf(aArg:DoubleFloat,bArg:DoubleFloat,epsArg:DoubleFloat,_ etaArg:DoubleFloat,ifailArg:Integer,_ fArg:Union(fn:FileName,fp:Asp1(F))): Result == @@ -166357,6 +168570,8 @@ NagRootFindingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c05nbf : (Integer,Integer,Matrix(DoubleFloat),DoubleFloat,Integer,_ + Union(fn: FileName,fp: Asp6(FCN))) -> Result c05nbf(nArg:Integer,lwaArg:Integer,xArg:Matrix DoubleFloat,_ xtolArg:DoubleFloat,ifailArg:Integer,_ fcnArg:Union(fn:FileName,fp:Asp6(FCN))): Result == @@ -166379,6 +168594,8 @@ NagRootFindingPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c05pbf : (Integer,Integer,Integer,Matrix(DoubleFloat),DoubleFloat,_ + Integer,Union(fn: FileName,fp: Asp35(FCN))) -> Result c05pbf(nArg:Integer,ldfjacArg:Integer,lwaArg:Integer,_ xArg:Matrix DoubleFloat,xtolArg:DoubleFloat,ifailArg:Integer,_ fcnArg:Union(fn:FileName,fp:Asp35(FCN))): Result == @@ -169820,6 +172037,7 @@ NagSeriesSummationPackage(): Exports == Implementation where import AnyFunctions1(String) import AnyFunctions1(Matrix DoubleFloat) + c06eaf : (Integer,Matrix(DoubleFloat),Integer) -> Result c06eaf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "c06eaf",_ @@ -169833,7 +172051,7 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result - + c06ebf : (Integer,Matrix(DoubleFloat),Integer) -> Result c06ebf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "c06ebf",_ @@ -169847,6 +172065,7 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06ecf: (Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result c06ecf(nArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -169862,6 +172081,8 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06ekf : (Integer,Integer,Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer) -> Result c06ekf(jobArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ yArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -169877,6 +172098,8 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06fpf : (Integer,Integer,String,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result c06fpf(mArg:Integer,nArg:Integer,initArg:String,_ xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -169896,6 +172119,8 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06fqf : (Integer,Integer,String,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Integer) -> Result c06fqf(mArg:Integer,nArg:Integer,initArg:String,_ xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == @@ -169915,6 +172140,8 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06frf : (Integer,Integer,String,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Integer) -> Result c06frf(mArg:Integer,nArg:Integer,initArg:String,_ xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ trigArg:Matrix DoubleFloat,_ @@ -169936,6 +172163,9 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06fuf : (Integer,Integer,String,Matrix(DoubleFloat),_ + Matrix(DoubleFloat),Matrix(DoubleFloat),Matrix(DoubleFloat),_ + Integer) -> Result c06fuf(mArg:Integer,nArg:Integer,initArg:String,_ xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ trigmArg:Matrix DoubleFloat,_ @@ -169960,6 +172190,7 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06gbf : (Integer,Matrix(DoubleFloat),Integer) -> Result c06gbf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "c06gbf",_ @@ -169973,6 +172204,7 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06gcf : (Integer,Matrix(DoubleFloat),Integer) -> Result c06gcf(nArg:Integer,yArg:Matrix DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "c06gcf",_ @@ -169986,6 +172218,7 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06gqf : (Integer,Integer,Matrix(DoubleFloat),Integer) -> Result c06gqf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -170001,6 +172234,7 @@ NagSeriesSummationPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + c06gsf : (Integer,Integer,Matrix(DoubleFloat),Integer) -> Result c06gsf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178387,6 +180621,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where import AnyFunctions1(DoubleFloat) import AnyFunctions1(String) + s01eaf : (Complex(DoubleFloat),Integer) -> Result s01eaf(zArg:Complex DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s01eaf",_ @@ -178400,6 +180635,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s13aaf : (DoubleFloat,Integer) -> Result s13aaf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s13aaf",_ @@ -178413,6 +180649,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s13acf : (DoubleFloat,Integer) -> Result s13acf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s13acf",_ @@ -178426,6 +180663,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s13adf : (DoubleFloat,Integer) -> Result s13adf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s13adf",_ @@ -178439,6 +180677,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s14aaf : (DoubleFloat,Integer) -> Result s14aaf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s14aaf",_ @@ -178452,6 +180691,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s14abf : (DoubleFloat,Integer) -> Result s14abf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s14abf",_ @@ -178465,6 +180705,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s14baf : (DoubleFloat,DoubleFloat,DoubleFloat,Integer) -> Result s14baf(aArg:DoubleFloat,xArg:DoubleFloat,tolArg:DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178481,6 +180722,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s15adf : (DoubleFloat,Integer) -> Result s15adf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s15adf",_ @@ -178494,6 +180736,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s15aef : (DoubleFloat,Integer) -> Result s15aef(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s15aef",_ @@ -178507,6 +180750,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17acf : (DoubleFloat,Integer) -> Result s17acf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17acf",_ @@ -178520,6 +180764,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17adf : (DoubleFloat,Integer) -> Result s17adf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17adf",_ @@ -178533,6 +180778,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17aef : (DoubleFloat,Integer) -> Result s17aef(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17aef",_ @@ -178546,6 +180792,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17aff : (DoubleFloat,Integer) -> Result s17aff(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17aff",_ @@ -178559,6 +180806,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17agf : (DoubleFloat,Integer) -> Result s17agf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17agf",_ @@ -178572,6 +180820,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17ahf : (DoubleFloat,Integer) -> Result s17ahf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17ahf",_ @@ -178585,6 +180834,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17ajf : (DoubleFloat,Integer) -> Result s17ajf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17ajf",_ @@ -178598,6 +180848,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17akf : (DoubleFloat,Integer) -> Result s17akf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s17akf",_ @@ -178612,6 +180863,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where pretend List (Record(key:Symbol,entry:Any))]$Result + s17dcf: (DoubleFloat,Complex(DoubleFloat),Integer,String,Integer) -> Result s17dcf(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_ scaleArg:String,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178630,6 +180882,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17def: (DoubleFloat,Complex(DoubleFloat),Integer,String,Integer) -> Result s17def(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_ scaleArg:String,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178647,6 +180900,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17dgf : (String,Complex(DoubleFloat),String,Integer) -> Result s17dgf(derivArg:String,zArg:Complex DoubleFloat,scaleArg:String,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178663,6 +180917,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17dhf : (String,Complex(DoubleFloat),String,Integer) -> Result s17dhf(derivArg:String,zArg:Complex DoubleFloat,scaleArg:String,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178679,6 +180934,8 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s17dlf : (Integer,DoubleFloat,Complex(DoubleFloat),Integer,String,_ + Integer) -> Result s17dlf(mArg:Integer,fnuArg:DoubleFloat,zArg:Complex DoubleFloat,_ nArg:Integer,scaleArg:String,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178698,6 +180955,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s18acf : (DoubleFloat,Integer) -> Result s18acf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s18acf",_ @@ -178711,6 +180969,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s18adf : (DoubleFloat,Integer) -> Result s18adf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s18adf",_ @@ -178724,6 +180983,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s18aef : (DoubleFloat,Integer) -> Result s18aef(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s18aef",_ @@ -178737,6 +180997,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s18aff : (DoubleFloat,Integer) -> Result s18aff(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s18aff",_ @@ -178750,6 +181011,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s18dcf: (DoubleFloat,Complex(DoubleFloat),Integer,String,Integer) -> Result s18dcf(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_ scaleArg:String,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178767,6 +181029,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s18def: (DoubleFloat,Complex(DoubleFloat),Integer,String,Integer) -> Result s18def(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_ scaleArg:String,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178784,6 +181047,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s19aaf : (DoubleFloat,Integer) -> Result s19aaf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s19aaf",_ @@ -178797,6 +181061,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s19abf : (DoubleFloat,Integer) -> Result s19abf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s19abf",_ @@ -178810,6 +181075,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s19acf : (DoubleFloat,Integer) -> Result s19acf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s19acf",_ @@ -178823,6 +181089,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s19adf : (DoubleFloat,Integer) -> Result s19adf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s19adf",_ @@ -178836,6 +181103,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s20acf : (DoubleFloat,Integer) -> Result s20acf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s20acf",_ @@ -178849,6 +181117,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s20adf : (DoubleFloat,Integer) -> Result s20adf(xArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s20adf",_ @@ -178862,6 +181131,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s21baf : (DoubleFloat,DoubleFloat,Integer) -> Result s21baf(xArg:DoubleFloat,yArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ "s21baf",_ @@ -178876,6 +181146,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s21bbf : (DoubleFloat,DoubleFloat,DoubleFloat,Integer) -> Result s21bbf(xArg:DoubleFloat,yArg:DoubleFloat,zArg:DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178891,6 +181162,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s21bcf : (DoubleFloat,DoubleFloat,DoubleFloat,Integer) -> Result s21bcf(xArg:DoubleFloat,yArg:DoubleFloat,zArg:DoubleFloat,_ ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -178906,6 +181178,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where @List Any]$Lisp)$Lisp)_ pretend List (Record(key:Symbol,entry:Any))]$Result + s21bdf: (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,Integer) -> Result s21bdf(xArg:DoubleFloat,yArg:DoubleFloat,zArg:DoubleFloat,_ rArg:DoubleFloat,ifailArg:Integer): Result == [(invokeNagman(NIL$Lisp,_ @@ -179004,6 +181277,8 @@ NewSparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with (* package NSUP2 *) (* + map : ((R -> S),NewSparseUnivariatePolynomial(R)) -> _ + NewSparseUnivariatePolynomial(S) map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R, NewSparseUnivariatePolynomial R, S, NewSparseUnivariatePolynomial S) @@ -179109,12 +181384,14 @@ NewtonInterpolation F: Exports == Implementation where (* package NEWTON *) (* + differences : List F -> List F differences(yl: List F): List F == [y2-y1 for y1 in yl for y2 in rest yl] z: SparseUnivariatePolynomial(F) := monomial(1,1) -- we assume x=[1,2,3,...,n] + newtonAux : (F,F,List F) -> SparseUnivariatePolynomial(F) newtonAux(k: F, fact: F, yl: List F): SparseUnivariatePolynomial(F) == if empty? rest yl then ((yl.1) exquo fact)::F::SparseUnivariatePolynomial(F) @@ -179123,6 +181400,7 @@ NewtonInterpolation F: Exports == Implementation where * newtonAux(k+1$F, fact*k, differences yl) + newton : List(F) -> SparseUnivariatePolynomial(F) newton yl == newtonAux(1$F, 1$F, yl) *) @@ -179400,6 +181678,9 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where (* package NPOLYGON *) (* + slope : (PolyRing,PolyRing) -> _ + Record(height: Integer,base: Integer,quotient: Integer,_ + reste: Integer,type: Union(left,center,right,vertical,horizontal)) slope(p1,p2)== -- calcule la pente de p1 a p2 et change le signe. e1:=degree p1 @@ -179430,7 +181711,6 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where restPANE oneToNeg: List List PolyRing -> List List PolyRing - oneToNeg(lpol)== fedge:= first lpol sl:= slope fedge @@ -179444,6 +181724,7 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where ( sl2.height < sl2.base ) => [ fedge , fedge2 ] restPANE + negAndPosEdge : (PolyRing,List(List(PolyRing))) -> List(List(PolyRing)) negAndPosEdge(pol, lpol)== -- cette fonction retourne deux liste de polynomes: -- la premiere est liee a @@ -179456,12 +181737,7 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where degree( pol , 2 )$PackPoly < degree( pol, 1 )$PackPoly => oneToPos lpol oneToNeg lpol - localNewtonPolygon: List PolyRing -> List PolyRing - - slEq: (recSlope, recSlope) -> Boolean - - regroup: List PolyRing -> List List PolyRing - + multiplicity : List(List(PolyRing)) -> NonNegativeInteger multiplicity( lpol )== nl:=#(lpol) flpol:= first lpol @@ -179470,9 +181746,11 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where s.height < s.base => totalDegree( first flpol )$PackPoly multiplicity( rest lpol ) + slEq: (recSlope, recSlope) -> Boolean slEq(s1,s2)== s1.height * s2.base = s2.height * s1.base + regroup: List PolyRing -> List List PolyRing regroup(lpol)== -- Note : les elements de lpol sont sur la frontiere d'un poly. -- de Newton et il sont deja trie's. @@ -179508,14 +181786,14 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where properSlope: ( List PolyRing, Integer, Integer, _ Union("left","center","right","vertical","horizontal")) -> Boolean - properSlope(lpol,hgt,bs, tp)== s:=slope lpol tp case "left" and s.height = hgt and s.base = bs => true tp case "right" and s.height = bs and s.base = hgt => true false - + newtonPolygon : (PolyRing,Integer,Integer,_ + Union(left,center,right,vertical,horizontal)) -> List(List(PolyRing)) newtonPolygon(pol,hgt,bs,tp)== ans:=regroup localNewtonPolygon _ sort( sortMono(#1,#2) , monomials(pol)$PackPoly) @@ -179537,6 +181815,9 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where rs.height < 0 => [p2,p1] -- p2 est plus haut que p1 [p2] -- p2 est a la meme hauteur que p1. + slope : List(PolyRing) -> _ + Record(height: Integer,base: Integer,quotient: Integer,_ + reste: Integer,type: Union(left,center,right,vertical,horizontal)) slope(lpol) == ^one?(#lpol) => slope( first lpol, second lpol) f:= first lpol @@ -179565,6 +181846,7 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where ^convex?(lt , st , lpol.2) => cons(lt, lpol) consBondary( lt, rest lpol ) + localNewtonPolygon: List PolyRing -> List PolyRing localNewtonPolygon(lpol)== -- lpol doit etre trie' par sortMono empty? lpol => empty() @@ -179741,6 +182023,7 @@ NonCommutativeOperatorDivision(P, F): PDcat == PDdef where (* package NCODIV *) (* + leftDivide : (P,P) -> Record(quotient: P,remainder: P) leftDivide(a, b) == q: P := 0 r: P := a @@ -179753,15 +182036,19 @@ NonCommutativeOperatorDivision(P, F): PDcat == PDdef where [q,r] -- leftQuotient(a,b) is the quotient from left division, etc. + leftQuotient : (P,P) -> P leftQuotient(a,b) == leftDivide(a,b).quotient - leftRemainder(a,b) == leftDivide(a,b).remainder + leftRemainder : (P,P) -> P + leftRemainder(a,b) == leftDivide(a,b).remainder + leftExactQuotient : (P,P) -> Union(P,"failed") leftExactQuotient(a,b) == qr := leftDivide(a,b) if qr.remainder = 0 then qr.quotient else "failed" -- l = leftGcd(a,b) means a = aa*l b = bb*l. Uses leftDivide. + leftGcd : (P,P) -> P leftGcd(a,b) == a = 0 =>b b = 0 =>a @@ -179769,6 +182056,7 @@ NonCommutativeOperatorDivision(P, F): PDcat == PDdef where if b=0 then a else b -- l = leftLcm(a,b) means l = a*aa l = b*bb Uses leftDivide. + leftLcm : (P,P) -> P leftLcm(a,b) == a = 0 =>b b = 0 =>a @@ -179859,6 +182147,7 @@ NoneFunctions1(S:Type): Exports == Implementation where (* package NONE1 *) (* + coerce : S -> None coerce(s:S):None == s pretend None *) @@ -180076,17 +182365,11 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where import ODEIntegration(R, F) import ElementaryFunctionODESolver(R, F) -- recursive dependency! - checkBernoulli : (F, F, K) -> Union(BER, "failed") - solveBernoulli : (BER, OP, SY, F) -> Union(F, "failed") - checkRiccati : (F, F, K) -> Union(List F, "failed") - solveRiccati : (List F, OP, SY, F) -> Union(F, "failed") - partSolRiccati : (List F, OP, SY, F) -> Union(F, "failed") - integratingFactor: (F, F, SY, SY) -> U - unk := new()$SY kunk:K := kernel unk + solve : (F,F,BasicOperator,Symbol) -> Union(F,"failed") solve(m, n, y, x) == -- first replace the operator y(x) by a new symbol z in m(x,y) and n(x,y) lk:List(K) := [retract(yx := y(x::F))@K] @@ -180112,6 +182395,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where "failed" -- look for an integrating factor + integratingFactor: (F, F, SY, SY) -> U integratingFactor(m, n, y, x) == -- check first for exactness zero?(d := differentiate(m, y) - differentiate(n, x)) => 1 @@ -180126,6 +182410,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where -- dy/dx + p(x)y + q(x)y^N = 0 with N > 1 -- i.e. whether m/n is of the form p(x) y + q(x) y^N -- returns [p, q, N] if the equation is in that form + checkBernoulli : (F, F, K) -> Union(BER, "failed") checkBernoulli(m, n, ky) == r := denom(f := m / n)::F (not freeOf?(r, y := ky::F)) @@ -180138,6 +182423,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where -- solves the equation dy/dx + rec.coef1 y + rec.coefn y^rec.exponent = 0 -- the change of variable v = y^{1-n} transforms the above equation to -- dv/dx + (1 - n) p v + (1 - n) q = 0 + solveBernoulli : (BER, OP, SY, F) -> Union(F, "failed") solveBernoulli(rec, y, x, yx) == n1 := 1 - rec.exponent::Integer deq := differentiate(yx, x) + n1 * rec.coef1 * yx + n1 * rec.coefn @@ -180151,6 +182437,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where -- dy/dx + q0(x) + q1(x)y + q2(x)y^2 = 0 -- i.e. whether m/n is a quadratic polynomial in y. -- returns the list [q0, q1, q2] if the equation is in that form + checkRiccati : (F, F, K) -> Union(List F, "failed") checkRiccati(m, n, ky) == q := denom(f := m / n)::F (not freeOf?(q, y := ky::F)) or degree(p := univariate(numer f, ky)) > 2 @@ -180160,6 +182447,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where [a0 / q, a1 / q, a2 / q] -- solves the equation dy/dx + l.1 + l.2 y + l.3 y^2 = 0 + solveRiccati : (List F, OP, SY, F) -> Union(F, "failed") solveRiccati(l, y, x, yx) == -- get first a particular solution (u := partSolRiccati(l, y, x, yx)) case "failed" => "failed" @@ -180174,6 +182462,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where (inv(yx - u::F) - gsol.particular) / first(gsol.basis) -- looks for a particular solution of dy/dx + l.1 + l.2 y + l.3 y^2 = 0 + partSolRiccati : (List F, OP, SY, F) -> Union(F, "failed") partSolRiccati(l, y, x, yx) == -- we first do the change of variable y = z / l.3, which transforms -- the equation into dz/dx + l.1 l.3 + (l.2 - l.3'/l.3) z + z^2 = 0 @@ -180362,33 +182651,37 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where (* package NLINSOL *) (* + solveInField : List(Polynomial(R)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solveInField l == solveInField(l, "setUnion"/[variables p for p in l]) if R has AlgebraicallyClosedField then import RationalFunction(R) - expandSol: List EQ -> List List EQ - RIfCan : F -> Union(R, "failed") - addRoot : (EQ, List List EQ) -> List List EQ - allRoots : List P -> List List EQ - evalSol : (List EQ, List EQ) -> List EQ - - solve l == solve(l, "setUnion"/[variables p for p in l]) + solve : List(Polynomial(R)) -> + + List(List(Equation(Fraction(Polynomial(R))))) + solve l == solve(l, "setUnion"/[variables p for p in l]) + solve : (List(Polynomial(R)),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solve(lp, lv) == concat([expandSol sol for sol in solveInField(lp, lv)]) + addRoot : (EQ, List List EQ) -> List List EQ addRoot(eq, l) == [concat(eq, sol) for sol in l] + evalSol : (List EQ, List EQ) -> List EQ evalSol(ls, l) == [equation(lhs eq, eval(rhs eq, l)) for eq in ls] -- converts [p1(a1),...,pn(an)] to -- [[a1=v1,...,an=vn]] where vi ranges over all the zeros of pi + allRoots : List P -> List List EQ allRoots l == empty? l => [empty()$List(EQ)] z := allRoots rest l s := mainVariable(p := first l)::SY::P::F concat [addRoot(equation(s, a::P::F), z) for a in zerosOf univariate p] + expandSol: List EQ -> List List EQ expandSol l == lassign := lsubs := empty()$List(EQ) luniv := empty()$List(P) @@ -180404,6 +182697,7 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where empty? luniv => [l] [concat(z, concat(evalSol(lsubs,z), lassign)) for z in allRoots luniv] + RIfCan : F -> Union(R, "failed") RIfCan f == ((n := retractIfCan(numer f)@Union(R,"failed")) case R) and ((d:= retractIfCan(denom f)@Union(R,"failed")) case R) => n::R / d::R @@ -180411,23 +182705,33 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where else - solve l == solveInField l + solve : List(Polynomial(R)) -> + + List(List(Equation(Fraction(Polynomial(R))))) + solve l == solveInField l + solve : (List(Polynomial(R)),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solve(lp, lv) == solveInField(lp, lv) -- 'else if' is doubtful with this compiler; all 3 conditions are explicit if (not(R is Q)) and (R has RetractableTo Q) then + solveInField : (List(Polynomial(R)),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solveInField(lp, lv) == solveRetract(lp, lv)$SOL(Q, R) if (not(R is Z)) and (not(R has RetractableTo Q)) and (R has RetractableTo Z) then + solveInField : (List(Polynomial(R)),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solveInField(lp, lv) == solveRetract(lp, lv)$SOL(Z, R) if (not(R is Z)) and (not(R has RetractableTo Q)) and (not(R has RetractableTo Z)) then + solveInField : (List(Polynomial(R)),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solveInField(lp, lv) == solve([p::F for p in lp]$List(F), lv)$SSP(R) *) @@ -180694,17 +182998,20 @@ NormalizationPackage(R,E,V,P,TS): Exports == Implementation where if TS has SquareFreeRegularTriangularSetCategory(R,E,V,P) then + normInvertible? : (P,TS) -> List(Record(val: Boolean,tower: TS)) normInvertible?(p:P, ts:TS): List BWT == stoseInvertible?_sqfreg(p,ts)$regsetgcdpack else + normInvertible? : (P,TS) -> List(Record(val: Boolean,tower: TS)) normInvertible?(p:P, ts:TS): List BWT == stoseInvertible?_reg(p,ts)$regsetgcdpack if (R has RetractableTo(Integer)) and (V has ConvertibleTo(Symbol)) then + outputArgs : (String,String,P,TS) -> Void outputArgs(s1:S, s2: S, p:P,ts:TS): Void == if not empty? s1 then output(s1, p::OutputForm)$OutputPackage if not empty? s1 then _ @@ -180721,12 +183028,14 @@ NormalizationPackage(R,E,V,P,TS): Exports == Implementation where else + outputArgs : (String,String,P,TS) -> Void outputArgs(s1:S, s2: S, p:P,ts:TS): Void == if not empty? s1 then output(s1, p::OutputForm)$OutputPackage output(" ")$OutputPackage if not empty? s2 then output(s2, ts::OutputForm)$OutputPackage output(" ")$OutputPackage + recip : (P,TS) -> Record(num: P,den: P) recip(p:P,ts:TS): Record(num:P, den:P) == -- ASSUME p is invertible w.r.t. ts -- ASSUME mvar(p) is algebraic w.r.t. ts @@ -180752,6 +183061,7 @@ NormalizationPackage(R,E,V,P,TS): Exports == Implementation where pd := removeZero(pd,ts) [numer(k) * pn, denom(k) * pd]$Record(num:P, den:P) + normalizedAssociate : (P,TS) -> P normalizedAssociate(p:P,ts:TS): P == -- ASSUME p is invertible or zero w.r.t. ts empty? ts => p @@ -180791,6 +183101,7 @@ NormalizationPackage(R,E,V,P,TS): Exports == Implementation where -- primitivePart stronglyReduce(r,ts) primitivePart initiallyReduce(r,ts) + normalize : (P,TS) -> List(Record(val: P,tower: TS)) normalize(p: P, ts: TS): List PWT == zero? p => [[p,ts]$PWT] ground? p => [[1,ts]$PWT] @@ -180921,6 +183232,7 @@ NormInMonogenicAlgebra(R, PolR, E, PolE): Exports == Implementation where defpol := PolR2SUP(definingPolynomial()$E) + norm : PolE -> PolR norm q == p:SUP PolR := 0 while q ~= 0 repeat @@ -181046,6 +183358,7 @@ NormRetractPackage(F, ExtF, SUEx, ExtP, n):C == T where (* package NORMRETR *) (* + normFactors : ExtP -> List(ExtP) normFactors(p:ExtP):List ExtP == facs : List ExtP := [p] for i in 1..n-1 repeat @@ -181053,6 +183366,7 @@ NormRetractPackage(F, ExtF, SUEx, ExtP, n):C == T where facs := cons(p, facs) facs + Frobenius : ExtP -> ExtP Frobenius(ff:ExtP):ExtP == fft:ExtP:=0 while ff^=0 repeat @@ -181061,6 +183375,9 @@ NormRetractPackage(F, ExtF, SUEx, ExtP, n):C == T where ff:=reductum ff fft + retractIfCan : ExtP -> _ + Union(SparseUnivariatePolynomial(SparseUnivariatePolynomial(F)),_ + "failed") retractIfCan(ff:ExtP):Union(P, "failed") == fft:P:=0 while ff ^= 0 repeat @@ -181300,13 +183617,10 @@ NPCoef(BP,E,OV,R,P) : C == T where (* package NPCOEF *) (* - ---- Local Functions ---- - check : (TermC,Vector P) -> Union(Detc,"failed") - buildvect : (List(VTerm),NNI) -> Vector(List(VTerm)) - buildtable : (Vector(P),List(List NNI),List P) -> TCoef - modify : (TCoef,Detc) -> TCoef - constructp : VTerm -> USP - + npcoef : (SparseUnivariatePolynomial(P),List(BP),List(P)) -> _ + Record(deter: List(SparseUnivariatePolynomial(P)),_ + dterm: List(List(Record(expt: NonNegativeInteger,pcoef: P))),_ + nfacts: List(BP),nlead: List(P)) npcoef(u:USP,factlist:List(BP),leadlist:List(P)) :DetCoef == detcoef:List(VTerm):=empty();detufact:List(USP):=empty() lexp:List(List(NNI)):=[listexp(v) for v in factlist] @@ -181352,7 +183666,7 @@ NPCoef(BP,E,OV,R,P) : C == T where leadlist:=delete(leadlist,i) [detufact,detcoef,factlist,leadlist]$DetCoef - + check : (TermC,Vector P) -> Union(Detc,"failed") check(tterm:TermC,ulist:Vector(P)) : Union(Detc,"failed") == cfu:P:=1$P;doit:NNI:=0;poselt:NNI:=0;pp:Union(P,"failed") termlist:List(VTerm):=tterm.detfacts @@ -181367,12 +183681,12 @@ NPCoef(BP,E,OV,R,P) : C == T where [vterm.poselt.expt,pp::P,poselt]$Detc "failed" + buildvect : (List(VTerm),NNI) -> Vector(List(VTerm)) buildvect(lvterm:List(VTerm),n:NNI) : Vector(List(VTerm)) == vtable:Vector(List(VTerm)):=new(n,empty()) (#lvterm)=1 => for term in lvterm.first repeat vtable.(term.expt+1):=[[term]] vtable - vtable:=buildvect(lvterm.rest,n) ntable:Vector(List(VTerm)):=new(n,empty()) for term in lvterm.first repeat @@ -181383,6 +183697,7 @@ NPCoef(BP,E,OV,R,P) : C == T where ntable.(nexp+i)) ntable + buildtable : (Vector(P),List(List NNI),List P) -> TCoef buildtable(vu:Vector(P),lvect:List(List(NNI)),leadlist:List(P)):TCoef== nfact:NNI:=#leadlist table:TCoef:=empty() @@ -181396,6 +183711,7 @@ NPCoef(BP,E,OV,R,P) : C == T where table:=cons([vu.i,partialv.i]$TermC, table) table + modify : (TCoef,Detc) -> TCoef modify(tablecoef:TCoef,cfter:Detc) : TCoef == cfexp:=cfter.valexp;cfcoef:=cfter.valcoef;cfpos:=cfter.posit lterase:List(NNI):=empty() @@ -181415,10 +183731,12 @@ NPCoef(BP,E,OV,R,P) : C == T where lterase:=empty() tablecoef + listexp : BP -> List(NonNegativeInteger) listexp(up:BP) :List(NNI) == degree up=0 => [0] [degree up,:listexp(reductum up)] + constructp : VTerm -> USP constructp(lterm:VTerm):USP == +/[monomial(term.pcoef,term.expt) for term in lterm] @@ -181713,12 +184031,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where import ModularHermitianRowReduction(I) import TriangularMatrixOperations(I, Vector I, Vector I, Matrix I) - frobMatrix : (Mat,Mat,I,NNI) -> Mat - wildPrimes : (FR,I) -> List I - tameProduct : (FR,I) -> I - iTameLocalIntegralBasis : (Mat,I,I) -> Ans - iWildLocalIntegralBasis : (Mat,I,I) -> Ans - + frobMatrix : (Mat,Mat,I,NNI) -> Mat frobMatrix(rb,rbinv,rbden,p) == n := rank()$F; b := basis()$F v : Vector F := new(n,0) @@ -181732,6 +184045,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where mat := transpose coordinates v ((transpose(rbinv) * mat) exquo (rbden ** p)) :: Mat + wildPrimes : (FR,I) -> List I wildPrimes(factoredDisc,n) == -- returns a list of the primes <=n which divide factoredDisc to a -- power greater than 1 @@ -181740,6 +184054,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where if f.exponent > 1 and f.factor <= n then ans := concat(f.factor,ans) ans + tameProduct : (FR,I) -> I tameProduct(factoredDisc,n) == -- returns the product of the primes > n which divide factoredDisc -- to a power greater than 1 @@ -181748,6 +184063,8 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where if f.exponent > 1 and f.factor > n then ans := f.factor * ans ans + integralBasis : () -> Record(basis: Matrix(Integer),basisDen: Integer,_ + basisInv: Matrix(Integer)) integralBasis() == traceMat := traceMatrix()$F; n := rank()$F disc := determinant traceMat -- discriminant of current order @@ -181787,6 +184104,8 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) [runningRb,runningRbden,runningRbinv] + localIntegralBasis : Integer -> _ + Record(basis:Matrix(Integer),basisDen: Integer,basisInv: Matrix(Integer)) localIntegralBasis p == traceMat := traceMatrix()$F; n := rank()$F disc := determinant traceMat -- discriminant of current order @@ -181798,6 +184117,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where iWildLocalIntegralBasis(scalarMatrix(n,0),disc,p) [lb.basis,lb.basisDen,lb.basisInv] + iTameLocalIntegralBasis : (Mat,I,I) -> Ans iTameLocalIntegralBasis(traceMat,disc,sing) == n := rank()$F; disc0 := disc rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) @@ -181830,6 +184150,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where (indexChange = 1) => return [rb, rbden, rbinv, disc] tfm := ((rb * traceMat * transpose rb) exquo (rbden * rbden)) :: Mat + iWildLocalIntegralBasis : (Mat,I,I) -> Ans iWildLocalIntegralBasis(matrixOut,disc,p) == n := rank()$F; disc0 := disc rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) @@ -181863,6 +184184,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where (indexChange = 1) or gcd(p2,disc) ^= p2 => return [rb, rbden, rbinv, disc] + discriminant : () -> Integer discriminant() == disc := determinant traceMatrix()$F intBas := integralBasis() @@ -182138,23 +184460,23 @@ NumberFormats(): NFexports == NFimplementation where import SExpression import Symbol - replaceD: C -> C - replaced: C -> C - contract: S -> S - check: S ->Boolean + replaceD: C -> C replaceD c == if c = char "D" then char "E" else c + replaced: C -> C replaced c == if c = char "d" then char "E" else c + contract: S -> S contract s == s:= map(replaceD,s) s:= map(replaced,s) ls:List S := split(s,char " ")$String s:= concat ls + check: S ->Boolean check s == NUMBERP(READ_-FROM_-STRING(s)$Lisp)$Lisp and -- if there is an "E" then there must be a "." @@ -182164,6 +184486,8 @@ NumberFormats(): NFexports == NFimplementation where and not any?((c2:C):Boolean +-> c2=char ".",s) ) sexfloat:SExpression:=convert(coerce("Float")@Symbol)$SExpression + + ScanFloatIgnoreSpaces : String -> Float ScanFloatIgnoreSpaces s == s := contract s not check s => error "Non-numeric value" @@ -182178,6 +184502,7 @@ NumberFormats(): NFexports == NFimplementation where else error "Non-numeric value" + ScanFloatIgnoreSpacesIfCan : String -> Union(Float,"failed") ScanFloatIgnoreSpacesIfCan s == s := contract s not check s => "failed" @@ -182194,31 +184519,52 @@ NumberFormats(): NFexports == NFimplementation where units:V S := construct ["","I","II","III","IV","V","VI","VII","VIII","IX"] + tens :V S := construct ["","X","XX","XXX","XL","L","LX","LXX","LXXX","XC"] + hunds:V S := construct ["","C","CC","CCC","CD","D","DC","DCC","DCCC","CM"] + umin := minIndex units + tmin := minIndex tens + hmin := minIndex hunds + romval:V I := new(256, -1) + romval ord char(" ")$C := 0 + romval ord char("I")$C := 1 + romval ord char("V")$C := 5 + romval ord char("X")$C := 10 + romval ord char("L")$C := 50 + romval ord char("C")$C := 100 + romval ord char("D")$C := 500 + romval ord char("M")$C := 1000 + thou:C := char "M" + plen:C := char "(" + pren:C := char ")" + ichar:C := char "I" + FormatArabic : PositiveInteger -> String FormatArabic n == PRINC_-TO_-STRING(n)$Lisp - ScanArabic s == PARSE_-INTEGER(s)$Lisp + ScanArabic : String -> PositiveInteger + ScanArabic s == PARSE_-INTEGER(s)$Lisp + FormatRoman : PositiveInteger -> String FormatRoman pn == n := pn::Integer -- Units @@ -182262,6 +184608,7 @@ NumberFormats(): NFexports == NFimplementation where -- then subtract otherwise add. -- Shift left and repeat until done. + ScanRoman : String -> PositiveInteger ScanRoman s == s := upperCase s tot: I := 0 @@ -182428,6 +184775,7 @@ NumberTheoreticPolynomialFunctions(R: CommutativeRing): Exports == Impl where SUP ==> SparseUnivariatePolynomial -- This is the wrong way to evaluate the polynomial. + cyclotomic : (NonNegativeInteger,R) -> R cyclotomic(k, x) == p: SUP(I) := cyclotomic(k) r: R := 0 @@ -182440,6 +184788,7 @@ NumberTheoreticPolynomialFunctions(R: CommutativeRing): Exports == Impl where if R has Algebra RN then + eulerE : (NonNegativeInteger,R) -> R eulerE(k, x) == p: SUP(RN) := euler(k) r: R := 0 @@ -182450,6 +184799,7 @@ NumberTheoreticPolynomialFunctions(R: CommutativeRing): Exports == Impl where r := c*x**d + r r + bernoulliB : (NonNegativeInteger,R) -> R bernoulliB(k, x) == p: SUP(RN) := bernoulli(k) r: R := 0 @@ -183020,11 +185370,15 @@ Numeric(S:ConvertibleTo Float): with if S has CommutativeRing then + complexNumericIfCan : Polynomial(Complex(S)) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(p:Polynomial Complex S) == p' : Union(Complex(S),"failed") := retractIfCan p p' case "failed" => "failed" complexNumeric(p') + complexNumericIfCan : (Polynomial(Complex(S)),PositiveInteger) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(p:Polynomial Complex S,n:PositiveInteger) == p' : Union(Complex(S),"failed") := retractIfCan p p' case "failed" => "failed" @@ -183032,21 +185386,26 @@ Numeric(S:ConvertibleTo Float): with if S has Ring then + numericIfCan : Polynomial(S) -> Union(Float,"failed") numericIfCan(p:Polynomial S) == p' : Union(S,"failed") := retractIfCan p p' case "failed" => "failed" numeric(p') + complexNumericIfCan : Polynomial(S) -> Union(Complex(Float),"failed") complexNumericIfCan(p:Polynomial S) == p' : Union(S,"failed") := retractIfCan p p' case "failed" => "failed" complexNumeric(p') + complexNumericIfCan : (Polynomial(S),PositiveInteger) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(p:Polynomial S, n:PositiveInteger) == p' : Union(S,"failed") := retractIfCan p p' case "failed" => "failed" complexNumeric(p', n) + numericIfCan : (Polynomial(S),PositiveInteger) -> Union(Float,"failed") numericIfCan(p:Polynomial S, n:PositiveInteger) == old := digits(n)$Float ans := numericIfCan p @@ -183055,6 +185414,7 @@ Numeric(S:ConvertibleTo Float): with if S has IntegralDomain then + numericIfCan : Fraction(Polynomial(S)) -> Union(Float,"failed") numericIfCan(f:Fraction Polynomial S)== num := numericIfCan(numer(f)) num case "failed" => "failed" @@ -183062,6 +185422,8 @@ Numeric(S:ConvertibleTo Float): with den case "failed" => "failed" num/den + complexNumericIfCan : Fraction(Polynomial(S)) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(f:Fraction Polynomial S) == num := complexNumericIfCan(numer f) num case "failed" => "failed" @@ -183069,6 +185431,8 @@ Numeric(S:ConvertibleTo Float): with den case "failed" => "failed" num/den + complexNumericIfCan : (Fraction(Polynomial(S)),PositiveInteger) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(f:Fraction Polynomial S, n:PositiveInteger) == num := complexNumericIfCan(numer f, n) num case "failed" => "failed" @@ -183076,12 +185440,16 @@ Numeric(S:ConvertibleTo Float): with den case "failed" => "failed" num/den + numericIfCan : (Fraction(Polynomial(S)),PositiveInteger) -> _ + Union(Float,"failed") numericIfCan(f:Fraction Polynomial S, n:PositiveInteger) == old := digits(n)$Float ans := numericIfCan f digits(old)$Float ans + complexNumericIfCan : Fraction(Polynomial(Complex(S))) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(f:Fraction Polynomial Complex S) == num := complexNumericIfCan(numer f) num case "failed" => "failed" @@ -183089,6 +185457,8 @@ Numeric(S:ConvertibleTo Float): with den case "failed" => "failed" num/den + complexNumericIfCan:(Fraction(Polynomial(Complex(S))),PositiveInteger) ->_ + Union(Complex(Float),"failed") complexNumericIfCan(f:Fraction Polynomial Complex S, n:PositiveInteger) == num := complexNumericIfCan(numer f, n) num case "failed" => "failed" @@ -183098,14 +185468,17 @@ Numeric(S:ConvertibleTo Float): with if S has OrderedSet then + numericIfCan : Expression(S) -> Union(Float,"failed") numericIfCan(x:Expression S) == retractIfCan(map(convert, x)$ExpressionFunctions2(S, Float)) --s2cs(u:S):Complex(S) == complex(u,0) + complexNumericIfCan : Expression(S) -> Union(Complex(Float),"failed") complexNumericIfCan(x:Expression S) == complexNumericIfCan map(coerce, x)$ExpressionFunctions2(S,Complex S) + numericIfCan : (Expression(S),PositiveInteger) -> Union(Float,"failed") numericIfCan(x:Expression S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Float := map(convert, x)$ExpressionFunctions2(S, Float) @@ -183113,6 +185486,8 @@ Numeric(S:ConvertibleTo Float): with digits(old)$Float ans + complexNumericIfCan : (Expression(S),PositiveInteger) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(x:Expression S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Complex S := _ @@ -183123,10 +185498,14 @@ Numeric(S:ConvertibleTo Float): with if S has RealConstant then + complexNumericIfCan : Expression(Complex(S)) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(x:Expression Complex S) == retractIfCan(map(convert, x)_ $ExpressionFunctions2(Complex S,Complex Float)) + complexNumericIfCan : (Expression(Complex(S)),PositiveInteger) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(x:Expression Complex S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Complex Float := @@ -183137,13 +185516,18 @@ Numeric(S:ConvertibleTo Float): with else + convert : Complex S -> Complex(Float) convert(x:Complex S):Complex(Float) == map(convert,x)$ComplexFunctions2(S,Float) + complexNumericIfCan : Expression(Complex(S)) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(x:Expression Complex S) == retractIfCan(map(convert, x)_ $ExpressionFunctions2(Complex S,Complex Float)) + complexNumericIfCan : (Expression(Complex(S)),PositiveInteger) -> _ + Union(Complex(Float),"failed") complexNumericIfCan(x:Expression Complex S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Complex Float := @@ -183152,12 +185536,15 @@ Numeric(S:ConvertibleTo Float): with digits(old)$Float ans + numeric : (S,PositiveInteger) -> Float numeric(s:S) == convert(s)@Float if S has ConvertibleTo Complex Float then + complexNumeric : S -> Complex(Float) numeric : S -> Float complexNumeric(s:S) == convert(s)@Complex(Float) + complexNumeric : (S,PositiveInteger) -> Complex(Float) complexNumeric(s:S, n:PositiveInteger) == old := digits(n)$Float ans := complexNumeric s @@ -183166,19 +185553,23 @@ Numeric(S:ConvertibleTo Float): with else + complexNumeric : S -> Complex(Float) numeric : S -> Float complexNumeric(s:S) == convert(s)@Float :: Complex(Float) + complexNumeric : (S,PositiveInteger) -> Complex(Float) complexNumeric(s:S,n:PositiveInteger) == numeric(s, n)::Complex(Float) if S has CommutativeRing then + complexNumeric : Polynomial(Complex(S)) -> Complex(Float) complexNumeric(p:Polynomial Complex S) == p' : Union(Complex(S),"failed") := retractIfCan p p' case "failed" => error "Cannot compute the numerical value of a non-constant polynomial" complexNumeric(p') + complexNumeric : (Polynomial(Complex(S)),PositiveInteger) -> Complex(Float) complexNumeric(p:Polynomial Complex S,n:PositiveInteger) == p' : Union(Complex(S),"failed") := retractIfCan p p' case "failed" => @@ -183186,8 +185577,11 @@ Numeric(S:ConvertibleTo Float): with complexNumeric(p',n) if S has RealConstant then + + complexNumeric : Complex(S) -> Complex(Float) complexNumeric(s:Complex S) == convert(s)$Complex(S) + complexNumeric : (Complex(S),PositiveInteger) -> Complex(Float) complexNumeric(s:Complex S, n:PositiveInteger) == old := digits(n)$Float ans := complexNumeric s @@ -183196,8 +185590,10 @@ Numeric(S:ConvertibleTo Float): with else if Complex(S) has ConvertibleTo(Complex Float) then + complexNumeric : Complex(S) -> Complex(Float) complexNumeric(s:Complex S) == convert(s)@Complex(Float) + complexNumeric : (Complex(S),PositiveInteger) -> Complex(Float) complexNumeric(s:Complex S, n:PositiveInteger) == old := digits(n)$Float ans := complexNumeric s @@ -183206,12 +185602,14 @@ Numeric(S:ConvertibleTo Float): with else + complexNumeric : Complex(S) -> Complex(Float) complexNumeric(s:Complex S) == s' : Union(S,"failed") := retractIfCan s s' case "failed" => error "Cannot compute the numerical value of a non-constant object" complexNumeric(s') + complexNumeric : (Complex(S),PositiveInteger) -> Complex(Float) complexNumeric(s:Complex S, n:PositiveInteger) == s' : Union(S,"failed") := retractIfCan s s' case "failed" => @@ -183229,24 +185627,28 @@ Numeric(S:ConvertibleTo Float): with if S has Ring then + numeric : Polynomial(S) -> Float if S has RING numeric(p:Polynomial S) == p' : Union(S,"failed") := retractIfCan p p' case "failed" => error _ "Can only compute the numerical value of a constant, real-valued polynomial" numeric(p') + complexNumeric : Polynomial(S) -> Complex(Float) complexNumeric(p:Polynomial S) == p' : Union(S,"failed") := retractIfCan p p' case "failed" => error "Cannot compute the numerical value of a non-constant polynomial" complexNumeric(p') + complexNumeric : (Polynomial(S),PositiveInteger) -> Complex(Float) complexNumeric(p:Polynomial S, n:PositiveInteger) == p' : Union(S,"failed") := retractIfCan p p' case "failed" => error "Cannot compute the numerical value of a non-constant polynomial" complexNumeric(p', n) + numeric : (Polynomial(S),PositiveInteger) -> Float numeric(p:Polynomial S, n:PositiveInteger) == old := digits(n)$Float ans := numeric p @@ -183255,29 +185657,37 @@ Numeric(S:ConvertibleTo Float): with if S has IntegralDomain then + numeric : Fraction(Polynomial(S)) -> Float numeric(f:Fraction Polynomial S)== numeric(numer(f)) / numeric(denom f) + complexNumeric : Fraction(Polynomial(S)) -> Complex(Float) complexNumeric(f:Fraction Polynomial S) == complexNumeric(numer f)/complexNumeric(denom f) + complexNumeric: (Fraction(Polynomial(S)),PositiveInteger) -> Complex(Float) complexNumeric(f:Fraction Polynomial S, n:PositiveInteger) == complexNumeric(numer f, n)/complexNumeric(denom f, n) + numeric : (Fraction(Polynomial(S)),PositiveInteger) -> Float numeric(f:Fraction Polynomial S, n:PositiveInteger) == old := digits(n)$Float ans := numeric f digits(old)$Float ans + complexNumeric : Fraction(Polynomial(Complex(S))) -> Complex(Float) complexNumeric(f:Fraction Polynomial Complex S) == complexNumeric(numer f)/complexNumeric(denom f) + complexNumeric : (Fraction(Polynomial(Complex(S))),PositiveInteger) -> _ + Complex(Float) complexNumeric(f:Fraction Polynomial Complex S, n:PositiveInteger) == complexNumeric(numer f, n)/complexNumeric(denom f, n) if S has OrderedSet then + numeric : Expression(S) -> Float numeric(x:Expression S) == x' : Union(Float,"failed") := retractIfCan(map(convert, x)$ExpressionFunctions2(S, Float)) @@ -183285,6 +185695,7 @@ Numeric(S:ConvertibleTo Float): with "Can only compute the numerical value of a constant, real-valued Expression" x' + complexNumeric : Expression(S) -> Complex(Float) complexNumeric(x:Expression S) == x' : Union(Complex Float,"failed") := retractIfCan( map(complexNumeric, x)$ExpressionFunctions2(S,Complex Float)) @@ -183293,6 +185704,7 @@ Numeric(S:ConvertibleTo Float): with "Cannot compute the numerical value of a non-constant expression" x' + numeric : (Expression(S),PositiveInteger) -> Float numeric(x:Expression S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Float := map(convert, x)$ExpressionFunctions2(S, Float) @@ -183302,6 +185714,7 @@ Numeric(S:ConvertibleTo Float): with "Can only compute the numerical value of a constant, real-valued Expression" ans + complexNumeric : (Expression(S),PositiveInteger) -> Complex(Float) complexNumeric(x:Expression S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Complex Float := @@ -183313,6 +185726,7 @@ Numeric(S:ConvertibleTo Float): with "Cannot compute the numerical value of a non-constant expression" ans + complexNumeric : Expression(Complex(S)) -> Complex(Float) complexNumeric(x:Expression Complex S) == x' : Union(Complex Float,"failed") := retractIfCan( map(complexNumeric, x)$ExpressionFunctions2(Complex S,Complex Float)) @@ -183321,6 +185735,7 @@ Numeric(S:ConvertibleTo Float): with "Cannot compute the numerical value of a non-constant expression" x' + complexNumeric:(Expression(Complex(S)),PositiveInteger) -> Complex(Float) complexNumeric(x:Expression Complex S, n:PositiveInteger) == old := digits(n)$Float x' : Expression Complex Float := @@ -183853,12 +186268,10 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where (* package NUMODE *) (* - rk4qclocal : (V NF,V NF,I,NF,RK4STEP,NF,V NF,(V NF,V NF,NF) -> VOID - ,V NF,V NF,V NF,V NF,V NF,V NF) -> VOID - rk4local : (V NF,V NF,I,NF,NF,V NF,(V NF,V NF,NF) -> VOID - ,V NF,V NF,V NF) -> VOID import OutputPackage + rk4a : (Vector(Float),Integer,Float,Float,Float,Float,Integer,_ + ((Vector(Float),Vector(Float),Float) -> Void)) -> Void rk4a(ystart,nvar,x1,x2,eps,htry,nstep,derivs) == y : V NF := new(nvar::NNI,0.0) yscal : V NF := new(nvar::NNI,1.0) @@ -183908,6 +186321,9 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where for i in 1..m repeat ystart(i) := y(i) + rk4qc : (Vector(Float),Integer,Float,Record(try: Float,did: Float,_ + next: Float),Float,Vector(Float),_ + ((Vector(Float),Vector(Float),Float) -> Void)) -> Void rk4qc(y,n,x,step,eps,yscal,derivs) == t1 : V NF := new(n::NNI,0.0) t2 : V NF := new(n::NNI,0.0) @@ -183920,11 +186336,17 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where eps := 1.0/eps rk4qclocal(y,t7,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6) + rk4qc : (Vector(Float),Integer,Float,Record(try: Float,did: Float,_ + next: Float),Float,Vector(Float),((Vector(Float),Vector(Float),_ + Float) -> Void),Vector(Float),Vector(Float),Vector(Float),_ + Vector(Float),Vector(Float),Vector(Float),Vector(Float)) -> Void rk4qc(y,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6,dydx) == derivs(dydx,y,x) eps := 1.0/eps rk4qclocal(y,dydx,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6) + rk4qclocal : (V NF,V NF,I,NF,RK4STEP,NF,V NF,(V NF,V NF,NF) -> VOID + ,V NF,V NF,V NF,V NF,V NF,V NF) -> VOID rk4qclocal(y,dydx,n,x,step,eps,yscal,derivs ,t1,t2,t3,ysav,dysav,ytemp) == xsav : NF := x @@ -183973,6 +186395,8 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where for i in 1..m repeat y(i) := y(i) + ytemp(i) * fcor + rk4f : (Vector(Float),Integer,Float,Float,Integer,_ + ((Vector(Float),Vector(Float),Float) -> Void)) -> Void rk4f(y,nvar,x1,x2,nstep,derivs) == yt : V NF := new(nvar::NNI,0.0) dyt : V NF := new(nvar::NNI,0.0) @@ -183989,6 +186413,8 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where rk4local(y,dydx,nvar,x,h,y,derivs,yt,dyt,dym) x := x + h + rk4 : (Vector(Float),Integer,Float,Float,((Vector(Float),Vector(Float),_ + Float) -> Void)) -> Void rk4(y,n,x,h,derivs) == t1 : V NF := new(n::NNI,0.0) t2 : V NF := new(n::NNI,0.0) @@ -183997,10 +186423,15 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where derivs(t1,y,x) rk4local(y,t1,n,x,h,y,derivs,t2,t3,t4) + rk4 : (Vector(Float),Integer,Float,Float,((Vector(Float),Vector(Float),_ + Float) -> Void),Vector(Float),Vector(Float),Vector(Float),_ + Vector(Float)) -> Void rk4(y,n,x,h,derivs,t1,t2,t3,t4) == derivs(t1,y,x) rk4local(y,t1,n,x,h,y,derivs,t2,t3,t4) + rk4local : (V NF,V NF,I,NF,NF,V NF,(V NF,V NF,NF) -> VOID + ,V NF,V NF,V NF) -> VOID rk4local(y,dydx,n,x,h,yout,derivs,yt,dyt,dym) == hh : NF := h*0.5 h6 : NF := h/6.0 @@ -184682,10 +187113,11 @@ NumericalQuadrature(): Exports == Implementation where (* package NUMQUAD *) (* - trapclosed : (F -> F,F,F,F,I) -> F - trapopen : (F -> F,F,F,F,I) -> F import OutputPackage + aromberg : ((Float -> Float),Float,Float,Float,Float,Integer,Integer,_ + Integer) -> Record(value: Float,error: Float,_ + totalpts: Integer,success: Boolean) aromberg(func,a,b,epsrel,epsabs,nmin,nmax,nint) == ans : TrapAns sum : F := 0.0 @@ -184711,6 +187143,9 @@ NumericalQuadrature(): Exports == Implementation where x2 := x2 + hh return( [sum , err , pts , done] ) + asimpson : ((Float -> Float),Float,Float,Float,Float,Integer,Integer,_ + Integer) -> Record(value: Float,error: Float,_ + totalpts: Integer,success: Boolean) asimpson(func,a,b,epsrel,epsabs,nmin,nmax,nint) == ans : TrapAns sum : F := 0.0 @@ -184736,6 +187171,9 @@ NumericalQuadrature(): Exports == Implementation where x2 := x2 + hh return( [sum , err , pts , done] ) + atrapezoidal : ((Float -> Float),Float,Float,Float,Float,Integer,Integer,_ + Integer) -> Record(value: Float,error: Float,_ + totalpts: Integer,success: Boolean) atrapezoidal(func,a,b,epsrel,epsabs,nmin,nmax,nint) == ans : TrapAns sum : F := 0.0 @@ -184761,6 +187199,8 @@ NumericalQuadrature(): Exports == Implementation where x2 := x2 + hh return( [sum , err , pts , done] ) + romberg : ((Float -> Float),Float,Float,Float,Float,Integer,Integer) -> _ + Record(value: Float,error: Float,totalpts: Integer,success: Boolean) romberg(func,a,b,epsrel,epsabs,nmin,nmax) == length : F := (b-a) delta : F := length @@ -184815,6 +187255,8 @@ NumericalQuadrature(): Exports == Implementation where qx1 := table(1) return( [table(1) , 1.25*change , pts+1 ,false] ) + simpson : ((Float -> Float),Float,Float,Float,Float,Integer,Integer) -> _ + Record(value: Float,error: Float,totalpts: Integer,success: Boolean) simpson(func,a,b,epsrel,epsabs,nmin,nmax) == length : F := (b-a) delta : F := length @@ -184857,6 +187299,8 @@ NumericalQuadrature(): Exports == Implementation where pts := 2*pts return( [newest , 1.25*change , pts+1 ,false] ) + trapezoidal : ((Float -> Float),Float,Float,Float,Float,Integer,Integer) ->_ + Record(value: Float,error: Float,totalpts: Integer,success: Boolean) trapezoidal(func,a,b,epsrel,epsabs,nmin,nmax) == length : F := (b-a) delta : F := length @@ -184894,6 +187338,8 @@ NumericalQuadrature(): Exports == Implementation where pts := 2*pts return( [newsum , 1.25*change , pts+1 ,false] ) + rombergo : ((Float -> Float),Float,Float,Float,Float,Integer,Integer) -> _ + Record(value: Float,error: Float,totalpts: Integer,success: Boolean) rombergo(func,a,b,epsrel,epsabs,nmin,nmax) == length : F := (b-a) delta : F := length / 3.0 @@ -184934,6 +187380,8 @@ NumericalQuadrature(): Exports == Implementation where qx1 := table(1) return( [table(1) , 1.5*change , pts ,false] ) + simpsono : ((Float -> Float),Float,Float,Float,Float,Integer,Integer) -> _ + Record(value: Float,error: Float,totalpts: Integer,success: Boolean) simpsono(func,a,b,epsrel,epsabs,nmin,nmax) == length : F := (b-a) delta : F := length / 3.0 @@ -184961,6 +187409,8 @@ NumericalQuadrature(): Exports == Implementation where pts := 3*pts return( [newest , 1.5*change , pts ,false] ) + trapezoidalo:((Float -> Float),Float,Float,Float,Float,Integer,Integer) ->_ + Record(value: Float,error: Float,totalpts: Integer,success: Boolean) trapezoidalo(func,a,b,epsrel,epsabs,nmin,nmax) == length : F := (b-a) delta : F := length/3.0 @@ -184983,6 +187433,7 @@ NumericalQuadrature(): Exports == Implementation where pts := 3*pts return([newsum , 1.5*change , pts ,false] ) + trapclosed : (F -> F,F,F,F,I) -> F trapclosed(func,start,h,oldsum,numpoints) == x : F := start + 0.5*h sum : F := 0.0 @@ -184992,6 +187443,7 @@ NumericalQuadrature(): Exports == Implementation where x := x + h return( 0.5*(oldsum + sum*h) ) + trapopen : (F -> F,F,F,F,I) -> F trapopen(func,start,del,oldsum,numpoints) == ddel : F := 2.0*del x : F := start + 0.5*del @@ -185149,17 +187601,26 @@ NumericComplexEigenPackage(Par) : C == T import InnerNumericEigenPackage(GRN,Complex Par,Par) + characteristicPolynomial : Matrix(Complex(Fraction(Integer))) -> _ + Polynomial(Complex(Fraction(Integer))) characteristicPolynomial(m:MGRN) : Polynomial GRN == x:SE:=new()$SE multivariate(charpol m, x) ---- characteristic polynomial of a matrix A ---- + characteristicPolynomial:(Matrix(Complex(Fraction(Integer))),Symbol) -> _ + Polynomial(Complex(Fraction(Integer))) characteristicPolynomial(A:MGRN,x:SE):Polynomial GRN == multivariate(charpol A, x) + complexEigenvalues : (Matrix(Complex(Fraction(Integer))),Par) -> _ + List(Complex(Par)) complexEigenvalues(m:MGRN,eps:Par) : List Complex Par == solve1(charpol m, eps) + complexEigenvectors : (Matrix(Complex(Fraction(Integer))),Par) -> _ + List(Record(outval: Complex(Par),outmult: Integer,_ + outvect: List(Matrix(Complex(Par))))) complexEigenvectors(m:MGRN,eps:Par) :List outForm == innerEigenvectors(m,eps,factor$ComplexFactorization(RN,SUPGRN)) @@ -185263,6 +187724,7 @@ NumericContinuedFraction(F): Exports == Implementation where zero?(b := a - (aa :: F)) => concat(aa,empty()$ST) concat(aa,cfc inv b) + continuedFraction : F -> ContinuedFraction(Integer) continuedFraction a == aa := wholePart a zero?(b := a - (aa :: F)) => @@ -185415,17 +187877,24 @@ NumericRealEigenPackage(Par) : C == T import InnerNumericEigenPackage(RN, Par, Par) + characteristicPolynomial : Matrix(Fraction(Integer)) -> _ + Polynomial(Fraction(Integer)) characteristicPolynomial(m:MRN) : Polynomial RN == x:SE:=new()$SE multivariate(charpol(m),x) ---- characteristic polynomial of a matrix A ---- + characteristicPolynomial : (Matrix(Fraction(Integer)),Symbol) -> _ + Polynomial(Fraction(Integer)) characteristicPolynomial(A:MRN,x:SE):Polynomial RN == multivariate(charpol(A),x) + realEigenvalues : (Matrix(Fraction(Integer)),Par) -> List(Par) realEigenvalues(m:MRN,eps:Par) : List Par == solve1(charpol m, eps) + realEigenvectors : (Matrix(Fraction(Integer)),Par) -> _ + List(Record(outval: Par,outmult: Integer,outvect: List(Matrix(Par)))) realEigenvectors(m:MRN,eps:Par) :List outForm == innerEigenvectors(m,eps,factor$GenUFactorize(RN)) @@ -185652,6 +188121,7 @@ NumericTubePlot(Curve): Exports == Implementation where loops := concat(loopPoints(pt,n,b,r,cosSin),loops) reverse_! loops + tube : (Curve,DoubleFloat,Integer) -> TubePlot(Curve) tube(curve,r,n) == n < 3 => error "tube: n should be at least 3" brans := listBranches curve @@ -185755,6 +188225,7 @@ OctonionCategoryFunctions2(OR,R,OS,S) : Exports == (* package OCTCT2 *) (* + map : ((R -> S),OR) -> OS map(fn : R -> S, u : OR): OS == octon(fn real u, fn imagi u, fn imagj u, fn imagk u,_ fn imagE u, fn imagI u, fn imagJ u, fn imagK u)$OS @@ -185920,19 +188391,18 @@ ODEIntegration(R, F): Exports == Implementation where import FunctionSpaceIntegration(R, F) import ElementaryFunctionStructurePackage(R, F) - isQ : List F -> UQ - isQlog: F -> Union(REC, "failed") - mkprod: List REC -> F - + diff : Symbol -> (F -> F) diff x == (f1:F):F +-> differentiate(f1, x) -- This is the integration function to be used for quadratures + int : (F,Symbol) -> F int(f, x) == (u := integrate(f, x)) case F => u::F first(u::List(F)) -- mkprod([q1, f1],...,[qn,fn]) returns */(fi^qi) but groups the -- qi having the same denominator together + mkprod: List REC -> F mkprod l == empty? l => 1 rec := first l @@ -185942,6 +188412,7 @@ ODEIntegration(R, F): Exports == Implementation where mkprod setDifference(l, ll) -- computes exp(int(f,x)) in a non-naive way + expint : (F,Symbol) -> F expint(f, x) == a := int(f, x) (u := validExponential(tower a, a, x)) case F => u::F @@ -185959,6 +188430,7 @@ ODEIntegration(R, F): Exports == Implementation where mkprod(lrec) * exp(exponent / da) -- checks if all the elements of l are rational numbers, returns product + isQ : List F -> UQ isQ l == prod:Q := 1 for x in l repeat @@ -185967,6 +188439,7 @@ ODEIntegration(R, F): Exports == Implementation where prod -- checks if a non-sum expr is of the form c * log(g) for rational number c + isQlog: F -> Union(REC, "failed") isQlog f == is?(f, "log"::SY) => [1, first argument(retract(f)@K)] (v := isTimes f) case List(F) and (#(l := v::List(F)) <= 3) => @@ -186114,8 +188587,10 @@ ODETools(F, LODO): Exports == Implementation where diff := D()$LODO + wronskianMatrix : List(F) -> Matrix(F) wronskianMatrix l == wronskianMatrix(l, #l) + wronskianMatrix : (List(F),NonNegativeInteger) -> Matrix(F) wronskianMatrix(l, q) == v:V := vector l m:M := zero(q, #v) @@ -186124,12 +188599,14 @@ ODETools(F, LODO): Exports == Implementation where v := map_!((f1:F):F +-> diff f1, v) m + variationOfParameters : (LODO,F,List(F)) -> Union(Vector(F),"failed") variationOfParameters(op, g, b) == empty? b => "failed" v:V := new(n := degree op, 0) qsetelt_!(v, maxIndex v, g / leadingCoefficient op) particularSolution(wronskianMatrix(b, n), v) + particularSolution : (LODO,F,List(F),(F -> F)) -> Union(F,"failed") particularSolution(op, g, b, integration) == zero? g => 0 (sol := variationOfParameters(op, g, b)) case "failed" => "failed" @@ -186258,10 +188735,13 @@ OneDimensionalArrayFunctions2(A, B): Exports == Implementation where (* package ARRAY12 *) (* - map(f, v) == map(f, v)$O2 + map : ((A -> B),OneDimensionalArray(A)) -> OneDimensionalArray(B) + map(f, v) == map(f, v)$O2 - scan(f, v, b) == scan(f, v, b)$O2 + scan : (((A,B) -> B),OneDimensionalArray(A),B) -> OneDimensionalArray(B) + scan(f, v, b) == scan(f, v, b)$O2 + reduce : (((A,B) -> B),OneDimensionalArray(A),B) -> B reduce(f, v, b) == reduce(f, v, b)$O2 *) @@ -186354,8 +188834,11 @@ OnePointCompletionFunctions2(R, S): Exports == Implementation where (* package ONECOMP2 *) (* + map : ((R -> S),OnePointCompletion(R)) -> OnePointCompletion(S) map(f, r) == map(f, r, infinity()) + map : ((R -> S),OnePointCompletion(R),OnePointCompletion(S)) -> _ + OnePointCompletion(S) map(f, r, i) == (u := retractIfCan r) case R => (f(u::R))::OPS i @@ -186510,18 +188993,22 @@ OpenMathPackage(): with import OpenMathDevice import String + OMunhandledSymbol : (String,String) -> Exit OMunhandledSymbol(u,v) == error concat ["AXIOM is unable to process the symbol ",u," from CD ",v,"."] + OMread : OpenMathDevice -> Any OMread(dev: OpenMathDevice): Any == interpret(OM_-READ(dev)$Lisp :: InputForm) + OMreadFile : String -> Any OMreadFile(filename: String): Any == dev := OMopenFile(filename, "r", OMencodingUnknown()) res: Any := interpret(OM_-READ(dev)$Lisp :: InputForm) OMclose(dev) res + OMreadStr : String -> Any OMreadStr(str: String): Any == strp := OM_-STRINGTOSTRINGPTR(str)$Lisp dev := OMopenString(strp pretend String, OMencodingUnknown()) @@ -186529,17 +189016,21 @@ OpenMathPackage(): with OMclose(dev) res + OMlistCDs : () -> List(String) OMlistCDs(): List(String) == OM_-LISTCDS()$Lisp pretend List(String) + OMlistSymbols : String -> List(String) OMlistSymbols(cd: String): List(String) == OM_-LISTSYMBOLS(cd)$Lisp pretend List(String) import SExpression + OMsupportsCD? : String -> Boolean OMsupportsCD?(cd: String): Boolean == not null? OM_-SUPPORTSCD(cd)$Lisp + OMsupportsSymbol? : (String,String) -> Boolean OMsupportsSymbol?(cd: String, name: String): Boolean == not null? OM_-SUPPORTSSYMBOL(cd, name)$Lisp @@ -186673,11 +189164,13 @@ OpenMathServerPackage(): with import OpenMathPackage import OpenMath + OMreceive : OpenMathConnection -> Any OMreceive(conn: OpenMathConnection): Any == dev: OpenMathDevice := OMconnInDevice(conn) OMsetEncoding(dev, OMencodingUnknown); OMread(dev) + OMsend : (OpenMathConnection,Any) -> Void OMsend(conn: OpenMathConnection, value: Any): Void == dev: OpenMathDevice := OMconnOutDevice(conn) OMsetEncoding(dev, OMencodingXML); @@ -186694,6 +189187,7 @@ OpenMathServerPackage(): with retractable?(value)$AnyFunctions1(String) => OMwrite(dev, retract(value)$AnyFunctions1(String), true) + OMserve : (SingleInteger,SingleInteger) -> Void OMserve(portNum: SingleInteger, timeout: SingleInteger): Void == conn: OpenMathConnection := OMmakeConn(timeout) OMbindTCP(conn, portNum) @@ -186776,6 +189270,7 @@ OperationsQuery(): Exports == Implementation where (* package OPQUERY *) (* + getDatabase : String -> Database(IndexCard) getDatabase(s) == getBrowseDatabase(s)$Lisp *) @@ -186870,8 +189365,11 @@ OrderedCompletionFunctions2(R, S): Exports == Implementation where (* package ORDCOMP2 *) (* + map : ((R -> S),OrderedCompletion(R)) -> OrderedCompletion(S) map(f, r) == map(f, r, plusInfinity(), minusInfinity()) + map : ((R -> S),OrderedCompletion(R),OrderedCompletion(S),_ + OrderedCompletion(S)) -> OrderedCompletion(S) map(f, r, p, m) == zero?(n := whatInfinity r) => (f retract r)::ORS (n = 1) => p @@ -187012,6 +189510,7 @@ OrderingFunctions(dim,S) : T == C where n:NonNegativeInteger:=dim -- pure lexicographical ordering + pureLex : (Vector(S),Vector(S)) -> Boolean pureLex(v1:VS,v2:VS) : Boolean == for i in 1..n repeat if qelt(v1,i) < qelt(v2,i) then return true @@ -187019,6 +189518,7 @@ OrderingFunctions(dim,S) : T == C where false -- total ordering refined with lex + totalLex : (Vector(S),Vector(S)) -> Boolean totalLex(v1:VS,v2:VS) :Boolean == n1:S:=0 n2:S:=0 @@ -187033,6 +189533,7 @@ OrderingFunctions(dim,S) : T == C where false -- reverse lexicographical ordering + reverseLex : (Vector(S),Vector(S)) -> Boolean reverseLex(v1:VS,v2:VS) :Boolean == n1:S:=0 n2:S:=0 @@ -187225,6 +189726,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where import IntegerCombinatoricFunctions() + laguerreL : (NonNegativeInteger,R) -> R laguerreL(n, x) == n = 0 => 1 (p1, p0) := (-x + 1, 1) @@ -187232,6 +189734,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where (p1, p0) := ((2*i::R + 1 - x)*p1 - i**2*p0, p1) p1 + laguerreL : (NonNegativeInteger,NonNegativeInteger,R) -> R laguerreL(m, n, x) == ni := n::Integer mi := m::Integer @@ -187245,6 +189748,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where p1 := p1 + cx*p0 p1 + chebyshevT : (NonNegativeInteger,R) -> R chebyshevT(n, x) == n = 0 => 1 (p1, p0) := (x, 1) @@ -187252,6 +189756,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where (p1, p0) := (2*x*p1 - p0, p1) p1 + chebyshevU : (NonNegativeInteger,R) -> R chebyshevU(n, x) == n = 0 => 1 (p1, p0) := (2*x, 1) @@ -187259,6 +189764,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where (p1, p0) := (2*x*p1 - p0, p1) p1 + hermiteH : (NonNegativeInteger,R) -> R hermiteH(n, x) == n = 0 => 1 (p1, p0) := (2*x, 1) @@ -187268,6 +189774,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where if R has Algebra RN then + legendreP : (NonNegativeInteger,R) -> R legendreP(n, x) == n = 0 => 1 p0 := 1 @@ -187411,6 +189918,7 @@ OutputPackage: with e: OutputForm l: List Any + output : String -> Void output e == mathprint(e)$Lisp void() @@ -187418,12 +189926,15 @@ OutputPackage: with -- Note that we have to do the pretend here because otherwise we will -- try to load STRING which is not yet compiled during build. + output : OutputForm -> Void output s == output(s pretend OutputForm) + output : (String,OutputForm) -> Void output(s,e) == output blankSeparate [s pretend OutputForm, e] + outputList : List(Any) -> Void outputList(l) == -- MGR output hconcat [if retractable?(x)$AnyFunctions1(String) then @@ -187849,111 +190360,164 @@ PackageForAlgebraicFunctionField(K,symb,BLMET):Exports == Implementation where import BP + homogenize : (DistributedMultivariatePolynomial(symb,K),Integer) -> _ + DistributedMultivariatePolynomial(symb,K) homogenize(pol,n) == homogenize(pol,n)$PACKPOLY + pointDominateBy : Places(K) -> ProjectivePlane(K) pointDominateBy(pl)== pointDominateBy(pl)$BP + placesAbove : ProjectivePlane(K) -> List(Places(K)) placesAbove(pt)== placesAbove(pt)$BP + setSingularPoints : List(ProjectivePlane(K)) -> List(ProjectivePlane(K)) setSingularPoints(lspt)== setSingularPoints(lspt)$BP + projectivePoint : List(K) -> ProjectivePlane(K) projectivePoint(lpt)==projectivePoint(lpt)$ProjPt + interpolateFormsForFact : (Divisor(Places(K)),_ + List(DistributedMultivariatePolynomial(symb,K))) -> _ + List(DistributedMultivariatePolynomial(symb,K)) interpolateFormsForFact(d,lm)== interpolateFormsForFact(d,lm)$BP if K has Finite then + goppaCode : (Divisor(Places(K)),List(Places(K))) -> Matrix(K) goppaCode(d:DIVISOR,lp:List(Plc))== lb:=lBasis(d) dd:=lb.den ll:=[[eval(f,dd,pl) for pl in lp] for f in lb.num] matrix ll + goppaCode : (Divisor(Places(K)),Divisor(Places(K))) -> Matrix(K) goppaCode(d:DIVISOR,p:DIVISOR)== lp:=supp p goppaCode(d,lp) + ZetaFunction : () -> UnivariateTaylorSeriesCZero(Integer,t) ZetaFunction == ZetaFunction()$BP + ZetaFunction : PositiveInteger -> UnivariateTaylorSeriesCZero(Integer,t) ZetaFunction(d) == ZetaFunction(d)$BP + numberOfPlacesOfDegree : PositiveInteger -> Integer numberOfPlacesOfDegree(i)==numberOfPlacesOfDegree(i)$BP + placesOfDegree : PositiveInteger -> List(Places(K)) placesOfDegree(i) ==placesOfDegree(i)$BP + numberRatPlacesExtDeg : PositiveInteger -> Integer numberRatPlacesExtDeg(extDegree)==numberRatPlacesExtDeg(extDegree)$BP + numberPlacesDegExtDeg : (PositiveInteger,PositiveInteger) -> Integer numberPlacesDegExtDeg(degree,extDegree)== numberPlacesDegExtDeg(degree,extDegree)$BP + LPolynomial : () -> SparseUnivariatePolynomial(Integer) LPolynomial == LPolynomial()$BP + LPolynomial : PositiveInteger -> SparseUnivariatePolynomial(Integer) LPolynomial(extDeg)==LPolynomial(extDeg)$BP + classNumber : () -> Integer classNumber== classNumber()$BP + rationalPlaces : () -> List(Places(K)) rationalPlaces == rationalPlaces()$BP + rationalPoints : () -> List(ProjectivePlane(K)) rationalPoints==rationalPoints()$BP crvLocal:PolyRing + eval : (DistributedMultivariatePolynomial(symb,K),Places(K)) -> K eval(f:PolyRing,pl:Plc)== dd:= degree pl ^one?(dd) => error " cannot evaluate at place of degree greater than one" eval(f,pl)$BP + evalIfCan : (Fraction(DistributedMultivariatePolynomial(symb,K)),_ + Places(K)) -> Union(K,"failed") evalIfCan(f:PolyRing,pl:Plc)== dd:= degree pl ^one?(dd) => error " cannot evaluate at place of degree greater than one" evalIfCan(f,pl)$BP + setCurve : DistributedMultivariatePolynomial(symb,K) -> _ + DistributedMultivariatePolynomial(symb,K) setCurve(pol)==setCurve(pol)$BP + lBasis : Divisor(Places(K)) -> _ + Record(num: List(DistributedMultivariatePolynomial(symb,K)),_ + den: DistributedMultivariatePolynomial(symb,K)) lBasis(divis)==lBasis(divis)$BP + genus : () -> NonNegativeInteger genus==genus()$BP + genusNeg : () -> Integer genusNeg==genusNeg()$BP + theCurve : () -> DistributedMultivariatePolynomial(symb,K) theCurve==theCurve()$BP + desingTree : () -> List(DesingTree(InfClsPt(K,symb,BLMET))) desingTree==desingTree()$BP + desingTreeWoFullParam : () -> List(DesingTree(InfClsPt(K,symb,BLMET))) desingTreeWoFullParam== desingTreeWoFullParam()$BP -- compute the adjunction divisor of the curve using -- adjunctionDivisor from DesingTreePackage + adjunctionDivisor : () -> Divisor(Places(K)) adjunctionDivisor == adjunctionDivisor()$BP + singularPoints : () -> List(ProjectivePlane(K)) singularPoints==singularPoints()$BP + parametrize : (DistributedMultivariatePolynomial(symb,K),Places(K)) -> _ + NeitherSparseOrDensePowerSeries(K) parametrize(f,pl)==parametrize(f,pl)$BP -- compute the interpolating forms (see package InterpolateFormsPackage) + interpolateForms : (Divisor(Places(K)),NonNegativeInteger) -> _ + List(DistributedMultivariatePolynomial(symb,K)) interpolateForms(d,n)==interpolateForms(d,n)$BP + eval : (DistributedMultivariatePolynomial(symb,K),_ + DistributedMultivariatePolynomial(symb,K),Places(K)) -> K eval(f:PolyRing,g:PolyRing,pl:Plc)==eval(f,g,pl)$BP + eval : (Fraction(DistributedMultivariatePolynomial(symb,K)),Places(K)) -> K eval(u:FRACPOLY,pl:Plc)== ff:=numer u gg:=denom u eval(ff,gg,pl) + evalIfCan : (DistributedMultivariatePolynomial(symb,K),_ + DistributedMultivariatePolynomial(symb,K),Places(K)) -> _ + Union(K,"failed") evalIfCan(f:PolyRing,g:PolyRing,pl:Plc)==evalIfCan(f,g,pl)$BP + evalIfCan : (DistributedMultivariatePolynomial(symb,K),Places(K)) -> _ + Union(K,"failed") evalIfCan(u:FRACPOLY,pl:Plc)== ff:=numer u gg:=denom u evalIfCan(ff,gg,pl) + intersectionDivisor : DistributedMultivariatePolynomial(symb,K) -> _ + Divisor(Places(K)) intersectionDivisor(pol)==intersectionDivisor(pol)$BP + fullDesTree : () -> Void fullDesTree== fullOutput()$DesTree => fullOutput(false())$DesTree fullOutput(true())$DesTree + fullInfClsPt : () -> Void fullInfClsPt== fullOutput()$InfClsPoint => fullOutput(false())$InfClsPoint fullOutput(true())$InfClsPoint @@ -188432,61 +190996,94 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where import BP + homogenize : (DistributedMultivariatePolynomial(symb,K),Integer) -> _ + DistributedMultivariatePolynomial(symb,K) homogenize(pol,n) == homogenize(pol,n)$PackageForPoly(K,PolyRing,E,#symb) - toPolyRing2: PolyRing -> PolyRing2 - - toPolyRing: PolyRing2 -> PolyRing - + projectivePoint : List(PseudoAlgebraicClosureOfFiniteField(K)) -> _ + ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K) projectivePoint(lpt)==projectivePoint(lpt)$ProjPt + pointDominateBy : PlacesOverPseudoAlgebraicClosureOfFiniteField(K) -> _ + ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K) pointDominateBy(pl)== pointDominateBy(pl)$BP + placesAbove: ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K) ->_ + List(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) placesAbove(pt)== placesAbove(pt)$BP - setSingularPoints(lspt)== setSingularPoints(lspt)$BP + setSingularPoints : _ + List(ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)) -> _ + List(ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)) + setSingularPoints(lspt) == setSingularPoints(lspt)$BP + findOrderOfDivisor : _ + (Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),Integer,_ + Integer) -> Record(ord: Integer,_ + num: DistributedMultivariatePolynomial(symb,K),_ + den: DistributedMultivariatePolynomial(symb,K),upTo: Integer) findOrderOfDivisor(divis,lb,hb) == ens:=findOrderOfDivisor(divis,lb,hb)$BP [ens.ord, toPolyRing ens.num, toPolyRing ens.den, ens.upTo] + setCurve : DistributedMultivariatePolynomial(symb,K) -> _ + DistributedMultivariatePolynomial(symb,K) setCurve(pol)== ooo:=setCurve(toPolyRing2 pol)$BP pol + ZetaFunction : () -> UnivariateTaylorSeriesCZero(Integer,t) ZetaFunction == ZetaFunction()$BP + ZetaFunction : PositiveInteger -> UnivariateTaylorSeriesCZero(Integer,t) ZetaFunction(d) == ZetaFunction(d)$BP + numberOfPlacesOfDegree : PositiveInteger -> Integer numberOfPlacesOfDegree(i)==numberOfPlacesOfDegree(i)$BP + placesOfDegree : PositiveInteger -> _ + List(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) placesOfDegree(i) ==placesOfDegree(i)$BP + numberRatPlacesExtDeg : PositiveInteger -> Integer numberRatPlacesExtDeg(extDegree)==numberRatPlacesExtDeg(extDegree)$BP + numberPlacesDegExtDeg : (PositiveInteger,PositiveInteger) -> Integer numberPlacesDegExtDeg(degree,extDegree)== numberPlacesDegExtDeg(degree,extDegree)$BP + LPolynomial : () -> SparseUnivariatePolynomial(Integer) LPolynomial == LPolynomial()$BP + LPolynomial : PositiveInteger -> SparseUnivariatePolynomial(Integer) LPolynomial(extDeg)==LPolynomial(extDeg)$BP - classNumber== classNumber()$BP + classNumber : () -> Integer + classNumber == classNumber()$BP + rationalPoints : () -> _ + List(ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)) rationalPlaces == rationalPlaces()$BP + rationalPlaces : () -> _ + List(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) rationalPoints==rationalPoints()$BP + goppaCode : (Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),_ + List(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))) -> Matrix(K) goppaCode(d:DIVISOR,lp:List(Plc))== lb:=lBasis(d) dd:=lb.den ll:=[[eval(f,dd,pl) for pl in lp] for f in lb.num] matrix ll + goppaCode : (Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),_ + Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))) -> Matrix(K) goppaCode(d:DIVISOR,p:DIVISOR)== lp:=supp p goppaCode(d,lp) + toPolyRing: PolyRing2 -> PolyRing toPolyRing(pol)== zero?(pol) => 0$PolyRing lc:=leadingCoefficient pol @@ -188495,6 +191092,7 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where lt:=degree lm monomial(lce,lt)$PolyRing + toPolyRing( reductum pol ) + toPolyRing2: PolyRing -> PolyRing2 toPolyRing2(pol)== zero?(pol) => 0$PolyRing2 lc:=leadingCoefficient pol @@ -188503,6 +191101,9 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where lt:=degree lm monomial(lce,lt)$PolyRing2 + toPolyRing2( reductum pol ) + evalIfCan : (DistributedMultivariatePolynomial(symb,K), + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> _ + Union(K,"failed") evalIfCan(f:PolyRing,pl:Plc)== dd:= degree pl ^one?(dd) => error " cannot evaluate at place of degree greater than one" @@ -188510,12 +191111,17 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where ee case "failed" => "failed" retract ee + eval : (DistributedMultivariatePolynomial(symb,K),_ + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> K eval(f:PolyRing,pl:Plc)== dd:= degree pl ^one?(dd) => error " cannot evaluate at place of degree greater than one" ee:=eval(toPolyRing2 f,pl)$BP retract ee + lBasis : Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> _ + Record(num: List(DistributedMultivariatePolynomial(symb,K)),_ + den: DistributedMultivariatePolynomial(symb,K)) lBasis(divis)== ans:=lBasis(divis)$BP nn:=ans.num @@ -188524,37 +191130,67 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where ddd:=toPolyRing dd [nnd,ddd] - genus==genus()$BP + genus : () -> NonNegativeInteger + genus == genus()$BP - genusNeg==genusNeg()$BP + genusNeg : () -> Integer + genusNeg == genusNeg()$BP + theCurve : () -> DistributedMultivariatePolynomial(symb,K) theCurve== ccc:= theCurve()$BP toPolyRing ccc - desingTree==desingTree()$BP + desingTree : () -> _ + List(DesingTree(_ + InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField(K,_ + symb,BLMET))) + desingTree == desingTree()$BP + desingTreeWoFullParam : () -> _ + List(DesingTree(_ + InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField(K,_ + symb,BLMET))) desingTreeWoFullParam== desingTreeWoFullParam()$BP -- compute the adjunction divisor of the curve using -- adjunctionDivisor from DesingTreePackage + adjunctionDivisor : () -> _ + Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) adjunctionDivisor == adjunctionDivisor()$BP - singularPoints==singularPoints()$BP + singularPoints : () -> _ + List(ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)) + singularPoints == singularPoints()$BP + parametrize : (DistributedMultivariatePolynomial(symb,K),_ + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> _ + NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)) parametrize(f,pl)== ff:= toPolyRing2 f parametrize(ff,pl)$BP -- compute the interpolating forms (see package InterpolateFormsPackage) + interpolateForms : _ + (Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),_ + NonNegativeInteger) -> List(DistributedMultivariatePolynomial(symb,K)) interpolateForms(d,n)== ans:=interpolateForms(d,n)$BP [toPolyRing pol for pol in ans] + interpolateFormsForFact : _ + (Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),_ + List(DistributedMultivariatePolynomial(symb,K))) -> _ + List(DistributedMultivariatePolynomial(symb,_ + PseudoAlgebraicClosureOfFiniteField(K))) interpolateFormsForFact(d,lm)== lm2:List PolyRing2 := [ toPolyRing2 p for p in lm] interpolateFormsForFact(d,lm2)$BP + evalIfCan : (DistributedMultivariatePolynomial(symb,K),_ + DistributedMultivariatePolynomial(symb,K),_ + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> _ + Union(K,"failed") evalIfCan(ff:PolyRing,gg:PolyRing,pl:Plc)== dd:= degree pl ^one?(dd) => error " cannot evaluate at place of degree greater than one" @@ -188564,6 +191200,9 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where ee case "failed" => "failed" retract ee + eval : (DistributedMultivariatePolynomial(symb,K),_ + DistributedMultivariatePolynomial(symb,K),_ + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> K eval(ff:PolyRing,gg:PolyRing,pl:Plc)== dd:= degree pl ^one?(dd) => error " cannot evaluate at place of degree greater than one" @@ -188572,24 +191211,33 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where ee:=eval(f,g,pl)$BP retract ee + evalIfCan : (Fraction(DistributedMultivariatePolynomial(symb,K)), + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> _ + Union(K,"failed") evalIfCan(u:FracPoly,pl:Plc)== ff:=numer u gg:=denom u evalIfCan(ff,gg,pl) + eval : (Fraction(DistributedMultivariatePolynomial(symb,K)),_ + PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) -> K eval(u:FracPoly,pl:Plc)== ff:=numer u gg:=denom u eval(ff,gg,pl) + intersectionDivisor : DistributedMultivariatePolynomial(symb,K) -> _ + Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)) intersectionDivisor(pol)== polu:=toPolyRing2 pol intersectionDivisor(polu)$BP + fullDesTree : () -> Void fullDesTree== fullOutput()$DesTree => fullOutput(false())$DesTree fullOutput(true())$DesTree + fullInfClsPt : () -> Void fullInfClsPt== fullOutput()$InfClsPoint => fullOutput(false())$InfClsPoint fullOutput(true())$InfClsPoint @@ -188990,6 +191638,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where import PolyRing + monomials : PolyRing -> List(PolyRing) monomials(pol)== zero? pol => empty() lt:=leadingMonomial pol @@ -189001,9 +191650,11 @@ PackageForPoly(R,PolyRing,E,dim): public == private where le.i := 1 directProduct( vector(le)$Vector(NNI) )$E - listVariable== + listVariable : () -> List(PolyRing) + listVariable == [monomial(1,ee)$PolyRing for ee in [lll(i) for i in 1..dim]] + univariate : PolyRing -> SparseUnivariatePolynomial(R) univariate(pol)== zero? pol => 0 d:=degree pol @@ -189011,24 +191662,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where td := reduce("+", entries d) monomial(lc,td)$SparseUnivariatePolynomial(R)+univariate(reductum pol) - collectExpon: List Term -> PolyRing - - translateLocal: (PolyRing,List R,Integer) -> PolyRing - - lA: (Integer,Integer) -> List List NNI - - toListRep: PolyRing -> List Term - - exponentEntryToZero: (E,Integer) -> E - - exponentEntryZero?: (E,Integer) -> Boolean - - homogenizeExp: (E,NNI,INT) -> E - - translateMonomial: (PolyRing,List R,INT,R) -> PolyRing - - leadingTerm: PolyRing -> Term - + mapExponents : ((E -> E),PolyRing) -> PolyRing mapExponents(f,pol)== zero?(pol) => 0 lt:=leadingTerm pol @@ -189036,11 +191670,13 @@ PackageForPoly(R,PolyRing,E,dim): public == private where newMono:PolyRing:= monomial(lt.c,newExp)$PolyRing newMono + mapExponents(f,reductum pol) + collectExpon: List Term -> PolyRing collectExpon(pol)== empty? pol => 0 ft:=first pol monomial(ft.c,ft.k) + collectExpon( rest pol ) + subs1stVar : (PolyRing,PolyRing) -> PolyRing subs1stVar(pol, spol)== zero? pol => 0 lexpE:E:= degree pol @@ -189049,6 +191685,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where coef * spol ** lexp.1 * second(listVariable())**lexp.2 _ + subs1stVar( reductum pol, spol ) + subs2ndVar : (PolyRing,PolyRing) -> PolyRing subs2ndVar(pol, spol)== zero? pol => 0 lexpE:E:= degree pol @@ -189057,10 +191694,12 @@ PackageForPoly(R,PolyRing,E,dim): public == private where coef * first(listVariable())**lexp.1 * spol ** lexp.2 _ + subs2ndVar( reductum pol, spol ) + subsInVar : (PolyRing,PolyRing,Integer) -> PolyRing subsInVar( pol, spol, n)== one?( n ) => subs1stVar( pol, spol) subs2ndVar(pol,spol) + translate : (PolyRing,List(R)) -> PolyRing translate(pol,lpt)== zero? pol => 0 lexpE:E:= degree pol @@ -189069,10 +191708,12 @@ PackageForPoly(R,PolyRing,E,dim): public == private where trVar:=[(listVariable().i + (lpt.i)::PolyRing)**lexp.i for i in 1..dim] coef * reduce("*",trVar,1) + translate(reductum pol , lpt) + translate : (PolyRing,List(R),Integer) -> PolyRing translate(poll,lpt,nV)== pol:=replaceVarByOne(poll,nV) translateLocal(pol,lpt,nV) + translateLocal: (PolyRing,List R,Integer) -> PolyRing translateLocal(pol,lpt,nV)== zero?(pol) => 0 lll:List R:=[l for l in lpt | ^zero?(l)] @@ -189085,15 +191726,18 @@ PackageForPoly(R,PolyRing,E,dim): public == private where translateMonomial(ltk,lpt,nV,ltc) + _ translateLocal(reductum(pol),lpt,nV) + exponentEntryToZero: (E,Integer) -> E exponentEntryToZero(exp,nV)== pexp:= parts exp pexp(nV):=0 directProduct(vector(pexp)$Vector(NonNegativeInteger)) + exponentEntryZero?: (E,Integer) -> Boolean exponentEntryZero?(exp,nV)== pexp:= parts exp zero?(pexp(nV)) + replaceVarByZero : (PolyRing,Integer) -> PolyRing replaceVarByZero(pol,nV)== -- surement le collectExpon ici n'est pas necessaire !!!! zero?(pol) => 0 @@ -189102,12 +191746,14 @@ PackageForPoly(R,PolyRing,E,dim): public == private where [monomial(p.c,p.k)$PolyRing _ for p in lRep | exponentEntryZero?(p.k,nV) ],0) + replaceVarByOne : (PolyRing,Integer) -> PolyRing replaceVarByOne(pol,nV)== zero?(pol) => 0 lRep:= toListRep pol reduce("+",_ [monomial(p.c,exponentEntryToZero(p.k,nV))$PolyRing for p in lRep],0) + homogenizeExp: (E,NNI,INT) -> E homogenizeExp(exp,deg,nV)== lv:List NNI:=parts(exp) lv.nV:=(deg+lv.nV - reduce("+",lv)) pretend NNI @@ -189118,18 +191764,22 @@ PackageForPoly(R,PolyRing,E,dim): public == private where zero? pol => empty cons( degree pol, listTerm reductum pol ) + degree : (PolyRing,Integer) -> NonNegativeInteger degree( a : PolyRing , n : Integer )== zero? a => error "Degree for 0 is not defined for this degree fnc" "max" / [ ee.n for ee in listTerm a ] + totalDegree : PolyRing -> NonNegativeInteger totalDegree p == zero? p => 0 "max"/[reduce("+",t::(Vector NNI), 0) for t in listTerm p] + homogenize : (PolyRing,Integer) -> PolyRing homogenize(pol,nV)== degP:=totalDegree(pol) mapExponents(homogenizeExp(#1,degP,nV),pol) + degOneCoef : (PolyRing,PositiveInteger) -> R degOneCoef(p:PolyRing,i:PI)== vv:=new(dim,0)$Vector(NNI) vv.i:=1 @@ -189138,6 +191788,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where lc:=[t.c for t in lp | t.k=pd] reduce("+",lc,0) + constant : PolyRing -> R constant(p)== vv:=new(dim,0)$Vector(NNI) pd:=directProduct(vv)$E @@ -189145,9 +191796,11 @@ PackageForPoly(R,PolyRing,E,dim): public == private where lc:=[t.c for t in lp | t.k=pd] reduce("+",lc,0) + degreeOfMinimalForm : PolyRing -> NonNegativeInteger degreeOfMinimalForm(pol)== totalDegree minimalForm pol + minimalForm : PolyRing -> PolyRing minimalForm(pol)== zero?(pol) => pol lpol:=toListRep pol @@ -189166,6 +191819,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where -- le code de collectExponSort a ete emprunte a D. Augot. + leadingTerm: PolyRing -> Term leadingTerm(pol)== zero?(pol) => error "no leading term for 0 (message from package)" lcoef:R:=leadingCoefficient(pol)$PolyRing @@ -189173,20 +191827,24 @@ PackageForPoly(R,PolyRing,E,dim): public == private where tt:E:=degree(lterm)$PolyRing [tt,lcoef]$Term + toListRep: PolyRing -> List Term toListRep(pol)== zero?(pol) => empty() lt:=leadingTerm pol cons(lt, toListRep reductum pol) + lA: (Integer,Integer) -> List List NNI lA(n,l)== zero?(n) => [new((l pretend NNI),0)$List(NNI)] one?(l) => [[(n pretend NNI)]] concat [[ concat([i],lll) for lll in lA(n-i,l-1)] for i in 0..n] + listAllMonoExp : Integer -> List(E) listAllMonoExp(l)== lst:=lA(l,(dim pretend Integer)) [directProduct(vector(pexp)$Vector(NNI)) for pexp in lst] + translateMonomial: (PolyRing,List R,INT,R) -> PolyRing translateMonomial(mono,pt,nV,coef)== lexpE:E:= degree mono lexp:List NNI:= parts lexpE @@ -189194,6 +191852,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where trVar:=[(listVariable().i + (pt.i)::PolyRing)** lexp.i for i in 1..dim] coef * reduce("*",trVar,1) + listAllMono : NonNegativeInteger -> List(PolyRing) listAllMono(l)== [monomial(1,e)$PolyRing for e in listAllMonoExp(l)] @@ -189315,6 +191974,11 @@ PadeApproximantPackage(R: Field, x:Symbol, pt:R): Exports == Implementation wher u,v : PS pa := PadeApproximants(R,PS,UP) + pade : (NonNegativeInteger,_ + NonNegativeInteger,_ + UnivariateTaylorSeries(R,x,pt),_ + UnivariateTaylorSeries(R,x,pt)) -> _ + Union(Fraction(UnivariatePolynomial(x,R)),"failed") pade(n,m,u,v) == ans:=pade(n,m,u,v)$pa ans case "failed" => ans @@ -189326,6 +191990,10 @@ PadeApproximantPackage(R: Field, x:Symbol, pt:R): Exports == Implementation wher den := den(xpt) num/den + pade : (NonNegativeInteger,_ + NonNegativeInteger,_ + UnivariateTaylorSeries(R,x,pt)) -> _ + Union(Fraction(UnivariatePolynomial(x,R)),"failed") pade(n,m,u) == pade(n,m,u,1) *) @@ -189535,27 +192203,31 @@ PadeApproximants(R,PS,UP): Exports == Implementation where -- p0 + x**a1/(p1 + x**a2/(...)) PadeRep ==> Record(ais: List UP, degs: List NNI) -- #ais= #degs + PadeU ==> Union(PadeRep, "failed") -- #ais= #degs+1 + constInner : UP -> PadeU constInner(up:UP):PadeU == [[up], []] + truncPoly : (UP,NNI) -> UP truncPoly(p:UP,n:NNI):UP == while n < degree p repeat p := reductum p p + truncSeries : (PS,NNI) -> UP truncSeries(s:PS,n:NNI):UP == p: UP := 0 for i in 0..n repeat p := p + monomial(coefficient(s,i),i) p -- Assumes s starts with a*x**n + ... and divides out x**n. + divOutDegree : (PS,NNI) -> PS divOutDegree(s:PS,n:NNI):PS == for i in 1..n repeat s := quoByVar s s - padeNormalize: (NNI,NNI,PS,PS) -> PadeU - padeInner: (NNI,NNI,PS,PS) -> PadeU - + pade : (NonNegativeInteger,NonNegativeInteger,PS,PS) -> _ + Union(Fraction(UP),"failed") pade(l,m,gps,dps) == (ad := padeNormalize(l,m,gps,dps)) case "failed" => "failed" plist := ad.ais; dlist := ad.degs @@ -189564,6 +192236,8 @@ PadeApproximants(R,PS,UP): Exports == Implementation where approx := p::QF + (monomial(1,d)$UP :: QF)/approx approx + padecf : (NonNegativeInteger,NonNegativeInteger,PS,PS) -> _ + Union(ContinuedFraction(UP),"failed") padecf(l,m,gps,dps) == (ad := padeNormalize(l,m,gps,dps)) case "failed" => "failed" alist := reverse(ad.ais) @@ -189571,6 +192245,7 @@ PadeApproximants(R,PS,UP): Exports == Implementation where continuedFraction(first(alist),_ blist::Stream UP,(rest alist) :: Stream UP) + padeNormalize: (NNI,NNI,PS,PS) -> PadeU padeNormalize(l,m,gps,dps) == zero? dps => "failed" zero? gps => constInner 0 @@ -189581,6 +192256,7 @@ PadeApproximants(R,PS,UP): Exports == Implementation where gps := divOutDegree(gps,ldeg) padeInner(l,m,gps,dps) + padeInner: (NNI,NNI,PS,PS) -> PadeU padeInner(l, m, gps, dps) == zero? coefficient(gps,0) and zero? coefficient(dps,0) => error "Pade' problem not normalized." @@ -189948,6 +192624,7 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where import ModularHermitianRowReduction(R) import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) + reducedDiscriminant : UP -> R reducedDiscriminant f == ff : SUP Q := mapUnivariate((r1:R):Q+->r1 :: Q,f)$IBPTOOLS(R,UP,SUP UP,Q) ee := extendedEuclidean(ff,differentiate ff) @@ -190067,6 +192744,8 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where index := diagonalProduct(ib.basisInv) [ib.basis,ib.basisDen,ib.basisInv,disc quo (index * index)] + localIntegralBasis : R -> _ + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) localIntegralBasis prime == p := definingPolynomial()$F; disc := discriminant p --disc := determinant traceMatrix()$F @@ -190084,6 +192763,8 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where if f.exponent > 1 then ans := concat(f.factor,ans) ans + integralBasis : () -> _ + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) integralBasis() == p := definingPolynomial()$F; disc := discriminant p; n := rank()$F --traceMat := traceMatrix()$F; n := rank()$F @@ -190207,6 +192888,7 @@ ParadoxicalCombinatorsForStreams(A):Exports == Implementation where (* package YSTREAM *) (* + Y : (Stream(A) -> Stream(A)) -> Stream(A) Y f == y : ST A := CONS(0$I,0$I)$Lisp j := f y @@ -190214,6 +192896,7 @@ ParadoxicalCombinatorsForStreams(A):Exports == Implementation where RPLACD(y,rst j)$Lisp y + Y : ((List(Stream(A)) -> List(Stream(A))),Integer) -> List(Stream(A)) Y(g,n) == x : L ST A := [CONS(0$I,0$I)$Lisp for i in 1..n] j := g x @@ -190988,16 +193671,23 @@ ParametricLinearEquations(R,Var,Expon,GR): (* package PLEQN *) (* + inconsistent? : List(GR) -> Boolean inconsistent?(pl:L GR):Boolean == for p in pl repeat ground? p => return true false + inconsistent? : List(Polynomial(R)) -> Boolean inconsistent?(pl:L PR):Boolean == for p in pl repeat ground? p => return true false + B1solve : Record(mat: Matrix(Fraction(Polynomial(R))),_ + vec: List(Fraction(Polynomial(R))),rank: NonNegativeInteger,_ + rows: List(Integer),cols: List(Integer)) -> _ + Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))) B1solve (sys:Linsys):Linsoln == i,j,i1,j1:I rss:L I:=sys.rows @@ -191032,6 +193722,12 @@ ParametricLinearEquations(R,Var,Expon,GR): pbas:=cons(pb,pbas) [p,pbas] + regime : (Record(det: GR,rows: List(Integer),cols: List(Integer)),_ + Matrix(GR),List(Fraction(Polynomial(R))),List(List(GR)),_ + NonNegativeInteger,NonNegativeInteger,Integer) -> _ + Record(eqzro: List(GR),neqzro: List(GR),wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R)))))) regime (y, coef, w, psbf, rk, rkmax, mode) == i,j:I -- use the y.det nonzero to simplify the groebner basis @@ -191068,6 +193764,11 @@ ParametricLinearEquations(R,Var,Expon,GR): not test.sysok => [test.z0, test.n0, [1$PR]$(L PR), pps]$Rec3 [test.z0, test.n0, [], redpps(pps, test.z0)]$Rec3 + bsolve : (Matrix(GR),List(Fraction(Polynomial(R))),NonNegativeInteger,_ + String,Integer) -> Record(rgl: List(Record(eqzro: List(GR),_ + neqzro: List(GR),wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))),rgsz: Integer) bsolve (coeff, w, h, outname, mode) == r:=nrows coeff r ^= #w => error "number of rows unequal on lhs and rhs" @@ -191101,10 +193802,15 @@ ParametricLinearEquations(R,Var,Expon,GR): if filemode then close_! rksoln [lrec3, count]$Ranksolns + factorset : GR -> List(GR) factorset y == ground? y => [] [j.factor for j in factors(factor$mf y)] + ParCondList : (Matrix(GR),NonNegativeInteger) -> _ + List(Record(rank: NonNegativeInteger,_ + eqns: List(Record(det: GR,rows: List(Integer),_ + cols: List(Integer))),fgb: List(GR))) ParCondList (mat, h) == rcl: RankConds:= [] ps: L GR:=[] @@ -191139,6 +193845,10 @@ ParametricLinearEquations(R,Var,Expon,GR): rcl:=cons(pcl,rcl) rcl + redpps : (Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))),List(GR)) -> _ + Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))) redpps(pps, zz) == pv:=pps.partsol r:=#pv @@ -191164,6 +193874,7 @@ ParametricLinearEquations(R,Var,Expon,GR): pb.(j-1):=pbj [pv, pb] + dmp2rfi : Matrix(GR) -> Matrix(Fraction(Polynomial(R))) dmp2rfi (mat:M GR): M GF == r:=nrows mat n:=ncols mat @@ -191173,36 +193884,68 @@ ParametricLinearEquations(R,Var,Expon,GR): nmat(i,j):=dmp2rfi mat(i,j) nmat + dmp2rfi : List(GR) -> List(Fraction(Polynomial(R))) dmp2rfi (vl: L GR):L GF == [dmp2rfi v for v in vl] + psolve : (Matrix(GR),List(GR)) -> _ + List(Record(eqzro: List(GR),neqzro: List(GR),_ + wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) psolve (mat:M GR, w:L GR): L Rec3 == bsolve(mat, dmp2rfi w, 1, "nofile", 1).rgl + psolve : (Matrix(GR),List(Symbol)) -> _ + List(Record(eqzro: List(GR),neqzro: List(GR),_ + wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) psolve (mat:M GR, w:L Symbol): L Rec3 == bsolve(mat, se2rfi w, 1, "nofile", 2).rgl + psolve : Matrix(GR) -> List(Record(eqzro: List(GR),neqzro: List(GR),_ + wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) psolve (mat:M GR): L Rec3 == bsolve(mat, [0$GF for i in 1..nrows mat], 1, "nofile", 3).rgl + psolve : (Matrix(GR),List(GR),PositiveInteger) -> _ + List(Record(eqzro: List(GR),neqzro: List(GR),wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) psolve (mat:M GR, w:L GR, h:PI): L Rec3 == bsolve(mat, dmp2rfi w, h::NNI, "nofile", 4).rgl + psolve : (Matrix(GR),List(Symbol),PositiveInteger) -> _ + List(Record(eqzro: List(GR),neqzro: List(GR),wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) psolve (mat:M GR, w:L Symbol, h:PI): L Rec3 == bsolve(mat, se2rfi w, h::NNI, "nofile", 5).rgl + psolve : (Matrix(GR),PositiveInteger) -> _ + List(Record(eqzro: List(GR),neqzro: List(GR),_ + wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) psolve (mat:M GR, h:PI): L Rec3 == bsolve(mat, [0$GF for i in 1..nrows mat], h::NNI, "nofile", 6).rgl + psolve : (Matrix(GR),List(GR),String) -> Integer psolve (mat:M GR, w:L GR, outname:S): I == bsolve(mat, dmp2rfi w, 1, outname, 7).rgsz + psolve : (Matrix(GR),List(Symbol),String) -> Integer psolve (mat:M GR, w:L Symbol, outname:S): I == bsolve(mat, se2rfi w, 1, outname, 8).rgsz + psolve : (Matrix(GR),String) -> Integer psolve (mat:M GR, outname:S): I == bsolve(mat, [0$GF for i in 1..nrows mat], 1, outname, 9).rgsz + nextSublist : (Integer,Integer) -> List(List(Integer)) nextSublist (n,k) == n <= 0 => [] k <= 0 => [ nil$(List Integer) ] @@ -191213,13 +193956,20 @@ ParametricLinearEquations(R,Var,Expon,GR): mslist:=cons(append(ms,[n]),mslist) append(nextSublist(n-1,k), mslist) + psolve : (Matrix(GR),List(GR),PositiveInteger,String) -> Integer psolve (mat:M GR, w:L GR, h:PI, outname:S): I == bsolve(mat, dmp2rfi w, h::NNI, outname, 10).rgsz + + psolve : (Matrix(GR),List(Symbol),PositiveInteger,String) -> Integer psolve (mat:M GR, w:L Symbol, h:PI, outname:S): I == bsolve(mat, se2rfi w, h::NNI, outname, 11).rgsz + + psolve : (Matrix(GR),PositiveInteger,String) -> Integer psolve (mat:M GR, h:PI, outname:S): I == bsolve(mat,[0$GF for i in 1..nrows mat],h::NNI,outname, 12).rgsz + hasoln : (List(GR),List(GR)) -> _ + Record(sysok: Boolean,z0: List(GR),n0: List(GR)) hasoln (zro,nzro) == empty? zro => [true, zro, nzro] zro:=groebner$gb zro @@ -191237,12 +193987,18 @@ ParametricLinearEquations(R,Var,Expon,GR): nzro:=[p for p in nzro | ^(ground? p)] [true, zro, nzro] + se2rfi : List(Symbol) -> List(Fraction(Polynomial(R))) se2rfi w == [coerce$GF monomial$PR (1$PR, wi, 1) for wi in w] + pr2dmp : Polynomial(R) -> GR pr2dmp p == ground? p => (ground p)::GR algCoerceInteractive(p,PR,GR)$(Lisp) pretend GR + wrregime : (List(Record(eqzro: List(GR),neqzro: List(GR),_ + wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))),String) -> Integer wrregime (lrec3, outname) == newfile:FNAME:=new$FNAME ("",outname,"regime") rksoln: File Rec3:=open$(File Rec3) newfile @@ -191253,11 +194009,15 @@ ParametricLinearEquations(R,Var,Expon,GR): close_!(rksoln) count + dmp2rfi : GR -> Fraction(Polynomial(R)) dmp2rfi (p:GR):GF == map$plift ((v1:Var):GF +-> (convert v1)@Symbol::GF, (r1:R):GF +-> r1::PR::GF, p) - + rdregime : String -> List(Record(eqzro: List(GR),neqzro: List(GR),_ + wcond: List(Polynomial(R)),_ + bsoln: Record(partsol: Vector(Fraction(Polynomial(R))),_ + basis: List(Vector(Fraction(Polynomial(R))))))) rdregime inname == infilename:=filename$FNAME ("",inname, "regime") infile: File Rec3:=open$(File Rec3) (infilename, "input") @@ -191269,20 +194029,30 @@ ParametricLinearEquations(R,Var,Expon,GR): close_!(infile) rksoln + maxrank : List(Record(rank: NonNegativeInteger,_ + eqns: List(Record(det: GR,rows: List(Integer),cols: List(Integer))),_ + fgb: List(GR))) -> NonNegativeInteger maxrank rcl == empty? rcl => 0 "max"/[j.rank for j in rcl] + minrank : List(Record(rank: NonNegativeInteger,_ + eqns: List(Record(det: GR,rows: List(Integer),cols: List(Integer))),_ + fgb: List(GR))) -> NonNegativeInteger minrank rcl == empty? rcl => 0 "min"/[j.rank for j in rcl] + minset : List(List(GR)) -> List(List(GR)) minset lset == empty? lset => lset [x for x in lset | ^(overset?(x,lset))] + sqfree : GR -> GR sqfree p == */[j.factor for j in factors(squareFree p)] + ParCond : (Matrix(GR),NonNegativeInteger) -> _ + List(Record(det: GR,rows: List(Integer),cols: List(Integer))) ParCond (mat, k) == k = 0 => [[1, [], []]$Rec] j:NNI:=k::NNI @@ -191303,11 +194073,13 @@ ParametricLinearEquations(R,Var,Expon,GR): found => [first DetEqn]$Eqns sort((z1:Rec,z2:Rec):Boolean +-> degree z1.det < degree z2.det, DetEqn) + overset? : (List(GR),List(List(GR))) -> Boolean overset?(p,qlist) == empty? qlist => false or/[(brace$(Set GR) q) <$(Set GR) (brace$(Set GR) p) _ for q in qlist] + redmat : (Matrix(GR),List(GR)) -> Matrix(GR) redmat (mat,psb) == i,j:I r:=nrows(mat) @@ -191391,6 +194163,7 @@ ParametricPlaneCurveFunctions2(CF1: Type, CF2:Type): with (* package PARPC2 *) (* + map : ((CF1 -> CF2),ParametricPlaneCurve(CF1)) -> ParametricPlaneCurve(CF2) map(f, c) == curve(f coordinate(c,1), f coordinate(c, 2)) *) @@ -191464,6 +194237,7 @@ ParametricSpaceCurveFunctions2(CF1: Type, CF2:Type): with (* package PARSC2 *) (* + map : ((CF1 -> CF2),ParametricSpaceCurve(CF1)) -> ParametricSpaceCurve(CF2) map(f, c) == curve(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3)) *) @@ -191537,6 +194311,7 @@ ParametricSurfaceFunctions2(CF1: Type, CF2:Type): with (* package PARSU2 *) (* + map : ((CF1 -> CF2),ParametricSurface(CF1)) -> ParametricSurface(CF2) map(f, c) == surface(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3)) *) @@ -191685,6 +194460,7 @@ ParametrizationPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):Exp == Impl where -- the precomputed local parametrization -- of the point pt. Note if pl is a place and pl = pt::PLc then -- parametrize(f,pt) <> parametrize(pl) unless pt is a simple point + parametrize : (PolyRing,List(PCS)) -> PCS parametrize(f:PolyRing,localPar:List(PCS))== zero?(f) => 0 lc:K:=leadingCoefficient(f) @@ -191695,16 +194471,19 @@ ParametrizationPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):Exp == Impl where monoPar:PCS:=reduce("*",[ s**e for s in localPar for e in ldp]) lc* monoPar + parametrize(reductum(f),localPar) + parametrize : (PolyRing,Plc) -> PCS parametrize(f:PolyRing,pt:Plc)== zero?(f) => 0 localPar:List PCS:=localParam pt parametrize(f,localPar) + parametrize : (PolyRing,PolyRing,Plc) -> PCS parametrize(f:PolyRing,g:PolyRing,pt:Plc)== sf:=parametrize(f,pt) sg:=parametrize(g,pt) sf * inv sg + parametrize : (PolyRing,Plc,Integer) -> PCS parametrize(f:PolyRing,pt:Plc,n:Integer)== s:=parametrize(f,pt) shift(s,n) @@ -191894,15 +194673,18 @@ PartialFractionPackage(R): Cat == Capsule where (* package PFRPAC *) (* + partialFraction : (Fraction(Polynomial(R)),Symbol) -> Any partialFraction(rf, v) == df := factor(denom rf)$MultivariateFactorize(Symbol, INDE,R,PR) partialFraction(numer rf, df, v) + makeSup : (Polynomial R,Symbol) -> SparseUnivariatePolynomial FPR makeSup(p:Polynomial R, v:Symbol) : SparseUnivariatePolynomial FPR == up := univariate(p,v) map((z1:PR):FPR +-> z1::FPR,up)_ $UnivariatePolynomialCategoryFunctions2(PR, SUP PR, FPR, SUP FPR) + partialFraction : (Polynomial(R),Factored(Polynomial(R)),Symbol) -> Any partialFraction(p, facq, v) == up := UnivariatePolynomial(v, Fraction Polynomial R) fup := Factored up @@ -191910,7 +194692,7 @@ PartialFractionPackage(R): Cat == Capsule where ffact:=[[makeSup(u.factor,v) pretend up,u.exponent] for u in factors facq] fcont:=makeSup(unit facq,v) pretend up - nflist:fup := fcont*(*/[primeFactor(ff.irr,ff.pow) for ff in ffact]) + nflist:fup := fcont*( */[primeFactor(ff.irr,ff.pow) for ff in ffact]) pfup:=partialFraction(makeSup(p,v) pretend up,nflist)$PartialFraction(up) coerce(pfup)$AnyFunctions1(PartialFraction up) @@ -192100,14 +194882,17 @@ PartitionsAndPermutations: Exports == Implementation where (* package PARTPERM *) (* + partitions : (Integer,Integer,Integer) -> Stream(List(Integer)) partitions(M,N,n) == zero? n => concat(empty()$L(I),empty()$(ST L I)) zero? M or zero? N or n < 0 => empty() c := map((l1:List(I)):List(I)+->concat(N,l1),partitions(M - 1,N,n - N)) concat(c,partitions(M,N - 1,n)) + partitions : Integer -> Stream(List(Integer)) partitions n == partitions(n,n,n) + partitions : (Integer,Integer) -> Stream(List(Integer)) partitions(M,N)== aaa : L ST L I := [partitions(M,N,i) for i in 0..M*N] concat(aaa :: ST ST L I)$ST1(L I) @@ -192117,18 +194902,22 @@ PartitionsAndPermutations: Exports == Implementation where nogreq: (I,L I) -> I nogreq(n,x) == +/[1 for i in x | i >= n] + conjugate : List(Integer) -> List(Integer) conjugate x == empty? x => empty() [nogreq(i,x) for i in 1..first x] + conjugates : Stream(List(Integer)) -> Stream(List(Integer)) conjugates z == map(conjugate,z) + shuffle : (List(Integer),List(Integer)) -> Stream(List(Integer)) shuffle(x,y)== empty? x => concat(y,empty())$(ST L I) empty? y => concat(x,empty())$(ST L I) concat(map((l1:List(I)):List(I)+->concat(first x,l1),shuffle(rest x,y)),_ map((l2:List(I)):List(I)+->concat(first y,l2),shuffle(x,rest y))) + shufflein : (List(Integer),Stream(List(Integer))) -> Stream(List(Integer)) shufflein(x,yy) == concat(map((l1:List(I)):ST(L I)+->shuffle(x,l1),yy)_ $ST2(L I,ST L I))$ST1(L I) @@ -192142,12 +194931,15 @@ PartitionsAndPermutations: Exports == Implementation where zrpt: (L I,L I) -> ST L I zrpt(x,y) == map(rpt,x :: ST I,y :: ST I)$ST3(I,I,L I) + sequences : (List(Integer),List(Integer)) -> Stream(List(Integer)) sequences(x,y) == reduce(concat(empty()$L(I),empty()$(ST L I)),_ shufflein,zrpt(x,y))$ST2(L I,ST L I) + sequences : List(Integer) -> Stream(List(Integer)) sequences x == sequences(x,[i for i in 0..#x-1]) + permutations : Integer -> Stream(List(Integer)) permutations n == sequences(rpt(n,1),[i for i in 1..n]) *) @@ -192294,32 +195086,40 @@ PatternFunctions1(R:SetCategory, D:Type): with A1 ==> AnyFunctions1(D -> Boolean) A1L ==> AnyFunctions1(List D -> Boolean) - applyAll: (List Any, D) -> Boolean - st : (Pattern R, List Any) -> Pattern R - + + st : (Pattern R, List Any) -> Pattern R st(p, l) == withPredicates(p, concat(predicates p, l)) + predicate : Pattern(R) -> (D -> Boolean) predicate p == (d1:D):Boolean +-> applyAll(predicates p, d1) + addBadValue : (Pattern(R),D) -> Pattern(R) addBadValue(p, v) == addBadValue(p, coerce(v)$A1D) - badValues p == [retract(v)$A1D for v in getBadValues p] + badValues : Pattern(R) -> List(D) + badValues p == [retract(v)$A1D for v in getBadValues p] + suchThat : (Pattern(R),List(Symbol),(List(D) -> Boolean)) -> Pattern(R) suchThat(p, l, f) == setTopPredicate(copy p, l, coerce(f)$A1L) + suchThat : (Pattern(R),(D -> Boolean)) -> Pattern(R) suchThat(p:Pattern R, f:D -> Boolean) == st(p, [coerce(f)$A1]) - satisfy?(d:D, p:Pattern R) == applyAll(predicates p, d) + satisfy? : (List(D),Pattern(R)) -> Boolean + satisfy?(d:D, p:Pattern R) == applyAll(predicates p, d) + satisfy? : (D,Pattern(R)) -> Boolean satisfy?(l:List D, p:Pattern R) == empty?((rec := topPredicate p).var) => true retract(rec.pred)$A1L l + applyAll: (List Any, D) -> Boolean applyAll(l, d) == for f in l repeat not(retract(f)$A1 d) => return false true + suchThat : (Pattern(R),List((D -> Boolean))) -> Pattern(R) suchThat(p:Pattern R, l:List(D -> Boolean)) == st(p, [coerce(f)$A1 for f in l]) @@ -192424,6 +195224,7 @@ PatternFunctions2(R:SetCategory, S:SetCategory): with (* package PATTERN2 *) (* + map : ((R -> S),Pattern(R)) -> Pattern(S) map(f, p) == (r := (retractIfCan p)@Union(R, "failed")) case R => f(r::R)::Pattern(S) @@ -192596,17 +195397,21 @@ PatternMatch(Base, Subject, Pat): Exports == Implementation where import PatternMatchListAggregate(Base, Subject, List Subject) ist: (Subject, Pat) -> PatternMatchResult(Base, Subject) + ist(s, p) == patternMatch(s, convert p, new()) - ist(s, p) == patternMatch(s, convert p, new()) - - is?(s: Subject, p:Pat) == not failed? ist(s, p) + is? : (Subject,Pat) -> Boolean + is?(s: Subject, p:Pat) == not failed? ist(s, p) + is? : (List(Subject),Pat) -> Boolean is?(s:List Subject, p:Pat) == not failed? Is(s, p) + Is : (List(Subject),Pat) -> _ + PatternMatchListResult(Base,Subject,List(Subject)) Is(s:List Subject, p:Pat) == patternMatch(s, convert p, new()) if Subject has RetractableTo(Symbol) then + Is : (Subject,Pat) -> List(Equation(Subject)) Is(s:Subject, p:Pat):List(Equation Subject) == failed?(r := ist(s, p)) => empty() [rec.key::Subject = rec.entry for rec in destruct r] @@ -192615,6 +195420,7 @@ PatternMatch(Base, Subject, Pat): Exports == Implementation where if Subject has Ring then + Is : (Subject,Pat) -> List(Equation(Polynomial(Subject))) Is(s:Subject, p:Pat):List(Equation Polynomial Subject) == failed?(r := ist(s, p)) => empty() [rec.key::Polynomial(Subject) =$Equation(Polynomial Subject) @@ -192622,6 +195428,7 @@ PatternMatch(Base, Subject, Pat): Exports == Implementation where else + Is : (Subject,Pat) -> PatternMatchResult(Base,Subject) Is(s:Subject,p:Pat):PatternMatchResult(Base,Subject) == ist(s,p) *) @@ -192737,12 +195544,16 @@ PatternMatchAssertions(): Exports == Implementation where import FunctionSpaceAssertions(Integer, FE) - constant x == constant(x::FE) + constant : Symbol -> Expression(Integer) + constant x == constant(x::FE) - multiple x == multiple(x::FE) + multiple : Symbol -> Expression(Integer) + multiple x == multiple(x::FE) - optional x == optional(x::FE) + optional : Symbol -> Expression(Integer) + optional x == optional(x::FE) + assert : (Symbol,String) -> Expression(Integer) assert(x, s) == assert(x::FE, s) *) @@ -192883,6 +195694,8 @@ PatternMatchFunctionSpace(S, R, F): Exports== Implementation where import PatternMatchTools(S, R, F) import PatternMatchPushDown(S, R, F) + patternMatch : (F,Pattern(S),PatternMatchResult(S,F)) -> _ + PatternMatchResult(S,F) patternMatch(x, p, l) == generic? p => addMatch(p, x, l) (r := retractIfCan(x)@Union(R, "failed")) case R => @@ -193063,19 +195876,19 @@ PatternMatchIntegerNumberSystem(I:IntegerNumberSystem): with PAT ==> Pattern Integer PMR ==> PatternMatchResult(Integer, I) - patternMatchInner : (I, PAT, PMR) -> PMR - patternMatchRestricted: (I, PAT, PMR, I) -> PMR - patternMatchSumProd : - (I, List PAT, PMR, (I, I) -> Union(I, "failed"), I) -> PMR - + patternMatch : (I,Pattern(Integer),PatternMatchResult(Integer,I)) -> _ + PatternMatchResult(Integer,I) patternMatch(x, p, l) == generic? p => addMatch(p, x, l) patternMatchInner(x, p, l) + patternMatchRestricted: (I, PAT, PMR, I) -> PMR patternMatchRestricted(x, p, l, y) == generic? p => addMatchRestricted(p, x, l, y) patternMatchInner(x, p, l) + patternMatchSumProd : + (I, List PAT, PMR, (I, I) -> Union(I, "failed"), I) -> PMR patternMatchSumProd(x, lp, l, invOp, ident) == #lp = 2 => p2 := last lp @@ -193087,6 +195900,7 @@ PatternMatchIntegerNumberSystem(I:IntegerNumberSystem): with patternMatchRestricted(y::I, p2, l, ident) failed() + patternMatchInner : (I, PAT, PMR) -> PMR patternMatchInner(x, p, l) == constant? p => (r := retractIfCan(p)@Union(Integer, "failed")) case Integer => @@ -193518,8 +196332,6 @@ PatternMatchIntegration(R, F): Exports == Implementation where import TrigonometricManipulations(R, F) import FunctionSpaceAttachPredicates(R, F, F) - mkalist : RES -> AssociationList(SY, F) - pm := new()$SY pmw := new pm pmm := new pm @@ -193543,8 +196355,10 @@ PatternMatchIntegration(R, F): Exports == Implementation where half := 1::F / 2::F + mkalist : RES -> AssociationList(SY, F) mkalist res == construct destruct res + splitConstant : (F,Symbol) -> Record(const: F,nconst: F) splitConstant(f, x) == not member?(x, variables f) => [f, 1] (retractIfCan(f)@Union(K, "failed")) case K => [1, f] @@ -193577,24 +196391,16 @@ PatternMatchIntegration(R, F): Exports == Implementation where if F has LiouvillianFunctionCategory then import ElementaryFunctionSign(R, F) - insqrt : F -> F - matchei : (F, SY) -> REC - matcherfei : (F, SY, Boolean) -> REC - matchsici : (F, SY) -> REC - matchli : (F, SY) -> List F - matchli0 : (F, K, SY) -> List F - matchdilog : (F, SY) -> List F - matchdilog0: (F, K, SY, P, F) -> List F goodlilog? : (K, P) -> Boolean - gooddilog? : (K, P, P) -> Boolean - goodlilog?(k, p) == is?(k, "log"::SY) and (minimumDegree(p, k) = 1) + gooddilog? : (K, P, P) -> Boolean gooddilog?(k, p, q) == is?(k, "log"::SY) and (degree(p, k) = 1) and zero? degree(q, k) -- matches the integral to a result of the form d*erf(u) or d*ei(u) -- returns [case, u, d] + matcherfei : (F, SY, Boolean) -> REC matcherfei(f, x, comp?) == res0 := new()$RES pat := c * exp(pma::F) @@ -193613,6 +196419,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where -- matches the integral to a result of the form d * ei(k * log u) -- returns [case, k * log u, d] + matchei : (F, SY) -> REC matchei(f, x) == res0 := new()$RES a := pma::F @@ -193627,6 +196434,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where -- matches the integral to a result of the form d*dilog(u) + int(v), -- returns [u,d,v] or [] + matchdilog : (F, SY) -> List F matchdilog(f, x) == n := numer f df := (d := denom f)::F @@ -193638,6 +196446,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where -- matches the integral to a result of the form d*dilog(a) + int(v) -- where k = log(a) -- returns [a,d,v] or [] + matchdilog0: (F, K, SY, P, F) -> List F matchdilog0(f, k, x, p, q) == zero?(da := differentiate(a := first argument k, x)) => empty() a1 := 1 - a @@ -193647,6 +196456,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where -- matches the integral to a result of the form d * li(u) + int(v), -- returns [u,d,v] or [] + matchli : (F, SY) -> List F matchli(f, x) == d := denom f for k in select_!( @@ -193657,6 +196467,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where -- matches the integral to a result of the form d * li(a) + int(v) -- where k = log(a) -- returns [a,d,v] or [] + matchli0 : (F, K, SY) -> List F matchli0(f, k, x) == g := (lg := k::F) * f zero?(da := differentiate(a := first argument k, x)) => empty() @@ -193669,6 +196480,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where empty() -- matches the integral to a result of the form -- d * Si(u) or d * Ci(u) returns [case, u, d] + matchsici : (F, SY) -> REC matchsici(f, x) == res0 := new()$RES b := pmb::F @@ -193693,12 +196505,15 @@ PatternMatchIntegration(R, F): Exports == Implementation where [NONE, 0, 0] -- returns a simplified sqrt(y) + insqrt : F -> F insqrt y == rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F) ((rec.exponent) = 1) => rec.coef * rec.radicand rec.exponent ^=2 => error "insqrt: hould not happen" rec.coef * sqrt(rec.radicand) + pmintegrate : (F,Symbol) -> _ + Union(Record(special: F, integrand: F),"failed") pmintegrate(f, x) == (rc := splitConstant(f, x)).const ^= 1 => (u := pmintegrate(rc.nconst, x)) case "failed" => "failed" @@ -193717,6 +196532,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where + rec.coeff * log(rec.exponent), 0] "failed" + pmComplexintegrate : (F,Symbol) -> _ + Union(Record(special: F,integrand: F),"failed") pmComplexintegrate(f, x) == (rc := splitConstant(f, x)).const ^= 1 => (u := pmintegrate(rc.nconst, x)) case "failed" => "failed" @@ -193728,10 +196545,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where if F has SpecialFunctionCategory then - match1 : (F, SY, F, F) -> List F - formula1 : (F, SY, F, F) -> Union(F, "failed") - -- tries only formula (1) of the Geddes & al, AAECC 1 (1990) paper + formula1 : (F, SY, F, F) -> Union(F, "failed") formula1(f, x, t, cc) == empty?(l := match1(f, x, t, cc)) => "failed" mw := first l @@ -193745,6 +196560,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where -- returns [w, m, s, c] or [] -- matches only formula (1) of the Geddes & al, AAECC 1 (1990) paper + match1 : (F, SY, F, F) -> List F match1(f, x, t, cc) == res0 := new()$RES pat := cc * log(t)**m * exp(-t**s) @@ -193769,6 +196585,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where [- l.pmw, l.pmm, l.pms, l.pmc] empty() + pmintegrate : (F,Symbol,OrderedCompletion(F),OrderedCompletion(F))_ + -> Union(F,"failed") pmintegrate(f, x, a, b) == zero? a and ((whatInfinity b) = 1) => formula1(f, x, constant(x::F), @@ -193935,10 +196753,8 @@ PatternMatchKernel(S, E): Exports == Implementation where (* package PMKERNEL *) (* - patternMatchArg : (List E, List PAT, PRS) -> PRS - patternMatchInner: (Kernel E, PAT, PRS) -> Union(PRS, "failed") - -- matches the ordered lists ls and lp. + patternMatchArg : (List E, List PAT, PRS) -> PRS patternMatchArg(ls, lp, l) == #ls ^= #lp => failed() for p in lp for s in ls repeat @@ -193948,6 +196764,7 @@ PatternMatchKernel(S, E): Exports == Implementation where return failed() l + patternMatchInner: (Kernel E, PAT, PRS) -> Union(PRS, "failed") patternMatchInner(s, p, l) == generic? p => addMatch(p, s::E, l) (u := isOp p) case Record(op:BasicOperator, arg: List PAT) => @@ -193963,15 +196780,14 @@ PatternMatchKernel(S, E): Exports == Implementation where if E has Monoid then - patternMatchMonoid: (Kernel E, PAT, PRS) -> Union(PRS, "failed") patternMatchOpt : (E, List PAT, PRS, E) -> PRS - patternMatchOpt(x, lp, l, id) == (u := optpair lp) case List(PAT) => failed?(l := addMatch(first(u::List(PAT)), id, l)) => failed() patternMatch(x, second(u::List(PAT)), l) failed() + patternMatchMonoid: (Kernel E, PAT, PRS) -> Union(PRS, "failed") patternMatchMonoid(s, p, l) == (u := patternMatchInner(s, p, l)) case PRS => u::PRS (v := isPower p) case Record(val:PAT, exponent:PAT) => @@ -193990,6 +196806,8 @@ PatternMatchKernel(S, E): Exports == Implementation where if E has AbelianMonoid then + patternMatch : (Kernel(E),Pattern(S),PatternMatchResult(S,E)) -> _ + PatternMatchResult(S,E) patternMatch(s, p, l) == (u := patternMatchMonoid(s, p, l)) case PRS => u::PRS (w := isPlus p) case List(PAT) => @@ -193998,12 +196816,16 @@ PatternMatchKernel(S, E): Exports == Implementation where else + patternMatch : (Kernel(E),Pattern(S),PatternMatchResult(S,E)) -> _ + PatternMatchResult(S,E) patternMatch(s, p, l) == (u := patternMatchMonoid(s, p, l)) case PRS => u::PRS failed() else + patternMatch : (Kernel(E),Pattern(S),PatternMatchResult(S,E)) -> _ + PatternMatchResult(S,E) patternMatch(s, p, l) == (u := patternMatchInner(s, p, l)) case PRS => u::PRS failed() @@ -194111,12 +196933,13 @@ PatternMatchListAggregate(S, R, L): Exports == Implementation where (* package PMLSAGG *) (* - match: (L, List Pattern S, PLR, Boolean) -> PLR - + patternMatch : (L,Pattern(S),PatternMatchListResult(S,R,L)) -> _ + PatternMatchListResult(S,R,L) patternMatch(l, p, r) == (u := isList p) case "failed" => failed() match(l, u::List Pattern S, r, true) + match: (L, List Pattern S, PLR, Boolean) -> PLR match(l, lp, r, new?) == empty? lp => empty? l => r @@ -194280,9 +197103,14 @@ PatternMatchPolynomialCategory(S,E,V,R,P):Exports== Implementation where if V has PatternMatchable S then + patternMatch : (P,Pattern(S),PatternMatchResult(S,P)) -> _ + PatternMatchResult(S,P) patternMatch(x, p, l) == patternMatch(x, p, l, patternMatch$PatternMatchPushDown(S,V,P)) + patternMatch : (P,Pattern(S),PatternMatchResult(S,P),((V,Pattern(S),_ + PatternMatchResult(S,P)) -> PatternMatchResult(S,P))) -> _ + PatternMatchResult(S,P) patternMatch(x, p, l, vmatch) == generic? p => addMatch(p, x, l) (r := retractIfCan(x)@Union(R, "failed")) case R => @@ -194484,23 +197312,20 @@ PatternMatchPushDown(S, A, B): Exports == Implementation where import PatternMatchResultFunctions2(S, A, B) - fixPred : Any -> Union(Any, "failed") - inA : (PAT, PRB) -> Union(List A, "failed") - fixPredicates: (PAT, PRB, PRA) -> Union(REC, "failed") - fixList:(List PAT -> PAT, List PAT, PRB, PRA) -> Union(REC,"failed") - - fixPredicate f == (a1:A):Boolean +-> f(a1::B) - + patternMatch : (A,Pattern(S),PatternMatchResult(S,B)) -> _ + PatternMatchResult(S,B) patternMatch(a, p, l) == (u := fixPredicates(p, l, new())) case "failed" => failed() union(l, map((a1:A):B +->a1::B, patternMatch(a, (u::REC).pat, (u::REC).res))) + inA : (PAT, PRB) -> Union(List A, "failed") inA(p, l) == (u := getMatch(p, l)) case "failed" => empty() (r := retractIfCan(u::B)@Union(A, "failed")) case A => [r::A] "failed" + fixList:(List PAT -> PAT, List PAT, PRB, PRA) -> Union(REC,"failed") fixList(fn, l, lb, la) == ll:List(PAT) := empty() for x in l repeat @@ -194509,12 +197334,14 @@ PatternMatchPushDown(S, A, B): Exports == Implementation where la := (f::REC).res [fn ll, la] + fixPred : Any -> Union(Any, "failed") fixPred f == (u:= retractIfCan(f)$AnyFunctions1(B -> Boolean)) case "failed" => "failed" g := fixPredicate(u::(B -> Boolean)) coerce(g)$AnyFunctions1(A -> Boolean) + fixPredicates: (PAT, PRB, PRA) -> Union(REC, "failed") fixPredicates(p, lb, la) == (r:=retractIfCan(p)@Union(S,"failed")) case S or quoted? p =>[p,la] (u := isOp p) case Record(op:BasicOperator, arg:List PAT) => @@ -194647,6 +197474,8 @@ PatternMatchQuotientFieldCategory(S,R,Q):Exports == Implementation where import PatternMatchPushDown(S, R, Q) + patternMatch : (Q,Pattern(S),PatternMatchResult(S,Q)) -> _ + PatternMatchResult(S,Q) patternMatch(x, p, l) == generic? p => addMatch(p, x, l) (r := retractIfCan x)@Union(R, "failed") case R => @@ -194740,6 +197569,7 @@ PatternMatchResultFunctions2(R, A, B): Exports == Implementation where (* package PATRES2 *) (* + map : ((A -> B),PatternMatchResult(R,A)) -> PatternMatchResult(R,B) map(f, r) == failed? r => failed() construct [[rec.key, f(rec.entry)] for rec in destruct r] @@ -194833,6 +197663,8 @@ PatternMatchSymbol(S:SetCategory): with import TopLevelPatternMatchControl + patternMatch : (Symbol,Pattern(S),PatternMatchResult(S,Symbol)) -> _ + PatternMatchResult(S,Symbol) patternMatch(s, p, l) == generic? p => addMatch(p, s, l) constant? p => @@ -195070,16 +197902,10 @@ PatternMatchTools(S, R, P): Exports == Implementation where import PatternFunctions1(S, P) - preprocessList: (PAT, List P, PRS) -> Union(List P, "failed") - selBestGen : List PAT -> List PAT - negConstant : List P -> Union(P, "failed") - findMatch : (PAT, List P, PRS, P, (P, PAT, PRS) -> PRS) -> REC - tryToMatch : (List PAT, REC, P, (P, PAT, PRS) -> PRS) -> - Union(REC, "failed") - filterMatchedPatterns: (List PAT, List P, PRS) -> Union(RC, "failed") mn1 := convert(-1::P)@Pattern(S) + negConstant : List P -> Union(P, "failed") negConstant l == for x in l repeat ((r := retractIfCan(x)@Union(R, "failed")) case R) and @@ -195089,6 +197915,8 @@ PatternMatchTools(S, R, P): Exports == Implementation where -- tries to match the list of patterns lp to the list of subjects rc.s -- with rc.res being the list of existing matches. -- updates rc with the new result and subjects still to match + tryToMatch : (List PAT, REC, P, (P, PAT, PRS) -> PRS) -> + Union(REC, "failed") tryToMatch(lp, rc, ident, pmatch) == rec:REC := [l := rc.res, ls := rc.s] for p in lp repeat @@ -195098,6 +197926,9 @@ PatternMatchTools(S, R, P): Exports == Implementation where rec -- handles -1 in the pattern list. + patternMatchTimes : (List(P),List(Pattern(S)),PatternMatchResult(S,P),_ + ((P,Pattern(S),PatternMatchResult(S,P)) -> _ + PatternMatchResult(S,P))) -> PatternMatchResult(S,P) patternMatchTimes(ls, lp, l, pmatch) == member?(mn1, lp) => (u := negConstant ls) case "failed" => failed() @@ -195107,6 +197938,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where patternMatch(ls, lp, (l1:List(P)):P +-> */l1, l, pmatch) -- finds a match for p in ls, try not to match to a "bad" value + findMatch : (PAT, List P, PRS, P, (P, PAT, PRS) -> PRS) -> REC findMatch(p, ls, l, ident, pmatch) == bad:List(P) := generic? p => setIntersection(badValues p, ls) @@ -195122,6 +197954,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where [l1, remove(t, ls)] -- filters out pattern if it's generic and already matched. + preprocessList: (PAT, List P, PRS) -> Union(List P, "failed") preprocessList(pattern, ls, l) == generic? pattern => (u := getMatch(pattern, l)) case P => @@ -195131,6 +197964,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where empty() -- take out already matched generic patterns + filterMatchedPatterns: (List PAT, List P, PRS) -> Union(RC, "failed") filterMatchedPatterns(lp, ls, l) == for p in lp repeat (rc := preprocessList(p, ls, l)) case "failed" => return "failed" @@ -195140,6 +197974,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where [lp, ls] -- select a generic pattern with no predicate if possible + selBestGen : List PAT -> List PAT selBestGen l == ans := empty()$List(PAT) for p in l | generic? p repeat @@ -195148,6 +197983,9 @@ PatternMatchTools(S, R, P): Exports == Implementation where ans -- matches unordered lists ls and lp + patternMatch : (List(P),List(Pattern(S)),(List(P) -> P),_ + PatternMatchResult(S,P),((P,Pattern(S),PatternMatchResult(S,P)) -> _ + PatternMatchResult(S,P))) -> PatternMatchResult(S,P) patternMatch(ls, lp, op, l, pmatch) == ident := op empty() (rc := filterMatchedPatterns(lp, ls, l)) case "failed" => return failed() @@ -195494,16 +198332,12 @@ Permanent(n : PositiveInteger, R : Ring with commutative("*")): (* package PERMAN *) (* - -- local functions: - - permanent2: SM -> R - - permanent3: SM -> R x : SM a,b : R i,j,k,l : I + permanent3: SM -> R permanent3(x) == -- This algorithm is based upon the principle of inclusion- -- exclusion. A Gray-code is used to generate the subsets of @@ -195530,7 +198364,7 @@ Permanent(n : PositiveInteger, R : Ring with commutative("*")): if odd?(n) then a := -a a - + permanent : SquareMatrix(n,R) -> R permanent(x) == -- If 2 has an inverse in R, we can spare half of the calcu- -- lation needed in "permanent3": This is the algorithm of @@ -195575,6 +198409,7 @@ Permanent(n : PositiveInteger, R : Ring with commutative("*")): if not odd?(n) then a := -a two * a + permanent2: SM -> R permanent2(x) == c : R := 0 sgn : R := 1 @@ -196113,17 +198948,20 @@ PermutationGroupExamples():public == private where import ListFunctions2(L L I,PERM I) -- the internal functions: + llli2gp : L L L I -> PERMGRP I llli2gp(l:L L L I):PERMGRP I == --++ Converts an list of permutations each represented by a list --++ of cycles ( each of them represented as a list of Integers ) --++ to the permutation group generated by these permutations. (map(cycles,l))::PERMGRP I + li1n : I -> L I li1n(n:I):L I == --++ constructs the list of integers from 1 to n [i for i in 1..n] -- definition of the exported functions: + youngGroup : List(Integer) -> PermutationGroup(Integer) youngGroup(l:L I):PERMGRP I == gens:= nil()$(L L L I) element:I:= 1 @@ -196135,9 +198973,11 @@ PermutationGroupExamples():public == private where #gens = 0 => [[[1]]] gens + youngGroup : Partition -> PermutationGroup(Integer) youngGroup(lambda : Partition):PERMGRP I == youngGroup(convert(lambda)$Partition) + rubiksGroup : () -> PermutationGroup(Integer) rubiksGroup():PERMGRP I == -- each generator represents a 90 degree turn of the appropriate -- side. @@ -196161,6 +199001,7 @@ PermutationGroupExamples():public == private where [47,27,37,57],[46,26,36,56]] llli2gp [f,r,u,d,l,b] + mathieu11 : List(Integer) -> PermutationGroup(Integer) mathieu11(l:L I):PERMGRP I == -- permutations derived from the ATLAS l:=removeDuplicates l @@ -196168,8 +199009,10 @@ PermutationGroupExamples():public == private where a:L L I:=[[l.1,l.10],[l.2,l.8],[l.3,l.11],[l.5,l.7]] llli2gp [a,[[l.1,l.4,l.7,l.6],[l.2,l.11,l.10,l.9]]] + mathieu11 : () -> PermutationGroup(Integer) mathieu11():PERMGRP I == mathieu11 li1n 11 + mathieu12 : List(Integer) -> PermutationGroup(Integer) mathieu12(l:L I):PERMGRP I == -- permutations derived from the ATLAS l:=removeDuplicates l @@ -196178,8 +199021,10 @@ PermutationGroupExamples():public == private where [[l.1,l.2,l.3,l.4,l.5,l.6,l.7,l.8,l.9,l.10,l.11]] llli2gp [a,[[l.1,l.6,l.5,l.8,l.3,l.7,l.4,l.2,l.9,l.10],[l.11,l.12]]] + mathieu12 : () -> PermutationGroup(Integer) mathieu12():PERMGRP I == mathieu12 li1n 12 + mathieu22 : List(Integer) -> PermutationGroup(Integer) mathieu22(l:L I):PERMGRP I == -- permutations derived from the ATLAS l:=removeDuplicates l @@ -196190,8 +199035,10 @@ PermutationGroupExamples():public == private where [l.7,l.9,l.20,l.12],[l.10,l.16],[l.11,l.19,l.14,l.22]] llli2gp [a,b] + mathieu22 : () -> PermutationGroup(Integer) mathieu22():PERMGRP I == mathieu22 li1n 22 + mathieu23 : List(Integer) -> PermutationGroup(Integer) mathieu23(l:L I):PERMGRP I == -- permutations derived from the ATLAS l:=removeDuplicates l @@ -196203,8 +199050,10 @@ PermutationGroupExamples():public == private where [l.7,l.17,l.10,l.11,l.22],[l.14,l.19,l.21,l.20,l.15]] llli2gp [a,b] + mathieu23 : () -> PermutationGroup(Integer) mathieu23():PERMGRP I == mathieu23 li1n 23 + mathieu24 : List(Integer) -> PermutationGroup(Integer) mathieu24(l:L I):PERMGRP I == -- permutations derived from the ATLAS l:=removeDuplicates l @@ -196215,8 +199064,10 @@ PermutationGroupExamples():public == private where [l.4,l.15,l.18,l.17,l.16,l.5,l.9,l.19,l.12,l.7],[l.23,l.24]] llli2gp [a,b] + mathieu24 : () -> PermutationGroup(Integer) mathieu24():PERMGRP I == mathieu24 li1n 24 + janko2 : List(Integer) -> PermutationGroup(Integer) janko2(l:L I):PERMGRP I == -- permutations derived from the ATLAS l:=removeDuplicates l @@ -196253,8 +199104,10 @@ PermutationGroupExamples():public == private where [l.10,l.78,l.88,l.29,l.12] ] llli2gp [a,b] + janko2 : () -> PermutationGroup(Integer) janko2():PERMGRP I == janko2 li1n 100 + abelianGroup : List(PositiveInteger) -> PermutationGroup(Integer) abelianGroup(l:L PI):PERMGRP I == gens:= nil()$(L L L I) element:I:= 1 @@ -196265,6 +199118,7 @@ PermutationGroupExamples():public == private where #gens = 0 => [[[1]]] gens + alternatingGroup : List(Integer) -> PermutationGroup(Integer) alternatingGroup(l:L I):PERMGRP I == l:=removeDuplicates l #l = 0 => @@ -196277,29 +199131,36 @@ PermutationGroupExamples():public == private where gens.1 := cons([l.1,l.2],gens.1) llli2gp gens + alternatingGroup : PositiveInteger -> PermutationGroup(Integer) alternatingGroup(n:PI):PERMGRP I == alternatingGroup li1n n + symmetricGroup : List(Integer) -> PermutationGroup(Integer) symmetricGroup(l:L I):PERMGRP I == l:=removeDuplicates l #l = 0 => error "Cannot construct symmetric group on empty set !" #l < 3 => llli2gp [[l]] llli2gp [[l],[[l.1,l.2]]] + symmetricGroup : PositiveInteger -> PermutationGroup(Integer) symmetricGroup(n:PI):PERMGRP I == symmetricGroup li1n n + cyclicGroup : List(Integer) -> PermutationGroup(Integer) cyclicGroup(l:L I):PERMGRP I == l:=removeDuplicates l #l = 0 => error "Cannot construct cyclic group on empty set" llli2gp [[l]] + cyclicGroup : PositiveInteger -> PermutationGroup(Integer) cyclicGroup(n:PI):PERMGRP I == cyclicGroup li1n n + dihedralGroup : List(Integer) -> PermutationGroup(Integer) dihedralGroup(l:L I):PERMGRP I == l:=removeDuplicates l #l < 3 => error "in dihedralGroup: Minimum of 3 elements needed !" tmp := [[l.i, l.(#l-i+1) ] for i in 1..(#l quo 2)] llli2gp [ [ l ], tmp ] + dihedralGroup : PositiveInteger -> PermutationGroup(Integer) dihedralGroup(n:PI):PERMGRP I == n = 1 => symmetricGroup (2::PI) n = 2 => llli2gp [[[1,2]],[[3,4]]] @@ -196390,12 +199251,12 @@ PiCoercions(R:Join(OrderedSet, IntegralDomain)): with (* package PICOERCE *) (* - p2e: SparseUnivariatePolynomial Integer -> Expression R - + coerce : Pi -> Expression(R) coerce(x:Pi):Expression(R) == f := convert(x)@Fraction(SparseUnivariatePolynomial Integer) p2e(numer f) / p2e(denom f) + p2e: SparseUnivariatePolynomial Integer -> Expression R p2e p == map((x1:Integer):Expression(R) +-> x1::Expression(R), p)_ $SparseUnivariatePolynomialFunctions2(Integer, Expression R)_ @@ -196504,13 +199365,17 @@ PlotFunctions1(S:ConvertibleTo InputForm): with import MakeFloatCompiledFunction(S) + plot : (S,Symbol,Segment(DoubleFloat)) -> Plot plot(f, x, xRange) == plot(makeFloatFunction(f, x), xRange) + plotPolar : (S,Symbol) -> Plot plotPolar(f,theta) == plotPolar(makeFloatFunction(f,theta)) + plot : (S,S,Symbol,Segment(DoubleFloat)) -> Plot plot(f1, f2, t, tRange) == plot(makeFloatFunction(f1, t), makeFloatFunction(f2, t), tRange) + plotPolar : (S,Symbol,Segment(DoubleFloat)) -> Plot plotPolar(f,theta,thetaRange) == plotPolar(makeFloatFunction(f,theta),thetaRange) @@ -196654,13 +199519,7 @@ PlotTools(): Exports == Implementation where import POINT import PointPackage(SF) - --%Local functions - xRange0: L Pt -> SEG SF - xRange: L L Pt -> SEG SF - yRange0: L Pt -> SEG SF - yRange: L L Pt -> SEG SF drawToScaleRanges: (SEG SF,SEG SF) -> L SEG SF - drawToScaleRanges(xVals,yVals) == xDiff := (xHi := hi xVals) - (xLo := lo xVals) yDiff := (yHi := hi yVals) - (yLo := lo yVals) @@ -196674,8 +199533,10 @@ PlotTools(): Exports == Implementation where for p in rest l repeat m := g(m,f p) m + xRange0: L Pt -> SEG SF xRange0(list:L Pt) == select(list,xCoord,min) .. select(list,xCoord,max) + yRange0: L Pt -> SEG SF yRange0(list:L Pt) == select(list,yCoord,min) .. select(list,yCoord,max) select2: (L L Pt,L Pt -> SF,(SF,SF) -> SF) -> SF @@ -196684,15 +199545,18 @@ PlotTools(): Exports == Implementation where for p in rest l repeat m := g(m,f p) m + xRange: L L Pt -> SEG SF xRange(list:L L Pt) == select2(list,(u1:L(Pt)):SF +-> lo(xRange0(u1)),min) _ .. select2(list,(v1:L(Pt)):SF +-> hi(xRange0(v1)),max) + yRange: L L Pt -> SEG SF yRange(list:L L Pt) == select2(list,(u1:L(Pt)):SF +-> lo(yRange0(u1)),min) _ .. select2(list,(v1:L(Pt)):SF +-> hi(yRange0(v1)),max) --%Exported Functions + calcRanges : List(List(Point(DoubleFloat))) -> List(Segment(DoubleFloat)) calcRanges(llp) == drawToScale() => drawToScaleRanges(xRange llp, yRange llp) [xRange llp, yRange llp] @@ -196934,9 +199798,9 @@ ProjectiveAlgebraicSetPackage(K,symb,PolyRing,E,ProjPt):_ import ProjPt listVar:List(OV):= [index(i::PI)$OV for i in 1..#symb] - polyToX10 : PolyRing -> SUP(K) - + --fonctions de resolution de sys. alg. de dim 0 + singularPoints : PolyRing -> List(ProjPt) singularPoints(crb)== F:=crb Fx:=differentiate(F,index(1)$OV) @@ -196975,6 +199839,7 @@ ProjectiveAlgebraicSetPackage(K,symb,PolyRing,E,ProjPt):_ listPtsIdl:=cons(projectivePoint([1,0,0]),listPtsIdl) listPtsIdl + algebraicSet : List(PolyRing) -> List(ProjPt) algebraicSet(idealT:List(PolyRing)) == idealToX10: List SUP(K) := [polyToX10 pol for pol in idealT] recOfZerosX10:= distinguishedCommonRootsOf(idealToX10,1)$RFP(K) @@ -197010,6 +199875,7 @@ ProjectiveAlgebraicSetPackage(K,symb,PolyRing,E,ProjPt):_ if K has FiniteFieldCategory then + rationalPoints : (PolyRing,PositiveInteger) -> List(ProjPt) rationalPoints(crv:PolyRing,extdegree:PI):List(ProjPt) == --The code of this is almost the same as for algebraicSet --We could just construct the ideal and call algebraicSet @@ -197030,6 +199896,7 @@ ProjectiveAlgebraicSetPackage(K,symb,PolyRing,E,ProjPt):_ listPtsIdl:=cons(projectivePoint([1,0,0]),listPtsIdl) listPtsIdl + polyToX10 : PolyRing -> SUP(K) polyToX10(pol)== zero?(pol) => 0 dd:= degree pol @@ -197040,6 +199907,7 @@ ProjectiveAlgebraicSetPackage(K,symb,PolyRing,E,ProjPt):_ e1:= pp.1 monomial(lc,e1)$SUP(K) + polyToX10 reductum pol + singularPointsWithRestriction : (PolyRing,List(PolyRing)) -> List(ProjPt) singularPointsWithRestriction(F,lstPol)== Fx:=differentiate(F,index(1)$OV) Fy:=differentiate(F,index(2)$OV) @@ -197129,6 +199997,7 @@ PointFunctions2(R1:Ring,R2:Ring):Exports == Implementation where import Point(R1) import Point(R2) + map : ((R1 -> R2),Point(R1)) -> Point(R2) map(mapping,p) == point([mapping p.(i::PositiveInteger)_ for i in minIndex(p)..maxIndex(p)])$Point(R2) @@ -197304,27 +200173,36 @@ PointPackage(R:Ring):Exports == Implementation where (* package PTPACK *) (* + xCoord : Point(R) -> R xCoord p == elt(p,1) + yCoord : Point(R) -> R yCoord p == elt(p,2) + zCoord : Point(R) -> R zCoord p == elt(p,3) + rCoord : Point(R) -> R rCoord p == elt(p,1) + thetaCoord : Point(R) -> R thetaCoord p == elt(p,2) + phiCoord : Point(R) -> R phiCoord p == elt(p,3) + color : Point(R) -> R color p == #p > 3 => p.4 p.3 + -- 4D points in 2D using extra dimensions for palette information + hue : Point(R) -> R hue p == elt(p,3) - -- 4D points in 2D using extra dimensions for palette information + -- 4D points in 2D using extra dimensions for palette information + shade : Point(R) -> R shade p == elt(p,4) - -- 4D points in 2D using extra dimensions for palette information *) @@ -197679,84 +200557,73 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where import PointsOfFiniteOrderTools(UPQ, UPUPQ) import UnivariatePolynomialCommonDenominator(Z, Q, UPQ) - cmult: List SMP -> SMP - raise : (UPQ, K) -> F - raise2 : (UP2, K) -> UP - qmod : F -> Q - fmod : UPF -> UPQ - rmod : UP -> UPQ - pmod : UPUP -> UPUPQ - kqmod : (F, K) -> UPQ - krmod : (UP, K) -> UP2 - kpmod : (UPUP, K) -> UP3 - selectIntegers: K -> REC - selIntegers: () -> RC0 - possibleOrder : FD -> N - ratcurve : (FD, RC0) -> N - algcurve : (FD, REC, K) -> N - kbad3Num : (UP3, UPQ) -> Z - kbadBadNum : (UP2, UPQ) -> Z - kgetGoodPrime : (REC, UPQ, UP3, UP2,UP2) -> Record(prime:PI,poly:UPQ) - goodRed : (REC, UPQ, UP3, UP2, UP2, PI) -> Union(UPQ, "failed") - good? : (UPQ, UP3, UP2, UP2, PI, UPQ) -> Boolean - klist : UP -> List K - aklist : R -> List K - alglist : FD -> List K - notIrr? : UPQ -> Boolean - rat : (UPUP, FD, PI) -> N - toQ1 : (UP2, UPQ) -> UP - toQ2 : (UP3, UPQ) -> R - Q2F : Q -> F - Q2UPUP : UPUPQ -> UPUP - q := FunctionSpaceReduce(R0, F) + torsion? : FiniteDivisor(F,UP,UPUP,R) -> Boolean torsion? d == order(d) case N - Q2F x == numer(x)::F / denom(x)::F + Q2F : Q -> F + Q2F x == numer(x)::F / denom(x)::F - qmod x == bringDown(x)$q + qmod : F -> Q + qmod x == bringDown(x)$q + kqmod : (F, K) -> UPQ kqmod(x,k) == bringDown(x, k)$q - fmod p == map(qmod, p)$SparseUnivariatePolynomialFunctions2(F, Q) + fmod : UPF -> UPQ + fmod p == map(qmod, p)$SparseUnivariatePolynomialFunctions2(F, Q) - pmod p == map(qmod, p)$MultipleMap(F, UP, UPUP, Q, UPQ, UPUPQ) + pmod : UPUP -> UPUPQ + pmod p == map(qmod, p)$MultipleMap(F, UP, UPUP, Q, UPQ, UPUPQ) - Q2UPUP p == map(Q2F, p)$MultipleMap(Q, UPQ, UPUPQ, F, UP, UPUP) + Q2UPUP : UPUPQ -> UPUP + Q2UPUP p == map(Q2F, p)$MultipleMap(Q, UPQ, UPUPQ, F, UP, UPUP) - klist d == "setUnion"/[kernels c for c in coefficients d] + klist : UP -> List K + klist d == "setUnion"/[kernels c for c in coefficients d] + notIrr? : UPQ -> Boolean notIrr? d == #(factors factor(d)$RationalFactorize(UPQ)) > 1 + kbadBadNum : (UP2, UPQ) -> Z kbadBadNum(d, m) == mix [badNum(c rem m) for c in coefficients d] + kbad3Num : (UP3, UPQ) -> Z kbad3Num(h, m) == lcm [kbadBadNum(c, m) for c in coefficients h] + torsionIfCan : FiniteDivisor(F,UP,UPUP,R) -> _ + Union(Record(order: NonNegativeInteger,function: R),"failed") torsionIfCan d == zero?(n := possibleOrder(d := reduce d)) => "failed" (g := generator reduce(n::Z * d)) case "failed" => "failed" [n, g::R] + UPQ2F : (UPQ,K) -> F UPQ2F(p:UPQ, k:K):F == map(Q2F, p)$UnivariatePolynomialCategoryFunctions2(Q, UPQ, F, UP) (k::F) + UP22UP : (UP2,K) -> UP UP22UP(p:UP2, k:K):UP == map((p1:UPQ):F +-> UPQ2F(p1, k), p)_ $UnivariatePolynomialCategoryFunctions2(UPQ,UP2,F,UP) + UP32UPUP : (UP3,K) -> UPUP UP32UPUP(p:UP3, k:K):UPUP == map((p1:UP2):QF +-> UP22UP(p1,k)::QF,p)_ $UnivariatePolynomialCategoryFunctions2(UP2, UP3, QF, UPUP) if R0 has GcdDomain then + cmult: List SMP -> SMP cmult(l:List SMP):SMP == lcm l else + cmult: List SMP -> SMP cmult(l:List SMP):SMP == */l + doubleDisc : UP3 -> Z doubleDisc(f:UP3):Z == d := discriminant f g := gcd(d, differentiate d) @@ -197764,39 +200631,48 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where zero?(e := discriminant d) => 0 gcd [retract(c)@Z for c in coefficients e] + commonDen : UP -> SMP commonDen(p:UP):SMP == l1:List F := coefficients p l2:List SMP := [denom c for c in l1] cmult l2 + polyred : UPUP -> UPUP polyred(f:UPUP):UPUP == cmult([commonDen(retract(c)@UP) for c in coefficients f])::F::UP::QF * f + aklist : R -> List K aklist f == (r := retractIfCan(f)@Union(QF, "failed")) case "failed" => "setUnion"/[klist(retract(c)@UP) for c in coefficients lift f] klist(retract(r::QF)@UP) + alglist : FD -> List K alglist d == n := numer(i := ideal d) select_!((k1:K):Boolean +-> has?(operator k1, ALGOP), setUnion(klist denom i, "setUnion"/[aklist qelt(n,i) for i in minIndex n..maxIndex n])) + krmod : (UP, K) -> UP2 krmod(p,k) == map(z1 +-> kqmod(z1, k), p)$UnivariatePolynomialCategoryFunctions2(F, UP, UPQ, UP2) + rmod : UP -> UPQ rmod p == map(qmod, p)$UnivariatePolynomialCategoryFunctions2(F, UP, Q, UPQ) + raise : (UPQ, K) -> F raise(p, k) == (map(Q2F, p)$SparseUnivariatePolynomialFunctions2(Q, F)) (k::F) + raise2 : (UP2, K) -> UP raise2(p, k) == map(z1 +-> raise(z1, k), p)$UnivariatePolynomialCategoryFunctions2(UPQ, UP2, F, UP) + algcurve : (FD, REC, K) -> N algcurve(d, rc, k) == mn := minIndex(n := numer(i := minimize ideal d)) h := kpmod(lift(hh := n(mn + 1)), k) @@ -197824,6 +200700,7 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where )$ReducedDivisor(F, UP, UPUP, R, sae) -- returns the potential order of d, 0 if d is of infinite order + ratcurve : (FD, RC0) -> N ratcurve(d, rc) == mn := minIndex(nm := numer(i := minimize ideal d)) h := pmod lift(hh := nm(mn + 1)) @@ -197842,6 +200719,7 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where 0 -- returns the order of d mod p + rat : (UPUP, FD, PI) -> N rat(pp, d, p) == gf := InnerPrimeField p order(d, pp, @@ -197849,6 +200727,7 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where )$ReducedDivisor(F, UP, UPUP, R, gf) -- returns the potential order of d, 0 if d is of infinite order + possibleOrder : FD -> N possibleOrder d == zero?(genus()) or (#(numer ideal d) = 1) => 1 empty?(la := alglist d) => ratcurve(d, selIntegers()) @@ -197856,11 +200735,13 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where error "PFO::possibleOrder: more than 1 algebraic constant" algcurve(d, selectIntegers first la, first la) + selIntegers: () -> RC0 selIntegers():RC0 == f := definingPolynomial()$R while zero?(d := doubleDisc(r := polyred pmod f)) repeat newReduc()$q [r, d] + selectIntegers: K -> REC selectIntegers(k:K):REC == g := polyred(f := definingPolynomial()$R) p := minPoly k @@ -197868,29 +200749,35 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where repeat newReduc()$q [r, d, splitDenominator(fmod p).num] + toQ1 : (UP2, UPQ) -> UP toQ1(p, d) == map((p1:UPQ):F +-> Q2F(retract(p1 rem d)@Q), p)$UnivariatePolynomialCategoryFunctions2(UPQ, UP2, F, UP) + toQ2 : (UP3, UPQ) -> R toQ2(p, d) == reduce map((p1:UP2):QF +-> toQ1(p1, d)::QF, p)$UnivariatePolynomialCategoryFunctions2(UP2, UP3, QF, UPUP) + kpmod : (UPUP, K) -> UP3 kpmod(p, k) == map((p1:QF):UP2 +-> krmod(retract(p1)@UP, k), p)$UnivariatePolynomialCategoryFunctions2(QF, UPUP, UP2, UP3) + order : FiniteDivisor(F,UP,UPUP,R) -> Union(NonNegativeInteger,"failed") order d == zero?(n := possibleOrder(d := reduce d)) => "failed" principal? reduce(n::Z * d) => n "failed" + kgetGoodPrime : (REC, UPQ, UP3, UP2,UP2) -> Record(prime:PI,poly:UPQ) kgetGoodPrime(rec, res, h, b, d) == p:PI := 3 while (u := goodRed(rec, res, h, b, d, p)) case "failed" repeat p := nextPrime(p::Z)::PI [p, u::UPQ] + goodRed : (REC, UPQ, UP3, UP2, UP2, PI) -> Union(UPQ, "failed") goodRed(rec, res, h, b, d, p) == zero?(rec.disc rem p) => "failed" gf := InnerPrimeField p @@ -197908,6 +200795,7 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where good?(res, h, b, d, p, md) => md "failed" + good? : (UPQ, UP3, UP2, UP2, PI, UPQ) -> Boolean good?(res, h, b, d, p, m) == bd := badNum(res rem m) not (zero?(bd.den rem p) or zero?(bd.gcdnum rem p) or @@ -198061,13 +200949,11 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where import PointsOfFiniteOrderTools(UP, UPUP) - possibleOrder: FD -> N - ratcurve : (FD, UPUP, Z) -> N - rat : (UPUP, FD, PI) -> N - + torsion? : FiniteDivisor(Fraction(Integer),UP,UPUP,R) -> Boolean torsion? d == order(d) case N -- returns the potential order of d, 0 if d is of infinite order + ratcurve : (FD, UPUP, Z) -> N ratcurve(d, modulus, disc) == mn := minIndex(nm := numer(i := ideal d)) h := lift(hh := nm(mn + 1)) @@ -198084,6 +200970,7 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where n = m => n 0 + rat : (UPUP, FD, PI) -> N rat(pp, d, p) == gf := InnerPrimeField p order(d, pp, @@ -198091,16 +200978,21 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where numer(z1)::gf / denom(z1)::gf)$ReducedDivisor(Q, UP, UPUP, R, gf) -- returns the potential order of d, 0 if d is of infinite order + possibleOrder: FD -> N possibleOrder d == zero?(genus()) or (#(numer ideal d) = 1) => 1 r := polyred definingPolynomial()$R ratcurve(d, r, doubleDisc r) + order : FiniteDivisor(Fraction(Integer),UP,UPUP,R) -> _ + Union(NonNegativeInteger,"failed") order d == zero?(n := possibleOrder(d := reduce d)) => "failed" principal? reduce(n::Z * d) => n "failed" + torsionIfCan : FiniteDivisor(Fraction(Integer),UP,UPUP,R) -> _ + Union(Record(order: NonNegativeInteger,function: R),"failed") torsionIfCan d == zero?(n := possibleOrder(d := reduce d)) => "failed" (g := generator reduce(n::Z * d)) case "failed" => "failed" @@ -198235,23 +201127,29 @@ PointsOfFiniteOrderTools(UP, UPUP): Exports == Implementation where import IntegerPrimesPackage(Z) import UnivariatePolynomialCommonDenominator(Z, Q, UP) - mix l == lcm(lcm [p.den for p in l], gcd [p.gcdnum for p in l]) + mix : List(Record(den: Integer,gcdnum: Integer)) -> Integer + mix l == lcm(lcm [p.den for p in l], gcd [p.gcdnum for p in l]) + badNum : UPUP -> Integer badNum(p:UPUP) == mix [badNum(retract(c)@UP) for c in coefficients p] + polyred : UPUP -> UPUP polyred r == lcm [commonDenominator(retract(c)@UP) for c in coefficients r] * r + badNum : UP -> Record(den: Integer,gcdnum: Integer) badNum(p:UP) == cd := splitDenominator p [cd.den, gcd [retract(c)@Z for c in coefficients(cd.num)]] + getGoodPrime : Integer -> PositiveInteger getGoodPrime n == p:PI := 3 while zero?(n rem p) repeat p := nextPrime(p::Z)::PI p + doubleDisc : UPUP -> Integer doubleDisc r == d := retract(discriminant r)@UP retract(discriminant((d exquo gcd(d, differentiate d))::UP))@Z @@ -198422,18 +201320,21 @@ PolynomialPackageForCurve(K,PolyRing,E,dim,ProjPt):Exp == Impl where import ProjPt import PackPoly + translateToOrigin : (PolyRing,ProjPt,Integer) -> PolyRing translateToOrigin(pol,pt,nV)== zero?(pt.nV) => error "Impossible de translater" pt:=homogenize(pt,nV) lpt:List K:=list(pt)$ProjPt translate(pol,lpt,nV) + pointInIdeal? : (List(PolyRing),ProjPt) -> Boolean pointInIdeal?(lstPol,pt)== temp:Boolean:=true()$Boolean for pol in lstPol repeat temp:=(zero?(eval(pol,pt)) and temp) temp + eval : (PolyRing,ProjPt) -> K eval(f,pt)== zero? f => 0 lpt:List(K) := list pt @@ -198442,18 +201343,23 @@ PolynomialPackageForCurve(K,PolyRing,E,dim,ProjPt):Exp == Impl where ee:= reduce( "*" , [ p**e for p in lpt for e in dd | ^zero?(e)], 1$K) lc * ee + eval( reductum f, pt) + translateToOrigin : (PolyRing,ProjPt) -> PolyRing translateToOrigin(pol,pt)== translateToOrigin(pol,pt,lastNonNull(pt)) + multiplicity : (PolyRing,ProjPt) -> NonNegativeInteger multiplicity(crb,pt)== degreeOfMinimalForm(translateToOrigin(crb,pt)) + multiplicity : (PolyRing,ProjPt,Integer) -> NonNegativeInteger multiplicity(crb,pt,nV)== degreeOfMinimalForm(translateToOrigin(crb,pt,nV)) + minimalForm : (PolyRing,ProjPt) -> PolyRing minimalForm(crb,pt)== minimalForm(translateToOrigin(crb,pt)) + minimalForm : (PolyRing,ProjPt,Integer) -> PolyRing minimalForm(crb,pt,nV)== minimalForm(translateToOrigin(crb,pt,nV)) @@ -198599,25 +201505,32 @@ PolToPol(lv,R) : C == T (* package POLTOPOL *) (* + variable1 : Symbol -> Ov variable1(xx:Symbol):Ov == variable(xx)::Ov -- transform a P in a HDPoly -- + pToDmp : Polynomial(R) -> DistributedMultivariatePolynomial(lv,R) pToHdmp(pol:P) : HDPoly == map(variable1,pol)$MPC3(Symbol,Ov,IES,HDP,R,P,HDPoly) -- transform an HDPoly in a P -- + hdmpToP:HomogeneousDistributedMultivariatePolynomial(lv,R) -> Polynomial(R) hdmpToP(hdpol:HDPoly) : P == map(convert,hdpol)$MPC3(Ov,Symbol,HDP,IES,R,HDPoly,P) -- transform an DPoly in a P -- + dmpToP : DistributedMultivariatePolynomial(lv,R) -> Polynomial(R) dmpToP(dpol:DPoly) : P == map(convert,dpol)$MPC3(Ov,Symbol,DP,IES,R,DPoly,P) -- transform a P in a DPoly -- + pToHdmp:Polynomial(R) -> HomogeneousDistributedMultivariatePolynomial(lv,R) pToDmp(pol:P) : DPoly == map(variable1,pol)$MPC3(Symbol,Ov,IES,DP,R,P,DPoly) -- transform a DPoly in a HDPoly -- + dmpToHdmp : DistributedMultivariatePolynomial(lv,R) -> _ + HomogeneousDistributedMultivariatePolynomial(lv,R) dmpToHdmp(dpol:DPoly) : HDPoly == dpol=0 => 0$HDPoly monomial(leadingCoefficient dpol, @@ -198625,6 +201538,8 @@ PolToPol(lv,R) : C == T dmpToHdmp(reductum dpol) -- transform a HDPoly in a DPoly -- + hdmpToDmp : HomogeneousDistributedMultivariatePolynomial(lv,R) -> _ + DistributedMultivariatePolynomial(lv,R) hdmpToDmp(hdpol:HDPoly) : DPoly == hdpol=0 => 0$DPoly dd:DP:= directProduct((degree hdpol)::VV)$DP @@ -198762,6 +201677,7 @@ PolyGroebner(F) : C == T (* package PGROEB *) (* + lexGroebner : (List(Polynomial(F)),List(Symbol)) -> List(Polynomial(F)) lexGroebner(lp: L P,lv:L E) : L P == PP:= PolToPol(lv,F) DPoly := DistributedMultivariatePolynomial(lv,F) @@ -198771,6 +201687,7 @@ PolyGroebner(F) : C == T gb:L DPoly :=groebner(b)$GroebnerPackage(F,DP,OV,DPoly) [dmpToP(pp)$PP for pp in gb] + totalGroebner : (List(Polynomial(F)),List(Symbol)) -> List(Polynomial(F)) totalGroebner(lp: L P,lv:L E) : L P == PP:= PolToPol(lv,F) HDPoly := HomogeneousDistributedMultivariatePolynomial(lv,F) @@ -198871,10 +201788,12 @@ PolynomialAN2Expression():Target == Implementation where (* package PAN2EXPR *) (* + coerce : Polynomial(AlgebraicNumber) -> Expression(Integer) coerce(p:PAN):EXPR == map(x+->x::EXPR, y+->y::EXPR, p)$PolynomialCategoryLifting( IndexedExponents SY, SY, AN, PAN, EXPR) + coerce : Fraction(Polynomial(AlgebraicNumber)) -> Expression(Integer) coerce(rf:Fraction PAN):EXPR == numer(rf)::EXPR / denom(rf)::EXPR @@ -198985,6 +201904,7 @@ PolynomialCategoryLifting(E,Vars,R,P,S): Exports == Implementation where (* package POLYLIFT *) (* + map : ((Vars -> S),(R -> S),P) -> S map(fv, fc, p) == (x1 := mainVariable p) case "failed" => fc leadingCoefficient p up := univariate(p, x1::Vars) @@ -199204,15 +202124,17 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F): (* package POLYCATQ *) (* - P2UP: (P, V) -> UP - + univariate : (F,V) -> Fraction(SparseUnivariatePolynomial(F)) univariate(f, x) == P2UP(numer f, x) / P2UP(denom f, x) + univariate : (F,V,SparseUnivariatePolynomial(F)) -> _ + SparseUnivariatePolynomial(F) univariate(f, x, modulus) == (bc := extendedEuclidean(P2UP(denom f, x), modulus, 1)) case "failed" => error "univariate: denominator is 0 mod p" (P2UP(numer f, x) * bc.coef1) rem modulus + multivariate : (Fraction(SparseUnivariatePolynomial(F)),V) -> F multivariate(f, x) == v := x::P::F ((numer f) v) / ((denom f) v) @@ -199225,9 +202147,11 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F): first l > first m => cons(first l,mymerge(rest l,m)) cons(first m,mymerge(l,rest m)) + variables : F -> List(V) variables f == mymerge(variables numer f, variables denom f) + isPower : F -> Union(Record(val: F,exponent: Integer),"failed") isPower f == (den := denom f) ^= 1 => numer f ^= 1 => "failed" @@ -199238,6 +202162,7 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F): r := ur::Record(var:V, exponent:NonNegativeInteger) [r.var::P::F, r.exponent::Integer] + isExpt : F -> Union(Record(var: V,exponent: Integer),"failed") isExpt f == (ur := isExpt numer f) case "failed" => (numer f) = 1 => @@ -199249,6 +202174,7 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F): (denom f) = 1 => [r.var, r.exponent::Integer] "failed" + isTimes : F -> Union(List(F),"failed") isTimes f == t := isTimes(num := numer f) l:Union(List F, "failed") := @@ -199260,17 +202186,20 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F): l case "failed" => [num::F, d] concat_!(l::List(F), d) + isPlus : F -> Union(List(F),"failed") isPlus f == denom f ^= 1 => "failed" (s := isPlus numer f) case "failed" => "failed" [x::F for x in s] + mainVariable : F -> Union(V,"failed") mainVariable f == a := mainVariable numer f (b := mainVariable denom f) case "failed" => a a case "failed" => b max(a::V, b::V) + P2UP: (P, V) -> UP P2UP(p, x) == map(z +-> z::F, univariate(p, x))$SparseUnivariatePolynomialFunctions2(P, F) @@ -199355,6 +202284,7 @@ PolynomialComposition(UP: UnivariatePolynomialCategory(R), R: Ring): with (* package PCOMP *) (* + compose : (UP,UP) -> UP compose(g, h) == r: UP := 0 while g ^= 0 repeat @@ -199494,6 +202424,7 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where (* package PDECOMP *) (* + leftFactor : (UP,UP) -> Union(UP,"failed") leftFactor(f, h) == g: UP := 0 for i in 0.. while f ^= 0 repeat @@ -199503,6 +202434,8 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where g := g + r * monomial(1, i) g + decompose : (UP,NonNegativeInteger,NonNegativeInteger) -> _ + Union(Record(left: UP,right: UP),"failed") decompose(f, dg, dh) == df := degree f dg*dh ^= df => "failed" @@ -199511,6 +202444,7 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where g case "failed" => "failed" [g::UP, h] + decompose : UP -> List(UP) decompose f == df := degree f for dh in 2..df-1 | df rem dh = 0 repeat @@ -199520,6 +202454,7 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where append(decompose(g::UP), decompose h) [f] + rightFactorCandidate : (UP,NonNegativeInteger) -> UP rightFactorCandidate(f, dh) == f := f/leadingCoefficient f df := degree f @@ -199941,30 +202876,9 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == import UnivariatePolynomialCategoryFunctions2(R,SupR,S,SupS) import UnivariatePolynomialCategoryFunctions2(S,SupS,SupR,SupSupR) import UnivariatePolynomialCategoryFunctions2(SupR,SupSupR,S,SupS) + hensel: (SupS,VarSet,R,List SupS) -> Union(Record(fctrs:List SupS),"failed") - chooseSLPEViableSubstitutions: (List VarSet,List SupS,SupS) -> - Record(substnsField:List R,lpolysRField:List SupR,ppRField:SupR) - --++ chooseSLPEViableSubstitutions(lv,lp,p) chooses substitutions - --++ for the variables in first arg (which are all - --++ the variables that exist) so that the polys in second argument don't - --++ drop in degree and remain square-free, and third arg doesn't drop - --++ drop in degree - chooseFSQViableSubstitutions: (List VarSet,SupS) -> - Record(substnsField:List R,ppRField:SupR) - --++ chooseFSQViableSubstitutions(lv,p) chooses substitutions - --++ for the variables in first arg (which are all - --++ the variables that exist) so that the second argument poly doesn't - --++ drop in degree and remains square-free - raise: SupR -> SupS - lower: SupS -> SupR - - SLPEBR: (List SupS, List VarSet, SupS, List VarSet) -> - Union(List SupS,"failed") - - factorSFBRlcUnitInner: (List VarSet, SupS,R) -> - Union(Factored SupS,"failed") - hensel(pp,vv,r,factors) == origFactors:=factors totdegree:Integer:=0 @@ -200004,6 +202918,8 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == n:=n+1 "failed" -- must have been a false split + factorSFBRlcUnitInner: (List VarSet, SupS,R) -> + Union(Factored SupS,"failed") factorSFBRlcUnitInner(lvpp,pp,r) == -- pp is square-free as a Sup, and its coefficients have precisely -- the variables of lvpp. Furthermore, its LC is a unit @@ -200026,6 +202942,8 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == if R has StepThrough then + factorSFBRlcUnit : (List(VarSet),SparseUnivariatePolynomial(S)) -> _ + Factored(SparseUnivariatePolynomial(S)) factorSFBRlcUnit(lvpp,pp) == val:R := init() while true repeat @@ -200038,6 +202956,8 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == else + factorSFBRlcUnit : (List(VarSet),SparseUnivariatePolynomial(S)) -> _ + Factored(SparseUnivariatePolynomial(S)) factorSFBRlcUnit(lvpp,pp) == val:R := randomR() while true repeat @@ -200047,14 +202967,19 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == if R has random: -> R then + randomR : () -> R randomR() == random() else + randomR : () -> R randomR() == (random()$Integer)::R if R has FiniteFieldCategory then + bivariateSLPEBR : _ + (List(SparseUnivariatePolynomial(S)),SparseUnivariatePolynomial(S),_ + VarSet) -> Union(List(SparseUnivariatePolynomial(S)),"failed") bivariateSLPEBR(lpolys,pp,v) == lpolysR:List SupSupR:=[map(univariate,u) for u in lpolys] ppR: SupSupR:=map(univariate,pp) @@ -200064,9 +202989,18 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == else + bivariateSLPEBR : _ + (List(SparseUnivariatePolynomial(S)),SparseUnivariatePolynomial(S),_ + VarSet) -> Union(List(SparseUnivariatePolynomial(S)),"failed") bivariateSLPEBR(lpolys,pp,v) == solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS + --++ chooseFSQViableSubstitutions(lv,p) chooses substitutions + --++ for the variables in first arg (which are all + --++ the variables that exist) so that the second argument poly doesn't + --++ drop in degree and remains square-free + chooseFSQViableSubstitutions: (List VarSet,SupS) -> + Record(substnsField:List R,ppRField:SupR) chooseFSQViableSubstitutions(lvpp,pp) == substns:List R ppR: SupR @@ -200078,6 +203012,13 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == leave [substns,ppR] + --++ chooseSLPEViableSubstitutions(lv,lp,p) chooses substitutions + --++ for the variables in first arg (which are all + --++ the variables that exist) so that the polys in second argument don't + --++ drop in degree and remain square-free, and third arg doesn't drop + --++ drop in degree + chooseSLPEViableSubstitutions: (List VarSet,List SupS,SupS) -> + Record(substnsField:List R,lpolysRField:List SupR,ppRField:SupR) chooseSLPEViableSubstitutions(lvpolys,lpolys,pp) == substns:List R lpolysR:List SupR @@ -200098,10 +203039,14 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == ppR:=map(z1 +-> (retract eval(z1,lvpolys,substns))::R,pp) [substns,lpolysR,ppR] + raise: SupR -> SupS raise(supR) == map(z1 +-> z1:R::S,supR) + lower: SupS -> SupR lower(pp) == map(z1 +-> retract(z1)::R,pp) + SLPEBR: (List SupS, List VarSet, SupS, List VarSet) -> + Union(List SupS,"failed") SLPEBR(lpolys,lvpolys,pp,lvpp) == not empty? (m:=setDifference(lvpp,lvpolys)) => v:=first m @@ -200130,6 +203075,9 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == #lvpolys = 1 => bivariateSLPEBR(lpolys,pp, first lvpolys) solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS + solveLinearPolynomialEquationByRecursion : _ + (List(SparseUnivariatePolynomial(S)),SparseUnivariatePolynomial(S)) -> _ + Union(List(SparseUnivariatePolynomial(S)),"failed") solveLinearPolynomialEquationByRecursion(lpolys,pp) == lvpolys := removeDuplicates_! concat [ concat [variables z for z in coefficients u] @@ -200138,6 +203086,8 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == concat [variables z for z in coefficients pp] SLPEBR(lpolys,lvpolys,pp,lvpp) + factorByRecursion : SparseUnivariatePolynomial(S) -> _ + Factored(SparseUnivariatePolynomial(S)) factorByRecursion pp == lv:List(VarSet) := removeDuplicates_! concat [variables z for z in coefficients pp] @@ -200149,6 +203099,8 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == mergeFactors(refine(squareFree pp,factorSquareFreeByRecursion), map(z1 +-> z1:S::SupS,factor(c)$S)) + factorSquareFreeByRecursion : SparseUnivariatePolynomial(S) -> _ + Factored(SparseUnivariatePolynomial(S)) factorSquareFreeByRecursion pp == lv:List(VarSet) := removeDuplicates_! concat [variables z for z in coefficients pp] @@ -200533,24 +203485,10 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where import UnivariatePolynomialCategoryFunctions2(S,SupS,R,SupR) import UnivariatePolynomialCategoryFunctions2(R,SupR,S,SupS) -- local function declarations - raise: SupR -> SupS - lower: SupS -> SupR - factorSFBRlcUnitInner: (SupS,R) -> Union(Factored SupS,"failed") - hensel: (SupS,R,List SupS) -> - Union(Record(fctrs:List SupS),"failed") - chooseFSQViableSubstitutions: (SupS) -> - Record(substnsField:R,ppRField:SupR) - --++ chooseFSQViableSubstitutions(p), p is a sup - --++ ("sparse univariate polynomial") - --++ over a sup over R, returns a record - --++ \spad{[substnsField: r, ppRField: q]} where r is a substitution point - --++ q is a sup over R so that the (implicit) variable in q - --++ does not drop in degree and remains square-free. - -- here for the moment, until it compiles - -- N.B., we know that R is NOT a FiniteField, since - -- that is meant to have a special implementation, to break the - -- recursion + solveLinearPolynomialEquationByRecursion : _ + (List(SparseUnivariatePolynomial(S)),SparseUnivariatePolynomial(S)) -> _ + Union(List(SparseUnivariatePolynomial(S)),"failed") solveLinearPolynomialEquationByRecursion(lpolys,pp) == lhsdeg:="max"/["max"/[degree v for v in coefficients u] for u in lpolys] rhsdeg:="max"/[degree v for v in coefficients pp] @@ -200568,6 +203506,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS -- local function definitions + hensel: (SupS,R,List SupS) -> Union(Record(fctrs:List SupS),"failed") hensel(pp,r,factors) == -- factors is a relatively prime factorization of pp modulo the ideal -- (x-r), with suitably imposed leading coefficients. @@ -200611,6 +203550,18 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where pn:=pn*prime "failed" -- must have been a false split + chooseFSQViableSubstitutions: (SupS) -> + Record(substnsField:R,ppRField:SupR) + --++ chooseFSQViableSubstitutions(p), p is a sup + --++ ("sparse univariate polynomial") + --++ over a sup over R, returns a record + --++ \spad{[substnsField: r, ppRField: q]} where r is a substitution point + --++ q is a sup over R so that the (implicit) variable in q + --++ does not drop in degree and remains square-free. + -- here for the moment, until it compiles + -- N.B., we know that R is NOT a FiniteField, since + -- that is meant to have a special implementation, to break the + -- recursion chooseFSQViableSubstitutions(pp) == substns:R ppR: SupR @@ -200622,10 +203573,13 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where leave [substns,ppR] + raise: SupR -> SupS raise(supR) == map(z1 +-> z1:R::S,supR) + lower: SupS -> SupR lower(pp) == map(z1 +-> retract(z1)::R,pp) + factorSFBRlcUnitInner: (SupS,R) -> Union(Factored SupS,"failed") factorSFBRlcUnitInner(pp,r) == -- pp is square-free as a Sup, but the Up variable occurs. -- Furthermore, its LC is a unit @@ -200645,6 +203599,8 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where if R has StepThrough then + factorSFBRlcUnit : SparseUnivariatePolynomial(S) -> _ + Factored(SparseUnivariatePolynomial(S)) factorSFBRlcUnit(pp) == val:R := init() while true repeat @@ -200657,6 +203613,8 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where else + factorSFBRlcUnit : SparseUnivariatePolynomial(S) -> _ + Factored(SparseUnivariatePolynomial(S)) factorSFBRlcUnit(pp) == val:R := randomR() while true repeat @@ -200668,6 +203626,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where randomCount:R:= init() + randomR : () -> R randomR() == v:=nextItem(randomCount) v case "failed" => @@ -200679,12 +203638,16 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where else if R has random: -> R then + randomR : () -> R randomR() == random() else + randomR : () -> R randomR() == (random()$Integer rem 100)::R + factorByRecursion : SparseUnivariatePolynomial(S) -> _ + Factored(SparseUnivariatePolynomial(S)) factorByRecursion pp == and/[zero? degree u for u in coefficients pp] => map(raise,factorPolynomial lower pp) @@ -200694,6 +203657,8 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where mergeFactors(refine(squareFree pp,factorSquareFreeByRecursion), map(z1 +-> z1:S::SupS,factor(c)$S)) + factorSquareFreeByRecursion : SparseUnivariatePolynomial(S) -> _ + Factored(SparseUnivariatePolynomial(S)) factorSquareFreeByRecursion pp == and/[zero? degree u for u in coefficients pp] => map(raise,factorSquareFreePolynomial lower pp) @@ -200809,6 +203774,7 @@ PolynomialFunctions2(R:Ring, S:Ring): with (* package POLY2 *) (* + map : ((R -> S),Polynomial(R)) -> Polynomial(S) map(f, p) == map(x1 +-> x1::Polynomial(S), x2 +-> f(x2)::Polynomial(S), p)$PolynomialCategoryLifting(IndexedExponents Symbol, Symbol, R, Polynomial R, Polynomial S) @@ -201351,32 +204317,13 @@ See Volume 10.1 for more details. import MultivariateLifting(E,OV,R,P) import FactoringUtilities(E,OV,R,P) - -------- Local Functions -------- - - myran : Integer -> Union(R,"failed") - better : (P,P) -> Boolean - failtest : (SUPP,SUPP,SUPP) -> Boolean - monomContent : (SUPP) -> SUPP - gcdMonom : (SUPP,SUPP) -> SUPP - gcdTermList : (P,P) -> P - good : (SUPP,List OV,List List R) -> Record(upol:SUP,inval:List List R) - - chooseVal : (SUPP,SUPP,List OV,List List R) -> Union(UTerm,"failed") - localgcd : (SUPP,SUPP,List OV,List List R) -> LGcd - notCoprime : (SUPP,SUPP, List NNI,List OV,List List R) -> SUPP - imposelc : (List SUP,List OV,List R,List P) -> - Union(List SUP, "failed") - - lift? :(SUPP,SUPP,UTerm,List NNI,List OV) -> _ - Union(s:SUPP,failed:"failed",notCoprime:"notCoprime") - lift :(SUPP,SUP,SUP,P,List OV,List NNI,List R) -> Union(SUPP,"failed") - - ---- Local functions ---- -- test if something wrong happened in the gcd + failtest : (SUPP,SUPP,SUPP) -> Boolean failtest(f:SUPP,p1:SUPP,p2:SUPP) : Boolean == (p1 exquo f) case "failed" or (p2 exquo f) case "failed" -- Choose the integers + chooseVal : (SUPP,SUPP,List OV,List List R) -> Union(UTerm,"failed") chooseVal(p1:SUPP,p2:SUPP,lvr:List OV,_ ltry:List List R):Union(UTerm,"failed") == d1:=degree(p1) @@ -201417,6 +204364,7 @@ See Volume 10.1 for more details. --the new gcd has degree less du

dd:=du + good : (SUPP,List OV,List List R) -> Record(upol:SUP,inval:List List R) good(f:SUPP,lvr:List OV, _ ltry:List List R):Record(upol:SUP,inval:List List R) == nvr:NNI:=#lvr @@ -201430,6 +204378,7 @@ See Volume 10.1 for more details. if degree gcd(uf,differentiate uf)=0 then return [uf,ltry] -- impose the right leading condition, check for failure. + imposelc : (List SUP,List OV,List R,List P) -> Union(List SUP, "failed") imposelc(lipol:List SUP, lvar:List OV, lval:List R, leadc:List P): Union(List SUP, "failed") == result:List SUP :=[] @@ -201441,6 +204390,7 @@ See Volume 10.1 for more details. reverse result --Compute the gcd between not coprime polynomials + notCoprime : (SUPP,SUPP, List NNI,List OV,List List R) -> SUPP notCoprime(g:SUPP, p2:SUPP, ldeg:List NNI,_ lvar1:List OV, ltry:List List R) : SUPP == g1:=gcd(g,differentiate g) @@ -201474,6 +204424,8 @@ See Volume 10.1 for more details. gd1:=gd1*gd2 ulist:=[(uf exquo d)::SUP for uf in ulist] + gcdPrimitive : (SparseUnivariatePolynomial(P),_ + SparseUnivariatePolynomial(P)) -> SparseUnivariatePolynomial(P) gcdPrimitive(p1:SUPP,p2:SUPP) : SUPP == if (d1:=degree(p1)) > (d2:=degree(p2)) then (p1,p2):= (p2,p1) @@ -201498,6 +204450,7 @@ See Volume 10.1 for more details. result --local function for the gcd : it returns the evaluation point too + localgcd : (SUPP,SUPP,List OV,List List R) -> LGcd localgcd(p1:SUPP,p2:SUPP,lvar:List(OV),ltry:List List R) : LGcd == uterm:=chooseVal(p1,p2,lvar,ltry)::UTerm ltry:=uterm.lint @@ -201518,17 +204471,20 @@ See Volume 10.1 for more details. [h.s,ltry]$LGcd -- content, internal functions return the poly if it is a monomial + monomContent : (SUPP) -> SUPP monomContent(p:SUPP):SUPP == degree(p)=0 => 1 md:= minimumDegree(p) monomial(gcd sort(better,coefficients p),md) -- Ordering for gcd purposes + better : (P,P) -> Boolean better(p1:P,p2:P):Boolean == ground? p1 => true ground? p2 => false degree(p1,mainVariable(p1)::OV) < degree(p2,mainVariable(p2)::OV) + best_to_front : List P -> List P best_to_front(l : List P) : List P == ress := [] best := first(l) @@ -201542,6 +204498,7 @@ See Volume 10.1 for more details. -- Gcd between polynomial p1 and p2 with -- mainVariable p1 < x=mainVariable p2 + gcdTermList : (P,P) -> P gcdTermList(p1:P,p2:P) : P == termList := best_to_front( cons(p1,coefficients univariate(p2,(mainVariable p2)::OV))) @@ -201550,6 +204507,8 @@ See Volume 10.1 for more details. q -- Gcd between polynomials with the same mainVariable + gcd : (SparseUnivariatePolynomial(P),SparseUnivariatePolynomial(P)) -> _ + SparseUnivariatePolynomial(P) gcd(p1:SUPP,p2:SUPP): SUPP == if degree(p1) > degree(p2) then (p1,p2):= (p2,p1) degree p1 = 0 => @@ -201565,11 +204524,14 @@ See Volume 10.1 for more details. gcdPrimitive(p1,p2) * gcdMonom(c1,c2) -- gcd between 2 monomials + gcdMonom : (SUPP,SUPP) -> SUPP gcdMonom(m1:SUPP,m2:SUPP):SUPP == monomial(gcd(leadingCoefficient(m1),leadingCoefficient(m2)), min(degree(m1),degree(m2))) --If there is a pol s.t. pol/gcd and gcd are coprime I can lift + lift? :(SUPP,SUPP,UTerm,List NNI,List OV) -> _ + Union(s:SUPP,failed:"failed",notCoprime:"notCoprime") lift?(p1:SUPP,p2:SUPP,uterm:UTerm,ldeg:List NNI, _ lvar:List OV) : _ Union(s:SUPP,failed:"failed",notCoprime:"notCoprime") == @@ -201589,6 +204551,7 @@ See Volume 10.1 for more details. [l :: SUPP] -- interface with the general "lifting" function + lift :(SUPP,SUP,SUP,P,List OV,List NNI,List R) -> Union(SUPP,"failed") lift(f:SUPP,d:SUP,uf:SUP,lgcd:P,lvar:List OV, ldeg:List NNI,lval:List R):Union(SUPP,"failed") == leadpol : Boolean := false @@ -201623,6 +204586,7 @@ See Volume 10.1 for more details. p0 exquo content(p0) -- Gcd for two multivariate polynomials + gcd : (P,P) -> P gcd(p1:P,p2:P) : P == ground? p1 => p1 := unitCanonical p1 @@ -201644,6 +204608,7 @@ See Volume 10.1 for more details. gcdTermList(p2,p1) -- Gcd for a list of multivariate polynomials + gcd : List(P) -> P gcd(listp:List P) : P == lf := best_to_front(listp) f:=lf.first @@ -201652,6 +204617,7 @@ See Volume 10.1 for more details. if f=1$P then return f f + gcd: List(SparseUnivariatePolynomial(P)) -> SparseUnivariatePolynomial(P) gcd(listp:List SUPP) : SUPP == lf:=sort((z1:SUPP,z2:SUPP):Boolean +-> degree(z1) P gcdPrimitive(p1:P,p2:P):P == (p1:= unitCanonical(p1)) = (p2:= unitCanonical(p2)) => p1 ground? p1 => @@ -201686,6 +204652,7 @@ See Volume 10.1 for more details. 1$P -- Gcd for a list of primitive multivariate polynomials + gcdPrimitive : List(P) -> P gcdPrimitive(listp:List P) : P == lf:=sort(better,listp) f:=lf.first @@ -201784,10 +204751,13 @@ PolynomialInterpolation(xx, F): Cat == Body where PIA ==> PolynomialInterpolationAlgorithms + interpolate : (UnivariatePolynomial(xx,F),List(F),List(F)) -> _ + UnivariatePolynomial(xx,F) interpolate(qx, lx, ly) == px := LagrangeInterpolation(lx, ly)$PIA(F, UP(xx, F)) elt(px, qx) + interpolate : (List(F),List(F)) -> SparseUnivariatePolynomial(F) interpolate(lx, ly) == LagrangeInterpolation(lx, ly)$PIA(F, SUP F) @@ -201878,6 +204848,7 @@ PolynomialInterpolationAlgorithms(F, P): Cat == Body where (* package PINTERPA *) (* + LagrangeInterpolation : (List(F),List(F)) -> P LagrangeInterpolation(lx, ly) == #lx ^= #ly => error "Different number of points and values." @@ -202205,6 +205176,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where da := degree a q + cyclotomic : Integer -> SparseUnivariatePolynomial(Integer) cyclotomic n == --++ cyclotomic polynomial denoted phi[n](x) p:I; q:I; r:I; s:I; m:NNI; c:SUP(I); t:SUP(I) @@ -202223,6 +205195,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where m := (n quo s) :: NNI multiplyExponents(c,m) + euler : Integer -> SparseUnivariatePolynomial(Fraction(Integer)) euler n == p : SUP(RN); t : SUP(RN); c : RN; s : I n < 0 => error "euler not defined for negative integers" @@ -202236,6 +205209,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where E.Ev := p p + bernoulli : Integer -> SparseUnivariatePolynomial(Fraction(Integer)) bernoulli n == p : SUP RN; t : SUP RN; c : RN; s : I n < 0 => error "bernoulli not defined for negative integers" @@ -202249,6 +205223,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where B.Bv := p p + fixedDivisor : SparseUnivariatePolynomial(Integer) -> Integer fixedDivisor a == g:I; d:NNI; SUP(I) d := degree a @@ -202256,6 +205231,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where for k in 1..d while g > 1 repeat g := gcd(g,a k) g + hermite : Integer -> SparseUnivariatePolynomial(Integer) hermite n == s : I; p : SUP(I); q : SUP(I) n < 0 => error "hermite not defined for negative integers" @@ -202267,6 +205243,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where H.H2 := q p + laguerre : Integer -> SparseUnivariatePolynomial(Integer) legendre n == s:I; t:I; p:SUP(RN); q:SUP(RN) n < 0 => error "legendre not defined for negative integers" @@ -202280,6 +205257,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where P.P2 := q p + legendre : Integer -> SparseUnivariatePolynomial(Fraction(Integer)) laguerre n == k:I; s:I; t:I; p:SUP(I); q:SUP(I) n < 0 => error "laguerre not defined for negative integers" @@ -202293,6 +205271,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where L.L2 := q p + chebyshevT : Integer -> SparseUnivariatePolynomial(Integer) chebyshevT n == s : I; p : SUP(I); q : SUP(I) n < 0 => error "chebyshevT not defined for negative integers" @@ -202304,6 +205283,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where CT.T2 := q p + chebyshevU : Integer -> SparseUnivariatePolynomial(Integer) chebyshevU n == s : I; p : SUP(I); q : SUP(I) n < 0 => error "chebyshevU not defined for negative integers" @@ -202527,9 +205507,7 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where import FactoredFunctions Z import FactoredFunctions P - rsplit: List P -> Record(coef:R, poly:P) zroot : (Z, N) -> Record(exponent:N, coef:Z, radicand:Z) - zroot(x, n) == zero? x or (x = 1) => [1, x, 1] s := nthRoot(squareFree x, n) @@ -202538,13 +205516,14 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where if R has imaginary: () -> R then czroot: (Z, N) -> REC - czroot(x, n) == rec := zroot(x, n) rec.exponent = 2 and rec.radicand < 0 => [rec.exponent, rec.coef * imaginary()::P::F, (-rec.radicand)::F] [rec.exponent, rec.coef::F, rec.radicand::F] + qroot : (Fraction(Integer),NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: F,radicand: F) qroot(x, n) == sn := czroot(numer x, n) sd := czroot(denom x, n) @@ -202555,6 +205534,8 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where else + qroot : (Fraction(Integer),NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: F,radicand: F) qroot(x, n) == sn := zroot(numer x, n) sd := zroot(denom x, n) @@ -202565,6 +205546,8 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where if R has RetractableTo Fraction Z then + rroot : (R,NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: F,radicand: F) rroot(x, n) == (r := retractIfCan(x)@Union(Fraction Z,"failed")) case "failed" => [n, 1, x::P::F] @@ -202574,6 +205557,8 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where if R has RetractableTo Z then + rroot : (R,NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: F,radicand: F) rroot(x, n) == (r := retractIfCan(x)@Union(Z,"failed")) case "failed" => [n, 1, x::P::F] @@ -202581,8 +205566,11 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where else + rroot : (R,NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: F,radicand: F) rroot(x, n) == [n, 1, x::P::F] + rsplit: List P -> Record(coef:R, poly:P) rsplit l == r := 1$R p := 1$P @@ -202595,6 +205583,8 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where if R has GcdDomain then if R has RetractableTo Z then + nthr : (P,NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: P,radicand: List(P)) nthr(x, n) == (r := retractIfCan(x)@Union(Z,"failed")) case "failed" => nthRoot(squareFree x, n) @@ -202603,8 +205593,12 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where else + nthr : (P,NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: P,radicand: List(P)) nthr(x, n) == nthRoot(squareFree x, n) + froot : (F,NonNegativeInteger) -> _ + Record(exponent: NonNegativeInteger,coef: F,radicand: F) froot(x, n) == zero? x or (x = 1) => [1, x, 1] sn := nthr(numer x, n) @@ -203562,11 +206556,16 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where (* package PSETPK *) (* - autoRemainder: T -> List(P) + interReduce : List(P) -> List(P) + bivariatePolynomials : List(P) -> Record(goodPols: List(P),badPols: List(P)) + univariatePolynomials : List(P) -> Record(goodPols: List(P),badPols: List(P)) + removeAssociates : LP -> LP removeAssociates (lp:LP):LP == removeDuplicates [primPartElseUnitCanonical(p) for p in lp] + selectPolynomials : ((P -> Boolean),List(P)) -> _ + Record(goodPols: List(P),badPols: List(P)) selectPolynomials (pred?,ps) == gps : LP := [] bps : LP := [] @@ -203582,6 +206581,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where bps := sort(infRittWu?,bps) [gps,bps] + selectOrPolynomials : (List((P -> Boolean)),List(P)) -> _ + Record(goodPols: List(P),badPols: List(P)) selectOrPolynomials (lpred?,ps) == gps : LP := [] bps : LP := [] @@ -203600,6 +206601,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where bps := sort(infRittWu?,bps) [gps,bps] + selectAndPolynomials : (List((P -> Boolean)),List(P)) -> _ + Record(goodPols: List(P),badPols: List(P)) selectAndPolynomials (lpred?,ps) == gps : LP := [] bps : LP := [] @@ -203618,13 +206621,16 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where bps := sort(infRittWu?,bps) [gps,bps] + linear? : P -> Boolean linear? p == ground? p => false (mdeg(p) = 1) + linearPolynomials : List(P) -> Record(goodPols: List(P),badPols: List(P)) linearPolynomials ps == selectPolynomials(linear?,ps) + univariate? : P -> Boolean univariate? p == ground? p => false not(ground?(init(p))) => false @@ -203633,9 +206639,11 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where not (mvar(p) = mvar(tp)) => false univariate?(tp) + univariatePolynomialsGcds : List(P) -> List(P) univariatePolynomials ps == selectPolynomials(univariate?,ps) + bivariate? : P -> Boolean bivariate? p == ground? p => false ground? tail(p) => univariate?(init(p)) @@ -203651,12 +206659,15 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where zero? degree(tail(p),vip) => univariate? tail(p) bivariate? tail(p) + bivariatePolynomials:List(P) -> Record(goodPols: List(P),badPols: List(P)) bivariatePolynomials ps == selectPolynomials(bivariate?,ps) + quasiMonicPolynomials:List(P)-> Record(goodPols: List(P),badPols: List(P)) quasiMonicPolynomials ps == selectPolynomials(quasiMonic?,ps) + removeRoughlyRedundantFactorsInPols : (List(P),List(P),Boolean) -> List(P) removeRoughlyRedundantFactorsInPols (lp,lf,opt) == empty? lp => lp newlp : LP := [] @@ -203679,20 +206690,24 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where stop => [1$P] newlp + removeRoughlyRedundantFactorsInPol : (P,List(P)) -> P removeRoughlyRedundantFactorsInPol(p,lf) == zero? p => p lp : LP := [p] first removeRoughlyRedundantFactorsInPols (lp,lf,true()$B) + removeRoughlyRedundantFactorsInPols : (List(P),List(P)) -> List(P) removeRoughlyRedundantFactorsInPols (lp,lf) == removeRoughlyRedundantFactorsInPols (lp,lf,false()$B) + possiblyNewVariety? : (List(P),List(List(P))) -> Boolean possiblyNewVariety?(newlp,llp) == while (not empty? llp) and _ (not certainlySubVariety?(newlp,first(llp))) repeat llp := rest llp empty? llp + certainlySubVariety? : (List(P),List(P)) -> Boolean certainlySubVariety?(lp,lq) == gs := construct(lp)$GPS while (not empty? lq) and _ @@ -203700,6 +206715,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where lq := rest lq empty? lq + probablyZeroDim? : List(P) -> Boolean probablyZeroDim?(lp: List P) : Boolean == m := #lp lv : List V := variables(first lp) @@ -203708,6 +206724,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where n := #(removeDuplicates lv) not (n > m) + interReduce : LP -> LP interReduce(lp: LP): LP == ps := lp rs: List(P) := [] @@ -203723,13 +206740,17 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where ps := concat(ps,cons(r,rs)) rs := [] + roughRed? : (P,P) -> B roughRed?(p:P,q:P):B == ground? p => false ground? q => true mvar(p) > mvar(q) + roughBasicSet : List(P) -> _ + Union(Record(bas: GeneralTriangularSet(R,E,V,P),top: List(P)),"failed") roughBasicSet(lp) == basicSet(lp,roughRed?)$T + autoRemainder: T -> List(P) autoRemainder(ts:T): List(P) == empty? ts => members(ts) lp := sort(infRittWu?, reverse members(ts)) @@ -203750,6 +206771,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where lp := rest(lp) newlp + crushedSet : List(P) -> List(P) crushedSet(lp) == rec := roughBasicSet(lp) contradiction := (rec case "failed")@B @@ -203768,6 +206790,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where contradiction => [1$P] rs + rewriteSetByReducingWithParticularGenerators : _ + (List(P),(P -> Boolean),((P,P) -> Boolean),((P,P) -> P)) -> List(P) rewriteSetByReducingWithParticularGenerators (ps,pred?,redOp?,redOp) == rs : LP := remove(zero?,ps) any?(ground?,rs) => [1$P] @@ -203800,12 +206824,14 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where rs := [1$P] rs + removeRedundantFactors : (List(P),List(P),(List(P) -> List(P))) -> List(P) removeRedundantFactors (lp:LP,lq :LP, remOp : (LP -> LP)) == -- ASSUME remOp(lp) returns lp up to similarity lq := removeRoughlyRedundantFactorsInPols(lq,lp,false) lq := remOp lq sort(infRittWu?,concat(lp,lq)) + removeRedundantFactors : (List(P),List(P)) -> List(P) removeRedundantFactors (lp:LP,lq :LP) == lq := removeRoughlyRedundantFactorsInPols(lq,lp,false) lq := removeRedundantFactors lq @@ -203814,6 +206840,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where if (R has EuclideanDomain) and (R has CharacteristicZero) then + irreducibleFactors : List(P) -> List(P) irreducibleFactors lp == newlp : LP := [] lrrz : List RRZ @@ -203828,6 +206855,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where newlp := concat(lf,newlp) removeDuplicates newlp + lazyIrreducibleFactors : List(P) -> List(P) lazyIrreducibleFactors lp == lp := removeRedundantFactors(lp) newlp : LP := [] @@ -203843,6 +206871,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where newlp := concat(lf,newlp) newlp + removeIrreducibleRedundantFactors : (List(P),List(P)) -> List(P) removeIrreducibleRedundantFactors (lp:LP,lq :LP) == -- ASSUME lp only contains irreducible factors over R lq := removeRoughlyRedundantFactorsInPols(lq,lp,false) @@ -203852,11 +206881,13 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where if R has GcdDomain then + squareFreeFactors : P -> List(P) squareFreeFactors(p:P) == sfp: Factored P := squareFree(p)$P lsf: List P := [foo.factor for foo in factors(sfp)] lsf + univariatePolynomialsGcds : (List(P),Boolean) -> List(P) univariatePolynomialsGcds (ps,opt) == lg : LP := [] pInV : LP @@ -203882,19 +206913,24 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where stop => [1$P] lg + univariatePolynomialsGcds : List(P) -> List(P) univariatePolynomialsGcds ps == univariatePolynomialsGcds (ps,false) + removeSquaresIfCan : List(P) -> List(P) removeSquaresIfCan lp == empty? lp => lp removeDuplicates [squareFreePart(p)$P for p in lp] + rewriteIdealWithQuasiMonicGenerators : _ + (List(P),((P,P) -> Boolean),((P,P) -> P)) -> List(P) rewriteIdealWithQuasiMonicGenerators (ps,redOp?,redOp) == ups := removeSquaresIfCan(univariatePolynomialsGcds(ps,true)) ps := removeDuplicates concat(ups,ps) rewriteSetByReducingWithParticularGenerators_ (ps,quasiMonic?,redOp?,redOp) + removeRoughlyRedundantFactorsInContents : (List(P),List(P)) -> List(P) removeRoughlyRedundantFactorsInContents (ps,lf) == empty? ps => ps newps : LP := [] @@ -203925,6 +206961,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where newps := cons(newp,newps) newps + removeRedundantFactorsInContents : (List(P),List(P)) -> List(P) removeRedundantFactorsInContents (ps,lf) == empty? ps => ps newps : LP := [] @@ -203953,6 +206990,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where newps := cons(newp,newps) newps + removeRedundantFactorsInPols : (List(P),List(P)) -> List(P) removeRedundantFactorsInPols (ps,lf) == empty? ps => ps newps : LP := [] @@ -203988,6 +207026,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where newps := cons(newp,newps) newps + removeRedundantFactors : (P,P) -> List(P) removeRedundantFactors (a:P,b:P) : LP == a := primPartElseUnitCanonical(squareFreePart(a)) b := primPartElseUnitCanonical(squareFreePart(b)) @@ -204008,6 +207047,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where else return(unprotectedRemoveRedundantFactors(a,b)) + unprotectedRemoveRedundantFactors : (P,P) -> List(P) unprotectedRemoveRedundantFactors (a,b) == c := b exquo$P a if (c case P)@B @@ -204028,13 +207068,17 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where else + removeSquaresIfCan : List(P) -> List(P) removeSquaresIfCan lp == lp + rewriteIdealWithQuasiMonicGenerators : _ + (List(P),((P,P) -> Boolean),((P,P) -> P)) -> List(P) rewriteIdealWithQuasiMonicGenerators (ps,redOp?,redOp) == rewriteSetByReducingWithParticularGenerators_ (ps,quasiMonic?,redOp?,redOp) + removeRedundantFactors : (P,P) -> List(P) removeRedundantFactors (a:P,b:P) == a := primPartElseUnitCanonical(a) b := primPartElseUnitCanonical(b) @@ -204055,6 +207099,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where else return(unprotectedRemoveRedundantFactors(a,b)) + unprotectedRemoveRedundantFactors : (P,P) -> List(P) unprotectedRemoveRedundantFactors (a,b) == c := b exquo$P a if (c case P)@B @@ -204069,6 +207114,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where else return([a,b]) + removeRedundantFactors : List(P) -> List(P) removeRedundantFactors (lp:LP) == lp := remove(ground?, lp) lp := removeDuplicates [primPartElseUnitCanonical(p) for p in lp] @@ -204087,6 +207133,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where top := rest top base + removeRedundantFactors : (List(P),P) -> List(P) removeRedundantFactors (lp:LP,a:P) == lp := remove(ground?, lp) lp := sort(infRittWu?, lp) @@ -204506,10 +207553,15 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where id ==> (IDENTITY$Lisp) maplist: List Record(arg: F, res: F) := [] + mapSolving?: Boolean := false + -- map: F -> F := id #1 replaced with line below map: Boolean := false + + mapSolve : (UP,(F -> F)) -> _ + Record(solns: List(F),maps: List(Record(arg: F,res: F))) mapSolve(p, fn) == -- map := fn #1 replaced with line below locmap: F -> F := x +-> fn x; map := id locmap @@ -204520,6 +207572,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where locmap := x +-> id x; map := id locmap [slist, maplist] + part : F -> F part(s: F): F == not mapSolving? => s -- t := map s replaced with line below @@ -204534,6 +207587,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where cc ==> coefficient -- local intsolve + intsolve : UP -> L(F) intsolve(u:UP):L(F) == u := (factors squareFree u).1.factor n := degree u @@ -204543,6 +207597,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where n=4 => quartic (cc(u,4), cc(u,3), cc(u,2), cc(u,1), cc(u,0)) error "All sqfr factors of polynomial must be of degree < 5" + solve : UP -> List(F) solve u == ls := nil$L(F) for f in factors squareFree u repeat @@ -204550,6 +207605,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where for i in 1..(f.exponent) repeat ls := [:lsf,:ls] ls + particularSolution : UP -> F particularSolution u == u := (factors squareFree u).1.factor n := degree u @@ -204559,32 +207615,39 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where n=4 => aQuartic (cc(u,4), cc(u,3), cc(u,2), cc(u,1), cc(u,0)) error "All sqfr factors of polynomial must be of degree < 5" + needDegree : (Integer,UP) -> Boolean needDegree(n: Integer, u: UP): Boolean == degree u = n => true error concat("Polynomial must be of degree ", n::String) + needLcoef : F -> Boolean needLcoef(cn: F): Boolean == cn ^= 0 => true error "Leading coefficient must not be 0." + needChar0 : () -> Boolean needChar0(): Boolean == characteristic()$F = 0 => true error "Formula defined only for fields of characteristic 0." + linear : UP -> List(F) linear u == needDegree(1, u) linear (coefficient(u,1), coefficient(u,0)) + quadratic : UP -> List(F) quadratic u == needDegree(2, u) quadratic (coefficient(u,2), coefficient(u,1), coefficient(u,0)) + cubic : UP -> List(F) cubic u == needDegree(3, u) cubic (coefficient(u,3), coefficient(u,2), coefficient(u,1), coefficient(u,0)) + quartic : UP -> List(F) quartic u == needDegree(4, u) quartic (coefficient(u,4),coefficient(u,3), @@ -204597,17 +207660,21 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where -- local function for testing equality of radicals. -- This function is necessary to detect at least some of the -- situations like sqrt(9)-3 = 0 --> false. + equ : (F,F) -> Boolean equ(x:F,y:F):Boolean == ( (recip(x-y)) case "failed" ) => true false + linear : (F,F) -> List(F) linear(c1, c0) == needLcoef c1 [- c0/c1 ] + aLinear : (F,F) -> F aLinear(c1, c0) == first linear(c1,c0) + quadratic : (F,F,F) -> List(F) quadratic(c2, c1, c0) == needLcoef c2; needChar0() (c0 = 0) => [0$F,:linear(c2, c1)] @@ -204615,6 +207682,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where D := part(c1**2 - 4*c2*c0)**(1/2) [(-c1+D)/(2*c2), (-c1-D)/(2*c2)] + aQuadratic : (F,F,F) -> F aQuadratic(c2, c1, c0) == needLcoef c2; needChar0() (c0 = 0) => 0$F @@ -204624,24 +207692,21 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where w3: F := (-1 + (-3::F)**(1/2)) / 2::F + cubic : (F,F,F,F) -> List(F) cubic(c3, c2, c1, c0) == needLcoef c3; needChar0() - -- case one root = 0, not necessary but keeps result small (c0 = 0) => [0$F,:quadratic(c3, c2, c1)] a1 := c2/c3; a2 := c1/c3; a3 := c0/c3 - -- case x**3-a3 = 0, not necessary but keeps result small (a1 = 0 and a2 = 0) => [ u*(-a3)**(1/3) for u in [1, w3, w3**2 ] ] - -- case x**3 + a1*x**2 + a1**2*x/3 + a3 = 0, the general for- -- mula is not valid in this case, but solution is easy. P := part(-a1/3::F) equ(a1**2,3*a2) => S := part((- a3 + (a1**3)/27::F)**(1/3)) [ P + S*u for u in [1,w3,w3**2] ] - -- general case Q := part((3*a2 - a1**2)/9::F) R := part((9*a1*a2 - 27*a3 - 2*a1**3)/54::F) @@ -204650,6 +207715,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where -- S = 0 is done in the previous case [ P + S*u - Q/(S*u) for u in [1, w3, w3**2] ] + aCubic : (F,F,F,F) -> F aCubic(c3, c2, c1, c0) == needLcoef c3; needChar0() (c0 = 0) => 0$F @@ -204665,20 +207731,18 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where S := part(R + D)**(1/3) P + S - Q/S + quartic : (F,F,F,F,F) -> List(F) quartic(c4, c3, c2, c1, c0) == needLcoef c4; needChar0() - -- case one root = 0, not necessary but keeps result small (c0 = 0) => [0$F,:cubic(c4, c3, c2, c1)] -- Make monic: a1 := c3/c4; a2 := c2/c4; a3 := c1/c4; a4 := c0/c4 - -- case x**4 + a4 = 0 <=> (x**2-sqrt(-a4))*(x**2+sqrt(-a4)) -- not necessary but keeps result small. (a1 = 0 and a2 = 0 and a3 = 0) => append( quadratic(1, 0, (-a4)**(1/2)),_ quadratic(1 ,0, -((-a4)**(1/2))) ) - -- Translate w = x+a1/4 to eliminate a1: w**4+p*w**2+q*w+r p := part(a2-3*a1*a1/8::F) q := part(a3-a1*a2/2::F + a1**3/8::F) @@ -204699,6 +207763,7 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where -- Translate back: [s - a1/4::F for s in slist] + aQuartic : (F,F,F,F,F) -> F aQuartic(c4, c3, c2, c1, c0) == needLcoef c4; needChar0() (c0 = 0) => 0$F @@ -204902,15 +207967,12 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where fUnion ==> Union("nil", "sqfr", "irred", "prime") FF ==> Record(flg:fUnion, fctr:P, xpnt:Integer) - finSqFr : (P,List VarSet) -> Factored P - pthPower : P -> Factored P - pPolRoot : P -> P - putPth : P -> P chrc:=characteristic$RC if RC has CharacteristicNonZero then -- find the p-th root of a polynomial + pPolRoot : P -> P pPolRoot(f:P) : P == lvar:=variables f empty? lvar => f @@ -204921,6 +207983,7 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where multivariate(uf,mv) -- substitute variables with their p-th power + putPth : P -> P putPth(f:P) : P == lvar:=variables f empty? lvar => f @@ -204931,6 +207994,7 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where multivariate(uf,mv) -- the polynomial is a perfect power + pthPower : P -> Factored P pthPower(f:P) : Factored P == proot : P := 0 isSq : Boolean := false @@ -204946,6 +208010,7 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where for u in factorList psqfr]) -- compute the square free decomposition, finite characteristic case + finSqFr : (P,List VarSet) -> Factored P finSqFr(f:P,lvar:List VarSet) : Factored P == empty? lvar => pthPower(f) mv:=first lvar @@ -204975,6 +208040,7 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where makeFR(unit(sqp)*coefficient(unit squf,0),pfaclist) makeFR(coefficient(unit squf,0),pfaclist) + squareFree : P -> Factored(P) squareFree(p:P) == mv:=mainVariable p mv case "failed" => makeFR(p,[])$Factored(P) @@ -205076,6 +208142,8 @@ PolynomialToUnivariatePolynomial(x:Symbol, R:Ring): with (* package POLY2UP *) (* + univariate : (Polynomial(R),Variable(x)) -> _ + UnivariatePolynomial(x,Polynomial(R)) univariate(p, y) == q:SparseUnivariatePolynomial(Polynomial R) := univariate(p, x) map(x1+->x1, q)$UnivariatePolynomialCategoryFunctions2(Polynomial R, @@ -205674,17 +208742,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where import ElementaryFunctionStructurePackage(R,FE) zeroFE:FE := 0 - anyRootsOrAtrigs? : FE -> Boolean - complLimit : (FE,SY) -> Union(OPF,"failed") - okProblem? : (String,String) -> Boolean - realLimit : (FE,SY) -> U - xxpLimit : (FE,SY) -> RESULT - limitPlus : (FE,SY) -> RESULT - localsubst : (FE,Kernel FE,Z,FE) -> FE - locallimit : (FE,SY,OFE) -> U - locallimitcomplex : (FE,SY,OPF) -> Union(OPF,"failed") - poleLimit:(RN,FE,SY) -> U - poleLimitPlus:(RN,FE,SY) -> RESULT + noX?: (FE,SY) -> Boolean noX?(fcn,x) == not member?(x,variables fcn) @@ -205740,11 +208798,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where error "limit package: internal error" inf - specialLimit1: (FE,SY) -> RESULT - specialLimitKernel: (Kernel FE,SY) -> RESULT - specialLimitNormalize: (FE,SY) -> RESULT specialLimit: (FE, SY) -> RESULT - specialLimit(fcn, x) == xkers := [k for k in kernels fcn | member?(x,variables(k::FE))] #xkers = 1 => specialLimit1(fcn,x) @@ -205763,6 +208817,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where den = 0 => return specialLimitNormalize(fcn,x) (num/den) :: OFE :: RESULT + specialLimitNormalize: (FE,SY) -> RESULT specialLimitNormalize(fcn,x) == -- tries to normalize result first nfcn := normalize(fcn) fcn ^= nfcn => limitPlus(nfcn,x) @@ -205789,6 +208844,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where "failed" -- limit of expression having only 1 kernel involving x + specialLimit1: (FE,SY) -> RESULT specialLimit1(fcn,x) == -- find the first interesting kernel in tower(fcn) xkers := [k for k in kernels fcn | member?(x,variables(k::FE))] @@ -205804,6 +208860,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where "failed" -- limit of single kernel involving x + specialLimitKernel: (Kernel FE,SY) -> RESULT specialLimitKernel(ker,x) == is?(ker,"log" :: Symbol) => args := argument ker @@ -205897,6 +208954,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where member?(x,variables(cc := eval(coef,eq))) => "failed" limitPlus(cc,vv) + locallimit : (FE,SY,OFE) -> U locallimit(fcn,x,a) == -- Here 'fcn' is a function f(x) = f(x,...) in 'x' and possibly -- other variables, and 'a' is a limiting value. The function @@ -205908,16 +208966,19 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where case "failed" => "failed" u::OFE + localsubst : (FE,Kernel FE,Z,FE) -> FE localsubst(fcn, k, n, a) == a = 0 and n = 1 => fcn eval(fcn,k,n * (k::FE) + a) + locallimitcomplex : (FE,SY,OPF) -> Union(OPF,"failed") locallimitcomplex(fcn,x,a) == xK := retract(x::FE)@Kernel(FE) (g := retractIfCan(a)@Union(FE,"failed")) case FE => complLimit(localsubst(fcn,xK,1,g::FE),x) complLimit(eval(fcn,xK,inv(xK::FE)),x) + limit : (FE,Equation(FE),String) -> Union(OrderedCompletion(FE),"failed") limit(fcn,eq,str) == (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => error "limit:left hand side must be a variable" @@ -205925,6 +208986,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where xK := retract(x::FE)@Kernel(FE) limitPlus(localsubst(fcn,xK,direction str,a),x) + anyRootsOrAtrigs? : FE -> Boolean anyRootsOrAtrigs? fcn == -- determines if 'fcn' has any kernels which are roots -- or if 'fcn' has any kernels which are inverse trig functions @@ -205937,6 +208999,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where is?(kernel,"acsc" :: Symbol) => return true false + complLimit : (FE,SY) -> Union(OPF,"failed") complLimit(fcn,x) == -- computes lim(x -> 0,fcn) using a Puiseux expansion of fcn, -- if fcn is an expression involving roots, and using a Laurent @@ -205965,6 +209028,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where answer :: OPF lim :: FE :: OPF + okProblem? : (String,String) -> Boolean okProblem?(function,problem) == (function = "log") or (function = "nth root") => (problem = "series of non-zero order") or _ @@ -205973,6 +209037,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where (function = "erf") => problem = "unknown kernel" problem = "essential singularity" + poleLimit:(RN,FE,SY) -> U poleLimit(order,coef,x) == -- compute limit for function with pole not member?(x,variables coef) => @@ -205985,6 +209050,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where "failed" error "limit: can't evaluate limit" + poleLimitPlus:(RN,FE,SY) -> RESULT poleLimitPlus(order,coef,x) == -- compute right hand limit for function with pole not member?(x,variables coef) => @@ -206009,6 +209075,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where "failed" t * plusInfinity() + realLimit : (FE,SY) -> U realLimit(fcn,x) == -- computes lim(x -> 0,fcn) using a Puiseux expansion of fcn, -- if fcn is an expression involving roots, and using a Laurent @@ -206069,6 +209136,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where answer :: OFE lim :: FE :: OFE + xxpLimit : (FE,SY) -> RESULT xxpLimit(fcn,x) == -- computes lim(x -> 0+,fcn) using an exponential expansion of fcn xpack := FS2EXPXP(R,FE,x,zeroFE) @@ -206076,6 +209144,7 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where xxp case %problem => "failed" limitPlus(xxp.%expansion) + limitPlus : (FE,SY) -> RESULT limitPlus(fcn,x) == -- computes lim(x -> 0+,fcn) using a generalized Puiseux expansion -- of fcn, if fcn is an expression involving roots, and using a @@ -206121,6 +209190,10 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where answer :: OFE lim :: FE :: OFE + limit : (FE,Equation(OrderedCompletion(FE))) -> _ + Union(OrderedCompletion(FE),_ + Record(leftHandLimit: Union(OrderedCompletion(FE),"failed"),_ + rightHandLimit: Union(OrderedCompletion(FE),"failed")),"failed") limit(fcn:FE,eq:EQ OFE) == (f := retractIfCan(lhs eq)@Union(FE,"failed")) case "failed" => error "limit:left hand side must be a variable" @@ -206129,6 +209202,8 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where x := xx :: SY; a := rhs eq locallimit(fcn,x,a) + complexLimit : (FE,Equation(OnePointCompletion(FE))) -> _ + Union(OnePointCompletion(FE),"failed") complexLimit(fcn:FE,eq:EQ OPF) == (f := retractIfCan(lhs eq)@Union(FE,"failed")) case "failed" => error "limit:left hand side must be a variable" @@ -206294,20 +209369,16 @@ PrecomputedAssociatedEquations(R, L): Exports == Implementation where (* package PREASSOC *) (* - A32: L -> U - A42: L -> U - A425: (A, A, A) -> List R - A426: (A, A, A) -> List R - makeMonic: L -> Union(A, "failed") - diff:L := D() + firstUncouplingMatrix : (L,PositiveInteger) -> Union(Matrix(R),"failed") firstUncouplingMatrix(op, m) == n := degree op n = 3 and m = 2 => A32 op n = 4 and m = 2 => A42 op "failed" + makeMonic: L -> Union(A, "failed") makeMonic op == lc := leadingCoefficient op a:A := new(n := degree op, 0) @@ -206316,12 +209387,14 @@ PrecomputedAssociatedEquations(R, L): Exports == Implementation where a.i := - (u::R) a + A32: L -> U A32 op == (u := makeMonic op) case "failed" => "failed" a := u::A matrix [[0, 1, 0], [a.1, a.2, 1], [diff(a.1) + a.1 * a.2 - a.0, diff(a.2) + a.2**2 + a.1, 2 * a.2]] + A42: L -> U A42 op == (u := makeMonic op) case "failed" => "failed" a := u::A @@ -206335,6 +209408,7 @@ PrecomputedAssociatedEquations(R, L): Exports == Implementation where a'.3 + a.3 ** 2 + a.2, 3 * a.3, 2::R], A425(a, a', a''), A426(a, a', a'')] + A425: (A, A, A) -> List R A425(a, a', a'') == [a''.1 + 2 * a.1 * a'.3 + a.3 * a'.1 - 2 * a'.0 + a.1 * a.3 ** 2 - 3 * a.0 * a.3 + a.1 * a.2, @@ -206344,6 +209418,7 @@ PrecomputedAssociatedEquations(R, L): Exports == Implementation where a''.3 + 3 * a.3 * a'.3 + 2 * a'.2 + a.3 ** 3 + 2 * a.2 * a.3 + a.1, 4 * a'.3 + 4 * a.3 ** 2 + 4 * a.2, 5 * a.3] + A426: (A, A, A) -> List R A426(a, a', a'') == [diff(a''.1) + 3 * a.1 * a''.3 + a.3 * a''.1 - 2 * a''.0 + (3 * a'.1 + 5 * a.1 * a.3 - 7 * a.0) * a'.3 + 3 * a.1 * a'.2 @@ -206482,10 +209557,13 @@ PrimitiveArrayFunctions2(A, B): Exports == Implementation where (* package PRIMARR2 *) (* - map(f, v) == map(f, v)$O2 + map : ((A -> B),PrimitiveArray(A)) -> PrimitiveArray(B) + map(f, v) == map(f, v)$O2 - scan(f, v, b) == scan(f, v, b)$O2 + scan : (((A,B) -> B),PrimitiveArray(A),B) -> PrimitiveArray(B) + scan(f, v, b) == scan(f, v, b)$O2 + reduce : (((A,B) -> B),PrimitiveArray(A),B) -> B reduce(f, v, b) == reduce(f, v, b)$O2 *) @@ -206658,21 +209736,24 @@ PrimitiveElement(F): Exports == Implementation where import PolyGroebner(F) - multi : (UP, SY) -> P - randomInts: (NonNegativeInteger, NonNegativeInteger) -> List Integer - findUniv : (List P, SY, SY) -> Union(P, "failed") - incl? : (List SY, List SY) -> Boolean - triangularLinearIfCan:(List P,List SY,SY) -> Union(List UP,"failed") innerPrimitiveElement: (List P, List SY, SY) -> REC - multi(p, v) == multivariate(map((f1:F):F +-> f1, p), v) + multi : (UP, SY) -> P + multi(p, v) == multivariate(map((f1:F):F +-> f1, p), v) + randomInts: (NonNegativeInteger, NonNegativeInteger) -> List Integer randomInts(n, m) == [symmetricRemainder(random()$Integer, m) for i in 1..n] - incl?(a, b) == every?((s1:SY):Boolean +-> member?(s1, b), a) + incl? : (List SY, List SY) -> Boolean + incl?(a, b) == every?((s1:SY):Boolean +-> member?(s1, b), a) + primitiveElement : (List(Polynomial(F)),List(Symbol)) -> _ + Record(coef: List(Integer),poly: List(SparseUnivariatePolynomial(F)),_ + prim: SparseUnivariatePolynomial(F)) primitiveElement(l, v) == primitiveElement(l, v, new()$SY) + primitiveElement : (Polynomial(F),Symbol,Polynomial(F),Symbol) -> _ + Record(coef1: Integer,coef2: Integer,prim: SparseUnivariatePolynomial(F)) primitiveElement(p1, a1, p2, a2) == (degree(p2, a1) = 1) => [0, 1, univariate resultant(p1, p2, a1)] u := (new()$SY)::P @@ -206683,11 +209764,13 @@ PrimitiveElement(F): Exports == Implementation where r := univariate resultant(eval(p1, a1, w), eval(p2, a1, w), a2) not zero? r and r = squareFreePart r => return [1, c, r] + findUniv : (List P, SY, SY) -> Union(P, "failed") findUniv(l, v, opt) == for p in l repeat degree(p, v) > 0 and incl?(variables p, [v, opt]) => return p "failed" + triangularLinearIfCan:(List P,List SY,SY) -> Union(List UP,"failed") triangularLinearIfCan(l, lv, w) == (u := findUniv(l, w, w)) case "failed" => "failed" pw := univariate(u::P) @@ -206701,6 +209784,9 @@ PrimitiveElement(F): Exports == Implementation where (- univariate(coefficient(p,0)) * bc.coef1) rem pw), ll) concat(map((f1:F):F +-> f1, pw), reverse_! ll) + primitiveElement : (List(Polynomial(F)),List(Symbol),Symbol) -> _ + Record(coef: List(Integer),poly: List(SparseUnivariatePolynomial(F)),_ + prim: SparseUnivariatePolynomial(F)) primitiveElement(l, vars, uu) == u := uu::P vv := [v::P for v in vars] @@ -206973,25 +210059,19 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where import InnerCommonDenominator(UP, RF, List UP, List RF) import UnivariatePolynomialCategoryFunctions2(F, UP, UP, UP2) - tau : (UP, UP, UP, N) -> UP - NPbound : (UP, L, UP) -> N - hdenom : (L, UP, UP) -> UP - denom0 : (Z, L, UP, UP, UP) -> UP - indicialEq : (UP, List N, List UP) -> UP - separateZeros: (UP, UP) -> UP - UPfact : N -> UP - UP2UP2 : UP -> UP2 - indeq : (UP, L) -> UP - NPmulambda : (UP, L) -> Record(mu:Z, lambda:List N, func:List UP) - diff := D()$L - UP2UP2 p == map((f1:F):UP +->f1::UP, p) + UP2UP2 : UP -> UP2 + UP2UP2 p == map((f1:F):UP +->f1::UP, p) - indicialEquations(op:L) == indicialEquations(op, leadingCoefficient op) + indicialEquations : L -> List(Record(center: UP,equation: UP)) + indicialEquations(op:L) == indicialEquations(op, leadingCoefficient op) + indicialEquation : (L,F) -> UP indicialEquation(op:L, a:F) == indeq(monomial(1, 1) - a::UP, op) + splitDenominator : (LQ,List(Fraction(UP))) -> _ + Record(eq: L,rh: List(Fraction(UP))) splitDenominator(op, lg) == cd := splitDenominator coefficients op f := cd.den / gcd(cd.num) @@ -207001,24 +210081,30 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where op := reductum op [l, [f * g for g in lg]] + tau : (UP, UP, UP, N) -> UP tau(p, pp, q, n) == ((pp ** n) * ((q exquo (p ** order(q, p)))::UP)) rem p + indicialEquations : LQ -> List(Record(center: UP,equation: UP)) indicialEquations(op:LQ) == indicialEquations(splitDenominator(op, empty()).eq) + indicialEquations : (LQ,UP) -> List(Record(center: UP,equation: UP)) indicialEquations(op:LQ, p:UP) == indicialEquations(splitDenominator(op, empty()).eq, p) + indicialEquation : (LQ,F) -> UP indicialEquation(op:LQ, a:F) == indeq(monomial(1, 1) - a::UP, splitDenominator(op, empty()).eq) -- returns z(z-1)...(z-(n-1)) + UPfact : N -> UP UPfact n == zero? n => 1 z := monomial(1, 1)$UP */[z - i::F::UP for i in 0..(n-1)::N] + indicialEq : (UP, List N, List UP) -> UP indicialEq(c, lamb, lf) == cp := diff c cc := UP2UP2 c @@ -207027,6 +210113,7 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where s := s + (UPfact i) * UP2UP2 tau(c, cp, f, i) primitivePart resultant(cc, s) + NPmulambda : (UP, L) -> Record(mu:Z, lambda:List N, func:List UP) NPmulambda(c, l) == lamb:List(N) := [d := degree l] lf:List(UP) := [a := leadingCoefficient l] @@ -207043,34 +210130,41 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where [mup, lamb, lf] -- e = 0 means homogeneous equation + NPbound : (UP, L, UP) -> N NPbound(c, l, e) == rec := NPmulambda(c, l) n := max(0, - integerBound indicialEq(c, rec.lambda, rec.func)) zero? e => n::N max(n, order(e, c)::Z - rec.mu)::N + hdenom : (L, UP, UP) -> UP hdenom(l, d, e) == */[dd.factor ** NPbound(dd.factor, l, e) for dd in factors balancedFactorisation(d, coefficients l)] + denom0 : (Z, L, UP, UP, UP) -> UP denom0(n, l, d, e, h) == hdenom(l, d, e) * */[hh.factor ** max(0, order(e, hh.factor) - n)::N for hh in factors balancedFactorisation(h, e)] -- returns a polynomials whose zeros are the zeros of e which are not -- zeros of d + separateZeros: (UP, UP) -> UP separateZeros(d, e) == ((g := squareFreePart e) exquo gcd(g, squareFreePart d))::UP + indeq : (UP, L) -> UP indeq(c, l) == rec := NPmulambda(c, l) indicialEq(c, rec.lambda, rec.func) + indicialEquations : (L,UP) -> List(Record(center: UP,equation: UP)) indicialEquations(op:L, p:UP) == [[dd.factor, indeq(dd.factor, op)] for dd in factors balancedFactorisation(p, coefficients op)] -- cannot return "failed" in the homogeneous case + denomLODE : (L,Fraction(UP)) -> Union(UP,"failed") denomLODE(l:L, g:RF) == d := leadingCoefficient l zero? g => hdenom(l, d, 0) @@ -207079,6 +210173,7 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where (e exquo (h**(n + 1))) case "failed" => "failed" denom0(n, l, d, e, h) + denomLODE : (L,List(Fraction(UP))) -> UP denomLODE(l:L, lg:List RF) == empty? lg => denomLODE(l, 0)::UP d := leadingCoefficient l @@ -207425,57 +210520,47 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where import PrimitiveRatDE(F, UP, L, LQ) import BalancedFactorisation(F, UP) - bound : (UP, L) -> N - lambda : (UP, L) -> List IJ - infmax : (IJ, L) -> List Z - dmax : (IJ, UP, L) -> List Z - getPoly : (IJ, L, List Z) -> UP - getPol : (IJ, UP, L, List Z) -> UP2 - innerlb : (L, UP -> Z) -> List IJ - innermax : (IJ, L, UP -> Z) -> List Z - tau0 : (UP, UP) -> UP - poly1 : (UP, UP, Z) -> UP2 - getPol1 : (List Z, UP, L) -> UP2 - getIndices : (N, List IJ) -> List Z - refine : (List UP, UP -> Factored UP) -> List UP - polysol : (L, N, Boolean, UP -> List F) -> List POL - fracsol : (L, (UP, UP2) -> List UP, List UP) -> List FRC - padicsol l : (UP, L, N, Boolean, (UP, UP2) -> List UP) -> List FRC - leadingDenomRicDE : (UP, L) -> List REC2 - factoredDenomRicDE: L -> List UP - constantCoefficientOperator: (L, N) -> UP - infLambda: L -> List IJ - -- infLambda(op) returns - -- \spad{[[[i,j], (\deg(a_i)-\deg(a_j))/(i-j) ]]} for all the pairs - -- of indices \spad{i,j} such that \spad{(\deg(a_i)-\deg(a_j))/(i-j)} is - -- an integer. - diff := D()$L diffq := D()$LQ - lambda(c, l) == innerlb(l, z +-> order(z, c)::Z) + lambda : (UP, L) -> List IJ + lambda(c, l) == innerlb(l, z +-> order(z, c)::Z) - infLambda l == innerlb(l, z +-> -(degree(z)::Z)) + -- infLambda(op) returns + -- \spad{[[[i,j], (\deg(a_i)-\deg(a_j))/(i-j) ]]} for all the pairs + -- of indices \spad{i,j} such that \spad{(\deg(a_i)-\deg(a_j))/(i-j)} is + -- an integer. + infLambda: L -> List IJ + infLambda l == innerlb(l, z +-> -(degree(z)::Z)) - infmax(rec,l) == innermax(rec, l, z +-> degree(z)::Z) + infmax : (IJ, L) -> List Z + infmax(rec,l) == innermax(rec, l, z +-> degree(z)::Z) - dmax(rec, c,l) == innermax(rec, l, z +-> - order(z, c)::Z) + dmax : (IJ, UP, L) -> List Z + dmax(rec, c,l) == innermax(rec, l, z +-> - order(z, c)::Z) - tau0(p, q) == ((q exquo (p ** order(q, p)))::UP) rem p + tau0 : (UP, UP) -> UP + tau0(p, q) == ((q exquo (p ** order(q, p)))::UP) rem p - poly1(c, cp,i) == */[monomial(1,1)$UP2 - (j * cp)::UP2 for j in 0..i-1] + poly1 : (UP, UP, Z) -> UP2 + poly1(c, cp,i) == */[monomial(1,1)$UP2 - (j * cp)::UP2 for j in 0..i-1] - getIndices(n,l) == removeDuplicates_! concat [r.ij for r in l | r.deg=n] + getIndices : (N, List IJ) -> List Z + getIndices(n,l) == removeDuplicates_! concat [r.ij for r in l | r.deg=n] - denomRicDE l == */[c ** bound(c, l) for c in factoredDenomRicDE l] + denomRicDE : L -> UP + denomRicDE l == */[c ** bound(c, l) for c in factoredDenomRicDE l] + polyRicDE : (L,(UP -> List(F))) -> List(Record(poly: UP,eq: L)) polyRicDE(l,zeros) == concat([0, l], polysol(l, 0, false, zeros)) -- refine([p1,...,pn], foo) refines the list of factors using foo + refine : (List UP, UP -> Factored UP) -> List UP refine(l, ezfactor) == concat [[r.factor for r in factors ezfactor p] for p in l] -- returns [] if the solutions of l have no p-adic component at c + padicsol l : (UP, L, N, Boolean, (UP, UP2) -> List UP) -> List FRC padicsol(c, op, b, finite?, zeros) == ans:List(FRC) := empty() finite? and zero? b => ans @@ -207491,6 +210576,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where concat_!([[rcn + sol.frac, sol.eq] for sol in sols], ans) ans + leadingDenomRicDE : (UP, L) -> List REC2 leadingDenomRicDE(c, l) == ind:List(Z) -- to cure the compiler... (won't compile without) lb := lambda(c, l) @@ -207502,18 +210588,23 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where done := concat(rec.deg, done) sort_!((z1,z2) +-> z1.deg > z2.deg, ans) + getPol : (IJ, UP, L, List Z) -> UP2 getPol(rec, c, l, ind) == (rec.deg = 1) => getPol1(ind, c, l) +/[monomial(tau0(c, coefficient(l, i::N)), i::N)$UP2 for i in ind] + getPol1 : (List Z, UP, L) -> UP2 getPol1(ind, c, l) == cp := diff c +/[tau0(c, coefficient(l, i::N)) * poly1(c, cp, i) for i in ind] + constantCoefficientRicDE : (L,(UP -> List(F))) -> _ + List(Record(constant: F,eq: L)) constantCoefficientRicDE(op, ric) == m := "max"/[degree p for p in coefficients op] [[a, changeVar(op,a::UP)] for a in ric constantCoefficientOperator(op,m)] + constantCoefficientOperator: (L, N) -> UP constantCoefficientOperator(op, m) == ans:UP := 0 while op ^= 0 repeat @@ -207522,11 +210613,13 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where op := reductum op ans + getPoly : (IJ, L, List Z) -> UP getPoly(rec, l, ind) == +/[monomial(leadingCoefficient coefficient(l,i::N),i::N)$UP for i in ind] -- returns empty() if rec is does not reach the max, -- the list of indices (including rec) that reach the max otherwise + innermax : (IJ, L, UP -> Z) -> List Z innermax(rec, l, nu) == n := degree l i := first(rec.ij) @@ -207537,6 +210630,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where else if (k = m) then ans := concat(j, ans) ans + leadingCoefficientRicDE : L -> List(Record(deg: NonNegativeInteger,eq: UP)) leadingCoefficientRicDE l == ind:List(Z) -- to cure the compiler... (won't compile without) lb := infLambda l @@ -207548,10 +210642,12 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where done := concat(rec.deg, done) sort_!((z1,z2) +-> z1.deg > z2.deg, ans) + factoredDenomRicDE: L -> List UP factoredDenomRicDE l == bd := factors balancedFactorisation(leadingCoefficient l, coefficients l) [dd.factor for dd in bd] + changeVar : (L,UP) -> L changeVar(l:L, a:UP) == dpa := diff + a::L -- the operator (D + a) dpan:L := 1 -- will accumulate the powers of (D + a) @@ -207561,6 +210657,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where dpan := dpa * dpan primitivePart op + changeVar : (L,Fraction(UP)) -> L changeVar(l:L, a:RF) == dpa := diffq + a::LQ -- the operator (D + a) dpan:LQ := 1 -- will accumulate the powers of (D + a) @@ -207570,12 +210667,14 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where dpan := dpa * dpan splitDenominator(op, empty()).eq + bound : (UP, L) -> N bound(c, l) == empty?(lb := lambda(c, l)) => 1 "max"/[rec.deg for rec in lb] -- returns all the pairs [[i, j], n] such that -- n = (nu(i) - nu(j)) / (i - j) is an integer + innerlb : (L, UP -> Z) -> List IJ innerlb(l, nu) == lb:List(IJ) := empty() n := degree l @@ -207586,10 +210685,13 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where lb := concat([[i, j], b::N], lb) lb + singRicDE : (L,((UP,SparseUnivariatePolynomial(UP)) -> List(UP)),_ + (UP -> Factored(UP))) -> List(Record(frac: Fraction(UP),eq: L)) singRicDE(l, zeros, ezfactor) == concat([0, l], fracsol(l, zeros, refine(factoredDenomRicDE l, ezfactor))) -- returns [] if the solutions of l have no singular component + fracsol : (L, (UP, UP2) -> List UP, List UP) -> List FRC fracsol(l, zeros, lc) == ans:List(FRC) := empty() empty? lc => ans @@ -207604,6 +210706,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where ans -- returns [] if the solutions of l have no polynomial component + polysol : (L, N, Boolean, UP -> List F) -> List POL polysol(l, b, finite?, zeros) == ans:List(POL) := empty() finite? and zero? b => ans @@ -207693,6 +210796,7 @@ PrintPackage(): with (* package PRINT *) (* + print : OutputForm -> Void print(x) == print(x)$OutputForm *) @@ -207917,35 +211021,22 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where (* package PSEUDLIN *) (* - normalForm0: (Matrix K, Automorphism K, Automorphism K, K -> K) -> REC - mulMatrix: (Integer, Integer, K) -> Matrix K - -- mulMatrix(N, i, a): under change of base with the resulting matrix of - -- size N*N the following operations are performed: - -- D1: column i will be multiplied by sig(a) - -- D2: row i will be multiplied by 1/a - -- D3: addition of der(a)/a to the element at position (i,i) - addMatrix: (Integer, Integer, Integer, K) -> Matrix K - -- addMatrix(N, i, k, a): under change of base with the resulting matrix - -- of size N*N the following operations are performed: - -- C1: addition of column i multiplied by sig(a) to column k - -- C2: addition of row k multiplied by -a to row i - -- C3: addition of -a*der(a) to the element at position (i,k) - permutationMatrix: (Integer, Integer, Integer) -> Matrix K - -- permutationMatrix(N, i, k): under a change of base with the resulting - -- permutation matrix of size N*N the following operations are performed: - -- P1: columns i and k will be exchanged - -- P2: rows i and k will be exchanged - inv: Matrix K -> Matrix K - -- inv(M): computes the inverse of a invertable matrix M. - -- avoids possible type conflicts - inv m == inverse(m) :: Matrix K + -- inv(M): computes the inverse of a invertable matrix M. + -- avoids possible type conflicts + inv: Matrix K -> Matrix K + inv m == inverse(m) :: Matrix K + changeBase : (Matrix(K),Matrix(K),Automorphism(K),(K -> K)) -> Matrix(K) changeBase(M, A, sig, der) == inv(A) * (M * map((k1:K):K +-> sig k1, A) + map(der, A)) + normalForm : (Matrix(K),Automorphism(K),(K -> K)) -> _ + Record(R: Matrix(K),A: Matrix(K),Ainv: Matrix(K)) normalForm(M, sig, der) == normalForm0(M, sig, inv sig, der) + companionBlocks : (Matrix(K),Vector(K)) -> _ + List(Record(C: Matrix(K),g: Vector(K))) companionBlocks(R, w) == -- decomposes the rational matrix R into single companion blocks -- and the inhomogenity w as well @@ -207962,6 +211053,7 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where i := j+1 l + normalForm0: (Matrix K, Automorphism K, Automorphism K, K -> K) -> REC normalForm0(M, sig, siginv, der) == -- the changes of base will be incremented in B and Binv, -- where B**(-1)=Binv; E defines an elementary matrix @@ -208028,16 +211120,33 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where i := N [M, B, Binv] + -- mulMatrix(N, i, a): under change of base with the resulting matrix of + -- size N*N the following operations are performed: + -- D1: column i will be multiplied by sig(a) + -- D2: row i will be multiplied by 1/a + -- D3: addition of der(a)/a to the element at position (i,i) + mulMatrix: (Integer, Integer, K) -> Matrix K mulMatrix(N, i, a) == M : Matrix K := diagonalMatrix [1 for j in 1..N] M(i, i) := a M + -- addMatrix(N, i, k, a): under change of base with the resulting matrix + -- of size N*N the following operations are performed: + -- C1: addition of column i multiplied by sig(a) to column k + -- C2: addition of row k multiplied by -a to row i + -- C3: addition of -a*der(a) to the element at position (i,k) + addMatrix: (Integer, Integer, Integer, K) -> Matrix K addMatrix(N, i, k, a) == A : Matrix K := diagonalMatrix [1 for j in 1..N] A(i, k) := a A + -- permutationMatrix(N, i, k): under a change of base with the resulting + -- permutation matrix of size N*N the following operations are performed: + -- P1: columns i and k will be exchanged + -- P2: rows i and k will be exchanged + permutationMatrix: (Integer, Integer, Integer) -> Matrix K permutationMatrix(N, i, k) == P : Matrix K := diagonalMatrix [1 for j in 1..N] P(i, i) := P(k, k) := 0 @@ -209093,12 +212202,15 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where X : polR := monomial(1$R,1) + ?*? : (R,Vector(polR)) -> Vector(polR) r : R * v : Vector(polR) == r::polR * v -- the instruction map(r * #1, v) is slower !? + exquo : (Vector(polR),R) -> Vector(polR) v : Vector(polR) exquo r : R == map((p1:polR):polR +-> (p1 exquo r)::polR, v) + pseudoDivide: (polR,polR) -> Record(coef: R,quotient: polR,remainder: polR) pseudoDivide(P : polR, Q : polR) : Record(coef:R,quotient:polR,remainder:polR) == -- computes the pseudoDivide of P by Q @@ -209119,6 +212231,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where P := lcQ**i * P return construct(co, quot, P) + divide : (polR,polR) -> Record(quotient: polR,remainder: polR) divide(F : polR, G : polR) : Record(quotient : polR, remainder : polR)== -- computes quotient and rest of the exact euclidean division of F by G lcG : R := LC(G) @@ -209132,6 +212245,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where F := reductum(F) - mon * G return construct(quot, F) + resultant_naif : (polR,polR) -> R resultant_naif(P : polR, Q : polR) : R == -- valid over a field a : R := 1 @@ -209144,6 +212258,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where a := a * LC(Q)**(degP - degree(U))::NNI (P, Q) := (Q, U) + resultantEuclidean_naif : (polR,polR) -> + Record(coef1 : polR, coef2 : polR, resultant : R) resultantEuclidean_naif(P : polR, Q : polR) : Record(coef1 : polR, coef2 : polR, resultant : R) == -- valid over a field. @@ -209163,6 +212279,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (old_cf1, old_cf2, cf1, cf2) := (cf1, cf2, old_cf1 - divid.quotient * cf1, old_cf2 - divid.quotient * cf2) + semiResultantEuclidean_naif : (polR,polR) -> + Record(coef2 : polR, resultant : R) semiResultantEuclidean_naif(P : polR, Q : polR) : Record(coef2 : polR, resultant : R) == -- valid over a field @@ -209180,6 +212298,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, divid.remainder) (old_cf2, cf2) := (cf2, old_cf2 - divid.quotient * cf2) + Lazard : (R,R,NonNegativeInteger) -> R Lazard(x : R, y : R, n : NNI) : R == zero?(n) => error("Lazard$PRS : n = 0") (n = 1) => x @@ -209193,12 +212312,14 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where c := ((c * c) exquo y)::R if n >= a then ( c := ((c * x) exquo y)::R ; n := (n - a)::NNI ) + Lazard2 : (polR,R,R,NonNegativeInteger) -> polR Lazard2(F : polR, x : R, y : R, n : NNI) : polR == zero?(n) => error("Lazard2$PRS : n = 0") (n = 1) => F x := Lazard(x, y, (n-1)::NNI) return ((x * F) exquo y)::polR + Lazard3 : (Vector(polR),R,R,NNI) -> Vector(polR) Lazard3(V : Vector(polR), x : R, y : R, n : NNI) : Vector(polR) == -- computes x**(n-1) * V / y**(n-1) zero?(n) => error("Lazard2$prs : n = 0") @@ -209206,6 +212327,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where x := Lazard(x, y, (n-1)::NNI) return ((x * V) exquo y) + next_sousResultant2 : (polR,polR,polR,R) -> polR next_sousResultant2(P : polR, Q : polR, Z : polR, s : R) : polR == (lcP, c, se) := (LC(P), LC(Q), LC(Z)) (d, e) := (degree(P), degree(Q)) @@ -209228,6 +212350,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where A := (A exquo s)::polR -- A = +/- S_e-1 return (if odd?(d-e) then A else - A) + next_sousResultant3 : (Vector(polR),Vector(polR),R,R) -> Vector(polR) next_sousResultant3(VP : Vector(polR), VQ : Vector(polR), s : R, ss : R) : Vector(polR) == -- P ~ S_d, Q = S_d-1, s = lc(S_d), ss = lc(S_e) @@ -209248,6 +212371,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where VP.i := (VP.i exquo r)::polR return (if odd?(delta) then VP else - VP) + algo_new : (polR,polR) -> R algo_new(P : polR, Q : polR) : R == delta : NNI := (degree(P) - degree(Q))::NNI s : R := LC(Q)**delta @@ -209263,6 +212387,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + resultant : (polR,polR) -> R resultant(P : polR, Q : polR) : R == zero?(Q) or zero?(P) => 0 if degree(P) < degree(Q) then @@ -209273,6 +212398,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where R has Finite => resultant_naif(P, Q) return algo_new(P, Q) + subResultantGcdEuclidean : (polR,polR) -> _ + Record(coef1: polR,coef2: polR,gcd: polR) subResultantEuclidean(P : polR, Q : polR) : Record(coef1 : polR, coef2 : polR, resultant : R) == s : R := LC(Q)**(degree(P) - degree(Q))::NNI @@ -209293,6 +212420,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + resultantEuclidean : (polR,polR) -> _ + Record(coef1: polR,coef2: polR,resultant: R) resultantEuclidean(P : polR, Q : polR) : Record(coef1 : polR, coef2 : polR, resultant : R) == zero?(P) or zero?(Q) => construct(0::polR, 0::polR, 0::R) @@ -209308,6 +212437,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where R has Finite => resultantEuclidean_naif(P, Q) return subResultantEuclidean(P,Q) + semiSubResultantEuclidean : (polR,polR) -> _ + Record(coef2 : polR, resultant : R) semiSubResultantEuclidean(P : polR, Q : polR) : Record(coef2 : polR, resultant : R) == s : R := LC(Q)**(degree(P) - degree(Q))::NNI @@ -209340,11 +212471,13 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where R has Finite => semiResultantEuclidean_naif(P, Q) return semiSubResultantEuclidean(P,Q) + semiResultantEuclidean1 : (polR,polR) -> Record(coef1: polR,resultant: R) semiResultantEuclidean1(P : polR, Q : polR) : Record(coef1 : polR, resultant : R) == result := resultantEuclidean(P,Q) [result.coef1, result.resultant] + indiceSubResultant : (polR,polR,NonNegativeInteger) -> polR indiceSubResultant(P : polR, Q : polR, i : NNI) : polR == zero?(Q) or zero?(P) => 0 if degree(P) < degree(Q) then @@ -209369,6 +212502,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + indiceSubResultantEuclidean : (polR,polR,NonNegativeInteger) -> _ + Record(coef1: polR,coef2: polR,subResultant: polR) indiceSubResultantEuclidean(P : polR, Q : polR, i : NNI) : Record(coef1 : polR, coef2 : polR, subResultant : polR) == zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR) @@ -209401,6 +212536,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + semiIndiceSubResultantEuclidean : (polR,polR,NonNegativeInteger) -> _ + Record(coef2: polR,subResultant: polR) semiIndiceSubResultantEuclidean(P : polR, Q : polR, i : NNI) : Record(coef2 : polR, subResultant : polR) == zero?(Q) or zero?(P) => construct(0::polR, 0::polR) @@ -209431,6 +212568,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + degreeSubResultant : (polR,polR,NonNegativeInteger) -> polR degreeSubResultant(P : polR, Q : polR, i : NNI) : polR == zero?(Q) or zero?(P) => 0 if degree(P) < degree(Q) then (P, Q) := (Q, P) @@ -209451,6 +212589,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + degreeSubResultantEuclidean : (polR,polR,NonNegativeInteger) -> _ + Record(coef1: polR,coef2: polR,subResultant: polR) degreeSubResultantEuclidean(P : polR, Q : polR, i : NNI) : Record(coef1 : polR, coef2 : polR, subResultant : polR) == zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR) @@ -209479,6 +212619,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + semiDegreeSubResultantEuclidean : (polR,polR,NonNegativeInteger) -> _ + Record(coef2: polR,subResultant: polR) semiDegreeSubResultantEuclidean(P : polR, Q : polR, i : NNI) : Record(coef2 : polR, subResultant : polR) == zero?(Q) or zero?(P) => construct(0::polR, 0::polR) @@ -209506,6 +212648,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + lastSubResultant : (polR,polR) -> polR lastSubResultant(P : polR, Q : polR) : polR == zero?(Q) or zero?(P) => 0 if degree(P) < degree(Q) then (P, Q) := (Q, P) @@ -209523,6 +212666,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + lastSubResultantEuclidean : (polR,polR) -> _ + Record(coef1: polR,coef2: polR,subResultant: polR) lastSubResultantEuclidean(P : polR, Q : polR) : Record(coef1 : polR, coef2 : polR, subResultant : polR) == zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR) @@ -209553,6 +212698,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + semiLastSubResultantEuclidean : (polR,polR) -> _ + Record(coef2: polR,subResultant: polR) semiLastSubResultantEuclidean(P : polR, Q : polR) : Record(coef2 : polR, subResultant : polR) == zero?(Q) or zero?(P) => construct(0::polR, 0::polR) @@ -209582,6 +212729,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + chainSubResultants : (polR,polR) -> List(polR) chainSubResultants(P : polR, Q : polR) : List(polR) == zero?(Q) or zero?(P) => [] if degree(P) < degree(Q) then @@ -209606,6 +212754,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + schema : (polR,polR) -> List(NonNegativeInteger) schema(P : polR, Q : polR) : List(NNI) == zero?(Q) or zero?(P) => [] if degree(P) < degree(Q) then (P, Q) := (Q, P) @@ -209625,6 +212774,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + subResultantGcd : (polR,polR) -> polR subResultantGcd(P : polR, Q : polR) : polR == zero?(P) and zero?(Q) => 0 zero?(P) => Q @@ -209642,6 +212792,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (P, Q) := (Q, next_sousResultant2(P, Q, Z, s)) s := LC(Z) + subResultantGcdEuclidean : (polR,polR) -> + Record(coef1 : polR, coef2 : polR, gcd : polR) subResultantGcdEuclidean(P : polR, Q : polR) : Record(coef1 : polR, coef2 : polR, gcd : polR) == zero?(P) and zero?(Q) => construct(0::polR, 0::polR, 0::polR) @@ -209666,6 +212818,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP,VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + semiSubResultantGcdEuclidean2: (polR,polR) -> Record(coef2: polR,gcd: polR) semiSubResultantGcdEuclidean2(P : polR, Q : polR) : Record(coef2 : polR, gcd : polR) == zero?(P) and zero?(Q) => construct(0::polR, 0::polR) @@ -209689,11 +212842,13 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where (VP,VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss)) s := ss + semiSubResultantGcdEuclidean1: (polR,polR) -> Record(coef1: polR,gcd: polR) semiSubResultantGcdEuclidean1(P : polR, Q : polR) : Record(coef1 : polR, gcd : polR) == result := subResultantGcdEuclidean(P,Q) [result.coef1, result.gcd] + discriminant : polR -> R discriminant(P : polR) : R == d : Integer := degree(P) zero?(d) => error "cannot take discriminant of constants" @@ -209705,6 +212860,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where return (if zero?(d) then a * (r exquo LC(P))::R else a * r * LC(P)**(d-1)::NNI) + discriminantEuclidean : polR -> _ + Record(coef1: polR,coef2: polR,discriminant: R) discriminantEuclidean(P : polR) : Record(coef1 : polR, coef2 : polR, discriminant : R) == d : Integer := degree(P) @@ -209724,6 +212881,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where cr : R := a * rE.resultant * LC(P)**(d-1)::NNI return construct(c1, c2, cr) + semiDiscriminantEuclidean : polR -> Record(coef2: polR,discriminant: R) semiDiscriminantEuclidean(P : polR) : Record(coef2 : polR, discriminant : R) == d : Integer := degree(P) @@ -209743,6 +212901,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where if R has GcdDomain then + resultantReduit : (polR,polR) -> R if R has GCDDOM resultantReduit(P : polR, Q : polR) : R == UV := subResultantGcdEuclidean(P, Q) UVs : polR := UV.gcd @@ -209750,6 +212909,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2)) return (LC(UVs) exquo gcd(l))::R + resultantReduitEuclidean : (polR,polR) -> _ + Record(coef1: polR,coef2: polR,resultantReduit: R) if R has GCDDOM resultantReduitEuclidean(P : polR, Q : polR) : Record(coef1 : polR, coef2 : polR, resultantReduit : R) == UV := subResultantGcdEuclidean(P, Q) @@ -209762,6 +212923,8 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where rr : R := (LC(UVs) exquo gl)::R return construct(c1, c2, rr) + semiResultantReduitEuclidean : (polR,polR) -> _ + Record(coef2: polR,resultantReduit: R) if R has GCDDOM semiResultantReduitEuclidean(P : polR, Q : polR) : Record(coef2 : polR, resultantReduit : R) == UV := subResultantGcdEuclidean(P, Q) @@ -209773,6 +212936,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where rr : R := (LC(UVs) exquo gl)::R return construct(c2, rr) + gcd_naif : (polR,polR) -> polR gcd_naif(P : polR, Q : polR) : polR == -- valid over a field zero?(P) => (Q exquo LC(Q))::polR @@ -209781,6 +212945,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where zero?(degree(Q)) => return 1$polR (P, Q) := (Q, divide(P, Q).remainder) + gcd : (polR,polR) -> polR gcd(P : polR, Q : polR) : polR == R has Finite => gcd_naif(P,Q) zero?(P) => Q @@ -210263,38 +213428,19 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents K, K, R, P, F) - quadIfCan : (K, K) -> Union(Record(coef:F, poly:UP), "failed") - linearInXIfCan : (K, K) -> Union(Record(xsub:F, dxsub:RF), "failed") - prootintegrate : (F, K, K) -> IR - prootintegrate1: (UPUP, K, K, UPUP) -> IR - prootextint : (F, K, K, F) -> U2 - prootlimint : (F, K, K, List F) -> U3 - prootRDE : (F, F, F, K, K, (F, F, SY) -> U1) -> U1 - palgRDE1 : (F, F, K, K) -> U1 - palgLODE1 : (List F, F, K, K, SY) -> REC - palgintegrate : (F, K, K) -> IR - palgext : (F, K, K, F) -> U2 - palglim : (F, K, K, List F) -> U3 - UPUP2F1 : (UPUP, RF, RF, K, K) -> F - UPUP2F0 : (UPUP, K, K) -> F - RF2UPUP : (RF, UPUP) -> UPUP - algaddx : (IR, F) -> IR - chvarIfCan : (UPUP, RF, UP, RF) -> Union(UPUP, "failed") - changeVarIfCan : (UPUP, RF, N) -> Union(CHV, "failed") - rationalInt : (UPUP, N, UP) -> IntegrationResult RF - chv : (UPUP, N, F, F) -> RF - chv0 : (UPUP, N, F, F) -> F - candidates : UP -> List CND - dummy := new()$SY dumk := kernel(dummy)@K + UPUP2F1 : (UPUP, RF, RF, K, K) -> F UPUP2F1(p, t, cf, kx, k) == UPUP2F0(eval(p, t, cf), kx, k) - UPUP2F0(p, kx, k) == multivariate(p, kx, k::F) + UPUP2F0 : (UPUP, K, K) -> F + UPUP2F0(p, kx, k) == multivariate(p, kx, k::F) - chv(f, n, a, b) == univariate(chv0(f, n, a, b), dumk) + chv : (UPUP, N, F, F) -> RF + chv(f, n, a, b) == univariate(chv0(f, n, a, b), dumk) + RF2UPUP : (RF, UPUP) -> UPUP RF2UPUP(f, modulus) == bc := extendedEuclidean(map((z1:F):RF+->z1::UP::RF, denom f), modulus, 1)::Record(coef1:UPUP, coef2:UPUP) @@ -210302,6 +213448,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- returns "failed", or (xx, c) such that f(x, y)dx = f(xx, y) c dy -- if p(x, y) = 0 is linear in x + linearInXIfCan : (K, K) -> Union(Record(xsub:F, dxsub:RF), "failed") linearInXIfCan(x, y) == a := b := 0$UP p := clearDenominator lift(minPoly y, x) @@ -210314,6 +213461,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where [xx(dumk::F), differentiate(xx, differentiate)] -- return Int(f(x,y)dx) where y is an n^th root of a rational function in x + prootintegrate : (F, K, K) -> IR prootintegrate(f, x, y) == modulus := lift(p := minPoly y, x) rf := reductum(ff := univariate(f, x, y, p)) @@ -210324,6 +213472,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where prootintegrate1(leadingMonomial ff, x, y, modulus) prootintegrate1(ff, x, y, modulus) + prootintegrate1: (UPUP, K, K, UPUP) -> IR prootintegrate1(ff, x, y, modulus) == chv:CHV r := radPoly(modulus)::Record(radicand:RF, deg:N) @@ -210351,6 +213500,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- Int(f(x, y) dx) --> Int(n u^(n-1) f((u^n - b)/a, u) / a du) where -- u^n = y^n = g(x) = a x + b -- returns the integral as an integral of a rational function in u + rationalInt : (UPUP, N, UP) -> IntegrationResult RF rationalInt(f, n, g) == not ((degree g) = 1) => error "rationalInt: radicand must be linear" a := leadingCoefficient g @@ -210361,6 +213511,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- f(x,y) --> f((u^n - b)/a, u) where -- u = y = (a x + b)^(1/n). -- Returns f((u^n - b)/a,u) as an element of F + chv0 : (UPUP, N, F, F) -> F chv0(f, n, a, b) == d := dumk::F (f (d::UP::RF)) ((d ** n - b) / a) @@ -210370,6 +213521,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- currently uses a dumb heuristic where the candidates u's are p itself -- and all the powers x^2, x^3, ..., x^{deg(p)}, -- will use polynomial decomposition in smarter days MB 8/93 + candidates : UP -> List CND candidates p == l:List(CND) := empty() ground? p => l @@ -210383,6 +213535,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- z = d y for some polynomial d, and z^m = g(u) -- returns either [r(u, z), g, u, d, m] or "failed" -- we have y^n = radi + changeVarIfCan : (UPUP, RF, N) -> Union(CHV, "failed") changeVarIfCan(p, radi, n) == rec := rootPoly(radi, n) for cnd in candidates(rec.radicand) repeat @@ -210395,6 +213548,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- Int(r(u, z) du) where u is some polynomial of x and z = d y -- we have y^n = a(x)/d(x) -- returns either "failed" or r(u, z) + chvarIfCan : (UPUP, RF, UP, RF) -> Union(UPUP, "failed") chvarIfCan(p, d, u, u1) == ans:UPUP := 0 while p ^= 0 repeat @@ -210404,11 +213558,13 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where p := reductum p ans + algaddx : (IR, F) -> IR algaddx(i, xx) == elem? i => i mkAnswer(ratpart i, logpart i, [[- ne.integrand / (xx**2), xx] for ne in notelem i]) + prootRDE : (F, F, F, K, K, (F, F, SY) -> U1) -> U1 prootRDE(nfp, f, g, x, k, rde) == modulus := lift(p := minPoly k, x) r := radPoly(modulus)::Record(radicand:RF, deg:N) @@ -210431,6 +213587,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where UPUP2F0(lift((rc.particular)::curve), x, k) palgRDE1(nfp, g, x, k) + prootlimint : (F, K, K, List F) -> U3 prootlimint(f, x, k, lu) == modulus := lift(p := minPoly k, x) r := radPoly(modulus)::Record(radicand:RF, deg:N) @@ -210453,6 +213610,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where case "failed" => FAIL [UPUP2F1(lift(ui::curve), cv.c1, cv.c2, x, k), empty()] + prootextint : (F, K, K, F) -> U2 prootextint(f, x, k, g) == modulus := lift(p := minPoly k, x) r := radPoly(modulus)::Record(radicand:RF, deg:N) @@ -210473,9 +213631,11 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where case "failed" => FAIL [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0] + palgRDE1 : (F, F, K, K) -> U1 palgRDE1(nfp, g, x, y) == palgLODE1([nfp, 1], g, x, y, symbolIfCan(x)::SY).particular + palgLODE1 : (List F, F, K, K, SY) -> REC palgLODE1(eq, g, kx, y, x) == modulus:= lift(p := minPoly y, kx) curve := AlgebraicFunctionField(F, UP, UPUP, modulus) @@ -210490,6 +213650,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where rec := algDsolve(neq, 0) ["failed", [UPUP2F0(lift h, kx, y) for h in rec.basis]] + palgintegrate : (F, K, K) -> IR palgintegrate(f, x, k) == modulus:= lift(p := minPoly k, x) cv := chvar(univariate(f, x, k, p), modulus) @@ -210498,6 +213659,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where algaddx(map(x1+->UPUP2F1(lift x1, cv.c1, cv.c2, x, k), palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F) + palglim : (F, K, K, List F) -> U3 palglim(f, x, k, lu) == modulus:= lift(p := minPoly k, x) cv := chvar(univariate(f, x, k, p), modulus) @@ -210507,6 +213669,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where case "failed" => FAIL [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), empty()] + palgext : (F, K, K, F) -> U2 palgext(f, x, k, g) == modulus:= lift(p := minPoly k, x) cv := chvar(univariate(f, x, k, p), modulus) @@ -210516,6 +213679,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where case "failed" => FAIL [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0] + palgint : (F,Kernel(F),Kernel(F)) -> IntegrationResult(F) palgint(f, x, y) == (v := linearInXIfCan(x, y)) case "failed" => (u := quadIfCan(x, y)) case "failed" => @@ -210525,6 +213689,8 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where palgint0(f, x, y, u.coef, u.poly) palgint0(f, x, y, dumk, v.xsub, v.dxsub) + palgextint : (F,Kernel(F),Kernel(F),F) -> _ + Union(Record(ratpart: F,coeff: F),"failed") palgextint(f, x, y, g) == (v := linearInXIfCan(x, y)) case "failed" => (u := quadIfCan(x, y)) case "failed" => @@ -210534,6 +213700,9 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where palgextint0(f, x, y, g, u.coef, u.poly) palgextint0(f, x, y, g, dumk, v.xsub, v.dxsub) + palglimint : (F,Kernel(F),Kernel(F),List(F)) -> _ + Union(Record(mainpart: F,_ + limitedlogs: List(Record(coeff: F,logand: F))),"failed") palglimint(f, x, y, lu) == (v := linearInXIfCan(x, y)) case "failed" => (u := quadIfCan(x, y)) case "failed" => @@ -210543,6 +213712,8 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where palglimint0(f, x, y, lu, u.coef, u.poly) palglimint0(f, x, y, lu, dumk, v.xsub, v.dxsub) + palgRDE : (F,F,F,Kernel(F),Kernel(F),((F,F,Symbol) -> _ + Union(F,"failed"))) -> Union(F,"failed") palgRDE(nfp, f, g, x, y, rde) == (v := linearInXIfCan(x, y)) case "failed" => (u := quadIfCan(x, y)) case "failed" => @@ -210553,6 +213724,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where -- returns "failed", or (d, P) such that (dy)**2 = P(x) -- and degree(P) = 2 + quadIfCan : (K, K) -> Union(Record(coef:F, poly:UP), "failed") quadIfCan(x, y) == (degree(p := minPoly y) = 2) and zero?(coefficient(p, 1)) => d := denom(ff := @@ -210563,6 +213735,8 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where if L has LinearOrdinaryDifferentialOperatorCategory F then + palgLODE : (L,F,Kernel(F),Kernel(F),Symbol) -> _ + Record(particular: Union(F,"failed"),basis: List(F)) palgLODE(eq, g, kx, y, x) == (v := linearInXIfCan(kx, y)) case "failed" => (u := quadIfCan(kx, y)) case "failed" => @@ -210671,6 +213845,8 @@ PureAlgebraicLODE(F, UP, UPUP, R): Exports == Implementation where import SystemODESolver(RF, LQ) import ReduceLODE(RF, LQ, UPUP, R, L) + algDsolve : (LinearOrdinaryDifferentialOperator1(R),R) -> _ + Record(particular: Union(R,"failed"),basis: List(R)) algDsolve(l, g) == rec := reduceLODE(l, g) sol := solveInField(rec.mat, rec.vec, ratDsolve) @@ -210810,19 +213986,23 @@ PushVariables(R,E,OV,PPR):C == T where (* package PUSHVAR *) (* + pushdown : (PPR,OV) -> PPR pushdown(g:PPR,x:OV) : PPR == eval(g,x,monomial(1,convert x,1)$PR) + pushdown : (PPR,List(OV)) -> PPR pushdown(g:PPR, lv:List OV) : PPR == vals:=[monomial(1,convert x,1)$PR for x in lv] eval(g,lv,vals) + map : ((Polynomial(R) -> PPR),PPR) -> PPR map(f:(PR -> PPR), p: PPR) : PPR == ground? p => f(retract p) v:=mainVariable(p)::OV multivariate(map((x:PPR):PPR+->map(f,x),univariate(p,v)),v) ---- push back the variable ---- + pushupCoef : (PR,List OV) -> PPR pushupCoef(c:PR, lv:List OV): PPR == ground? c => c::PPR v:=mainVariable(c)::Symbol @@ -210841,9 +214021,11 @@ PushVariables(R,E,OV,PPR):C == T where uc := reductum uc ppr + pushup : (PPR,OV) -> PPR pushup(f:PPR,x:OV) :PPR == map(y +-> pushupCoef(y,[x]), f) + pushup : (PPR,List(OV)) -> PPR pushup(g:PPR, lv:List OV) : PPR == map(y +-> pushupCoef(y, lv), g) @@ -211039,13 +214221,11 @@ QuasiAlgebraicSet2(vl,nv) : C == T where ---- Local Functions ---- ts:=new()$Symbol + newvl:=concat(ts, vl) + tv:newVar:=(variable ts)::newVar - npoly : Dpoly -> newPoly - oldpoly : newPoly -> Union(Dpoly,"failed") - f : Var -> newPoly - g : newVar -> Dpoly - + import PolynomialIdeals(F,newExpon,newVar,newPoly) import GroebnerPackage(F,Expon,Var,Dpoly) import GroebnerPackage(F,newExpon,newVar,newPoly) @@ -211054,20 +214234,31 @@ QuasiAlgebraicSet2(vl,nv) : C == T where import PolynomialCategoryLifting(Expon,Var,F,Dpoly,newPoly) import PolynomialCategoryLifting(newExpon,newVar,F,newPoly,Dpoly) + f : Var -> newPoly f(v:Var):newPoly == variable((convert v)@Symbol)@Union(newVar,"failed")::newVar ::newPoly + + g : newVar -> Dpoly g(v:newVar):Dpoly == v = tv => 0 variable((convert v)@Symbol)@Union(Var,"failed")::Var::Dpoly + npoly : Dpoly -> newPoly npoly(p:Dpoly) : newPoly == map(z1 +-> f z1, z2 +-> z2::newPoly, p) + oldpoly : newPoly -> Union(Dpoly,"failed") oldpoly(q:newPoly) : Union(Dpoly,"failed") == (x:=mainVariable q) case "failed" => (leadingCoefficient q)::Dpoly (x::newVar = tv) => "failed" map(z1 +-> g z1, z2 +-> z2::Dpoly, q) + radicalSimplify : QuasiAlgebraicSet(Fraction(Integer),_ + OrderedVariableList(vl),DirectProduct(nv,NonNegativeInteger),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) -> _ + QuasiAlgebraicSet(Fraction(Integer),OrderedVariableList(vl),_ + DirectProduct(nv,NonNegativeInteger),_ + DistributedMultivariatePolynomial(vl,Fraction(Integer))) radicalSimplify x == status(x)$QALG = true => x -- x is empty z0:=definingEquations x @@ -211556,6 +214747,7 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where (* package QCMPACK *) (* + squareFreeFactors : LP -> LP squareFreeFactors(lp: LP): LP == lsflp: LP := [] for p in lp repeat @@ -211563,16 +214755,19 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where lsflp := concat(lsfp,lsflp) sort(infRittWu?,removeDuplicates lsflp) + startTable! : (String,String,String) -> Void startTable!(ok: S, ko: S, domainName: S): Void == initTable!()$H if (not empty? ok) and (not empty? ko) then printInfo!(ok,ko)$H if (not empty? domainName) then startStats!(domainName)$H void() + stopTable! : () -> Void stopTable!(): Void == if makingStats?()$H then printStats!()$H clearTable!()$H + supDimElseRittWu? : (TS,TS) -> Boolean supDimElseRittWu? (ts:TS,us:TS): Boolean == #ts < #us => true #ts > #us => false @@ -211584,10 +214779,12 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where lp2 := rest lp2 not empty? lp1 + algebraicSort : List(TS) -> List(TS) algebraicSort (lts:Split): Split == lts := removeDuplicates lts sort(supDimElseRittWu?,lts) + moreAlgebraic? : (TS,TS) -> Boolean moreAlgebraic?(ts:TS,us:TS): Boolean == empty? ts => empty? us empty? us => true @@ -211596,6 +214793,7 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where not algebraic?(mvar(p),ts) => return false true + subTriSet? : (TS,TS) -> Boolean subTriSet?(ts:TS,us:TS): Boolean == empty? ts => true empty? us => false @@ -211604,6 +214802,7 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where first(ts)::P = first(us)::P => subTriSet?(rest(ts)::TS,rest(us)::TS) false + internalSubPolSet? : (List(P),List(P)) -> Boolean internalSubPolSet?(lp1: LP, lp2: LP): Boolean == empty? lp1 => true empty? lp2 => false @@ -211612,16 +214811,19 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where infRittWu?(first lp1, first lp2) => false internalSubPolSet?(lp1, rest lp2) + subPolSet? : (List(P),List(P)) -> Boolean subPolSet?(lp1: LP, lp2: LP): Boolean == lp1 := sort(infRittWu?, lp1) lp2 := sort(infRittWu?, lp2) internalSubPolSet?(lp1,lp2) + infRittWu? : (List(P),List(P)) -> Boolean infRittWu?(lp1: LP, lp2: LP): Boolean == lp1 := sort(infRittWu?, lp1) lp2 := sort(infRittWu?, lp2) internalInfRittWu?(lp1,lp2) + internalInfRittWu? : (List(P),List(P)) -> Boolean internalInfRittWu?(lp1: LP, lp2: LP): Boolean == empty? lp1 => not empty? lp2 empty? lp2 => false @@ -211629,11 +214831,14 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where infRittWu?(first lp2, first lp1)$P => false infRittWu?(rest lp1, rest lp2)$$ + subCase? : (Record(val: List(P),tower: TS),_ + Record(val: List(P),tower: TS)) -> Boolean subCase? (lpwt1:LpWT,lpwt2:LpWT): Boolean == -- ASSUME lpwt.{1,2}.val is sorted w.r.t. infRittWu? not internalSubPolSet?(lpwt2.val, lpwt1.val) => false subQuasiComponent?(lpwt1.tower,lpwt2.tower) + internalSubQuasiComponent? : (TS,TS) -> Union(Boolean,"failed") internalSubQuasiComponent?(ts:TS,us:TS): Union(Boolean,"failed") == -- "failed" is false iff saturate(us) is radical subTriSet?(us,ts) => true @@ -211650,6 +214855,7 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where return(false::Union(Boolean,"failed")) true::Union(Boolean,"failed") + subQuasiComponent? : (TS,TS) -> Boolean subQuasiComponent?(ts:TS,us:TS): Boolean == k: Key := [ts, us] e := extractIfCan(k)$H @@ -211659,11 +214865,14 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where insert!(k,b)$H b + subQuasiComponent? : (TS,List(TS)) -> Boolean subQuasiComponent?(ts:TS,lus:Split): Boolean == for us in lus repeat subQuasiComponent?(ts,us)@B => return true false + removeSuperfluousCases : List(Record(val: List(P),tower: TS)) -> _ + List(Record(val: List(P),tower: TS)) removeSuperfluousCases (cases:List LpWT) == #cases < 2 => cases toSee := @@ -211699,6 +214908,7 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where toSee := reverse toSave maxcases + removeSuperfluousQuasiComponents : List(TS) -> List(TS) removeSuperfluousQuasiComponents(lts: Split): Split == lts := removeDuplicates lts #lts < 2 => lts @@ -211732,9 +214942,12 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where toSee := reverse toSave algebraicSort maxlts + removeAssociates : LP -> LP removeAssociates (lp:LP):LP == removeDuplicates [primitivePart(p) for p in lp] + branchIfCan : (List(P),TS,List(P),Boolean,Boolean,Boolean,Boolean,_ + Boolean) -> Union(Record(eq: List(P),tower: TS,ineq: List(P)),"failed") branchIfCan(leq: LP,ts: TS,lineq: LP, b1:B,b2:B,b3:B,b4:B,b5:B):UBF == -- ASSUME pols in leq are squarefree and mainly primitive -- if b1 then CLEAN UP leq @@ -211783,6 +214996,8 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where leq := sort(infRittWu?, removeDuplicates leq) ([leq, ts, lineq]$Branch)::UBF + prepareDecompose : (List(P),List(TS),Boolean,Boolean) -> _ + List(Record(eq: List(P),tower: TS,ineq: List(P))) prepareDecompose(lp: LP, lts: List(TS), b1: B, b2: B): List Branch == -- if b1 then REMOVE REDUNDANT COMPONENTS in lts -- if b2 then SPLIT the input system with squareFree @@ -211900,6 +215115,7 @@ QuotientFieldCategoryFunctions2(A, B, R, S): Exports == Impl where (* package QFCAT2 *) (* + map : ((A -> B),R) -> S map(f, r) == f(numer r) / f(denom r) *) @@ -212048,6 +215264,7 @@ QuaternionCategoryFunctions2(QR,R,QS,S) : Exports == (* package QUATCT2 *) (* + map : ((R -> S),QR) -> QS map(fn : R -> S, u : QR): QS == quatern(fn real u, fn imagI u, fn imagJ u, fn imagK u)$QS @@ -212306,14 +215523,13 @@ RadicalEigenPackage() : C == T (* PI ==> PositiveInteger + RSP := RadicalSolvePackage R - import EigenPackage R - ---- Local Functions ---- - evalvect : (M,RE,SE) -> MRE - innerprod : (MRE,MRE) -> RE + import EigenPackage R ---- eval a vector of F in a radical expression ---- + evalvect : (M,RE,SE) -> MRE evalvect(vect:M,alg:RE,x:SE) : MRE == n:=nrows vect xx:=kernel(x)$Kernel(RE) @@ -212323,15 +215539,19 @@ RadicalEigenPackage() : C == T setelt(w,i,1,v) w ---- inner product ---- + innerprod : (MRE,MRE) -> RE innerprod(v1:MRE,v2:MRE): RE == (((transpose v1)* v2)::MRE)(1,1) ---- normalization of a vector ---- + normalise : Matrix(Expression(Integer)) -> Matrix(Expression(Integer)) normalise(v:MRE) : MRE == normv:RE := sqrt(innerprod(v,v)) normv = 0$RE => v (1/normv)*v ---- Eigenvalues of the matrix A ---- + radicalEigenvalues : Matrix(Fraction(Polynomial(Integer))) -> _ + List(Expression(Integer)) radicalEigenvalues(A:M): List(RE) == x:SE :=new()$SE pol:= characteristicPolynomial(A,x) :: F @@ -212339,6 +215559,9 @@ RadicalEigenPackage() : C == T ---- Eigenvectors belonging to a given eigenvalue ---- ---- expressed in terms of radicals ---- + radicalEigenvector : (Expression(Integer),_ + Matrix(Fraction(Polynomial(Integer)))) -> _ + List(Matrix(Expression(Integer))) radicalEigenvector(alpha:RE,A:M) : List(MRE) == n:=nrows A B:MRE := zero(n,n)$MRE @@ -212348,6 +215571,9 @@ RadicalEigenPackage() : C == T [v::MRE for v in nullSpace B] ---- eigenvectors and eigenvalues ---- + radicalEigenvectors : Matrix(Fraction(Polynomial(Integer))) -> _ + List(Record(radval: Expression(Integer),radmult: Integer,_ + radvect: List(Matrix(Expression(Integer))))) radicalEigenvectors(A:M) : List(RadicalForm) == leig:List EigenForm := eigenvectors A n:=nrows A @@ -212373,6 +215599,8 @@ RadicalEigenPackage() : C == T ---- orthonormalization of a list of vectors ---- ---- Grahm - Schmidt process ---- + gramschmidt : List(Matrix(Expression(Integer))) -> _ + List(Matrix(Expression(Integer))) gramschmidt(lvect:List(MRE)) : List(MRE) == lvect=[] => [] v:=lvect.first @@ -212387,6 +215615,8 @@ RadicalEigenPackage() : C == T ---- The matrix of eigenvectors ---- + eigenMatrix : Matrix(Fraction(Polynomial(Integer))) -> _ + Union(Matrix(Expression(Integer)),"failed") eigenMatrix(A:M) : Union(MRE,"failed") == lef:List(MRE):=[:eiv.radvect for eiv in radicalEigenvectors(A)] n:=nrows A @@ -212397,6 +215627,8 @@ RadicalEigenPackage() : C == T ---- orthogonal basis for a symmetric matrix ---- + orthonormalBasis : Matrix(Fraction(Polynomial(Integer))) -> _ + List(Matrix(Expression(Integer))) orthonormalBasis(A:M):List(MRE) == ^symmetric?(A) => error "the matrix is not symmetric" basis:List(MRE):=[] @@ -213420,47 +216652,38 @@ RadicalSolvePackage(R): Cat == Capsule where import SOLVEFOR SideEquations: List EQ RE := [] + ContractSoln: B := false ---- Local Function Declarations ---- - solveInner:(PR, SY, B) -> SU - linear: UP -> List RE - quadratic: UP -> List RE - cubic: UP -> List RE - quartic: UP -> List RE - rad: PI -> RE - wrap: RE -> RE - New: RE -> RE - makeEq : (List RE,L SY) -> L EQ RE - select : L L RE -> L L RE - isGeneric? : (L PR,L SY) -> Boolean - findGenZeros : (L PR,L SY) -> L L RE - findZeros : (L PR,L SY) -> L L RE - + New: RE -> RE New s == s = 0 => 0 S := new()$Symbol ::PR::RF::RE SideEquations := append([S = s], SideEquations) S - linear u == [(-coefficient(u,0))::RE /(coefficient(u,1))::RE] + linear: UP -> List RE + linear u == [(-coefficient(u,0))::RE /(coefficient(u,1))::RE] + quadratic: UP -> List RE quadratic u == quadratic(map(coerce,u)$UPF2)$SOLVEFOR - cubic u == cubic(map(coerce,u)$UPF2)$SOLVEFOR + cubic: UP -> List RE + cubic u == cubic(map(coerce,u)$UPF2)$SOLVEFOR - quartic u == quartic(map(coerce,u)$UPF2)$SOLVEFOR + quartic: UP -> List RE + quartic u == quartic(map(coerce,u)$UPF2)$SOLVEFOR - rad n == n::Z::RE - - wrap s == (ContractSoln => New s; s) - - - ---- Exported Functions ---- + rad: PI -> RE + rad n == n::Z::RE + wrap: RE -> RE + wrap s == (ContractSoln => New s; s) -- find the zeros of components in "generic" position -- + findGenZeros : (L PR,L SY) -> L L RE findGenZeros(rlp:L PR,rlv:L SY) : L L RE == pp:=rlp.first v:=first rlv @@ -213473,7 +216696,7 @@ RadicalSolvePackage(R): Cat == Capsule where for r in radicalRoots(pp::RF,v)],res) res - + findZeros : (L PR,L SY) -> L L RE findZeros(rlp:L PR,rlv:L SY) : L L RE == parRes:=[radicalRoots(p::RF,v) for p in rlp for v in rlv] parRes:=select parRes @@ -213492,9 +216715,12 @@ RadicalSolvePackage(R): Cat == Capsule where res:=cons(res1,res) res + radicalSolve : (List(Equation(Fraction(Polynomial(R)))),_ + List(Symbol)) -> List(List(Equation(Expression(R)))) radicalSolve(pol:RF,v:SY) == [equation(v::RE,r) for r in radicalRoots(pol,v)] + radicalSolve : Fraction(Polynomial(R)) -> List(Equation(Expression(R))) radicalSolve(p:RF) == zero? p => error "equation is always satisfied" @@ -213504,12 +216730,18 @@ RadicalSolvePackage(R): Cat == Capsule where #lv>1 => error "too many variables" radicalSolve(p,lv.first) + radicalSolve : Equation(Fraction(Polynomial(R))) -> _ + List(Equation(Expression(R))) radicalSolve(eq: EQ RF) == radicalSolve(lhs eq -rhs eq) + radicalSolve : (Equation(Fraction(Polynomial(R))),Symbol) -> _ + List(Equation(Expression(R))) radicalSolve(eq: EQ RF,v:SY) == radicalSolve(lhs eq - rhs eq,v) + radicalSolve : (List(Fraction(Polynomial(R))),List(Symbol)) -> _ + List(List(Equation(Expression(R)))) radicalRoots(lp: L RF,lv: L SY) == parRes:=triangularSystems(lp,lv)$SystemSolvePackage(R) parRes= list [] => [] @@ -213527,57 +216759,70 @@ RadicalSolvePackage(R): Cat == Capsule where append("append"/[findZeros(res,rlv) for res in rpRes], result) + radicalRoots : (List(Fraction(Polynomial(R))),List(Symbol)) -> _ + List(List(Expression(R))) radicalSolve(lp:L RF,lv:L SY) == [makeEq(lres,lv) for lres in radicalRoots(lp,lv)] + radicalSolve : List(Fraction(Polynomial(R))) -> _ + List(List(Equation(Expression(R)))) radicalSolve(lp: L RF) == lv:="setUnion"/[setUnion(variables numer p,variables denom p) for p in lp] [makeEq(lres,lv) for lres in radicalRoots(lp,lv)] + radicalSolve:(List(Equation(Fraction(Polynomial(R)))),List(Symbol)) ->_ + List(List(Equation(Expression(R)))) radicalSolve(le:L EQ RF,lv:L SY) == lp:=[rhs p -lhs p for p in le] [makeEq(lres,lv) for lres in radicalRoots(lp,lv)] + radicalSolve : List(Equation(Fraction(Polynomial(R)))) -> _ + List(List(Equation(Expression(R)))) radicalSolve(le: L EQ RF) == lp:=[rhs p -lhs p for p in le] lv:="setUnion"/[setUnion(variables numer p,variables denom p) for p in lp] [makeEq(lres,lv) for lres in radicalRoots(lp,lv)] + contractSolve : (Equation(Fraction(Polynomial(R))),Symbol) -> _ + SuchThat(List(Expression(R)),List(Equation(Expression(R)))) contractSolve(eq:EQ RF, v:SY)== solveInner(numer(lhs eq - rhs eq), v, true) + contractSolve : (Fraction(Polynomial(R)),Symbol) -> _ + SuchThat(List(Expression(R)),List(Equation(Expression(R)))) contractSolve(pq:RF, v:SY) == solveInner(numer pq, v, true) + radicalRoots : (Fraction(Polynomial(R)),Symbol) -> List(Expression(R)) radicalRoots(pq:RF, v:SY) == lhs solveInner(numer pq, v, false) - -- test if the ideal is radical in generic position -- + isGeneric? : (L PR,L SY) -> Boolean isGeneric?(rlp:L PR,rlv:L SY) : Boolean == "and"/[degree(f,x)=1 for f in rest rlp for x in rest rlv] ---- select the univariate factors + select : L L RE -> L L RE select(lp:L L RE) : L L RE == lp=[] => list [] [:[cons(f,lsel) for lsel in select lp.rest] for f in lp.first] ---- Local Functions ---- - -- construct the equation + -- construct the equation + makeEq : (List RE,L SY) -> L EQ RE makeEq(nres:L RE,lv:L SY) : L EQ RE == [equation(x :: RE,r) for x in lv for r in nres] + solveInner:(PR, SY, B) -> SU solveInner(pq:PR,v:SY,contractFlag:B) == SideEquations := [] ContractSoln := contractFlag - factors:= factors (factor pq)$MultivariateFactorize(SY,IndexedExponents SY,R,PR) - constants: List PR := [] unsolved: List PR := [] solutions: List RE := [] - for f in factors repeat ff:=f.factor ^ member?(v, variables (ff)) => @@ -213677,6 +216922,7 @@ RadixUtilities: Exports == Implementation where (* package RADUTIL *) (* + radix : (Fraction(Integer),Integer) -> Any radix(q, b) == coerce(q :: RadixExpansion(b))$AnyFunctions1(RadixExpansion b) @@ -213799,6 +217045,7 @@ RandomDistributions(S: SetCategory): with import RandomNumberSource() + weighted : List(Record(value: S,weight: Integer)) -> (() -> S) weighted lvw == -- Collapse duplicates, adding weights. t: Table(S, Integer) := table() @@ -213806,28 +217053,27 @@ RandomDistributions(S: SetCategory): with u := search(r.value,t) w := (u case "failed" => 0; u::Integer) t r.value := w + r.weight - -- Construct vectors of values and cumulative weights. kl := keys t n := (#kl)::NonNegativeInteger n = 0 => error "Cannot select from empty set" kv: Vector(S) := new(n, kl.0) wv: Vector(Integer) := new(n, 0) - totwt: Integer := 0 for k in kl for i in 1..n repeat kv.i := k totwt:= totwt + t k wv.i := totwt - -- Function to generate an integer and lookup. rdHack1(kv, wv, totwt) + rdHack1 : (Vector(S),Vector(Integer),Integer) -> (() -> S) rdHack1(kv, wv, totwt) == w := randnum totwt -- do binary search in wv kv.1 + uniform : Set(S) -> (() -> S) uniform fset == l := members fset n := #l @@ -214010,22 +217256,27 @@ RandomFloatDistributions(): Cat == Body where -- random() generates numbers in 0..rnmax rnmax := (size()$RandomNumberSource() - 1)::Float + uniform01 : () -> Float uniform01() == randnum()::Float/rnmax + uniform : (Float,Float) -> (() -> Float) uniform(a,b) == a + uniform01()*(b-a) + exponential1 : () -> Float exponential1() == u: Float := 0 -- This test should really be u < m where m is -- the minumum acceptible argument to log. while u = 0 repeat u := uniform01() - log u + exponential : Float -> (() -> Float) exponential(mean) == mean*exponential1() -- This method is correct but slow. + normal01 : () -> Float normal01() == s := 2::Float while s >= 1 repeat @@ -214033,9 +217284,12 @@ RandomFloatDistributions(): Cat == Body where v2 := 2 * uniform01() - 1 s := v1**2 + v2**2 v1 * sqrt(-2 * log s/s) + + normal : (Float,Float) -> (() -> Float) normal(mean, stdev) == mean + stdev*normal01() + chiSquare1 : NonNegativeInteger -> Float chiSquare1 dgfree == x: Float := 0 for i in 1..dgfree quo 2 repeat @@ -214043,19 +217297,24 @@ RandomFloatDistributions(): Cat == Body where if odd? dgfree then x := x + normal01()**2 x + + chiSquare : NonNegativeInteger -> (() -> Float) chiSquare dgfree == chiSquare1 dgfree + Beta : (NonNegativeInteger,NonNegativeInteger) -> (() -> Float) Beta(dgfree1, dgfree2) == y1 := chiSquare1 dgfree1 y2 := chiSquare1 dgfree2 y1/(y1 + y2) + F : (NonNegativeInteger,NonNegativeInteger) -> (() -> Float) F(dgfree1, dgfree2) == y1 := chiSquare1 dgfree1 y2 := chiSquare1 dgfree2 (dgfree2 * y1)/(dgfree1 * y2) + t : NonNegativeInteger -> (() -> Float) t dgfree == n := normal01() d := chiSquare1(dgfree) / (dgfree::Float) @@ -214180,12 +217439,11 @@ RandomIntegerDistributions(): with import RandomNumberSource() import IntegerBits() + uniform : Segment(Integer) -> (() -> Integer) uniform aTob == a := lo aTob; b := hi aTob l := min(a,b); m := abs(a-b) + 1 - w := 2**(bitLength size() quo 2)::NonNegativeInteger - n := 0 mq := m -- m quo w**n while (mqnext := mq quo w) > 0 repeat @@ -214193,6 +217451,7 @@ RandomIntegerDistributions(): with mq := mqnext ridHack1(mq, n, w, l) + ridHack1 : (Integer,Integer,Integer,Integer) -> Integer ridHack1(mq, n, w, l) == r := randnum mq for i in 1..n repeat r := r*w + randnum w @@ -214328,22 +217587,27 @@ RandomNumberSource(): with x0: Integer := 1231231231 x1: Integer := 3243232987 + randnum : () -> Integer randnum() == t := (271828183 * x1 - 314159269 * x0) rem ranbase if t < 0 then t := t + ranbase x0:= x1 x1:= t + size : () -> Integer size() == ranbase + reseed : Integer -> Void reseed n == x0 := n rem ranbase -- x1 := (n quo ranbase) rem ranbase x1 := n quo ranbase + seed : () -> Integer seed() == x1*ranbase + x0 -- Compute an integer in 0..n-1. + randnum : Integer -> Integer randnum n == (n * randnum()) quo ranbase @@ -214483,6 +217747,7 @@ RationalFactorize(RP) : public == private where fUnion ==> Union("nil", "sqfr", "irred", "prime") FFE ==> Record(flg:fUnion, fctr:RP, xpnt:I) + factor : RP -> Factored(RP) factor(p:RP) : Factored(RP) == p = 0 => 0 pden: I := lcm([denom c for c in coefficients p]) @@ -214493,6 +217758,7 @@ RationalFactorize(RP) : public == private where [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE for u in ffact.factors]) + factorSquareFree : RP -> Factored(RP) factorSquareFree(p:RP) : Factored(RP) == p = 0 => 0 pden: I := lcm([denom c for c in coefficients p]) @@ -214658,32 +217924,47 @@ RationalFunction(R:IntegralDomain): Exports == Implementation where (* package RF *) (* - foo : (List V, List Q, V) -> Q - peval: (P, List V, List Q) -> Q - - coerce(r:R):Q == r::P::Q + coerce : R -> Fraction(Polynomial(R)) + coerce(r:R):Q == r::P::Q - variables f == variables(f)$QF + variables : Fraction(Polynomial(R)) -> List(Symbol) + variables f == variables(f)$QF - mainVariable f == mainVariable(f)$QF + mainVariable : Fraction(Polynomial(R)) -> Union(Symbol,"failed") + mainVariable f == mainVariable(f)$QF - univariate(f, x) == univariate(f, x)$QF + univariate : (Fraction(Polynomial(R)),Symbol) -> _ + Fraction(SparseUnivariatePolynomial(Fraction(Polynomial(R)))) + univariate(f, x) == univariate(f, x)$QF - multivariate(f, x) == multivariate(f, x)$QF + multivariate : _ + (Fraction(SparseUnivariatePolynomial(Fraction(Polynomial(R)))),Symbol) ->_ + Fraction(Polynomial(R)) + multivariate(f, x) == multivariate(f, x)$QF - eval(x:Q, s:V, y:Q) == eval(x, [s], [y]) + eval : (Fraction(Polynomial(R)),Symbol,Fraction(Polynomial(R))) -> _ + Fraction(Polynomial(R)) + eval(x:Q, s:V, y:Q) == eval(x, [s], [y]) + eval : (Fraction(Polynomial(R)),Equation(Fraction(Polynomial(R)))) -> _ + Fraction(Polynomial(R)) eval(x:Q, eq:Equation Q) == eval(x, [eq]) - foo(ls, lv, x) == match(ls, lv, x, x::Q)$ListToMap(V, Q) + foo : (List V, List Q, V) -> Q + foo(ls, lv, x) == match(ls, lv, x, x::Q)$ListToMap(V, Q) + eval:(Fraction(Polynomial(R)),List(Equation(Fraction(Polynomial(R))))) ->_ + Fraction(Polynomial(R)) eval(x:Q, l:List Equation Q) == eval(x, [retract(lhs eq)@V for eq in l]$List(V), [rhs eq for eq in l]$List(Q)) + eval : (Fraction(Polynomial(R)),List(Symbol),_ + List(Fraction(Polynomial(R)))) -> Fraction(Polynomial(R)) eval(x:Q, ls:List V, lv:List Q) == peval(numer x, ls, lv) / peval(denom x, ls, lv) + peval: (P, List V, List Q) -> Q peval(p, ls, lv) == map(z1 +-> foo(ls, lv, z1), z2 +-> z2::Q,p) $PolynomialCategoryLifting(IndexedExponents V,V,R,P,Q) @@ -214847,12 +218128,16 @@ RationalFunctionDefiniteIntegration(R): Exports == Implementation where import IntegrationResultRFToFunction(R) import OrderedCompletionFunctions2(RF, FE) - int : (RF, SE, OFE, OFE, Boolean) -> U - nopole: (RF, SE, OFE, OFE) -> U - + integrate : (Fraction(Polynomial(R)),_ + SegmentBinding(OrderedCompletion(Expression(R)))) -> _ + Union(f1: OrderedCompletion(Expression(R)),_ + f2: List(OrderedCompletion(Expression(R))),_ + fail: failed,_ + pole: potentialPole) integrate(f:RF, s:SegmentBinding OFE) == int(f, variable s, lo segment s, hi segment s, false) + nopole: (RF, SE, OFE, OFE) -> U nopole(f, x, a, b) == k := kernel(x)@Kernel(FE) (u := integrate(f, x)) case FE => @@ -214864,17 +218149,36 @@ RationalFunctionDefiniteIntegration(R): Exports == Implementation where ans := concat_!(ans, [v::OFE]) [ans] + integrate : (Fraction(Polynomial(R)),_ + SegmentBinding(OrderedCompletion(Fraction(Polynomial(R))))) ->_ + Union(f1: OrderedCompletion(Expression(R)),_ + f2: List(OrderedCompletion(Expression(R))),_ + fail: failed,_ + pole: potentialPole) integrate(f:RF, s:SegmentBinding ORF) == int(f, variable s, map(x +-> x::FE, lo segment s), map(x +-> x::FE, hi segment s), false) + integrate : (Fraction(Polynomial(R)),_ + SegmentBinding(OrderedCompletion(Fraction(Polynomial(R)))),String) ->_ + Union(f1: OrderedCompletion(Expression(R)), + f2: List(OrderedCompletion(Expression(R))), + fail: failed, + pole: potentialPole) integrate(f:RF, s:SegmentBinding ORF, str:String) == int(f, variable s, map(x +-> x::FE, lo segment s), map(x +-> x::FE, hi segment s), ignore? str) + integrate : (Fraction(Polynomial(R)),_ + SegmentBinding(OrderedCompletion(Expression(R))),String) ->_ + Union(f1: OrderedCompletion(Expression(R)),_ + f2: List(OrderedCompletion(Expression(R))),_ + fail: failed,_ + pole: potentialPole) integrate(f:RF, s:SegmentBinding OFE, str:String) == int(f, variable s, lo segment s, hi segment s, ignore? str) + int : (RF, SE, OFE, OFE, Boolean) -> U int(f, x, a, b, ignor?) == a = b => [0::OFE] (z := checkForZero(denom f, x, a, b, true)) case "failed" => @@ -214977,15 +218281,15 @@ RationalFunctionFactor(UP): Exports == Implementation where \begin{chunk}{COQ RFFACT} (* package RFFACT *) (* - - likuniv: (P, SE, P) -> UP dummy := new()$SE + likuniv: (P, SE, P) -> UP likuniv(p, x, d) == map(y +-> y/d, univariate(p, x))$UPCF2(P,SparseUnivariatePolynomial P, RF, UP) - + + factor : UP -> Factored(UP) factor p == d := denom(q := elt(p,dummy::P :: RF)) map(x +-> likuniv(x,dummy,d), @@ -215092,6 +218396,8 @@ RationalFunctionFactorizer(R) : C == T (* package RFFACTOR *) (* + factorFraction : Fraction(Polynomial(R)) -> _ + Fraction(Factored(Polynomial(R))) factorFraction(p:FP) : Fraction Factored(P) == R is Fraction Integer => MR:=MRationalFactorize(IndexedExponents SE,SE, @@ -215238,16 +218544,29 @@ RationalFunctionIntegration(F): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents SE, SE, F, P, Q) + infieldIntegrate : (Fraction(Polynomial(F)),Symbol) -> _ + Union(Fraction(Polynomial(F)),"failed") infieldIntegrate(f, x) == map(x1 +-> multivariate(x1, x), infieldint univariate(f, x)) + internalIntegrate : (Fraction(Polynomial(F)),Symbol) -> _ + IntegrationResult(Fraction(Polynomial(F))) internalIntegrate(f, x) == map(x1 +-> multivariate(x1, x), integrate univariate(f, x)) + extendedIntegrate : (Fraction(Polynomial(F)),Symbol,_ + Fraction(Polynomial(F))) -> _ + Union(Record(ratpart: Fraction(Polynomial(F)),_ + coeff: Fraction(Polynomial(F))),"failed") extendedIntegrate(f, x, g) == map(x1 +-> multivariate(x1, x), extendedint(univariate(f, x), univariate(g, x))) + limitedIntegrate : (Fraction(Polynomial(F)),Symbol,_ + List(Fraction(Polynomial(F)))) -> _ + Union(Record(mainpart: Fraction(Polynomial(F)),_ + limitedlogs: List(Record(coeff: Fraction(Polynomial(F)),_ + logand: Fraction(Polynomial(F))))),"failed") limitedIntegrate(f, x, lu) == map(x1 +-> multivariate(x1, x), limitedint(univariate(f, x), [univariate(u, x) for u in lu])) @@ -215480,6 +218799,11 @@ RationalFunctionLimitPackage(R:GcdDomain):Exports==Implementation where locallimit : (RF, SE, ORF) -> U locallimitcomplex: (RF, SE, OPF) -> OPF + limit : (Fraction(Polynomial(R)),Equation(Fraction(Polynomial(R)))) -> _ + Union(OrderedCompletion(Fraction(Polynomial(R))),_ + Record(leftHandLimit: Union(OrderedCompletion(Fraction(Polynomial(R))),_ + "failed"),rightHandLimit: _ + Union(OrderedCompletion(Fraction(Polynomial(R))),"failed")),"failed") limit(f:RF,eq:EQ RF) == (xx := retractIfCan(lhs eq)@Union(SE,"failed")) case "failed" => error "limit: left hand side must be a variable" @@ -215716,22 +219040,21 @@ RationalFunctionSign(R:GcdDomain): Exports == Implementation where import PolynomialCategoryQuotientFunctions(IndexedExponents SE, SE, R, P, RF) - psign : P -> U - sqfrSign : P -> U - termSign : P -> U - listSign : (List P, Integer) -> U - finiteSign: (Fraction UP, RF) -> U + sign : Fraction(Polynomial(R)) -> Union(Integer,"failed") sign f == (un := psign numer f) case "failed" => "failed" (ud := psign denom f) case "failed" => "failed" (un::Integer) * (ud::Integer) + finiteSign: (Fraction UP, RF) -> U finiteSign(g, a) == (ud := signAround(denom g, a, sign$%)) case "failed" => "failed" (un := signAround(numer g, a, sign$%)) case "failed" => "failed" (un::Integer) * (ud::Integer) + sign : (Fraction(Polynomial(R)),Symbol,_ + OrderedCompletion(Fraction(Polynomial(R)))) -> Union(Integer,"failed") sign(f, x, a) == g := univariate(f, x) zero?(n := whatInfinity a) => finiteSign(g, retract a) @@ -215739,12 +219062,15 @@ RationalFunctionSign(R:GcdDomain): Exports == Implementation where (un := signAround(numer g, n, sign$%)) case "failed" => "failed" (un::Integer) * (ud::Integer) + sign : (Fraction(Polynomial(R)),Symbol,Fraction(Polynomial(R)),String) ->_ + Union(Integer,"failed") sign(f, x, a, st) == (ud := signAround(denom(g := univariate(f, x)), a, d := direction st, sign$%)) case "failed" => "failed" (un := signAround(numer g, a, d, sign$%)) case "failed" => "failed" (un::Integer) * (ud::Integer) + psign : P -> U psign p == (r := retractIfCan(p)@Union(R, "failed")) case R => sign(r::R)$SGN (u := sign(retract(unit(s := squareFree p))@R)$SGN) case "failed" => @@ -215755,16 +219081,19 @@ RationalFunctionSign(R:GcdDomain): Exports == Implementation where ans := ans * (u::Integer) ans + sqfrSign : P -> U sqfrSign p == (u := termSign first(l := monomials p)) case "failed" => "failed" listSign(rest l, u::Integer) + listSign : (List P, Integer) -> U listSign(l, s) == for term in l repeat (u := termSign term) case "failed" => return "failed" u::Integer ^= s => return "failed" s + termSign : P -> U termSign term == for var in variables term repeat odd? degree(term, var) => return "failed" @@ -216142,9 +219471,8 @@ RationalFunctionSum(R): Exports == Impl where import RationalFunction R import GosperSummationMethod(IndexedExponents SE, SE, R, P, RF) - innersum : (RF, SE) -> Union(RF, "failed") - innerpolysum: (P, SE) -> RF - + sum : (Fraction(Polynomial(R)),SegmentBinding(Fraction(Polynomial(R)))) ->_ + Union(Fraction(Polynomial(R)),Expression(R)) sum(f:RF, s:SegmentBinding RF) == (indef := innersum(f, v := variable s)) case "failed" => summation(f::FE,map((z:RF):FE +->z::FE,s) @@ -216152,14 +219480,19 @@ RationalFunctionSum(R): Exports == Impl where eval(indef::RF, v, 1 + hi segment s) - eval(indef::RF, v,lo segment s) + sum : (Fraction(Polynomial(R)),Symbol) -> _ + Union(Fraction(Polynomial(R)),Expression(R)) sum(an:RF, n:SE) == (u := innersum(an, n)) case "failed" => summation(an::FE, n) u::RF + sum : (Polynomial(R),SegmentBinding(Polynomial(R))) -> _ + Fraction(Polynomial(R)) sum(p:P, s:SegmentBinding P) == f := sum(p, v := variable s) eval(f, v, (1 + hi segment s)::RF) - eval(f,v,lo(segment s)::RF) + innersum : (RF, SE) -> Union(RF, "failed") innersum(an, n) == (r := retractIfCan(an)@Union(P, "failed")) case "failed" => an1 := eval(an, n, -1 + n::RF) @@ -216168,6 +219501,7 @@ RationalFunctionSum(R): Exports == Impl where an1 * eval(u::RF, n, -1 + n::RF) sum(r::P, n) + sum : (Polynomial(R),Symbol) -> Fraction(Polynomial(R)) sum(p:P, n:SE) == rec := sum(p, n)$InnerPolySum(IndexedExponents SE, SE, R, P) rec.num / (rec.den :: P) @@ -216305,21 +219639,29 @@ RationalIntegration(F, UP): Exports == Implementation where import TranscendentalIntegration(F, UP) + infieldint : Fraction(UP) -> Union(Fraction(UP),"failed") infieldint f == rec := baseRDE(0, f)$TranscendentalRischDE(F, UP) rec.nosol => "failed" rec.ans + integrate : Fraction(UP) -> IntegrationResult(Fraction(UP)) integrate f == rec := monomialIntegrate(f, differentiate) integrate(rec.polypart)::RF::IR + rec.ir + limitedint : (Fraction(UP),List(Fraction(UP))) -> _ + Union(Record(mainpart: Fraction(UP),_ + limitedlogs: List(Record(coeff: Fraction(UP),logand: Fraction(UP)))),_ + "failed") limitedint(f, lu) == quorem := divide(numer f, denom f) (u := primlimintfrac(quorem.remainder / (denom f), differentiate, lu)) case "failed" => "failed" [u.mainpart + integrate(quorem.quotient)::RF, u.limitedlogs] + extendedint : (Fraction(UP),Fraction(UP)) -> _ + Union(Record(ratpart: Fraction(UP),coeff: Fraction(UP)),"failed") extendedint(f, g) == fqr := divide(numer f, denom f) gqr := divide(numer g, denom g) @@ -216506,6 +219848,8 @@ Finally, we generate the rational function: \begin{chunk}{COQ RINTERP} (* package RINTERP *) (* + interpolate:(List(F),List(F),NonNegativeInteger,NonNegativeInteger) ->_ + Fraction(Polynomial(F)) interpolate(xlist, ylist, m, k) == #xlist ^= #ylist => error "Different number of points and values." @@ -216835,27 +220179,15 @@ RationalLODE(F, UP): Exports == Implementation where import LinearSystemMatrixPackage(F, V, V, M) import InnerCommonDenominator(UP, RF, List UP, List RF) - nzero? : V -> Boolean - evenodd : N -> F - UPfact : N -> UP - infOrder : RF -> Z - infTau : (UP, N) -> F - infBound : (LODO2, List RF) -> N - regularPoint : (LODO2, List RF) -> Z - infIndicialEquation: (List N, List UP) -> UP - makeDot : (Vector F, List RF) -> RF - unitlist : (N, N) -> List F - infMuLambda: LODO2 -> Record(mu:Z, lambda:List N, func:List UP) - ratDsolve0: (LODO2, RF) -> Record(particular: U, basis: List RF) - ratDsolve1: (LODO2, List RF) -> Record(basis:List RF, mat:Matrix F) - candidates: (LODO2,List RF,UP) -> Record(basis:List RF,particular:List RF) - dummy := new()$Symbol + infOrder : RF -> Z infOrder f == (degree denom f) - (degree numer f) + evenodd : N -> F evenodd n == (even? n => 1; -1) + ratDsolve1: (LODO2, List RF) -> Record(basis:List RF, mat:Matrix F) ratDsolve1(op, lg) == d := denomLODE(op, lg) rec := candidates(op, lg, d) @@ -216864,6 +220196,7 @@ RationalLODE(F, UP): Exports == Implementation where sys1 := reducedSystem(matrix [l])@Matrix(UP) [rec.basis, reducedSystem sys1] + ratDsolve0: (LODO2, RF) -> Record(particular: U, basis: List RF) ratDsolve0(op, g) == zero? degree op => [inv(leadingCoefficient(op)::RF) * g, empty()] minimumDegree op > 0 => @@ -216902,14 +220235,19 @@ RationalLODE(F, UP): Exports == Implementation where [part, concat_!(lsol, [makeDot(v, lb) for v in sol.basis | nzero? v])] + indicialEquationAtInfinity : _ + LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)) -> UP indicialEquationAtInfinity(op:LODO2) == rec := infMuLambda op infIndicialEquation(rec.lambda, rec.func) + indicialEquationAtInfinity : _ + LinearOrdinaryDifferentialOperator1(Fraction(UP)) -> UP indicialEquationAtInfinity(op:LODO) == rec := splitDenominator(op, empty()) indicialEquationAtInfinity(rec.eq) + regularPoint : (LODO2, List RF) -> Z regularPoint(l, lg) == a := leadingCoefficient(l) * commonDenominator lg coefficient(a, 0) ^= 0 => 0 @@ -216917,11 +220255,13 @@ RationalLODE(F, UP): Exports == Implementation where a(j := i::F) ^= 0 => return i a(-j) ^= 0 => return(-i) + unitlist : (N, N) -> List F unitlist(i, q) == v := new(q, 0)$Vector(F) v.i := 1 parts v + candidates: (LODO2,List RF,UP) -> Record(basis:List RF,particular:List RF) candidates(op, lg, d) == n := degree d + infBound(op, lg) m := regularPoint(op, lg) @@ -216942,17 +220282,20 @@ RationalLODE(F, UP): Exports == Implementation where /$RF d for g in lg | g ^= 0]$List(RF) [hom, part] + nzero? : V -> Boolean nzero? v == for i in minIndex v .. maxIndex v repeat not zero? qelt(v, i) => return true false -- returns z(z+1)...(z+(n-1)) + UPfact : N -> UP UPfact n == zero? n => 1 z := monomial(1, 1)$UP */[z + i::F::UP for i in 0..(n-1)::N] + infMuLambda: LODO2 -> Record(mu:Z, lambda:List N, func:List UP) infMuLambda l == lamb:List(N) := [d := degree l] lf:List(UP) := [a := leadingCoefficient l] @@ -216968,12 +220311,14 @@ RationalLODE(F, UP): Exports == Implementation where lf := concat(a, lf) [mup, lamb, lf] + infIndicialEquation: (List N, List UP) -> UP infIndicialEquation(lambda, lf) == ans:UP := 0 for i in lambda for f in lf repeat ans := ans + evenodd i * leadingCoefficient f * UPfact i ans + infBound : (LODO2, List RF) -> N infBound(l, lg) == rec := infMuLambda l n := min(- degree(l)::Z - 1, @@ -216985,23 +220330,34 @@ RationalLODE(F, UP): Exports == Implementation where if not(zero? g) and (mm := infOrder g) < m then m := mm (-min(n, rec.mu - degree(leadingCoefficient l)::Z + m))::N + makeDot : (Vector F, List RF) -> RF makeDot(v, bas) == ans:RF := 0 for i in 1.. for b in bas repeat ans := ans + v.i::UP * b ans + ratDsolve : (LinearOrdinaryDifferentialOperator1(Fraction(UP)),_ + Fraction(UP)) -> Record(particular: Union(Fraction(UP),"failed"),_ + basis: List(Fraction(UP))) ratDsolve(op:LODO, g:RF) == rec := splitDenominator(op, [g]) ratDsolve0(rec.eq, first(rec.rh)) + ratDsolve : (LinearOrdinaryDifferentialOperator1(Fraction(UP)),_ + List(Fraction(UP))) -> Record(basis: List(Fraction(UP)),mat: Matrix(F)) ratDsolve(op:LODO, lg:List RF) == rec := splitDenominator(op, lg) ratDsolve1(rec.eq, rec.rh) + ratDsolve : (LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)),_ + Fraction(UP)) -> Record(particular: Union(Fraction(UP),"failed"),_ + basis: List(Fraction(UP))) ratDsolve(op:LODO2, g:RF) == unit?(c := content op) => ratDsolve0(op, g) ratDsolve0((op exquo c)::LODO2, inv(c::RF) * g) + ratDsolve : (LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)),_ + List(Fraction(UP))) -> Record(basis: List(Fraction(UP)),mat: Matrix(F)) ratDsolve(op:LODO2, lg:List RF) == unit?(c := content op) => ratDsolve1(op, lg) ratDsolve1((op exquo c)::LODO2, [inv(c::RF) * g for g in lg]) @@ -217096,10 +220452,13 @@ RationalRetractions(S:RetractableTo(Fraction Integer)): with (* package RATRET *) (* - rational s == retract s + rational : S -> Fraction(Integer) + rational s == retract s - rational? s == retractIfCan(s) case Fraction(Integer) + rational? : S -> Boolean + rational? s == retractIfCan(s) case Fraction(Integer) + rationalIfCan : S -> Union(Fraction(Integer),"failed") rationalIfCan s == retractIfCan s *) @@ -217476,45 +220835,32 @@ RationalRicDE(F, UP): Exports == Implementation where import PrimitiveRatDE(F, UP, L, LQ) import PrimitiveRatRicDE(F, UP, L, LQ) - FifCan : RF -> Union(F, "failed") - UP2SUP : UP -> SUP - innersol : (List UP, Boolean) -> List QF - mapeval : (SUP, List SY, List F) -> UP - ratsol : List List EQ -> List SOL - ratsln : List EQ -> Union(SOL, "failed") - solveModulo : (UP, UP2) -> List UP - logDerOnly : L -> List QF - nonSingSolve : (N, L, UP -> List F) -> List QF - constantRic : (UP, UP -> List F) -> List F - nopoly : (N, UP, L, UP -> List F) -> List QF - reverseUP : UP -> UTS - reverseUTS : (UTS, N) -> UP - newtonSolution : (L, F, N, UP -> List F) -> UP - newtonSolve : (UPS, F, N) -> Union(UTS, "failed") - genericPolynomial: (SY, Z) -> Record(poly:SUP, vars:List SY) - -- genericPolynomial(s, n) returns - -- \spad{[[s0 + s1 X +...+ sn X^n],[s0,...,sn]]}. + innersol : (List UP, Boolean) -> List QF dummy := new()$SY + UP2SUP : UP -> SUP UP2SUP p == map(z +-> z::P,p) $UnivariatePolynomialCategoryFunctions2(F,UP,P,SUP) + logDerOnly : L -> List QF logDerOnly l == [differentiate(s) / s for s in ratDsolve(l, 0).basis] ricDsolve(l:LQ, zeros:UP -> List F) == ricDsolve(l, zeros, squareFree) - ricDsolve(l:L, zeros:UP -> List F) == ricDsolve(l, zeros, squareFree) + ricDsolve(l:L, zeros:UP -> List F) == ricDsolve(l, zeros, squareFree) - singRicDE(l, ezfactor) == singRicDE(l, solveModulo, ezfactor) + singRicDE(l, ezfactor) == singRicDE(l, solveModulo, ezfactor) ricDsolve(l:LQ, zeros:UP -> List F, ezfactor:UP -> Factored UP) == ricDsolve(splitDenominator(l, empty()).eq, zeros, ezfactor) + mapeval : (SUP, List SY, List F) -> UP mapeval(p, ls, lv) == map(z +-> ground eval(z, ls, lv),p) $UnivariatePolynomialCategoryFunctions2(P, SUP, F, UP) + FifCan : RF -> Union(F, "failed") FifCan f == ((n := retractIfCan(numer f))@Union(F, "failed") case F) and ((d := retractIfCan(denom f))@Union(F, "failed") case F) => @@ -217522,6 +220868,9 @@ RationalRicDE(F, UP): Exports == Implementation where "failed" -- returns [0, []] if n < 0 + -- genericPolynomial(s, n) returns + -- \spad{[[s0 + s1 X +...+ sn X^n],[s0,...,sn]]}. + genericPolynomial: (SY, Z) -> Record(poly:SUP, vars:List SY) genericPolynomial(s, n) == ans:SUP := 0 l:List(SY) := empty() @@ -217530,6 +220879,7 @@ RationalRicDE(F, UP): Exports == Implementation where l := concat(sy, l) [ans, reverse_! l] + ratsln : List EQ -> Union(SOL, "failed") ratsln l == ls:List(SY) := empty() lv:List(F) := empty() @@ -217541,6 +220891,7 @@ RationalRicDE(F, UP): Exports == Implementation where ls := concat(v::SY, ls) [ls, lv] + ratsol : List List EQ -> List SOL ratsol l == ans:List(SOL) := empty() for sol in l repeat @@ -217548,6 +220899,9 @@ RationalRicDE(F, UP): Exports == Implementation where ans -- returns [] if the solutions of l have no polynomial component + polyRicDE : (LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)),_ + (UP -> List(F))) -> List(Record(poly: UP,_ + eq: LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)))) polyRicDE(l, zeros) == ans:List(POL) := [[0, l]] empty?(lc := leadingCoefficientRicDE l) => ans @@ -217558,6 +220912,7 @@ RationalRicDE(F, UP): Exports == Implementation where ans -- reverseUP(a_0 + a_1 x + ... + an x^n) = a_n + ... + a_0 x^n + reverseUP : UP -> UTS reverseUP p == ans:UTS := 0 n := degree(p)::Z @@ -217567,10 +220922,12 @@ RationalRicDE(F, UP): Exports == Implementation where ans -- reverseUTS(a_0 + a_1 x + ..., n) = a_n + ... + a_0 x^n + reverseUTS : (UTS, N) -> UP reverseUTS(s, n) == +/[monomial(coefficient(s, i), (n - i)::N)$UP for i in 0..n] -- returns potential polynomial solution p with leading coefficient a*?**n + newtonSolution : (L, F, N, UP -> List F) -> UP newtonSolution(l, a, n, zeros) == i:N m:Z := 0 @@ -217600,6 +220957,7 @@ RationalRicDE(F, UP): Exports == Implementation where -- uses naive newton approximation for now -- an example where this fails is y^2 + 2 x y + 1 + x^2 = 0 -- which arises from the differential operator D^2 + 2 x D + 1 + x^2 + newtonSolve : (UPS, F, N) -> Union(UTS, "failed") newtonSolve(eq, a, n) == deq := differentiate eq sol := a::UTS @@ -217610,6 +220968,8 @@ RationalRicDE(F, UP): Exports == Implementation where -- there could be the same solutions coming in different ways, so we -- stop when the number of solutions reaches the order of the equation + ricDsolve : (LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)),_ + (UP -> List(F)),(UP -> Factored(UP))) -> List(Fraction(UP)) ricDsolve(l:L, zeros:UP -> List F, ezfactor:UP -> Factored UP) == n := degree l ans:List(QF) := empty() @@ -217621,6 +220981,7 @@ RationalRicDE(F, UP): Exports == Implementation where -- there could be the same solutions coming in different ways, so we -- stop when the number of solutions reaches the order of the equation + nonSingSolve : (N, L, UP -> List F) -> List QF nonSingSolve(n, l, zeros) == ans:List(QF) := empty() for rec in polyRicDE(l, zeros) repeat @@ -217628,12 +220989,14 @@ RationalRicDE(F, UP): Exports == Implementation where #ans = n => return ans ans + constantRic : (UP, UP -> List F) -> List F constantRic(p, zeros) == zero? degree p => empty() zeros squareFreePart p -- there could be the same solutions coming in different ways, so we -- stop when the number of solutions reaches the order of the equation + nopoly : (N, UP, L, UP -> List F) -> List QF nopoly(n, p, l, zeros) == ans:List(QF) := empty() for rec in constantCoefficientRicDE(l,z+->constantRic(z, zeros)) repeat @@ -217643,6 +221006,7 @@ RationalRicDE(F, UP): Exports == Implementation where ans -- returns [p1,...,pn] s.t. h(x,pi(x)) = 0 mod c(x) + solveModulo : (UP, UP2) -> List UP solveModulo(c, h) == rec := genericPolynomial(dummy, degree(c)::Z - 1) unk:SUP := 0 @@ -217655,22 +221019,29 @@ RationalRicDE(F, UP): Exports == Implementation where if F has AlgebraicallyClosedField then - zro1: UP -> List F - zro : (UP, UP -> Factored UP) -> List F - + ricDsolve : LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)) -> _ + List(Fraction(UP)) ricDsolve(l:L) == ricDsolve(l, squareFree) + ricDsolve : LinearOrdinaryDifferentialOperator1(Fraction(UP)) -> _ + List(Fraction(UP)) if F has ACF ricDsolve(l:LQ) == ricDsolve(l, squareFree) + ricDsolve : (LinearOrdinaryDifferentialOperator2(UP,Fraction(UP)),_ + (UP -> List(F))) -> List(Fraction(UP)) ricDsolve(l:L, ezfactor:UP -> Factored UP) == ricDsolve(l, z +-> zro(z, ezfactor), ezfactor) + ricDsolve : (LinearOrdinaryDifferentialOperator1(Fraction(UP)),_ + (UP -> List(F))) -> List(Fraction(UP)) ricDsolve(l:LQ, ezfactor:UP -> Factored UP) == ricDsolve(l, z +-> zro(z, ezfactor), ezfactor) + zro : (UP, UP -> Factored UP) -> List F zro(p, ezfactor) == concat [zro1(r.factor) for r in factors ezfactor p] + zro1: UP -> List F zro1 p == [zeroOf(map((z:F):F +-> z, p) $UnivariatePolynomialCategoryFunctions2(F, UP, F, @@ -217882,6 +221253,9 @@ RationalUnivariateRepresentationPackage(R,ls): Exports == Implementation where newv: V := variable(news)::V newq : Q := newv :: Q + rur : (List(Polynomial(R)),Boolean,Boolean) -> _ + List(Record(complexRoots: SparseUnivariatePolynomial(R),_ + coordinates: List(Polynomial(R)))) rur(lp: List P, univ?: Boolean, check?: Boolean): List RUR == lp := remove(zero?,lp) empty? lp => @@ -217938,9 +221312,15 @@ RationalUnivariateRepresentationPackage(R,ls): Exports == Implementation where toReturn := cons([g,lc]$RUR, toReturn) toReturn + rur : (List(Polynomial(R)),Boolean) -> _ + List(Record(complexRoots: SparseUnivariatePolynomial(R),_ + coordinates: List(Polynomial(R)))) rur(lp: List P, univ?: Boolean): List RUR == rur(lp,univ?,false) + rur : List(Polynomial(R)) -> _ + List(Record(complexRoots: SparseUnivariatePolynomial(R),_ + coordinates: List(Polynomial(R)))) rur(lp: List P): List RUR == rur(lp,true) *) @@ -218155,9 +221535,11 @@ RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where (* package POLUTIL *) (* + sturmSequence : ThePols -> List(ThePols) sturmSequence(p) == sylvesterSequence(p,differentiate(p)) + sylvesterSequence : (ThePols,ThePols) -> List(ThePols) sylvesterSequence(p1,p2) == res : List(ThePols) := [p1] while (p2 ^= 0) repeat @@ -218172,12 +221554,14 @@ RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where if TheField has OrderedRing then + boundOfCauchy : ThePols -> TheField boundOfCauchy(p) == c :TheField := inv(leadingCoefficient(p)) l := [ c*term for term in rest(coefficients(p))] null(l) => 1 1 + ("max" / [ abs(t) for t in l ]) + sturmVariationsOf : List(TheField) -> NonNegativeInteger sturmVariationsOf(l) == null(l) => error "POLUTIL: sturmVariationsOf: empty list !" l1 := first(l) @@ -218195,6 +221579,7 @@ RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where zero?(l1) => 1 + lazyVariations(rest(ll),sign(first(ll)),sign(ln)) lazyVariations(ll, sign(l1), sign(ln)) + lazyVariations : (List(TheField),Integer,Integer) -> NonNegativeInteger lazyVariations(l,sl,sh) == zero?(sl) or zero?(sh) => error "POLUTIL: lazyVariations: zero sign!" null(l) => @@ -218480,10 +221865,14 @@ RealSolvePackage(): Exports == Implementation where pi2rfi: P I -> RFI pi2rfi p == p :: RFI + solve : (Polynomial(Fraction(Integer)),Float) -> List(Float) solve(p:P RN,eps:NF) == realRoots(prn2rfi p, eps)$SOLV + solve : (Polynomial(Integer),Float) -> List(Float) solve(p:P I,eps:NF) == realRoots(p::RFI, eps)$SOLV + realSolve : (List(Polynomial(Integer)),List(Symbol),Float) -> _ + List(List(Float)) realSolve(lp,lv,eps) == realRoots(map(pi2rfi, lp)$ListFunctions2(P I,RFI),lv,eps)$SOLV @@ -218837,46 +222226,51 @@ RealZeroPackage(Pol): T == C where (* --Local Functions - makeSqfr: Pol -> Pol - ReZeroSqfr: (Pol) -> isoList - PosZero: (Pol) -> isoList - Zero1: (Pol) -> isoList - transMult: (Integer, Pol) -> Pol - transMultInv: (Integer, Pol) -> Pol - transAdd1: (Pol) -> Pol - invert: (Pol) -> Pol - minus: (Pol) -> Pol - negate: Interval -> Interval - rootBound: (Pol) -> Integer - var: (Pol) -> Integer + negate: Interval -> Interval negate(int : Interval):Interval == [-int.right,-int.left] + midpoint : Record(left: Fraction(Integer),right: Fraction(Integer)) ->_ + Fraction(Integer) midpoint(i : Interval):RN == (1/2)*(i.left + i.right) + midpoints : List(Record(left: Fraction(Integer),_ + right: Fraction(Integer))) -> List(Fraction(Integer)) midpoints(li : isoList) : List RN == [midpoint x for x in li] + makeSqfr: Pol -> Pol makeSqfr(F : Pol):Pol == sqfr := squareFree F F := */[s.factor for s in factors(sqfr)] + realZeros : Pol -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(F : Pol) == ReZeroSqfr makeSqfr F + realZeros : (Pol,Fraction(Integer)) -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(F : Pol, rn : RN) == F := makeSqfr F [refine(F,int,rn) for int in ReZeroSqfr(F)] + realZeros : (Pol,Record(left: Fraction(Integer),_ + right: Fraction(Integer))) -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(F : Pol, bounds : Interval) == F := makeSqfr F [rint::Interval for int in ReZeroSqfr(F) | (rint:=refine(F,int,bounds)) case Interval] + realZeros : (Pol,Record(left: Fraction(Integer),_ + right: Fraction(Integer)),Fraction(Integer)) -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(F : Pol, bounds : Interval, rn : RN) == F := makeSqfr F [refine(F,int,rn) for int in realZeros(F,bounds)] + ReZeroSqfr: (Pol) -> isoList ReZeroSqfr(F : Pol) == F = 0 => error "ReZeroSqfr: zero polynomial" L : isoList := [] @@ -218890,16 +222284,17 @@ RealZeroPackage(Pol): T == C where K : isoList := PosZero(F) append(append(J, L), K) + PosZero: (Pol) -> isoList PosZero(F : Pol) == --F is square free, primitive --and F(0) ^= 0; returns isoList for positive --roots of F - b : Integer := rootBound(F) F := transMult(b,F) L : isoList := Zero1(F) int : Interval L := [[b*int.left, b*int.right]$Interval for int in L] + Zero1: (Pol) -> isoList Zero1(F : Pol) == --returns isoList for roots of F in (0,1) J : isoList K : isoList @@ -218925,6 +222320,7 @@ RealZeroPackage(Pol): T == C where for int in Zero1(G)] append(append(J, L), K) + rootBound: (Pol) -> Integer rootBound(F : Pol) == --returns power of 2 that is a bound --for the positive roots of F if leadingCoefficient(F) < 0 then F := -F @@ -218939,6 +222335,7 @@ RealZeroPackage(Pol): T == C where b := 2 * b b + transMult: (Integer, Pol) -> Pol transMult(c : Integer, F : Pol) == --computes Pol G such that G(x) = F(c*x) G : Pol := 0 @@ -218948,6 +222345,7 @@ RealZeroPackage(Pol): T == C where F := reductum(F) G + transMultInv: (Integer, Pol) -> Pol transMultInv(c : Integer, F : Pol) == --computes Pol G such that G(x) = (c**n) * F(x/c) d := degree(F) @@ -218960,6 +222358,7 @@ RealZeroPackage(Pol): T == C where d := n G + transAdd1: (Pol) -> Pol transAdd1(F : Pol) == --computes Pol G such that G(x) = F(x+1) n := degree F @@ -218972,7 +222371,7 @@ RealZeroPackage(Pol): T == C where ans := ans + monomial(qelt(v,(i+1)),i) ans - + minus: (Pol) -> Pol minus(F : Pol) == --computes Pol G such that G(x) = F(-x) G : Pol := 0 @@ -218986,6 +222385,7 @@ RealZeroPackage(Pol): T == C where F := reductum(F) G + invert: (Pol) -> Pol invert(F : Pol) == --computes Pol G such that G(x) = (x**n) * F(1/x) G : Pol := 0 @@ -218996,6 +222396,7 @@ RealZeroPackage(Pol): T == C where F := reductum(F) G + var: (Pol) -> Integer var(F : Pol) == --number of sign variations in coefs of F i : Integer := 0 LastCoef : Boolean @@ -219008,6 +222409,9 @@ RealZeroPackage(Pol): T == C where LastCoef := next i + refine : (Pol,Record(left: Fraction(Integer),right: Fraction(Integer)),_ + Record(left: Fraction(Integer),right: Fraction(Integer))) -> _ + Union(Record(left: Fraction(Integer),right: Fraction(Integer)),"failed") refine(F : Pol, int : Interval, bounds : Interval) == lseg := min(int.right,bounds.right) - max(int.left,bounds.left) lseg < 0 => "failed" @@ -219020,6 +222424,9 @@ RealZeroPackage(Pol): T == C where lseg = int.right - int.left => int refine(F, refine(F, int, lseg), bounds) + refine: (Pol,Record(left: Fraction(Integer),right: Fraction(Integer)),_ + Fraction(Integer)) -> _ + Record(left: Fraction(Integer),right: Fraction(Integer)) refine(F : Pol, int : Interval, eps : RN) == a := int.left b := int.right @@ -219206,25 +222613,40 @@ RealZeroPackageQ(Pol): T == C where import RealZeroPackage SparseUnivariatePolynomial Integer convert2PolInt: Pol -> SparseUnivariatePolynomial Integer - convert2PolInt(f : Pol) == pden:I :=lcm([denom c for c in coefficients f]) map(numer,pden * f)_ $UnivariatePolynomialCategoryFunctions2(RN,Pol,I,SUP I) + realZeros : Pol -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(f : Pol) == realZeros(convert2PolInt f) + realZeros : (Pol,Fraction(Integer)) -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(f : Pol, rn : RN) == realZeros(convert2PolInt f, rn) + realZeros : (Pol,Record(left: Fraction(Integer),_ + right: Fraction(Integer))) -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(f : Pol, bounds : Interval) == realZeros(convert2PolInt f, bounds) + realZeros : (Pol,Record(left: Fraction(Integer),_ + right: Fraction(Integer)),Fraction(Integer)) -> _ + List(Record(left: Fraction(Integer),right: Fraction(Integer))) realZeros(f : Pol, bounds : Interval, rn : RN) == realZeros(convert2PolInt f, bounds, rn) + refine : (Pol,Record(left: Fraction(Integer),right: Fraction(Integer)),_ + Fraction(Integer)) -> _ + Record(left: Fraction(Integer),right: Fraction(Integer)) refine(f : Pol, int : Interval, eps : RN) == refine(convert2PolInt f, int, eps) + refine : (Pol,Record(left: Fraction(Integer),right: Fraction(Integer)),_ + Record(left: Fraction(Integer),right: Fraction(Integer))) -> _ + Union(Record(left: Fraction(Integer),right: Fraction(Integer)),"failed") refine(f : Pol, int : Interval, bounds : Interval) == refine(convert2PolInt f, int, bounds) @@ -219348,6 +222770,7 @@ RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ minc ==> minColIndex maxc ==> maxColIndex + map : ((R1 -> R2),M1) -> M2 map(f,mat) == ans : M2 := new(m,n,0)$Matrix(R2) pretend M2 for i in minr(mat)..maxr(mat) for k in minr(ans)..maxr(ans) repeat @@ -219355,6 +222778,7 @@ RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ qsetelt_!(ans pretend Matrix R2,k,l,f qelt(mat,i,j)) ans + reduce : (((R1,R2) -> R2),M1,R2) -> R2 reduce(f,mat,ident) == s := ident for i in minr(mat)..maxr(mat) repeat @@ -219925,7 +223349,6 @@ getOrder returns the maximum derivative of op occurring in f. ddADE l == op := operatorName l values := reverse l - vals: List OutputForm := cons(eval(eqAsF l, dummyAsF l, displayVariable l)::OutputForm = _ 0::OutputForm, @@ -219934,7 +223357,6 @@ getOrder returns the maximum derivative of op occurring in f. (values.(i+1))::OutputForm * _ factorial(box(i::R::F)$F)::OutputForm _ for i in 0..min(4,#values-5)]) - bracket(hconcat([bracket((displayVariable l)::OutputForm ** _ (operatorArgument l)::OutputForm), (op(displayVariable l))::OutputForm, ": ", @@ -220052,16 +223474,15 @@ ReducedDivisor(F1, UP, UPUP, R, F2): Exports == Implementation where (* package RDIV *) (* - algOrder : (FD, UPUP, F1 -> F2) -> N - rootOrder: (FD, UP, N, F1 -> F2) -> N - -- pp is not necessarily monic + order : (FiniteDivisor(F1,UP,UPUP,R),UPUP,(F1 -> F2)) -> NonNegativeInteger order(d, pp, f) == (r := retractIfCan(reductum pp)@Union(Fraction UP, "failed")) case "failed" => algOrder(d, pp, f) rootOrder(d, - retract(r::Fraction(UP) / leadingCoefficient pp)@UP, degree pp, f) + algOrder : (FD, UPUP, F1 -> F2) -> N algOrder(d, modulus, reduce) == redmod := map(reduce, modulus)$MultipleMap(F1,UP,UPUP,F2,UP2,UPUP2) curve := AlgebraicFunctionField(F2, UP2, UPUP2, redmod) @@ -220069,6 +223490,7 @@ ReducedDivisor(F1, UP, UPUP, R, F2): Exports == Implementation where d)$FiniteDivisorFunctions2(F1,UP,UPUP,R,F2,UP2,UPUP2,curve) )$FindOrderFinite(F2, UP2, UPUP2, curve) + rootOrder: (FD, UP, N, F1 -> F2) -> N rootOrder(d, radicand, n, reduce) == redrad := map(reduce, radicand)$UnivariatePolynomialCategoryFunctions2(F1,UP,F2,UP2) @@ -220196,11 +223618,10 @@ ReduceLODE(F, L, UP, A, LO): Exports == Implementation where (* package ODERED *) (* - matF2L: Matrix F -> M - diff := D()$L -- coerces a matrix of elements of F into a matrix of (order 0) L.O.D.O's + matF2L: Matrix F -> M matF2L m == map((f1:F):L+->f1::L, m)$MatrixCategoryFunctions2(F, V, V, Matrix F, L, Vector L, Vector L, M) @@ -220209,6 +223630,7 @@ ReduceLODE(F, L, UP, A, LO): Exports == Implementation where -- "The Risch Differential Equation on an Algebraic Curve", M. Bronstein, -- in 'Proceedings of ISSAC '91', Bonn, BRD, ACM Press, -- pp.241-246, July 1991. + reduceLODE : (LO,A) -> Record(mat: Matrix(L),vec: Vector(F)) reduceLODE(l, g) == n := rank()$A -- md is the basic differential matrix (D x I + Dy) @@ -220350,21 +223772,22 @@ ReductionOfOrder(F, L): Exports == Impl where (* package REDORDER *) (* - ithcoef : (L, Z, A) -> F - locals : (A, Z, Z) -> F - localbinom: (Z, Z) -> Z - diff := D()$L + localbinom: (Z, Z) -> Z localbinom(j, i) == (j > i => binomial(j, i+1); 0) + + locals : (A, Z, Z) -> F locals(s, j, i) == (j > i => qelt(s, j - i - 1); 0) + ReduceOrder : (L,List(F)) -> Record(eq: L,op: List(F)) ReduceOrder(l:L, sols:List F) == empty? sols => [l, empty()] neweq := ReduceOrder(l, sol := first sols) rec := ReduceOrder(neweq, [diff(s / sol) for s in rest sols]) [rec.eq, concat_!(rec.op, sol)] + ithcoef : (L, Z, A) -> F ithcoef(eq, i, s) == ans:F := 0 while eq ^= 0 repeat @@ -220373,6 +223796,7 @@ ReductionOfOrder(F, L): Exports == Impl where eq := reductum eq ans + ReduceOrder : (L,F) -> L ReduceOrder(eq:L, sol:F) == s:A := new(n := degree eq, 0) -- will contain derivatives of sol si := sol -- will run through the derivatives @@ -220766,15 +224190,19 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where (* package RSDCMPK *) (* + KrullNumber : (List(P),List(TS)) -> NonNegativeInteger KrullNumber(lp: LP, lts: Split): N == ln: List N := [#(ts) for ts in lts] n := #lp + reduce(max,ln) + numberOfVariables : (List(P),List(TS)) -> NonNegativeInteger numberOfVariables(lp: LP, lts: Split): N == lv: List V := variables([lp]$PS) for ts in lts repeat lv := concat(variables(ts), lv) # removeDuplicates(lv) + algebraicDecompose : (P,TS,Boolean) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) algebraicDecompose(p: P, ts: TS, clos?: B):_ Record(done: Split, todo: List LpWT) == ground? p => @@ -220810,6 +224238,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where llpwt := cons([[f,p],vs]$LpWT, llpwt) [lts,llpwt] + transcendentalDecompose : (P,TS,NonNegativeInteger) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) transcendentalDecompose(p: P, ts: TS,bound: N):_ Record(done: Split, todo: List LpWT) == lts: Split @@ -220821,17 +224251,23 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where llpwt: List LpWT := [] [lts,llpwt] + transcendentalDecompose : (P,TS) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) transcendentalDecompose(p: P, ts: TS):_ Record(done: Split, todo: List LpWT) == lts: Split:= augment(p,ts) llpwt: List LpWT := [] [lts,llpwt] + internalDecompose : (P,TS,NonNegativeInteger,Boolean) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) internalDecompose(p: P, ts: TS,bound: N,clos?:B):_ Record(done: Split, todo: List LpWT) == clos? => internalDecompose(p,ts,bound) internalDecompose(p,ts) + internalDecompose : (P,TS,NonNegativeInteger) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) internalDecompose(p: P, ts: TS,bound: N):_ Record(done: Split, todo: List LpWT) == -- ASSUME p not constant @@ -220867,6 +224303,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) [lts,llpwt] + internalDecompose : (P,TS) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) internalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == -- ASSUME p not constant llpwt: List LpWT := [] @@ -220901,14 +224339,18 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) [lts,llpwt] + decompose : (List(P),List(TS),Boolean,Boolean) -> List(TS) decompose(lp: LP, lts: Split, clos?: B, info?: B): Split == decompose(lp,lts,false,false,clos?,true,info?) + convert : Record(val: List(P),tower: TS) -> String convert(lpwt: LpWT): String == ls: List String := _ ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ] concat ls + printInfo : (List(Record(val: List(P),tower: TS)),NonNegativeInteger) ->_ + Void printInfo(toSee: List LpWT, n: N): Void == lpwt := first toSee s: String:= concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String] @@ -220921,6 +224363,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where iprint(s)$iprintpack void() + decompose: (List(P),List(TS),Boolean,Boolean,Boolean,Boolean,Boolean) ->_ + List(TS) decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, _ rem?: B, info?: B): Split == -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts @@ -220953,6 +224397,9 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where toSee := upDateBranches(lp,toSave,toSee,rsl,bound) removeSuperfluousQuasiComponents(toSave)$quasicomppack + upDateBranches : (List(P),List(TS),List(Record(val: List(P),tower: TS)),_ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))),_ + NonNegativeInteger) -> List(Record(val: List(P),tower: TS)) upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N):_ List LpWT == newBranches: List LpWT := wip.todo @@ -221404,26 +224851,31 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where (* package RSETGCD *) (* + startTableGcd! : (String,String,String) -> Void startTableGcd!(ok: S, ko: S, domainName: S): Void == initTable!()$HGcd printInfo!(ok,ko)$HGcd startStats!(domainName)$HGcd void() + stopTableGcd! : () -> Void stopTableGcd!(): Void == if makingStats?()$HGcd then printStats!()$HGcd clearTable!()$HGcd + startTableInvSet! : (String,String,String) -> Void startTableInvSet!(ok: S, ko: S, domainName: S): Void == initTable!()$HInvSet printInfo!(ok,ko)$HInvSet startStats!(domainName)$HInvSet void() + stopTableInvSet! : () -> Void stopTableInvSet!(): Void == if makingStats?()$HInvSet then printStats!()$HInvSet clearTable!()$HInvSet + toseInvertible? : (P,TS) -> Boolean toseInvertible?(p:P,ts:TS): Boolean == q := primitivePart initiallyReduce(p,ts) zero? q => false @@ -221443,6 +224895,7 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where return false true + toseInvertible? : (P,TS) -> List(Record(val: Boolean,tower: TS)) toseInvertible?(p:P,ts:TS): List BWT == q := primitivePart initiallyReduce(p,ts) zero? q => [[false,ts]$BWT] @@ -221484,6 +224937,7 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where lbwt := concat([bwt for bwt in inv | bwt.val],lbwt) sort((x,y) +-> x.val < y.val,lbwt) + toseInvertibleSet : (P,TS) -> List(TS) toseInvertibleSet(p:P,ts:TS): Split == k: KeyInvSet := [p,ts] e := extractIfCan(k)$HInvSet @@ -221524,6 +224978,7 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where insert!(k,toSave)$HInvSet toSave + toseSquareFreePart : (P,TS) -> List(Record(val: P,tower: TS)) toseSquareFreePart_wip(p:P, ts: TS): List PWT == -- ASSUME p is not constant and mvar(p) > mvar(ts) -- ASSUME init(p) is invertible w.r.t. ts @@ -221544,10 +224999,13 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where lpwt := cons([sfp,us],lpwt) lpwt + toseSquareFreePart_base : (P,TS) -> List PWT toseSquareFreePart_base(p:P, ts: TS): List PWT == [[p,ts]$PWT] + toseSquareFreePart : (P,TS) -> List PWT toseSquareFreePart(p:P, ts: TS): List PWT == toseSquareFreePart_wip(p,ts) + prepareSubResAlgo : (P,P,TS) -> List(Record(val: List(P),tower: TS)) prepareSubResAlgo(p1:P,p2:P,ts:TS): List LpWT == -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2) -- ASSUME init(p1) invertible modulo ts !!! @@ -221576,6 +225034,7 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where toSee := cons([[p1,newp2],bwt.tower]$LpWT,toSee) toSave + integralLastSubResultant : (P,P,TS) -> List(Record(val: P,tower: TS)) integralLastSubResultant(p1:P,p2:P,ts:TS): List PWT == -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2) -- ASSUME p1 and p2 have no algebraic coefficients @@ -221587,6 +225046,8 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where ex case "failed" => [[lsr,ts]$PWT] [[ex::P,ts]$PWT] + internalLastSubResultant : (P,P,TS,Boolean,Boolean) -> _ + List(Record(val: P,tower: TS)) internalLastSubResultant(p1:P,p2:P,ts:TS,b1:B,b2:B): List PWT == -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2) -- if b1 ASSUME init(p2) invertible w.r.t. ts @@ -221611,6 +225072,8 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where insert!(k,toSave)$HGcd toSave + internalLastSubResultant : (List(Record(val: List(P),tower: TS)),V,_ + Boolean) -> List(Record(val: P,tower: TS)) internalLastSubResultant(llpwt: List LpWT,v:V,b2:B): List PWT == toReturn: List PWT := []; toSee: List LpWT; while (not empty? llpwt) repeat @@ -221642,6 +225105,7 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) toReturn + toseLastSubResultant : (P,P,TS) -> List(Record(val: P,tower: TS)) toseLastSubResultant(p1:P,p2:P,ts:TS): List PWT == ground? p1 => error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" @@ -221755,6 +225219,7 @@ RepeatedDoubling(S):Exports ==Implementation where x: S n: PositiveInteger + double : (PositiveInteger,S) -> S double(n,x) == (n = 1) => x odd?(n)$Integer => @@ -221868,6 +225333,7 @@ RepeatedSquaring(S): Exports == Implementation where x: S n: PositiveInteger + expt : (S,PositiveInteger) -> S expt(x, n) == (n = 1) => x odd?(n)$Integer=> x * expt(x*x,shift(n,-1) pretend PositiveInteger) @@ -222268,23 +225734,23 @@ RepresentationPackage1(R): public == private where -- declaration of local functions: - calcCoef : (L I, M I) -> I - -- calcCoef(beta,C) calculates the term - -- |S(beta) gamma S(alpha)| / |S(beta)| - - invContent : L I -> V I - -- invContent(alpha) calculates the weak monoton function f with - -- f : m -> n with invContent alpha. f is stored in the returned - -- vector + -- definition of local functions + -- calcCoef(beta,C) calculates the term + -- |S(beta) gamma S(alpha)| / |S(beta)| + calcCoef : (L I, M I) -> I calcCoef(beta,C) == prod : I := 1 for i in 1..maxIndex beta repeat prod := prod * multinomial(beta(i), entries row(C,i))$ICF prod + -- invContent(alpha) calculates the weak monoton function f with + -- f : m -> n with invContent alpha. f is stored in the returned + -- vector + invContent : L I -> V I invContent(alpha) == n : NNI := (+/alpha)::NNI f : V I := new(n,0) @@ -222301,6 +225767,7 @@ RepresentationPackage1(R): public == private where if R has commutative("*") then + antisymmetricTensors : (Matrix(R),PositiveInteger) -> Matrix(R) antisymmetricTensors ( a : M R , k : PI ) == n : NNI := nrows a k = 1 => a @@ -222325,9 +225792,12 @@ RepresentationPackage1(R): public == private where if R has commutative("*") then + antisymmetricTensors : (List(Matrix(R)),PositiveInteger) -> _ + List(Matrix(R)) antisymmetricTensors(la: L M R, k: PI) == [antisymmetricTensors(ma,k) for ma in la] + symmetricTensors : (Matrix(R),PositiveInteger) -> Matrix(R) symmetricTensors (a : M R, n : PI) == m : NNI := nrows a m ^= ncols a => @@ -222360,9 +225830,11 @@ RepresentationPackage1(R): public == private where -- end of i-loop c + symmetricTensors : (List(Matrix(R)),PositiveInteger) -> List(Matrix(R)) symmetricTensors(la : L M R, k : PI) == [symmetricTensors (ma, k) for ma in la] + tensorProduct : (Matrix(R),Matrix(R)) -> Matrix(R) tensorProduct(a: M R, b: M R) == n : NNI := nrows a m : NNI := nrows b @@ -222380,14 +225852,19 @@ RepresentationPackage1(R): public == private where indexr := indexr + 1 c + tensorProduct : (List(Matrix(R)),List(Matrix(R))) -> List(Matrix(R)) tensorProduct (la: L M R, lb: L M R) == [tensorProduct(la.i, lb.i) for i in 1..maxIndex la] + tensorProduct : Matrix(R) -> Matrix(R) tensorProduct(a : M R) == tensorProduct(a, a) + tensorProduct : List(Matrix(R)) -> List(Matrix(R)) tensorProduct(la : L M R) == tensorProduct(la :: L M R, la :: L M R) + permutationRepresentation : (Permutation(Integer),Integer) -> _ + Matrix(Integer) permutationRepresentation (p : PERM I, n : I) == -- permutations are assumed to permute {1,2,...,n} a : M I := zero(n :: NNI, n :: NNI) @@ -222395,6 +225872,7 @@ RepresentationPackage1(R): public == private where a(eval(p,i)$(PERM I),i) := 1 a + permutationRepresentation : List(Integer) -> Matrix(Integer) permutationRepresentation (p : L I) == -- permutations are assumed to permute {1,2,...,n} n : I := #p @@ -222403,14 +225881,18 @@ RepresentationPackage1(R): public == private where a(p.i,i) := 1 a + permutationRepresentation : (List(Permutation(Integer)),Integer) -> _ + List(Matrix(Integer)) permutationRepresentation(listperm : L PERM I, n : I) == -- permutations are assumed to permute {1,2,...,n} [permutationRepresentation(perm, n) for perm in listperm] + permutationRepresentation : List(List(Integer)) -> List(Matrix(Integer)) permutationRepresentation (listperm : L L I) == -- permutations are assumed to permute {1,2,...,n} [permutationRepresentation perm for perm in listperm] + createGenericMatrix : NonNegativeInteger -> Matrix(Polynomial(R)) createGenericMatrix(m) == res : M P R := new(m,m,0$(P R)) for i in 1..m repeat @@ -223290,6 +226772,7 @@ RepresentationPackage2(R): public == private where error "Sorry, but there are only 6 fingerprints!" x + completeEchelonBasis : Vector(Vector(R)) -> Matrix(R) completeEchelonBasis(basis) == dimensionOfSubmodule : NNI := #basis n : NNI := # basis.1 @@ -223312,6 +226795,7 @@ RepresentationPackage2(R): public == private where completedBasis(j,j) := 1 --put unit vector into basis completedBasis + createRandomElement : (List(Matrix(R)),Matrix(R)) -> Matrix(R) createRandomElement(aG,algElt) == numberOfGenerators : NNI := #aG -- randomIndex := randnum numberOfGenerators @@ -223323,6 +226807,7 @@ RepresentationPackage2(R): public == private where if R has EuclideanDomain then + cyclicSubmodule : (List(Matrix(R)),Vector(R)) -> Vector(Vector(R)) cyclicSubmodule (lm : L M R, v : V R) == basis : M R := rowEchelon matrix list entries v -- normalizing the vector @@ -223349,6 +226834,7 @@ RepresentationPackage2(R): public == private where furtherElts := rest furtherElts vector [row(basis, i) for i in 1..maxRowIndex basis] + standardBasisOfCyclicSubmodule : (List(Matrix(R)),Vector(R)) -> Matrix(R) standardBasisOfCyclicSubmodule (lm : L M R, v : V R) == dim : NNI := #v standardBasis : L L R := list(entries v) @@ -223466,12 +226952,16 @@ RepresentationPackage2(R): public == private where -- exported functions for FiniteField-s. + areEquivalent? : (List(Matrix(R)),List(Matrix(R))) -> Matrix(R) areEquivalent? (aG0, aG1) == areEquivalent? (aG0, aG1, true, 25) + areEquivalent? : (List(Matrix(R)),List(Matrix(R)),Integer) -> Matrix(R) areEquivalent? (aG0, aG1, numberOfTries) == areEquivalent? (aG0, aG1, true, numberOfTries) + areEquivalent? : (List(Matrix(R)),List(Matrix(R)),Boolean,Integer) -> _ + Matrix(R) areEquivalent? (aG0, aG1, randomelements, numberOfTries) == result : B := false transitionM : M R := zero(1, 1) @@ -223570,8 +227060,10 @@ RepresentationPackage2(R): public == private where messagePrint "Representations are not equivalent." transitionM + isAbsolutelyIrreducible? : List(Matrix(R)) -> Boolean isAbsolutelyIrreducible?(aG) == isAbsolutelyIrreducible?(aG,25) + isAbsolutelyIrreducible? : (List(Matrix(R)),Integer) -> Boolean isAbsolutelyIrreducible?(aG, numberOfTries) == result : B := false numberOfGenerators : NNI := #aG @@ -223620,9 +227112,11 @@ RepresentationPackage2(R): public == private where -- messagePrint "Representation is irreducible." result + split : (List(Matrix(R)),Vector(R)) -> List(List(Matrix(R))) split(algebraGenerators: L M R, vector: V R) == splitInternal(algebraGenerators, vector, true) + split : (List(Matrix(R)),Vector(Vector(R))) -> List(List(Matrix(R))) split(algebraGenerators : L M R, submodule: V V R)== --not zero submodule n : NNI := #submodule.1 -- R-rank of representation module = -- degree of representation @@ -223652,7 +227146,6 @@ RepresentationPackage2(R): public == private where cons(reverse submoduleRepresentation, list( reverse _ factormoduleRepresentation)::(L L M R)) - -- the following is "under" "if R has Field", as there are compiler -- problems with conditinally defined local functions, i.e. it -- doesn't know, that "FiniteField" has "Field". @@ -223661,6 +227154,8 @@ RepresentationPackage2(R): public == private where -- we are scanning through the vectorspaces if (R has Finite) and (R has Field) then + meatAxe : (List(Matrix(R)),Boolean,Integer,Integer) -> _ + List(List(Matrix(R))) meatAxe(algebraGenerators, randomelements, numberOfTries, _ maxTests) == numberOfGenerators : NNI := #algebraGenerators @@ -223747,16 +227242,20 @@ RepresentationPackage2(R): public == private where messagePrint " or consider using an extension field." result + meatAxe : List(Matrix(R)) -> List(List(Matrix(R))) meatAxe (algebraGenerators) == meatAxe(algebraGenerators, false, 25, 7) + meatAxe : (List(Matrix(R)),Boolean) -> List(List(Matrix(R))) meatAxe (algebraGenerators, randomElements?) == randomElements? => meatAxe (algebraGenerators, true, 25, 7) meatAxe(algebraGenerators, false, 6, 7) + meatAxe : (List(Matrix(R)),PositiveInteger) -> List(List(Matrix(R))) meatAxe (algebraGenerators:L M R, numberOfTries:PI) == meatAxe (algebraGenerators, true, numberOfTries, 7) + scanOneDimSubspaces : (List(Vector(R)),Integer) -> Vector(R) scanOneDimSubspaces(basis,n) == -- "dimension" of subspace generated by "basis" dim : NNI := #basis @@ -223870,8 +227369,10 @@ ResolveLatticeCompletion(S: Type): with (* package RESLATC *) (* + coerce : S -> Void coerce(s: S): Void == void() + coerce : Exit -> S coerce(e: Exit): S == error "Bug: Should not be able to obtain value of type Exit" @@ -224000,21 +227501,23 @@ RetractSolvePackage(Q, R): Exports == Implementation where (* package RETSOL *) (* - LEQQ2F : List EQ FQ -> List EQ F - FQ2F : FQ -> F PQ2P : PQ -> P - QIfCan : List P -> Union(List FQ, "failed") - PQIfCan: P -> Union(FQ, "failed") - PQ2P p == map((q1:Q):R +-> q1::R, p)$PolynomialFunctions2(Q, R) + + FQ2F : FQ -> F FQ2F f == PQ2P numer f / PQ2P denom f + + LEQQ2F : List EQ FQ -> List EQ F LEQQ2F l == [equation(FQ2F lhs eq, FQ2F rhs eq) for eq in l] + solveRetract : (List(Polynomial(R)),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solveRetract(lp, lv) == (u := QIfCan lp) case "failed" => solve([p::F for p in lp]$List(F), lv)$SSP(R) [LEQQ2F l for l in solve(u::List(FQ), lv)$SSP(Q)] + QIfCan : List P -> Union(List FQ, "failed") QIfCan l == ans:List(FQ) := empty() for p in l repeat @@ -224022,6 +227525,7 @@ RetractSolvePackage(Q, R): Exports == Implementation where ans := concat(u::FQ, ans) ans + PQIfCan: P -> Union(FQ, "failed") PQIfCan p == (u := mainVariable p) case "failed" => (r := retractIfCan(ground p)@Union(Q,"failed")) case Q => r::Q::PQ::FQ @@ -224225,15 +227729,17 @@ RootsFindingPackage(K):P==T where (* package RFP *) (* - -- signature of local function - zeroOfLinearPoly: SUP(K) -> K + -- local variable listOfAllZeros:List(K):=empty() + foundZeroes : () -> List(K) foundZeroes==listOfAllZeros if K has PseudoAlgebraicClosureOfPerfectFieldCategory then + distinguishedRootsOf : (SparseUnivariatePolynomial(K),K) -> _ + Record(zeros: List(K),extDegree: Integer) distinguishedRootsOf(polyZero, theExtension) == --PRECONDITION: setExtension! is called in K to set the extension to --the extension of factorization @@ -224245,6 +227751,8 @@ RootsFindingPackage(K):P==T where if K has FiniteFieldCategory and _ ^(K has PseudoAlgebraicClosureOfFiniteFieldCategory) then + distinguishedRootsOf : (SparseUnivariatePolynomial(K),K) -> _ + Record(zeros: List(K),extDegree: Integer) distinguishedRootsOf(polyZero,dummy)== zero?(polyZero) => [empty(),0] factorpolyZero:=factor(polyZero)$FFFACTSE(K,SUP(K)) @@ -224259,6 +227767,8 @@ RootsFindingPackage(K):P==T where if K has QuotientFieldCategory( Integer ) and _ ^(K has PseudoAlgebraicClosureOfRationalNumberCategory) then + distinguishedRootsOf : (SparseUnivariatePolynomial(K),K) -> _ + Record(zeros: List(K),extDegree: Integer) distinguishedRootsOf(polyZero,dummy)== zero?(polyZero) => [empty(),0] factorpolyZero:=factor(polyZero)$RationalFactorize( SUP(K) ) @@ -224270,6 +227780,8 @@ RootsFindingPackage(K):P==T where [zeroOfLinearPoly(poly) for poly in listFact | one?(degree(poly))] [listOfZeros,degExt] + distinguishedCommonRootsOf : (List(SparseUnivariatePolynomial(K)),K) -> _ + Record(zeros: List(K),extDegree: Integer) distinguishedCommonRootsOf(listOfPoly1,theExtension)== listOfPoly:List(SUP(K)):=[pol for pol in listOfPoly1 | ^zero?(pol)] empty?(listOfPoly) ==> [empty(),0] @@ -224278,12 +227790,14 @@ RootsFindingPackage(K):P==T where degExt:INT:= reco.extDegree [listOfZeros,degExt] + zeroOfLinearPoly: SUP(K) -> K zeroOfLinearPoly(pol)== ^one?(degree(pol)) => error "the polynomial is not linear" listCoef:List(K):=coefficients(pol) one?(#listCoef) => 0 - last(listCoef) / first(listCoef) + setFoundZeroes : List(K) -> List(K) setFoundZeroes(setlist)== oldListOfAllZeroes:= copy listOfAllZeros listOfAllZeros:=setlist @@ -224374,6 +227888,7 @@ SAERationalFunctionAlgFactor(UP, SAE, UPA): Exports == Implementation where (* package SAERFFC *) (* + factor : UPA -> Factored(UPA) factor q == factor(q, factor$RationalFunctionFactor(UP) )$InnerAlgFactor(Fraction Polynomial Integer, UP, SAE, UPA) @@ -224469,6 +227984,7 @@ ScriptFormulaFormat1(S : SetCategory): public == private where import ScriptFormulaFormat() + coerce : S -> ScriptFormulaFormat coerce(s : S): ScriptFormulaFormat == coerce(s :: OutputForm)$ScriptFormulaFormat @@ -224548,6 +228064,7 @@ SegmentBindingFunctions2(R:Type, S:Type): with (* package SEGBIND2 *) (* + map : ((R -> S),SegmentBinding(R)) -> SegmentBinding(S) map(f, b) == equation(variable b, map(f, segment b)$SegmentFunctions2(R, S)) @@ -224652,11 +228169,13 @@ SegmentFunctions2(R:Type, S:Type): public == private where (* package SEG2 *) (* + map : ((R -> S),Segment(R)) -> Segment(S) map(f : R->S, r : Segment R): Segment S == SEGMENT(f lo r,f hi r)$Segment(S) if R has OrderedRing then + map : ((R -> S),Segment(R)) -> List(S) map(f : R->S, r : Segment R): List S == lr := nil()$List(S) l := lo r @@ -224755,6 +228274,7 @@ SimpleAlgebraicExtensionAlgFactor(UP,SAE,UPA):Exports==Implementation where (* package SAEFACT *) (* + factor : UPA -> Factored(UPA) factor q == factor(q, factor$RationalFactorize(UP) )$InnerAlgFactor(Fraction Integer, UP, SAE, UPA) @@ -224834,6 +228354,7 @@ SimplifyAlgebraicNumberConvertPackage(): with (* package SIMPAN *) (* + simplify : AlgebraicNumber -> Expression(Integer) simplify(a:AlgebraicNumber) == simplify(a::Expression(Integer))$_ TranscendentalManipulations(Integer, Expression Integer) @@ -225134,17 +228655,9 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where Col2 ==> Vector QF M2 ==> Matrix QF - ------ Local Functions ----- - elRow1 : (M,I,I) -> M - elRow2 : (M,R,I,I) -> M - elColumn2 : (M,R,I,I) -> M - isDiagonal? : M -> Boolean - ijDivide : (SmithForm ,I,I) -> SmithForm - lastStep : SmithForm -> SmithForm - test1 : (M,Col,NNI) -> Union(NNI, "failed") - test2 : (M, Col,NNI,NNI) -> Union( Col, "failed") -- inconsistent system : case 0 = c -- + test1 : (M,Col,NNI) -> Union(NNI, "failed") test1(sm:M,b:Col,m1 : NNI) : Union(NNI , "failed") == km:=m1 while zero? sm(km,km) repeat @@ -225154,6 +228667,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where if Col has shallowlyMutable then + test2 : (M, Col,NNI,NNI) -> Union( Col, "failed") test2(sm : M ,b : Col, n1:NNI,dk:NNI) : Union( Col, "failed") == -- test divisibility -- sol:Col := new(n1,0) @@ -225163,6 +228677,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where sol -- test if the matrix is diagonal or pseudo-diagonal -- + isDiagonal? : M -> Boolean isDiagonal?(m : M) : Boolean == m1:= nrows m n1:= ncols m @@ -225172,6 +228687,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where true -- elementary operation of first kind: exchange two rows -- + elRow1 : (M,I,I) -> M elRow1(m:M,i:I,j:I) : M == vec:=row(m,i) setRow!(m,i,row(m,j)) @@ -225180,6 +228696,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where -- elementary operation of second kind: add to row i-- -- a*row j (i^=j) -- + elRow2 : (M,R,I,I) -> M elRow2(m : M,a:R,i:I,j:I) : M == vec:= map(x +-> a*x,row(m,j)) vec:=map("+",row(m,i),vec) @@ -225187,6 +228704,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where m -- elementary operation of second kind: add to column i -- -- a*column j (i^=j) -- + elColumn2 : (M,R,I,I) -> M elColumn2(m : M,a:R,i:I,j:I) : M == vec:= map(x +-> a*x,column(m,j)) vec:=map("+",column(m,i),vec) @@ -225195,6 +228713,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where -- modify SmithForm in such a way that the term m(i,i) -- -- divides the term m(j,j). m is diagonal -- + ijDivide : (SmithForm ,I,I) -> SmithForm ijDivide(sf : SmithForm , i : I,j : I) : SmithForm == m:=sf.Smith mii:=m(i,i) @@ -225221,6 +228740,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where -- given a diagonal matrix compute its Smith form -- + lastStep : SmithForm -> SmithForm lastStep(sf : SmithForm) : SmithForm == m:=sf.Smith m1:=min(nrows m,ncols m) @@ -225232,6 +228752,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where -- given m and t row-equivalent matrices, with t in upper triangular -- -- form compute the matrix u such that u*m=t -- + findEqMat : (M,M) -> Record(Hermite : M, eqMat : M) findEqMat(m : M,t : M) : Record(Hermite : M, eqMat : M) == m1:=nrows m n1:=ncols m @@ -225261,14 +228782,18 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where [t,map(retract$QF,(inverse u1)::M2)$MATCAT2] --- Hermite normal form of m --- + hermite : M -> M hermite(m:M) : M == rowEchelon m -- Hermite normal form and equivalence matrix -- + completeHermite : M -> Record(Hermite: M,eqMat: M) completeHermite(m : M) : Record(Hermite : M, eqMat : M) == findEqMat(m,rowEchelon m) + smith : M -> M smith(m : M) : M == completeSmith(m).Smith + completeSmith : M -> Record(Smith: M,leftEqMat: M,rightEqMat: M) completeSmith(m : M) : Record(Smith : M, leftEqMat : M, rightEqMat : M) == cm1:=completeHermite m leftm:=cm1.eqMat @@ -225289,6 +228814,8 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where [transpose m, cm2.leftEqMat, cm2.rightEqMat] -- Find the solution in R of the linear system mX = b -- + diophantineSystem : (M,Col) -> _ + Record(particular: Union(Col,"failed"),basis: List(Col)) diophantineSystem(m : M, b : Col) : Both == sf:=completeSmith m sm:=sf.Smith @@ -225454,22 +228981,23 @@ SortedCache(S:CachableSet): Exports == Implementation where (* package SCACHE *) (* - shiftCache : (List S, N) -> Void - insertInCache: (List S, List S, S, N) -> S - cach := [nil()]$Record(cche:List S) + cache : () -> List(S) cache() == cach.cche + shiftCache : (List S, N) -> Void shiftCache(l, n) == for x in l repeat setPosition(x, n + position x) void + clearCache : () -> Void clearCache() == for x in cache repeat setPosition(x, 0) cach.cche := nil() void + enterInCache : (S,(S -> Boolean)) -> S enterInCache(x:S, equal?:S -> Boolean) == scan := cache() while not null scan repeat @@ -225481,6 +229009,7 @@ SortedCache(S:CachableSet): Exports == Implementation where cach.cche := concat(cache(), x) x + enterInCache : (S,((S,S) -> Integer)) -> S enterInCache(x:S, triage:(S, S) -> Integer) == scan := cache() pos:N:= 0 @@ -225495,6 +229024,7 @@ SortedCache(S:CachableSet): Exports == Implementation where cach.cche := concat(cache(), x) x + insertInCache: (List S, List S, S, N) -> S insertInCache(before, after, x, pos) == if ((pos+1) = position first after) then shiftCache(after, DIFF) setPosition(x, pos + (((position first after) - pos)::N quo 2)) @@ -225628,6 +229158,7 @@ SortPackage(S,A) : Exports == Implementation where (* package SORTPAK *) (* + bubbleSort! : (A,((S,S) -> Boolean)) -> A bubbleSort_!(m,f) == n := #m for i in 1..(n-1) repeat @@ -225635,6 +229166,7 @@ SortPackage(S,A) : Exports == Implementation where if f(m.j,m.(j-1)) then swap_!(m,j,j-1) m + insertionSort! : (A,((S,S) -> Boolean)) -> A insertionSort_!(m,f) == for i in 2..#m repeat j := i @@ -225645,12 +229177,15 @@ SortPackage(S,A) : Exports == Implementation where if S has OrderedSet then + bubbleSort! : A -> A if S has ORDSET bubbleSort_!(m) == bubbleSort_!(m,_<$S) + insertionSort! : A -> A if S has ORDSET insertionSort_!(m) == insertionSort_!(m,_<$S) if A has UnaryRecursiveAggregate(S) then + bubbleSort! : (A,((S,S) -> Boolean)) -> A bubbleSort_!(m,fn) == empty? m => m l := m @@ -225748,6 +229283,8 @@ SparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with (* package SUP2 *) (* + map : ((R -> S),SparseUnivariatePolynomial(R)) -> _ + SparseUnivariatePolynomial(S) map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R, SparseUnivariatePolynomial R, S, SparseUnivariatePolynomial S) @@ -225904,31 +229441,38 @@ SpecialOutputPackage: public == private where juxtaposeTerms: List OutputForm -> OutputForm juxtaposeTerms l == blankSeparate l + outputAsFortran : OutputForm -> Void outputAsFortran e == dispfortexp$Lisp e void()$Void + outputAsFortran : (String,OutputForm) -> Void outputAsFortran(var,e) == e := var::Symbol::OutputForm = e dispfortexp(e)$Lisp void()$Void + outputAsFortran : List(OutputForm) -> Void outputAsFortran l == dispfortexp$Lisp juxtaposeTerms l void()$Void + outputAsScript : OutputForm -> Void outputAsScript e == formulaFormat$Lisp e void()$Void + outputAsScript : List(OutputForm) -> Void outputAsScript l == formulaFormat$Lisp juxtaposeTerms l void()$Void + outputAsTex : OutputForm -> Void outputAsTex e == texFormat$Lisp e void()$Void + outputAsTex : List(OutputForm) -> Void outputAsTex l == texFormat$Lisp juxtaposeTerms l void()$Void @@ -226421,6 +229965,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where (* package SFQCMPK *) (* + squareFreeFactors : LP -> LP squareFreeFactors(lp: LP): LP == lsflp: LP := [] for p in lp repeat @@ -226428,16 +229973,19 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where lsflp := concat(lsfp,lsflp) sort(infRittWu?,removeDuplicates lsflp) + startTable! : (String,String,String) -> Void startTable!(ok: S, ko: S, domainName: S): Void == initTable!()$H if (not empty? ok) and (not empty? ko) then printInfo!(ok,ko)$H if (not empty? domainName) then startStats!(domainName)$H void() + stopTable! : () -> Void stopTable!(): Void == if makingStats?()$H then printStats!()$H clearTable!()$H + supDimElseRittWu? : (TS,TS) -> Boolean supDimElseRittWu? (ts:TS,us:TS): Boolean == #ts < #us => true #ts > #us => false @@ -226449,10 +229997,12 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where lp2 := rest lp2 not empty? lp1 + algebraicSort : List(TS) -> List(TS) algebraicSort (lts:Split): Split == lts := removeDuplicates lts sort(supDimElseRittWu?,lts) + moreAlgebraic? : (TS,TS) -> Boolean moreAlgebraic?(ts:TS,us:TS): Boolean == empty? ts => empty? us empty? us => true @@ -226461,6 +230011,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where not algebraic?(mvar(p),ts) => return false true + subTriSet? : (TS,TS) -> Boolean subTriSet?(ts:TS,us:TS): Boolean == empty? ts => true empty? us => false @@ -226469,6 +230020,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where first(ts)::P = first(us)::P => subTriSet?(rest(ts)::TS,rest(us)::TS) false + internalSubPolSet? : (List(P),List(P)) -> Boolean internalSubPolSet?(lp1: LP, lp2: LP): Boolean == empty? lp1 => true empty? lp2 => false @@ -226477,16 +230029,19 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where infRittWu?(first lp1, first lp2) => false internalSubPolSet?(lp1, rest lp2) + subPolSet? : (List(P),List(P)) -> Boolean subPolSet?(lp1: LP, lp2: LP): Boolean == lp1 := sort(infRittWu?, lp1) lp2 := sort(infRittWu?, lp2) internalSubPolSet?(lp1,lp2) + infRittWu? : (List(P),List(P)) -> Boolean infRittWu?(lp1: LP, lp2: LP): Boolean == lp1 := sort(infRittWu?, lp1) lp2 := sort(infRittWu?, lp2) internalInfRittWu?(lp1,lp2) + internalInfRittWu? : (List(P),List(P)) -> Boolean internalInfRittWu?(lp1: LP, lp2: LP): Boolean == empty? lp1 => not empty? lp2 empty? lp2 => false @@ -226494,6 +230049,8 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where infRittWu?(first lp2, first lp1)$P => false infRittWu?(rest lp1, rest lp2)$$ + subCase? : (Record(val: List(P),tower: TS),_ + Record(val: List(P),tower: TS)) -> Boolean subCase? (lpwt1:LpWT,lpwt2:LpWT): Boolean == -- ASSUME lpwt.{1,2}.val is sorted w.r.t. infRittWu? not internalSubPolSet?(lpwt2.val, lpwt1.val) => false @@ -226502,6 +230059,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where if TS has SquareFreeRegularTriangularSetCategory(R,E,V,P) then + internalSubQuasiComponent? : (TS,TS) -> Union(Boolean,"failed") internalSubQuasiComponent?(ts:TS,us:TS): Union(Boolean,"failed") == subTriSet?(us,ts) => true not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed") @@ -226520,6 +230078,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where else + internalSubQuasiComponent? : (TS,TS) -> Union(Boolean,"failed") internalSubQuasiComponent?(ts:TS,us:TS): Union(Boolean,"failed") == subTriSet?(us,ts) => true not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed") @@ -226531,6 +230090,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where return("failed"::Union(Boolean,"failed")) true::Union(Boolean,"failed") + subQuasiComponent? : (TS,TS) -> Boolean subQuasiComponent?(ts:TS,us:TS): Boolean == k: Key := [ts, us] e := extractIfCan(k)$H @@ -226540,11 +230100,14 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where insert!(k,b)$H b + subQuasiComponent? : (TS,List(TS)) -> Boolean subQuasiComponent?(ts:TS,lus:Split): Boolean == for us in lus repeat subQuasiComponent?(ts,us)@B => return true false + removeSuperfluousCases : List(Record(val: List(P),tower: TS)) -> _ + List(Record(val: List(P),tower: TS)) removeSuperfluousCases (cases:List LpWT) == #cases < 2 => cases toSee := @@ -226580,6 +230143,7 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where toSee := reverse toSave maxcases + removeSuperfluousQuasiComponents : List(TS) -> List(TS) removeSuperfluousQuasiComponents(lts: Split): Split == lts := removeDuplicates lts #lts < 2 => lts @@ -226613,9 +230177,12 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where toSee := reverse toSave algebraicSort maxlts + removeAssociates : LP -> LP removeAssociates (lp:LP):LP == removeDuplicates [primitivePart(p) for p in lp] + branchIfCan : (List(P),TS,List(P),Boolean,Boolean,Boolean,Boolean,_ + Boolean) -> Union(Record(eq: List(P),tower: TS,ineq: List(P)),"failed") branchIfCan(leq: LP,ts: TS,lineq: LP, b1:B,b2:B,b3:B,b4:B,b5:B):UBF == -- ASSUME pols in leq are squarefree and mainly primitive -- if b1 then CLEAN UP leq @@ -226664,6 +230231,8 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where leq := sort(infRittWu?, removeDuplicates leq) ([leq, ts, lineq]$Branch)::UBF + prepareDecompose : (List(P),List(TS),Boolean,Boolean) -> _ + List(Record(eq: List(P),tower: TS,ineq: List(P))) prepareDecompose(lp: LP, lts: List(TS), b1: B, b2: B): List Branch == -- if b1 then REMOVE REDUNDANT COMPONENTS in lts -- if b2 then SPLIT the input system with squareFree @@ -227076,15 +230645,19 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation (* package SRDCMPK *) (* + KrullNumber : (List(P),List(TS)) -> NonNegativeInteger KrullNumber(lp: LP, lts: Split): N == ln: List N := [#(ts) for ts in lts] n := #lp + reduce(max,ln) + numberOfVariables : (List(P),List(TS)) -> NonNegativeInteger numberOfVariables(lp: LP, lts: Split): N == lv: List V := variables([lp]$PS) for ts in lts repeat lv := concat(variables(ts), lv) # removeDuplicates(lv) + algebraicDecompose : (P,TS) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) algebraicDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == ground? p => error " in algebraicDecompose$REGSET: should never happen !" @@ -227120,6 +230693,8 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation lts := concat(augment(members(ts_v_+),augment(g,us)$TS)$TS,lts) [lts,llpwt] + transcendentalDecompose : (P,TS,NonNegativeInteger) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) transcendentalDecompose(p: P, ts: TS,bound: N): _ Record(done: Split, todo: List LpWT) == lts: Split @@ -227131,17 +230706,23 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation llpwt: List LpWT := [] [lts,llpwt] + transcendentalDecompose : (P,TS) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) transcendentalDecompose(p: P, ts: TS): _ Record(done: Split, todo: List LpWT) == lts: Split:= augment(p,ts)$TS llpwt: List LpWT := [] [lts,llpwt] + internalDecompose : (P,TS,NonNegativeInteger,Boolean) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) internalDecompose(p: P, ts: TS,bound: N,clos?:B): _ Record(done: Split, todo: List LpWT) == clos? => internalDecompose(p,ts,bound) internalDecompose(p,ts) + internalDecompose : (P,TS,NonNegativeInteger) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) internalDecompose(p: P, ts: TS,bound: N): _ Record(done: Split, todo: List LpWT) == -- ASSUME p not constant @@ -227175,6 +230756,8 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) [lts,llpwt] + internalDecompose : (P,TS) -> _ + Record(done: List(TS),todo: List(Record(val: List(P),tower: TS))) internalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == -- ASSUME p not constant llpwt: List LpWT := [] @@ -227207,14 +230790,18 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) [lts,llpwt] + decompose : (List(P),List(TS),Boolean,Boolean) -> List(TS) decompose(lp: LP, lts: Split, clos?: B, info?: B): Split == decompose(lp,lts,false,false,clos?,true,info?) + convert : Record(val: List(P),tower: TS) -> String convert(lpwt: LpWT): String == ls: List String := __ ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ] concat ls + printInfo : (List(Record(val: List(P),tower: TS)),NonNegativeInteger) ->_ + Void printInfo(toSee: List LpWT, n: N): Void == lpwt := first toSee s:String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String] @@ -227227,6 +230814,8 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation iprint(s)$iprintpack void() + decompose : (List(P),List(TS),Boolean,Boolean,Boolean,Boolean,Boolean) ->_ + List(TS) decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, _ rem?: B, info?: B): Split == -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts @@ -227259,6 +230848,9 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation toSee := upDateBranches(lp,toSave,toSee,rsl,bound) removeSuperfluousQuasiComponents(toSave)$quasicomppack + upDateBranches : (List(P),List(TS),List(Record(val: List(P),_ + tower: TS)),Record(done: List(TS),todo: List(Record(val: List(P),_ + tower: TS))),NonNegativeInteger) -> List(Record(val: List(P),tower: TS)) upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N):_ List LpWT == newBranches: List LpWT := wip.todo @@ -227814,26 +231406,31 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation (* package SFRGCD *) (* + startTableGcd! : (String,String,String) -> Void startTableGcd!(ok: S, ko: S, domainName: S): Void == initTable!()$HGcd printInfo!(ok,ko)$HGcd startStats!(domainName)$HGcd void() + stopTableGcd! : () -> Void stopTableGcd!(): Void == if makingStats?()$HGcd then printStats!()$HGcd clearTable!()$HGcd + startTableInvSet! : (String,String,String) -> Void startTableInvSet!(ok: S, ko: S, domainName: S): Void == initTable!()$HInvSet printInfo!(ok,ko)$HInvSet startStats!(domainName)$HInvSet void() + stopTableInvSet! : () -> Void stopTableInvSet!(): Void == if makingStats?()$HInvSet then printStats!()$HInvSet clearTable!()$HInvSet + stoseInvertible? : (P,TS) -> Boolean stoseInvertible?(p:P,ts:TS): Boolean == q := primitivePart initiallyReduce(p,ts) zero? q => false @@ -227853,6 +231450,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation return false true + stosePrepareSubResAlgo : (P,P,TS) -> List(Record(val: List(P),tower: TS)) stosePrepareSubResAlgo(p1:P,p2:P,ts:TS): List LpWT == -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2) -- ASSUME init(p1) invertible modulo ts !!! @@ -227881,6 +231479,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation toSee := cons([[p1,newp2],bwt.tower]$LpWT,toSee) toSave + stoseIntegralLastSubResultant : (P,P,TS) -> List(Record(val: P,tower: TS)) stoseIntegralLastSubResultant(p1:P,p2:P,ts:TS): List PWT == -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2) -- ASSUME p1 and p2 have no algebraic coefficients @@ -227892,6 +231491,8 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation ex case "failed" => [[lsr,ts]$PWT] [[ex::P,ts]$PWT] + stoseInternalLastSubResultant : (P,P,TS,Boolean,Boolean) -> _ + List(Record(val: P,tower: TS)) stoseInternalLastSubResultant(p1:P,p2:P,ts:TS,b1:B,b2:B): List PWT == -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2) -- if b1 ASSUME init(p2) invertible w.r.t. ts @@ -227916,6 +231517,8 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation insert!(k,toSave)$HGcd toSave + stoseInternalLastSubResultant : (List(Record(val: List(P),tower: TS)),_ + V,Boolean) -> List(Record(val: P,tower: TS)) stoseInternalLastSubResultant(llpwt: List LpWT,v:V,b2:B): List PWT == toReturn: List PWT := []; toSee: List LpWT; while (not empty? llpwt) repeat @@ -227950,6 +231553,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) toReturn + stoseLastSubResultant : (P,P,TS) -> List(Record(val: P,tower: TS)) stoseLastSubResultant(p1:P,p2:P,ts:TS): List PWT == ground? p1 => error"in stoseLastSubResultantElseSplit$SFRGCD : bad #1" @@ -227970,6 +231574,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation if odd?(mdeg(p1)) and odd?(mdeg(p2)) then p2 := - p2 stoseInternalLastSubResultant(p1,p2,ts,false,false) + stoseSquareFreePart : (P,TS) -> List(Record(val: P,tower: TS)) stoseSquareFreePart_wip(p:P, ts: TS): List PWT == -- ASSUME p is not constant and mvar(p) > mvar(ts) -- ASSUME init(p) is invertible w.r.t. ts @@ -227990,10 +231595,13 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation lpwt := cons([sfp,us],lpwt) lpwt + stoseSquareFreePart_base : (P,TS) -> List PWT stoseSquareFreePart_base(p:P, ts: TS): List PWT == [[p,ts]$PWT] + stoseSquareFreePart : (P,TS) -> List PWT stoseSquareFreePart(p:P, ts:TS): List PWT == stoseSquareFreePart_wip(p,ts) + stoseInvertible? : (P,TS) -> List(Record(val: Boolean,tower: TS)) stoseInvertible?_sqfreg(p:P,ts:TS): List BWT == --iprint("+")$iprintpack q := primitivePart initiallyReduce(p,ts) @@ -228039,6 +231647,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation lbwt := cons([true, ts_h]$BWT,lbwt) sort((x,y) +-> x.val < y.val,lbwt) + stoseInvertibleSet_sqfreg : (P,TS) -> Split stoseInvertibleSet_sqfreg(p:P,ts:TS): Split == --iprint("*")$iprintpack k: KeyInvSet := [p,ts] @@ -228080,6 +231689,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation insert!(k,toSave)$HInvSet toSave + stoseInvertible?_reg : (P,TS) -> List BWT stoseInvertible?_reg(p:P,ts:TS): List BWT == --iprint("-")$iprintpack q := primitivePart initiallyReduce(p,ts) @@ -228126,6 +231736,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation lbwt := concat([bwt for bwt in inv | bwt.val],lbwt) sort((x,y) +-> x.val < y.val,lbwt) + stoseInvertibleSet_reg : (P,TS) -> Split stoseInvertibleSet_reg(p:P,ts:TS): Split == --iprint("/")$iprintpack k: KeyInvSet := [p,ts] @@ -228172,14 +231783,18 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation if TS has SquareFreeRegularTriangularSetCategory(R,E,V,P) then + stoseInvertible? : (P,TS) -> List(Record(val: Boolean,tower: TS)) stoseInvertible?(p:P,ts:TS): List BWT == stoseInvertible?_sqfreg(p,ts) + stoseInvertibleSet : (P,TS) -> List(TS) stoseInvertibleSet(p:P,ts:TS): Split == stoseInvertibleSet_sqfreg(p,ts) else + stoseInvertible? : (P,TS) -> List(Record(val: Boolean,tower: TS)) stoseInvertible?(p:P,ts:TS): List BWT == stoseInvertible?_reg(p,ts) + stoseInvertibleSet : (P,TS) -> List(TS) stoseInvertibleSet(p:P,ts:TS): Split == stoseInvertibleSet_reg(p,ts) *) @@ -228448,6 +232063,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where rep : M -> REP rep m == m pretend REP + copy! : (Matrix(R),Matrix(R)) -> Matrix(R) copy_!(c,a) == m := nrows a; n := ncols a not((nrows c) = m and (ncols c) = n) => @@ -228459,6 +232075,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where qsetelt_!(cRow,j,qelt(aRow,j)) c + plus! : (Matrix(R),Matrix(R),Matrix(R)) -> Matrix(R) plus_!(c,a,b) == m := nrows a; n := ncols a not((nrows b) = m and (ncols b) = n) => @@ -228472,6 +232089,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where qsetelt_!(cRow,j,qelt(aRow,j) + qelt(bRow,j)) c + minus! : (Matrix(R),Matrix(R)) -> Matrix(R) minus_!(c,a) == m := nrows a; n := ncols a not((nrows c) = m and (ncols c) = n) => @@ -228483,6 +232101,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where qsetelt_!(cRow,j,-qelt(aRow,j)) c + minus! : (Matrix(R),Matrix(R),Matrix(R)) -> Matrix(R) minus_!(c,a,b) == m := nrows a; n := ncols a not((nrows b) = m and (ncols b) = n) => @@ -228496,6 +232115,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where qsetelt_!(cRow,j,qelt(aRow,j) - qelt(bRow,j)) c + leftScalarTimes! : (Matrix(R),R,Matrix(R)) -> Matrix(R) leftScalarTimes_!(c,r,a) == m := nrows a; n := ncols a not((nrows c) = m and (ncols c) = n) => @@ -228507,6 +232127,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where qsetelt_!(cRow,j,r * qelt(aRow,j)) c + rightScalarTimes! : (Matrix(R),Matrix(R),R) -> Matrix(R) rightScalarTimes_!(c,a,r) == m := nrows a; n := ncols a not((nrows c) = m and (ncols c) = n) => @@ -228522,6 +232143,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where copyCol_!(bCol,bb,j,n1) == for i in 0..n1 repeat qsetelt_!(bCol,i,qelt(qelt(bb,i),j)) + times! : (Matrix(R),Matrix(R),Matrix(R)) -> Matrix(R) times_!(c,a,b) == m := nrows a; n := ncols a; p := ncols b not((nrows b) = n and (nrows c) = m and (ncols c) = p) => @@ -228539,6 +232161,8 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where qsetelt_!(cRow,j,sum) c + power! : (Matrix(R),Matrix(R),Matrix(R),Matrix(R),NonNegativeInteger) ->_ + Matrix(R) power_!(a,b,c,m,p) == mm := nrows a; nn := ncols a not(mm = nn) => @@ -228563,6 +232187,7 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where times_!(c,b,b) copy_!(b,c) + ?**? : (Matrix(R),NonNegativeInteger) -> Matrix(R) m ** n == not square? m => error "**: matrix must be square" a := copy m; b := copy m; c := copy m @@ -228655,6 +232280,7 @@ StreamFunctions1(S:Type): Exports == Implementation where (* package STREAM1 *) (* + concat : Stream(Stream(S)) -> Stream(S) concat z == delay empty? z => empty() empty?(x := frst z) => concat rst z @@ -228798,16 +232424,19 @@ StreamFunctions2(A:Type,B:Type): Exports == Implementation where empty? x => empty() concat(f frst x, map(f,rst x)) + map : ((A -> B),Stream(A)) -> Stream(B) map(f,x) == explicitlyEmpty? x => empty() eq?(x,rst x) => repeating([f frst x]) mapp(f, x) + scan : (B,((A,B) -> B),Stream(A)) -> Stream(B) scan(b,h,x) == delay empty? x => empty() c := h(frst x,b) concat(c,scan(c,h,rst x)) + reduce : (B,((A,B) -> B),Stream(A)) -> B reduce(b,h,x) == empty? x => b reduce(h(frst x,b),h,rst x) @@ -228916,6 +232545,7 @@ StreamFunctions3(A,B,C): Exports == Implementation where empty? x or empty? y => empty() concat(g(frst x,frst y), map(g,rst x,rst y)) + map : (((A,B) -> C),Stream(A),Stream(B)) -> Stream(C) map(g,x,y) == explicitlyEmpty? x => empty() eq?(x,rst x) => map(z +-> g(frst x,z),y)$StreamFunctions2(B,C) @@ -229063,12 +232693,16 @@ StreamInfiniteProduct(Coef): Exports == Implementation where import StreamTaylorSeriesOperations(Coef) import StreamTranscendentalFunctions(Coef) - infiniteProduct st == exp lambert log st + infiniteProduct : Stream(Coef) -> Stream(Coef) + infiniteProduct st == exp lambert log st - evenInfiniteProduct st == exp evenlambert log st + evenInfiniteProduct : Stream(Coef) -> Stream(Coef) + evenInfiniteProduct st == exp evenlambert log st - oddInfiniteProduct st == exp oddlambert log st + oddInfiniteProduct : Stream(Coef) -> Stream(Coef) + oddInfiniteProduct st == exp oddlambert log st + generalInfiniteProduct : (Stream(Coef),Integer,Integer) -> Stream(Coef) generalInfiniteProduct(st,a,d) == exp generalLambert(log st,a,d) else @@ -229081,12 +232715,16 @@ StreamInfiniteProduct(Coef): Exports == Implementation where stQF := map(z1 +-> z1::QF(Coef),st)$StreamFunctions2(Coef,QF Coef) map(z1 +-> retract(z1)@Coef,f stQF)$StreamFunctions2(QF Coef,Coef) - infiniteProduct st == applyOverQF(z1 +-> exp lambert log z1,st) + infiniteProduct : Stream(Coef) -> Stream(Coef) + infiniteProduct st == applyOverQF(z1 +-> exp lambert log z1,st) + evenInfiniteProduct : Stream(Coef) -> Stream(Coef) evenInfiniteProduct st == applyOverQF(z1 +-> exp evenlambert log z1,st) + oddInfiniteProduct : Stream(Coef) -> Stream(Coef) oddInfiniteProduct st == applyOverQF(z1 +-> exp oddlambert log z1,st) + generalInfiniteProduct : (Stream(Coef),Integer,Integer) -> Stream(Coef) generalInfiniteProduct(st,a,d) == applyOverQF(z1 +-> exp generalLambert(log z1,a,d),st) @@ -229675,12 +233313,13 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where --% definitions - zro: () -> ST A -- returns a zero power series + zro: () -> ST A zro() == empty()$ST(A) --% arithmetic + ?+? : (Stream(A),Stream(A)) -> Stream(A) x + y == delay empty? y => x empty? x => y @@ -229688,6 +233327,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where eq?(y,rst y) => map(z +-> frst y+z, x) concat(frst x + frst y,rst x + rst y) + ?-? : (Stream(A),Stream(A)) -> Stream(A) x - y == delay empty? y => x empty? x => -y @@ -229695,17 +233335,21 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where eq?(y,rst y) => map(z +-> z-frst y, x) concat(frst x - frst y,rst x - rst y) + -? : Stream(A) -> Stream(A) -y == map(z +-> -z, y) + ?*? : (Stream(A),Stream(A)) -> Stream(A) (x:ST A) * (y:ST A) == delay empty? y => zro() empty? x => zro() concat(frst x * frst y,frst x * rst y + rst x * y) + ?*? : (A,Stream(A)) -> Stream(A) (s:A) * (x:ST A) == zero? s => zro() map(z +-> s*z, x) + ?*? : (Stream(A),A) -> Stream(A) (x:ST A) * (s:A) == zero? s => zro() map(z +-> z*s, x) @@ -229716,6 +233360,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where c0 := frst x * ry0 concat(c0,iDiv(rst x - c0 * rst y,y,ry0)) + exquo : (Stream(A),Stream(A)) -> Union(Stream(A),"failed") x exquo y == for n in 1.. repeat n > 1000 => return "failed" @@ -229729,6 +233374,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where empty? rst y => map(z +-> z*(ry0 :: A), x) iDiv(x,y,ry0 :: A) + ?/? : (Stream(A),Stream(A)) -> Stream(A) (x:ST A) / (y:ST A) == delay empty? y => error "/: division by zero" empty? x => empty() @@ -229737,6 +233383,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where empty? rst y => map(z +-> z*(ry0::A),x) iDiv(x,y,ry0 :: A) + recip : Stream(A) -> Union(Stream(A),"failed") recip x == empty? x => "failed" rh1 := recip frst x @@ -229747,18 +233394,19 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where --% coefficients - rp: (I,A) -> L A -- rp(z,s) is a list of length z each of whose entries is s. + rp: (I,A) -> L A rp(z,s) == z <= 0 => empty() concat(s,rp(z-1,s)) - rpSt: (I,A) -> ST A -- rpSt(z,s) is a stream of length z each of whose entries is s. + rpSt: (I,A) -> ST A rpSt(z,s) == delay z <= 0 => empty() concat(s,rpSt(z-1,s)) + monom : (A,Integer) -> Stream(A) monom(s,z) == z < 0 => error "monom: cannot create monomial of negative degree" concat(rpSt(z,0),concat(s,zro())) @@ -229767,38 +233415,47 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where nnintegers: NNI -> ST NNI nnintegers zz == generate(y +-> y+1, zz) - integers z == generate(y +-> y+1, z) + integers : Integer -> Stream(Integer) + integers z == generate(y +-> y+1, z) + oddintegers : Integer -> Stream(Integer) oddintegers z == generate(y +-> y+2, z) - int s == generate(y +-> y+1, s) + int : A -> Stream(A) + int s == generate(y +-> y+1, s) --% derivatives + mapmult : (Stream(A),Stream(A)) -> Stream(A) mapmult(x,y) == delay empty? y => zro() empty? x => zro() concat(frst x * frst y,mapmult(rst x,rst y)) + deriv : Stream(A) -> Stream(A) deriv x == empty? x => zro() mapmult(int 1,rest x) + gderiv : ((Integer -> A),Stream(A)) -> Stream(A) gderiv(f,x) == empty? x => zro() mapmult(map(f,integers 0)$SP2(I,A),x) --% coercions + coerce : A -> Stream(A) coerce(s:A) == zero? s => zro() concat(s,zro()) --% evaluations and compositions + eval : (Stream(A),A) -> Stream(A) eval(x,at) == scan(0,(y,z) +-> y+z,mapmult(x,generate(y +-> at*y,1)))$SP2(A,A) + compose : (Stream(A),Stream(A)) -> Stream(A) compose(x,y) == delay empty? y => concat(frst x,zro()) not zero? frst y => @@ -229811,8 +233468,10 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where lagrangere:(ST A,ST A) -> ST A lagrangere(x,c) == delay(concat(0,compose(x,c))) + lagrange : Stream(A) -> Stream(A) lagrange x == YS(y +-> lagrangere(x,y)) + revert : Stream(A) -> Stream(A) revert x == empty? x => error "revert should start 0,1,..." zero? frst x => @@ -229822,6 +233481,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where --% lambert functions + addiag : Stream(Stream(A)) -> Stream(A) addiag(ststa:ST ST A) == delay empty? ststa => zro() empty? frst ststa => concat(0,addiag rst ststa) @@ -229847,24 +233507,28 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where rptg3(a,d,n,s) == concat(rpSt(n*(a-1),0),repeating(concat(s,rp(d*n-1,0)))) + lambert : Stream(A) -> Stream(A) lambert x == delay empty? x => zro() zero? frst x => concat(0,addiag(map(rptg1,integers 0,rst x)$SP3(I,A,ST A))) error "lambert:constant coefficient should be zero" + oddlambert : Stream(A) -> Stream(A) oddlambert x == delay empty? x => zro() zero? frst x => concat(0,addiag(map(rptg1,oddintegers 1,rst x)$SP3(I,A,ST A))) error "oddlambert: constant coefficient should be zero" + evenlambert : Stream(A) -> Stream(A) evenlambert x == delay empty? x => zro() zero? frst x => concat(0,addiag(map(rptg2,integers 1,rst x)$SP3(I,A,ST A))) error "evenlambert: constant coefficient should be zero" + generalLambert : (Stream(A),Integer,Integer) -> Stream(A) generalLambert(st,a,d) == delay a < 1 or d < 1 => error "generalLambert: both integer arguments must be positive" @@ -229882,6 +233546,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where zero? n => concat(frst s,ms(m,m-1,rst s)) ms(m,n-1,rst s) + multisect : (Integer,Integer,Stream(A)) -> Stream(A) multisect(b,a,x) == ms(a+b,0,rest(x,a :: NNI)) altn: (ST A,ST A) -> ST A @@ -229889,6 +233554,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where empty? s => zro() concat(frst s,concat(zs,altn(zs,rst s))) + invmultisect : (Integer,Integer,Stream(A)) -> Stream(A) invmultisect(a,b,x) == concat(rpSt(b,0),altn(rpSt(a + b - 1,0),x)) @@ -229914,14 +233580,16 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where integ: ST A -> ST A integ x == integre(x,1) + integrate : (A,Stream(A)) -> Stream(A) integrate(a,x) == concat(a,integ x) + lazyIntegrate : (A,(() -> Stream(A))) -> Stream(A) lazyIntegrate(s,xf) == concat(s,integ(delay xf)) nldere:(ST ST A,ST A) -> ST A - nldere(lslsa,c) == lazyIntegrate(0,addiag(comps(lslsa,c))) + nlde : Stream(Stream(A)) -> Stream(A) nlde lslsa == YS(y +-> nldere(lslsa,y)) RATPOWERS : Boolean := A has "**": (A,RN) -> A @@ -229933,6 +233601,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where powerrn(rn,x,c) == delay concat(1,integ(smult(rn + 1,c * deriv x)) - rst x * c) + powern : (Fraction(Integer),Stream(A)) -> Stream(A) powern(rn,x) == order : I := 0 for n in 0.. repeat @@ -229957,6 +233626,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where if A has Field then + mapdiv : (Stream(A),Stream(A)) -> Stream(A) mapdiv(x,y) == delay empty? y => error "stream division by zero" empty? x => zro() @@ -229965,6 +233635,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where ginteg: (I -> A,ST A) -> ST A ginteg(f,x) == mapdiv(x,map(f,integers 1)$SP2(I,A)) + lazyGintegrate : ((Integer -> A),A,(() -> Stream(A))) -> Stream(A) lazyGintegrate(fntoa,s,xf) == concat(s,ginteg(fntoa,delay xf)) finteg: ST A -> ST A @@ -230052,6 +233723,7 @@ StreamTensor(R: Type): with (* package STNSR *) (* + tensorMap : (Stream(R),(R -> List(R))) -> Stream(R) tensorMap(s, f) == empty? s => empty() concat([f first s], delay tensorMap(rest s, f)) @@ -230595,12 +234267,14 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where expre:(Coef,ST,ST) -> ST expre(r,e,dx) == lazyIntegrate(r,e*dx) + exp : Stream(Coef) -> Stream(Coef) exp z == empty? z => 1 :: ST (coef := frst z) = 0 => YS(y +-> expre(1,y,deriv z)) TRANSFCN => YS(y +-> expre(exp coef,y,deriv z)) error concat("exp: ",TRCONST) + log : Stream(Coef) -> Stream(Coef) log z == empty? z => error "log: constant coefficient should not be 0" (coef := frst z) = 0 => error "log: constant coefficient should not be 0" @@ -230608,6 +234282,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where TRANSFCN => lazyIntegrate(log coef,deriv z/z) error concat("log: ",TRCONST) + ?**? : (Stream(Coef),Stream(Coef)) -> Stream(Coef) z1:ST ** z2:ST == exp(z2 * log z1) --% Trigonometric Functions @@ -230616,6 +234291,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where sincosre(rs,rc,sc,dx,sign) == [lazyIntegrate(rs,(second sc)*dx),lazyIntegrate(rc,sign*(first sc)*dx)] + sincos : Stream(Coef) -> Record(sin: Stream(Coef),cos: Stream(Coef)) sincos z == empty? z => [0 :: ST,1 :: ST] l := @@ -230624,12 +234300,16 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where error concat("sincos: ",TRCONST) [first l,second l] + sin : Stream(Coef) -> Stream(Coef) sin z == sincos(z).sin + + cos : Stream(Coef) -> Stream(Coef) cos z == sincos(z).cos tanre:(Coef,ST,ST,Coef) -> ST tanre(r,t,dx,sign) == lazyIntegrate(r,((1 :: ST) + sign*t*t)*dx) + tan : Stream(Coef) -> Stream(Coef) tan z == empty? z => 0 :: ST (coef := frst z) = 0 => YS(y +-> tanre(0,y,deriv z,1)) @@ -230639,12 +234319,14 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where cotre:(Coef,ST,ST) -> ST cotre(r,t,dx) == lazyIntegrate(r,-((1 :: ST) + t*t)*dx) + cot : Stream(Coef) -> Stream(Coef) cot z == empty? z => error "cot: cot(0) is undefined" (coef := frst z) = 0 => error concat("cot: ",NPOWERS) TRANSFCN => YS(y +-> cotre(cot coef,y,deriv z)) error concat("cot: ",TRCONST) + sec : Stream(Coef) -> Stream(Coef) sec z == empty? z => 1 :: ST frst z = 0 => recip(cos z) :: ST @@ -230654,6 +234336,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where recip(cosz) :: ST error concat("sec: ",TRCONST) + csc : Stream(Coef) -> Stream(Coef) csc z == empty? z => error "csc: csc(0) is undefined" TRANSFCN => @@ -230672,6 +234355,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where x := rst x "failed" + asin : Stream(Coef) -> Stream(Coef) asin z == empty? z => 0 :: ST (coef := frst z) = 0 => @@ -230691,6 +234375,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where integrate(asin coef,powern(-1/2,(1 :: ST) - z*z) * (deriv z)) error concat("asin: ",TRCONST) + acos : Stream(Coef) -> Stream(Coef) acos z == empty? z => TRANSFCN => acos(0)$Coef :: ST @@ -230711,6 +234396,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where integrate(acos coef,-powern(-1/2,(1 :: ST) - z*z) * (deriv z)) error concat("acos: ",TRCONST) + atan : Stream(Coef) -> Stream(Coef) atan z == empty? z => 0 :: ST (coef := frst z) = 0 => @@ -230721,6 +234407,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where integrate(atan coef,(y :: ST) * (deriv z)) error concat("atan: ",TRCONST) + acot : Stream(Coef) -> Stream(Coef) acot z == empty? z => TRANSFCN => acot(0)$Coef :: ST @@ -230731,6 +234418,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where integrate(acot frst z,-(y :: ST) * (deriv z)) error concat("acot: ",TRCONST) + asec : Stream(Coef) -> Stream(Coef) asec z == empty? z => error "asec: constant coefficient should not be 0" TRANSFCN => @@ -230752,6 +234440,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where integrate(asec coef,(powern(-1/2,z*z-(1::ST))*(deriv z)) / z) error concat("asec: ",TRCONST) + acsc : Stream(Coef) -> Stream(Coef) acsc z == empty? z => error "acsc: constant coefficient should not be zero" TRANSFCN => @@ -230775,6 +234464,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where --% Hyperbolic Trigonometric Functions + sinhcosh : Stream(Coef) -> Record(sinh: Stream(Coef),cosh: Stream(Coef)) sinhcosh z == empty? z => [0 :: ST,1 :: ST] l := @@ -230783,32 +234473,39 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where error concat("sinhcosh: ",TRCONST) [first l,second l] + sinh : Stream(Coef) -> Stream(Coef) sinh z == sinhcosh(z).sinh + cosh : Stream(Coef) -> Stream(Coef) cosh z == sinhcosh(z).cosh + tanh : Stream(Coef) -> Stream(Coef) tanh z == empty? z => 0 :: ST (coef := frst z) = 0 => YS(y +-> tanre(0,y,deriv z,-1)) TRANSFCN => YS(y +-> tanre(tanh coef,y,deriv z,-1)) error concat("tanh: ",TRCONST) + coth : Stream(Coef) -> Stream(Coef) coth z == tanhz := tanh z empty? tanhz => error "coth: coth(0) is undefined" (frst tanhz) = 0 => error concat("coth: ",NPOWERS) recip(tanhz) :: ST + sech : Stream(Coef) -> Stream(Coef) sech z == coshz := cosh z (empty? coshz) or (frst coshz = 0) => error concat("sech: ",NPOWERS) recip(coshz) :: ST + csch : Stream(Coef) -> Stream(Coef) csch z == sinhz := sinh z (empty? sinhz) or (frst sinhz = 0) => error concat("csch: ",NPOWERS) recip(sinhz) :: ST + asinh : Stream(Coef) -> Stream(Coef) asinh z == empty? z => 0 :: ST (coef := frst z) = 0 => log(z + powern(1/2,(1 :: ST) + z*z)) @@ -230823,6 +234520,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where log(z + powern(1/2,x)) error concat("asinh: ",TRCONST) + acosh : Stream(Coef) -> Stream(Coef) acosh z == empty? z => TRANSFCN => acosh(0)$Coef :: ST @@ -230841,6 +234539,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where log(z + powern(1/2,z*z - (1 :: ST))) error concat("acosh: ",TRCONST) + atanh : Stream(Coef) -> Stream(Coef) atanh z == empty? z => 0 :: ST (coef := frst z) = 0 => @@ -230850,6 +234549,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where (inv(2::RN)::Coef) * log(((1 :: ST) + z)/((1 :: ST) - z)) error concat("atanh: ",TRCONST) + acoth : Stream(Coef) -> Stream(Coef) acoth z == empty? z => TRANSFCN => acoth(0)$Coef :: ST @@ -230859,6 +234559,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where (inv(2::RN)::Coef) * log((z + (1 :: ST))/(z - (1 :: ST))) error concat("acoth: ",TRCONST) + asech : Stream(Coef) -> Stream(Coef) asech z == empty? z => error "asech: asech(0) is undefined" TRANSFCN => @@ -230874,6 +234575,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where log(((1 :: ST) + powern(1/2,(1 :: ST) - z*z))/z) error concat("asech: ",TRCONST) + acsch : Stream(Coef) -> Stream(Coef) acsch z == empty? z => error "acsch: acsch(0) is undefined" TRANSFCN => @@ -231223,6 +234925,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ --% Exponentials and Logarithms + exp : Stream(Coef) -> Stream(Coef) exp z == empty? z => 1 :: ST (frst z) = 0 => @@ -231230,6 +234933,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(expx,z) error concat("exp: ",ZERO) + log : Stream(Coef) -> Stream(Coef) log z == empty? z => error concat("log: ",ONE) (frst z) = 1 => @@ -231237,10 +234941,12 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(log1PlusX,z - monom(1,0)) error concat("log: ",ONE) + ?**? : (Stream(Coef),Stream(Coef)) -> Stream(Coef) (z1:ST) ** (z2:ST) == exp(log(z1) * z2) --% Trigonometric Functions + sin : Stream(Coef) -> Stream(Coef) sin z == empty? z => 0 :: ST (frst z) = 0 => @@ -231248,6 +234954,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(sinx,z) error concat("sin: ",ZERO) + cos : Stream(Coef) -> Stream(Coef) cos z == empty? z => 1 :: ST (frst z) = 0 => @@ -231255,6 +234962,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(cosx,z) error concat("cos: ",ZERO) + tan : Stream(Coef) -> Stream(Coef) tan z == empty? z => 0 :: ST (frst z) = 0 => @@ -231262,11 +234970,13 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(tanx,z) error concat("tan: ",ZERO) + cot : Stream(Coef) -> Stream(Coef) cot z == empty? z => error "cot: cot(0) is undefined" (frst z) = 0 => error concat("cot: ",NPOWERS) error concat("cot: ",ZERO) + sec : Stream(Coef) -> Stream(Coef) sec z == empty? z => 1 :: ST (frst z) = 0 => @@ -231274,11 +234984,13 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(secx,z) error concat("sec: ",ZERO) + csc : Stream(Coef) -> Stream(Coef) csc z == empty? z => error "csc: csc(0) is undefined" (frst z) = 0 => error concat("csc: ",NPOWERS) error concat("csc: ",ZERO) + asin : Stream(Coef) -> Stream(Coef) asin z == empty? z => 0 :: ST (frst z) = 0 => @@ -231286,6 +234998,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(asinx,z) error concat("asin: ",ZERO) + atan : Stream(Coef) -> Stream(Coef) atan z == empty? z => 0 :: ST (frst z) = 0 => @@ -231293,16 +235006,21 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(atanx,z) error concat("atan: ",ZERO) + acos : Stream(Coef) -> Stream(Coef) acos z == error "acos: acos undefined on this coefficient domain" + acot : Stream(Coef) -> Stream(Coef) acot z == error "acot: acot undefined on this coefficient domain" + asec : Stream(Coef) -> Stream(Coef) asec z == error "asec: asec undefined on this coefficient domain" + acsc : Stream(Coef) -> Stream(Coef) acsc z == error "acsc: acsc undefined on this coefficient domain" --% Hyperbolic Trigonometric Functions + sinh : Stream(Coef) -> Stream(Coef) sinh z == empty? z => 0 :: ST (frst z) = 0 => @@ -231310,6 +235028,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(sinhx,z) error concat("sinh: ",ZERO) + cosh : Stream(Coef) -> Stream(Coef) cosh z == empty? z => 1 :: ST (frst z) = 0 => @@ -231317,6 +235036,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(coshx,z) error concat("cosh: ",ZERO) + tanh : Stream(Coef) -> Stream(Coef) tanh z == empty? z => 0 :: ST (frst z) = 0 => @@ -231324,11 +235044,13 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(tanhx,z) error concat("tanh: ",ZERO) + coth : Stream(Coef) -> Stream(Coef) coth z == empty? z => error "coth: coth(0) is undefined" (frst z) = 0 => error concat("coth: ",NPOWERS) error concat("coth: ",ZERO) + sech : Stream(Coef) -> Stream(Coef) sech z == empty? z => 1 :: ST (frst z) = 0 => @@ -231336,11 +235058,13 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(sechx,z) error concat("sech: ",ZERO) + csch : Stream(Coef) -> Stream(Coef) csch z == empty? z => error "csch: csch(0) is undefined" (frst z) = 0 => error concat("csch: ",NPOWERS) error concat("csch: ",ZERO) + asinh : Stream(Coef) -> Stream(Coef) asinh z == empty? z => 0 :: ST (frst z) = 0 => @@ -231348,6 +235072,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(asinhx,z) error concat("asinh: ",ZERO) + atanh : Stream(Coef) -> Stream(Coef) atanh z == empty? z => 0 :: ST (frst z) = 0 => @@ -231355,12 +235080,16 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _ compose(atanhx,z) error concat("atanh: ",ZERO) + acosh : Stream(Coef) -> Stream(Coef) acosh z == error "acosh: acosh undefined on this coefficient domain" + acoth : Stream(Coef) -> Stream(Coef) acoth z == error "acoth: acoth undefined on this coefficient domain" + asech : Stream(Coef) -> Stream(Coef) asech z == error "asech: asech undefined on this coefficient domain" + acsch : Stream(Coef) -> Stream(Coef) acsch z == error "acsch: acsch undefined on this coefficient domain" *) @@ -231568,6 +235297,7 @@ StructuralConstantsPackage(R:Field): public == private where li : L R := reduce(concat, lili) construct(li)$(V R) + coordinates : (Matrix(R),List(Matrix(R))) -> Vector(R) coordinates(x,b) == m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger n : NonNegativeInteger := nrows(b.1) * ncols(b.1) @@ -231582,6 +235312,7 @@ StructuralConstantsPackage(R:Field): public == private where second argument") (res.particular) :: (Vector R) + structuralConstants : List(Matrix(R)) -> Vector(Matrix(R)) structuralConstants b == --n := rank() -- be careful with the possibility that b is not a basis @@ -231594,6 +235325,8 @@ StructuralConstantsPackage(R:Field): public == private where setelt( sC.k, i, j, covec.k ) sC + structuralConstants : (List(Symbol),Matrix(Polynomial(R))) -> _ + Vector(Matrix(Polynomial(R))) structuralConstants(ls:L S, mt: M POLY R) == nn := #(ls) nrows(mt) ^= nn or ncols(mt) ^= nn => @@ -231615,6 +235348,8 @@ StructuralConstantsPackage(R:Field): public == private where lscopy := rest lscopy vector reverse gamma + structuralConstants : (List(Symbol),Matrix(Fraction(Polynomial(R)))) ->_ + Vector(Matrix(Fraction(Polynomial(R)))) structuralConstants(ls:L S, mt: M FRAC POLY R) == nn := #(ls) nrows(mt) ^= nn or ncols(mt) ^= nn => @@ -232062,6 +235797,7 @@ SturmHabichtPackage(R,x): T == C where Ex ==> OutputForm import OutputForm + subresultantSequenceBegin : (UP(x,R),UP(x,R)) -> L UP(x,R) subresultantSequenceBegin(p1,p2):L UP(x,R) == d1:NNI:=degree(p1) d2:NNI:=degree(p2) @@ -232084,6 +235820,7 @@ SturmHabichtPackage(R,x): T == C where (-leadingCoefficient(p1))**((n-d2)::NNI)*pseudoRemainder(p1,p2) append(LSubr::L UP(x,R),[Lc1,Lc2]::L UP(x,R)) + subresultantSequenceNext : L UP(x,R) -> L UP(x,R) subresultantSequenceNext(LcsI:L UP(x,R)):L UP(x,R) == p2:UP(x,R):=last LcsI p1:UP(x,R):=first rest reverse LcsI @@ -232106,6 +235843,7 @@ SturmHabichtPackage(R,x): T == C where LSub:L UP(x,R):=append([0]:L UP(x,R),LSub:L UP(x,R)) append(LcsI:L UP(x,R),LSub:L UP(x,R)) + subresultantSequenceInner : (UP(x,R),UP(x,R)):L UP(x,R) == subresultantSequenceInner(p1,p2):L UP(x,R) == Lin:L UP(x,R):=subresultantSequenceBegin(p1:UP(x,R),p2:UP(x,R)) indf:NNI:= if not(Lin.last::UP(x,R) = 0) then degree(Lin.last::UP(x,R)) @@ -232122,6 +235860,9 @@ SturmHabichtPackage(R,x): T == C where -- Computation of the subresultant sequence Sres(j)(P,p,Q,q) when: -- deg(P) = p and deg(Q) = q and p > q + subresultantSequence : _ + (UnivariatePolynomial(x,R),UnivariatePolynomial(x,R)) -> _ + List(UnivariatePolynomial(x,R)) subresultantSequence(p1,p2):L UP(x,R) == p:NNI:=degree(p1) q:NNI:=degree(p2) @@ -232136,12 +235877,14 @@ SturmHabichtPackage(R,x): T == C where -- Computation of the delta function: + delta : NNI -> R delta(int1:NNI):R == (-1)**((int1*(int1+1) exquo 2)::NNI) -- Computation of the Sturm-Habicht sequence of two polynomials P and Q -- in R[x] where R is an ordered integral domaine + polsth1 : (UP(x,R),NNI,UP(x,R),NNI,R) -> L UP(x,R) polsth1(p1,p:NNI,p2,q:NNI,c1:R):L UP(x,R) == sc1:R:=(sign(c1))::R Pr1:UP(x,R):=pseudoRemainder(differentiate(p1)*p2,p1) @@ -232164,6 +235907,7 @@ SturmHabichtPackage(R,x): T == C where List2:L UP(x,R):=append([Pr6]:L UP(x,R),List2:L UP(x,R)) append(Listf:L UP(x,R),List2:L UP(x,R)) + polsth2 : (UP(x,R),NNI,UP(x,R),NNI,R) -> L UP(x,R) polsth2(p1,p:NNI,p2,q:NNI,c1:R):L UP(x,R) == sc1:R:=(sign(c1))::R Pr1:UP(x,R):=monomial(sc1,0)*p1 @@ -232178,6 +235922,7 @@ SturmHabichtPackage(R,x): T == C where List2:L UP(x,R):=append([Pr5]:L UP(x,R),List2:L UP(x,R)) append(Listf:L UP(x,R),List2:L UP(x,R)) + polsth3 : (UP(x,R),NNI,UP(x,R),NNI,R) -> L UP(x,R) polsth3(p1,p:NNI,p2,q:NNI,c1:R):L UP(x,R) == sc1:R:=(sign(c1))::R q1:NNI:=(q-1)::NNI @@ -232192,6 +235937,9 @@ SturmHabichtPackage(R,x): T == C where List2:L UP(x,R):=append([Pr3]:L UP(x,R),List2:L UP(x,R)) append(Listf:L UP(x,R),List2:L UP(x,R)) + SturmHabichtSequence : _ + (UnivariatePolynomial(x,R),UnivariatePolynomial(x,R)) -> _ + List(UnivariatePolynomial(x,R)) SturmHabichtSequence(p1,p2):L UP(x,R) == p:NNI:=degree(p1) q:NNI:=degree(p2) @@ -232204,6 +235952,8 @@ SturmHabichtPackage(R,x): T == C where -- Computation of the Sturm-Habicht principal coefficients of two -- polynomials P and Q in R[x] where R is an ordered integral domain + SturmHabichtCoefficients : _ + (UnivariatePolynomial(x,R),UnivariatePolynomial(x,R)) -> List(R) SturmHabichtCoefficients(p1,p2):L R == List1:L UP(x,R):=SturmHabichtSequence(p1,p2) qp:NNI:=#(List1)::NNI @@ -232213,6 +235963,7 @@ SturmHabichtPackage(R,x): T == C where -- Computation of the number of sign variations of a list of non zero -- elements in an ordered integral domain + variation : L R -> INT variation(Lsig:L R):INT == size?(Lsig,1) => 0 elt1:R:=first Lsig @@ -232226,6 +235977,7 @@ SturmHabichtPackage(R,x): T == C where -- Computation of the number of sign permanences of a list of non zero -- elements in an ordered integral domain + permanence : L R -> INT permanence(Lsig:L R):INT == size?(Lsig,1) => 0 elt1:R:=first Lsig @@ -232239,11 +235991,13 @@ SturmHabichtPackage(R,x): T == C where -- Computation of the functional W which works over a list of elements -- in an ordered integral domain, with non zero first element + qzeros : L R -> L R qzeros(Lsig:L R):L R == while last Lsig = 0 repeat Lsig:L R:=reverse rest reverse Lsig Lsig + epsil : (NNI,R,R) -> INT epsil(int1:NNI,elt1:R,elt2:R):INT == int1 = 0 => 0 odd? int1 => 0 @@ -232253,18 +236007,21 @@ SturmHabichtPackage(R,x): T == C where ct4:INT:=(ct1*ct2)::INT ((-1)**(ct3::NNI))*ct4 + numbnce : L R -> NNI numbnce(Lsig:L R):NNI == null Lsig => 0 eltp:R:=Lsig.1 eltp = 0 => 0 1 + numbnce(rest Lsig) + numbce : L R -> NNI numbce(Lsig:L R):NNI == null Lsig => 0 eltp:R:=Lsig.1 not(eltp = 0) => 0 1 + numbce(rest Lsig) + wfunctaux : L R -> INT wfunctaux(Lsig:L R):INT == null Lsig => 0 List2:L R:=[] @@ -232282,6 +236039,7 @@ SturmHabichtPackage(R,x): T == C where ind4:INT:=ind2+ind3 ind4+wfunctaux(List1:L R) + wfunct : L R -> INT wfunct(Lsig:L R):INT == List1:L R:=qzeros(Lsig:L R) wfunctaux(List1:L R) @@ -232299,6 +236057,8 @@ SturmHabichtPackage(R,x): T == C where -- - SturmHabicht(P,1) is the number of "real" roots of P, -- - SturmHabicht(P,Q**2) is the number of "real" roots of P making Q neq 0 + SturmHabicht : (UnivariatePolynomial(x,R),UnivariatePolynomial(x,R)) ->_ + Integer SturmHabicht(p1,p2):INT == p2 = 0 => 0 degree(p1:UP(x,R)) = 0 => 0 @@ -232310,6 +236070,8 @@ SturmHabichtPackage(R,x): T == C where if R has GcdDomain then + SturmHabichtMultiple : _ + (UnivariatePolynomial(x,R),UnivariatePolynomial(x,R)) -> Integer SturmHabichtMultiple(p1,p2):INT == p2 = 0 => 0 degree(p1:UP(x,R)) = 0 => 0 @@ -232329,6 +236091,7 @@ SturmHabichtPackage(R,x): T == C where #sqfr = 1 and sqfr.first.xpnt=1 => ans reduce("+",[f.xpnt*SturmHabicht(f.fctr,p2) for f in sqfr]) + countRealRootsMultiple UP(x,R) -> INT countRealRootsMultiple(p1):INT == SturmHabichtMultiple(p1,1) *) @@ -232529,11 +236292,14 @@ SubResultantPackage(R, UP): Exports == Implementation where Lionel ==> PseudoRemainderSequence(R,UP) if R has EuclideanDomain then + + primitivePart : (UP,R) -> UP primitivePart(p, q) == rec := extendedEuclidean(leadingCoefficient p, q, 1)::Record(coef1:R, coef2:R) unitCanonical primitivePart map(x1 +-> (rec.coef1 * x1) rem q, p) + subresultantVector : (UP,UP) -> PrimitiveArray(UP) subresultantVector(p1, p2) == F : UP -- auxiliary stuff ! res : PrimitiveArray(UP) := new(2+max(degree(p1),degree(p2)), 0) @@ -232752,6 +236518,8 @@ SupFractionFactorizer(E,OV,R,P) : C == T MSQFR ==> MultivariateSquareFree(E,OV,R,P) UPCF2 ==> UnivariatePolynomialCategoryFunctions2 + factor : SparseUnivariatePolynomial(Fraction(P)) -> _ + Factored(SparseUnivariatePolynomial(Fraction(P))) factor(p:SUP FP) : Factored SUP FP == p=0 => 0 R has CharacteristicZero and R has EuclideanDomain => @@ -232765,6 +236533,8 @@ SupFractionFactorizer(E,OV,R,P) : C == T u.exponent] for u in factors ffact]) squareFree p + squareFree : SparseUnivariatePolynomial(Fraction(P)) -> _ + Factored(SparseUnivariatePolynomial(Fraction(P))) squareFree(p:SUP FP) : Factored SUP FP == p=0 => 0 pden : P := lcm [denom c for c in coefficients p] @@ -233083,15 +236853,11 @@ SystemODESolver(F, LO): Exports == Implementation where import PseudoLinearNormalForm F - applyLodo : (M, Z, V, N) -> F - applyLodo0 : (M, Z, Matrix F, Z, N) -> F - backsolve : (M, V, (LO, F) -> FSL) -> VSL - firstnonzero: (M, Z) -> Z - FSL2USL : FSL -> USL - M2F : M -> Union(MF, "failed") - diff := D()$LO + solve : (Matrix(F),Vector(F),((LO,F) -> _ + Union(Record(particular: F,basis: List(F)),"failed"))) -> _ + Union(Record(particular: Vector(F),basis: Matrix(F)),"failed") solve(mm, v, solve) == rec := triangulate(mm, v) sols:List(SOL) := empty() @@ -233126,6 +236892,9 @@ SystemODESolver(F, LO): Exports == Implementation where -- transform these values back to the original system [rec.A * part, rec.A * SolMatrix] + triangulate : (Matrix(F),Vector(F)) -> _ + Record(A: Matrix(F),_ + eqs: List(Record(C: Matrix(F),g: Vector(F),eq: LO,rh: F))) triangulate(m:MF, v:V) == k:N := 0 -- sum of companion-dimensions rat := normalForm(m, 1, (f1:F):F +-> - diff f1) @@ -233146,6 +236915,7 @@ SystemODESolver(F, LO): Exports == Implementation where [rat.A, ler] -- like solveInField, but expects a system already triangularized + backsolve : (M, V, (LO, F) -> FSL) -> VSL backsolve(m, v, solve) == part:V r := maxRowIndex m @@ -233179,6 +236949,9 @@ SystemODESolver(F, LO): Exports == Implementation where part? => [part, bas] ["failed", bas] + solveInField : (Matrix(LO),Vector(F),((LO,F) -> _ + Record(particular: Union(F,"failed"),basis: List(F)))) -> _ + Record(particular: Union(Vector(F),"failed"),basis: List(Vector(F))) solveInField(m, v, solve) == ((n := nrows m) = ncols m) and ((u := M2F(diagonalMatrix [diff for i in 1..n] - m)) case MF) => @@ -233190,6 +236963,7 @@ SystemODESolver(F, LO): Exports == Implementation where rec := triangulate(m, v) backsolve(rec.mat, rec.vec, solve) + M2F : M -> Union(MF, "failed") M2F m == mf:MF := new(nrows m, ncols m, 0) for i in minRowIndex m .. maxRowIndex m repeat @@ -233199,17 +236973,20 @@ SystemODESolver(F, LO): Exports == Implementation where mf(i, j) := u::F mf + FSL2USL : FSL -> USL FSL2USL rec == rec.particular case "failed" => "failed" [rec.particular::F, rec.basis] -- returns the index of the first nonzero entry in row r of m + firstnonzero: (M, Z) -> Z firstnonzero(m, r) == for c in minColIndex m .. maxColIndex m repeat m(r, c) ^= 0 => return c error "firstnonzero: zero row" -- computes +/[m(r, i) v(i) for i ranging over the last n columns of m] + applyLodo : (M, Z, V, N) -> F applyLodo(m, r, v, n) == ans:F := 0 c := maxColIndex m @@ -233221,6 +236998,7 @@ SystemODESolver(F, LO): Exports == Implementation where ans -- computes +/[m(r, i) mm(i, c) for i ranging over the last n columns of m] + applyLodo0 : (M, Z, Matrix F, Z, N) -> F applyLodo0(m, r, mm, c, n) == ans := 0 rr := maxRowIndex mm @@ -233231,6 +237009,8 @@ SystemODESolver(F, LO): Exports == Implementation where rr := rr - 1 ans + triangulate : (Matrix(LO),Vector(F)) -> _ + Record(mat: Matrix(LO),vec: Vector(F)) triangulate(m:M, v:V) == x := copy m w := copy v @@ -233579,18 +237359,17 @@ SystemSolvePackage(R): Cat == Cap where import MPolyCatRationalFunctionFactorizer(IE,SE,R,P F) - ---- Local Functions ---- - linSolve: (L F, L SE) -> Union(L EQ F, "failed") - makePolys : L EQ F -> L F - + makeR2F : R -> F makeR2F(r : R) : F == r :: (P R) :: F + makeP2F : P F -> F makeP2F(p:P F):F == lv:=variables p lv = [] => retract p for v in lv repeat p:=pushdown(p,v) retract p - ---- Local Functions ---- + + makeEq : (P F,L SE) -> EQ F makeEq(p:P F,lv:L SE): EQ F == z:=last lv np:=numer makeP2F p @@ -233601,15 +237380,19 @@ SystemSolvePackage(R): Cat == Cap where equation(x::P(R)::F,-coefficient(up,0)/leadingCoefficient up) equation(np::F,0$F) + varInF : SE -> F varInF(v: SE): F == v::P(R) :: F + newInF : Integer -> F newInF(n: Integer):F==varInF new()$SE + testDegree : (P R,L SE) -> Boolean testDegree(f :P R , lv :L SE) : Boolean == "or"/[degree(f,vv)>0 for vv in lv] - ---- Exported Functions ---- -- solve a system of rational functions + triangularSystems : (List(Fraction(Polynomial(R))),List(Symbol)) -> _ + List(List(Polynomial(R))) triangularSystems(lf: L F,lv:L SE) : L L P R == empty? lv => empty() empty? lf => empty() @@ -233634,6 +237417,8 @@ SystemSolvePackage(R): Cat == Cap where [[retract pushdown(pf,lvv)$push for pf in pr] for pr in parRes] -- One polynomial. Implicit variable -- + solve : Fraction(Polynomial(R)) -> _ + List(Equation(Fraction(Polynomial(R)))) solve(pol : F) == zero? pol => error "equation is always satisfied" @@ -233644,6 +237429,8 @@ SystemSolvePackage(R): Cat == Cap where solve(pol,first lv) -- general solver. Input in equation style. Implicit variables -- + solve : Equation(Fraction(Polynomial(R))) -> _ + List(Equation(Fraction(Polynomial(R)))) solve(eq : EQ F) == pol:= lhs eq - rhs eq zero? pol => @@ -233655,9 +237442,13 @@ SystemSolvePackage(R): Cat == Cap where solve(pol,first lv) -- general solver. Input in equation style -- + solve : (Equation(Fraction(Polynomial(R))),Symbol) -> _ + List(Equation(Fraction(Polynomial(R)))) solve(eq:EQ F,var:SE) == solve(lhs eq - rhs eq,var) -- general solver. Input in polynomial style -- + solve : (Fraction(Polynomial(R)),Symbol) -> _ + List(Equation(Fraction(Polynomial(R)))) solve(pol:F,var:SE) == if R has GcdDomain then p:=primitivePart(numer pol,var) @@ -233666,9 +237457,11 @@ SystemSolvePackage(R): Cat == Cap where else empty() -- Convert a list of Equations in a list of Polynomials + makePolys : L EQ F -> L F makePolys(l: L EQ F):L F == [lhs e - rhs e for e in l] -- linear systems solver. Input as list of polynomials -- + linSolve: (L F, L SE) -> Union(L EQ F, "failed") linSolve(lp:L F,lv:L SE) == rec:Record(particular:Union(V F,"failed"),basis:L V F) lr : L P R:=[numer f for f in lp] @@ -233686,12 +237479,16 @@ SystemSolvePackage(R): Cat == Cap where eqs -- general solver. Input in polynomial style. Implicit variables -- + solve : List(Fraction(Polynomial(R))) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solve(lr : L F) == lv :="setUnion"/[setUnion(variables numer p, variables denom p) for p in lr] solve(lr,lv) -- general solver. Input in equation style. Implicit variables -- + solve : List(Equation(Fraction(Polynomial(R)))) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solve(le : L EQ F) == lr:=makePolys le lv :="setUnion"/[setUnion(variables numer p, variables denom p) @@ -233699,8 +237496,11 @@ SystemSolvePackage(R): Cat == Cap where solve(lr,lv) -- general solver. Input in equation style -- + solve : (List(Equation(Fraction(Polynomial(R)))),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solve(le:L EQ F,lv:L SE) == solve(makePolys le, lv) + checkLinear : (L F,L SE) -> Boolean checkLinear(lr:L F,vl:L SE):Boolean == ld:=[denom pol for pol in lr] for f in ld repeat @@ -233708,6 +237508,8 @@ SystemSolvePackage(R): Cat == Cap where and/[totalDegree(numer pol,vl) < 2 for pol in lr] -- general solver. Input in polynomial style -- + solve : (List(Fraction(Polynomial(R))),List(Symbol)) -> _ + List(List(Equation(Fraction(Polynomial(R))))) solve(lr:L F,vl:L SE) == empty? vl => empty() checkLinear(lr,vl) => @@ -234245,18 +238047,13 @@ SymmetricGroupCombinatoricFunctions(): public == private where import Set I - -- declaration of local functions - + -- this is used as subtree counting function in + -- "unrankImproperPartitions1". For (n,m,cm) it counts + -- the following set of m-tuples: The first (from left + -- to right) m-cm non-zero entries are equal, the remaining + -- positions sum up to n. Example: (3,3,2) counts + -- [x,3,0], [x,0,3], [0,x,3], [x,2,1], [x,1,2], x non-zero. numberOfImproperPartitionsInternal: (I,I,I) -> I - -- this is used as subtree counting function in - -- "unrankImproperPartitions1". For (n,m,cm) it counts - -- the following set of m-tuples: The first (from left - -- to right) m-cm non-zero entries are equal, the remaining - -- positions sum up to n. Example: (3,3,2) counts - -- [x,3,0], [x,0,3], [0,x,3], [x,2,1], [x,1,2], x non-zero. - - -- definition of local functions - numberOfImproperPartitionsInternal(n,m,cm) == n = 0 => binomial(m,cm)$ICF cm = 0 and n > 0 => 0 @@ -234265,8 +238062,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where s := s + numberOfImproperPartitionsInternal(i,m,cm-1) s - -- definition of exported functions - + numberOfImproperPartitions : (Integer,Integer) -> Integer numberOfImproperPartitions(n,m) == if n < 0 or m < 1 then return 0 if m = 1 or n = 0 then return 1 @@ -234275,6 +238071,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where s := s + numberOfImproperPartitions(n-i,m-1) s + unrankImproperPartitions0 : (Integer,Integer,Integer) -> List(Integer) unrankImproperPartitions0(n,m,k) == l : L I := nil$(L I) k < 0 => error"counting of partitions is started at 0" @@ -234292,6 +238089,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where l := append(l,list(n)$(L I))$(L I) l + unrankImproperPartitions1 : (Integer,Integer,Integer) -> List(Integer) unrankImproperPartitions1(n,m,k) == -- we use the counting procedure of the leaves in a tree -- having the following structure: First of all non-zero @@ -234324,6 +238122,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where for i in 1..m-cm repeat partition.(1+nonZeroPos.i) := nonZeros.i entries partition + subSet : (Integer,Integer,Integer) -> List(Integer) subSet(n,m,k) == k < 0 or n < 0 or m < 0 or m > n => error "improper argument to subSet" @@ -234342,6 +238141,8 @@ SymmetricGroupCombinatoricFunctions(): public == private where s := s-1 l + nextLatticePermutation : (List(Integer),List(Integer),Boolean) -> _ + List(Integer) nextLatticePermutation(lambda, lattP, constructNotFirst) == lprime : L I := conjugate(lambda)$PartitionsAndPermutations columns : NNI := (first(lambda)$(L I))::NNI @@ -234391,6 +238192,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where not constructNotFirst => nil$(L I) lattP + makeYoungTableau : (List(Integer),List(Integer)) -> Matrix(Integer) makeYoungTableau(lambda,gitter) == lprime : L I := conjugate(lambda)$PartitionsAndPermutations columns : NNI := (first(lambda)$(L I))::NNI @@ -234407,6 +238209,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where help(j) := help(j) + 1 ytab + listYoungTableaus : List(Integer) -> List(Matrix(Integer)) listYoungTableaus(lambda) == lattice : L I ytab : M I @@ -234418,6 +238221,8 @@ SymmetricGroupCombinatoricFunctions(): public == private where lattice := nextLatticePermutation(lambda,lattice,true) younglist + nextColeman : (List(Integer),List(Integer),Matrix(Integer)) -> _ + Matrix(Integer) nextColeman(alpha,beta,C) == nrow : NNI := #beta ncol : NNI := #alpha @@ -234460,9 +238265,11 @@ SymmetricGroupCombinatoricFunctions(): public == private where -- vrest(k) := vrest(k) - succ(k) setRow_!(coleman, nrow, vrest) + nextPartition: (Vector(Integer),Vector(Integer),Integer) -> Vector(Integer) nextPartition(gamma:V I, part:V I, number:I) == nextPartition(entries gamma, part, number) + nextPartition : (List(Integer),Vector(Integer),Integer) -> Vector(Integer) nextPartition(gamma:L I,part:V I,number:I) == n : NNI := #gamma vnull : V I := vector(nil()$(L I)) -- empty vector @@ -234489,6 +238296,8 @@ SymmetricGroupCombinatoricFunctions(): public == private where part(k) := 0 part + inverseColeman : (List(Integer),List(Integer),Matrix(Integer)) -> _ + List(Integer) inverseColeman(alpha,beta,C) == pi : L I := nil$(L I) nrow : NNI := #beta @@ -234505,6 +238314,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where help(i) := help(i) + 1 pi + coleman : (List(Integer),List(Integer),List(Integer)) -> Matrix(Integer) coleman(alpha,beta,pi) == nrow : NNI := #beta ncol : NNI := #alpha @@ -234623,13 +238433,15 @@ SymmetricFunctions(R:Ring): Exports == Implementation where (* package SYMFUNC *) (* - signFix: (UP, NonNegativeInteger) -> Vector R + symFunc : (R,PositiveInteger) -> Vector(R) symFunc(x, n) == signFix((monomial(1, 1)$UP - x::UP) ** n, 1 + n) + symFunc : List(R) -> Vector(R) symFunc l == - signFix(*/[monomial(1, 1)$UP - a::UP for a in l], 1 + #l) + signFix( */[monomial(1, 1)$UP - a::UP for a in l], 1 + #l) + signFix: (UP, NonNegativeInteger) -> Vector R signFix(p, n) == m := minIndex(v := vectorise(p, n)) + 1 for i in 0..((#v quo 2) - 1)::NonNegativeInteger repeat @@ -234851,6 +238663,8 @@ TableauxBumpers(S:OrderedSet):T==C where cf:(S,S)->B + bumprow : (((S,S) -> Boolean),List(S),List(List(S))) -> _ + Record(fs: Boolean,sd: List(S),td: List(List(S))) bumprow(cf,x:(PAIR),lls:(L PAIR))== if null lls then [false,x,[x]]$ROW @@ -234860,6 +238674,8 @@ TableauxBumpers(S:OrderedSet):T==C where else (rw:ROW:=bumprow(cf,x,rest lls); [rw.fs,rw.sd,cons(first lls,rw.td)]$ROW )) + bumptab : (((S,S) -> Boolean),List(S),List(List(List(S)))) -> _ + List(List(List(S))) bumptab(cf,x:(PAIR),llls:(L L PAIR))== if null llls then [[x]] @@ -234868,10 +238684,12 @@ TableauxBumpers(S:OrderedSet):T==C where then cons(rw.td, bumptab(cf,rw.sd,rest llls)) else cons(rw.td,rest llls)) + bumptab1 : (List(S),List(List(List(S)))) -> List(List(List(S))) bumptab1(x,llls)==bumptab((s1,s2) +-> s1 reduce$StreamFunctions2(PAIR,L L PAIR) + tab1 : List(List(S)) -> List(List(List(S))) tab1(lls:(L PAIR))== rd([],bumptab1,lls::(ST PAIR)) srt==>sort$(PAIR) @@ -234879,16 +238697,24 @@ TableauxBumpers(S:OrderedSet):T==C where lexorder:(PAIR,PAIR)->B lexorder(p1,p2)==if p1.1=p2.1 then p1.2 List(List(S)) lex lp==(sort$(L PAIR))((s1,s2) +-> lexorder(s1,s2), lp) + slex : List(S) -> List(List(S)) slex ls==lex([[i,j] for i in srt((s1, s2) +-> s1 List(S) inverse ls==[lss.2 for lss in lex([[j,i] for i in srt((s1,s2) +-> s1 Tableau(List(S)) tab(ls:(PAIR))==(tableau tab1 slex ls ) + maxrow : (List(S),List(List(List(S))),List(List(S)),_ + List(List(List(S))),List(List(List(S))),List(List(List(S)))) -> _ + Record(f1: List(S),f2: List(List(List(S))),f3: List(List(S)),_ + f4: List(List(List(S)))) maxrow(n,a,b,c,d,llls)== if null llls or null(first llls) then [n,a,b,c]$RC @@ -234897,9 +238723,12 @@ TableauxBumpers(S:OrderedSet):T==C where then maxrow(fst,d,rst,rest llls,cons(first llls,d),rest llls) else maxrow(n,a,b,c,cons(first llls,d),rest llls)) + mr : List(List(List(S))) -> Record(f1: List(S),_ + f2: List(List(List(S))),f3: List(List(S)),f4: List(List(List(S)))) mr llls==maxrow(first first llls,[],rest first llls,rest llls, [],llls) + untab : (List(List(S)),List(List(List(S)))) -> List(List(S)) untab(lp, llls)== if null llls then lp @@ -234911,7 +238740,10 @@ TableauxBumpers(S:OrderedSet):T==C where then [] else cons(rc.f3,rc.f4)))) + bat1 : List(List(List(S))) -> List(List(S)) bat1 llls==untab([],[reverse lls for lls in llls]) + + bat : Tableau(List(S)) -> List(List(S)) bat tb==bat1(listOfLists tb) *) @@ -235124,19 +238956,28 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where (* table?: Boolean := false + t: H := empty() + info?: Boolean := false + stats?: Boolean := false + used: NonNegativeInteger := 0 + ok: String := "o" + ko: String := "+" + domainName: String := empty()$String + initTable! : () -> Void initTable!(): Void == table? := true t := empty() void() + printInfo! : (String,String) -> Void printInfo!(s1: String, s2: String): Void == (empty? s1) or (empty? s2) => void() not usingTable? => @@ -235146,6 +238987,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where ko := s2 void() + startStats! : String -> Void startStats!(s: String): Void == empty? s => void() not table? => @@ -235155,6 +238997,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where domainName := s void() + printStats! : () -> Void printStats!(): Void == not table? => error "in printStats!()$TBCMPPK: not allowed to use hashtable" @@ -235167,6 +239010,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where output(" Table size: ", n::OutputForm)$OutputPackage output(" Entries reused: ", used::OutputForm)$OutputPackage + clearTable! : () -> Void clearTable!(): Void == not table? => error "in clearTable!()$TBCMPPK: not allowed to use hashtable" @@ -235177,12 +239021,16 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where domainName := empty()$String void() + usingTable? : () -> Boolean usingTable?() == table? + printingInfo? : () -> Boolean printingInfo?() == info? + makingStats? : () -> Boolean makingStats?() == stats? + extractIfCan : Key -> Union(Entry,"failed") extractIfCan(k: Key): Union(Entry,"failed") == not table? => "failed" :: Union(Entry,"failed") s: Union(Entry,"failed") := search(k,t) @@ -235192,6 +239040,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where return s "failed" :: Union(Entry,"failed") + insert! : (Key,Entry) -> Void insert!(k: Key, e:Entry): Void == not table? => void() t.k := e @@ -235320,17 +239169,18 @@ TangentExpansions(R:Field): Exports == Implementation where import SymmetricFunctions(UP) m1toN : Integer -> Integer - tanPIa: PI -> QF - - m1toN n == (odd? n => -1; 1) + m1toN n == (odd? n => -1; 1) + tanAn : (R,PositiveInteger) -> SparseUnivariatePolynomial(R) tanAn(a, n) == a * denom(q := tanPIa n) - numer q + tanNa : (R,Integer) -> R tanNa(a, n) == zero? n => 0 negative? n => - tanNa(a, -n) (numer(t := tanPIa(n::PI)) a) / ((denom t) a) + tanSum : List(R) -> R tanSum l == m := minIndex(v := symFunc l) +/[m1toN(i+1) * v(2*i - 1 + m) for i in 1..(#v quo 2)] @@ -235338,6 +239188,7 @@ TangentExpansions(R:Field): Exports == Implementation where -- tanPIa(n) returns P(a)/Q(a) such that -- if a = tan(u) then P(a)/Q(a) = tan(n * u); + tanPIa: PI -> QF tanPIa n == m := minIndex(v := symFunc(monomial(1, 1)$UP, n)) +/[m1toN(i+1) * v(2*i - 1 + m) for i in 1..(#v quo 2)] @@ -235540,6 +239391,8 @@ should be unique. \begin{chunk}{COQ UTSSOL} (* package UTSSOL *) (* + + seriesSolve : ((UTSSUPF -> UTSSUPF),List(F)) -> UTSF seriesSolve(f, l) == c1 := map((x:F):SUP F +-> x::(SUP F), l) @@ -235549,7 +239402,6 @@ should be unique. next: () -> F := nr := st.1 res: F - if ground?(coeff: SUP F := nr.1)$(SUP F) then res := ground coeff @@ -235673,17 +239525,21 @@ TemplateUtilities(): Exports == Implementation where import InputForm + stripC : (String,String) -> String stripC(s:String,u:String):String == i : Integer := position(u,s,1) i = 0 => s delete(s,i..) + stripCommentsAndBlanks : String -> String stripCommentsAndBlanks(s:String):String == trim(stripC(stripC(s,"++"),"--"),char " ") + parse : String -> InputForm parse(s:String):InputForm == ncParseFromString(s)$Lisp::InputForm + interpretString : String -> Any interpretString(s:String):Any == interpret parse s @@ -235772,6 +239628,7 @@ TexFormat1(S : SetCategory): public == private where import TexFormat() + coerce : S -> TexFormat coerce(s : S): TexFormat == coerce(s :: OutputForm)$TexFormat @@ -235898,16 +239755,19 @@ ToolsForSign(R:Ring): with if R is AlgebraicNumber then + nonQsign : R -> Union(Integer,"failed") nonQsign r == sign((r pretend AlgebraicNumber)::Expression( Integer))$ElementaryFunctionSign(Integer, Expression Integer) else + nonQsign : R -> Union(Integer,"failed") nonQsign r == "failed" if R has RetractableTo Fraction Integer then + sign : R -> Union(Integer,"failed") sign r == (u := retractIfCan(r)@Union(Fraction Integer, "failed")) case Fraction(Integer) => sign(u::Fraction Integer) @@ -235916,6 +239776,7 @@ ToolsForSign(R:Ring): with else if R has RetractableTo Integer then + sign : R -> Union(Integer,"failed") sign r == (u := retractIfCan(r)@Union(Integer, "failed")) case "failed" => "failed" @@ -235923,12 +239784,14 @@ ToolsForSign(R:Ring): with else + sign : R -> Union(Integer,"failed") sign r == zero? r => 0 r = 1 => 1 r = -1 => -1 "failed" + direction : String -> Integer direction st == st = "right" => 1 st = "left" => -1 @@ -236347,6 +240210,8 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): --% Two Dimensional Function Plots + draw : (Ex, SegmentBinding(Float), List(DrawOption)) -> _ + TwoDimensionalViewport draw(f:Ex,bind:BIND,l:L DROP) == -- create title if necessary if not option?(l,"title" :: Symbol) then @@ -236357,10 +240222,13 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' draw(makeFloatFunction(f,variable bind),segment bind,l) + draw : (Ex, SegmentBinding(Float)) -> TwoDimensionalViewport draw(f:Ex,bind:BIND) == draw(f,bind,nil()) --% Parametric Plane Curves + draw : (ParametricPlaneCurve(Ex), SegmentBinding(Float),_ + List(DrawOption)) -> TwoDimensionalViewport draw(ppc:PPC,bind:BIND,l:L DROP) == f := coordinate(ppc,1); g := coordinate(ppc,2) -- create title if necessary @@ -236375,12 +240243,16 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' draw(curve,segment bind,l) + draw : (ParametricPlaneCurve(Ex), + SegmentBinding(Float)) -> TwoDimensionalViewport draw(ppc:PPC,bind:BIND) == draw(ppc,bind,nil()) ------------------------------------------------------------------------ -- 3D - Curves (given by formulas) ------------------------------------------------------------------------ + makeObject : (ParametricSpaceCurve(Ex),SegmentBinding(Float),_ + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(psc:PSC,tBind:BIND,l:L DROP) == -- obtain dependent variable and coordinate functions t := variable tBind; tSeg := segment tBind @@ -236401,9 +240273,13 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' makeObject(curve,tSeg,l) + makeObject : (ParametricSpaceCurve(Ex), + SegmentBinding(Float)) -> ThreeSpace(DoubleFloat) makeObject(psc:PSC,tBind:BIND) == makeObject(psc,tBind,nil()) + draw : (ParametricSpaceCurve(Ex), SegmentBinding(Float), + List(DrawOption)) -> ThreeDimensionalViewport draw(psc:PSC,tBind:BIND,l:L DROP) == -- obtain dependent variable and coordinate functions t := variable tBind; tSeg := segment tBind @@ -236424,6 +240300,8 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' draw(curve,tSeg,l) + draw : (ParametricSpaceCurve(Ex), + SegmentBinding(Float)) -> ThreeDimensionalViewport draw(psc:PSC,tBind:BIND) == draw(psc,tBind,nil()) @@ -236433,6 +240311,9 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): --% Three Dimensional Function Plots + makeObject : (ParametricSurface(Ex), SegmentBinding(Float), + SegmentBinding(Float), List(DrawOption)) -> + ThreeSpace(DoubleFloat) makeObject(f:Ex,xBind:BIND,yBind:BIND,l:L DROP) == -- create title if necessary if not option?(l,"title" :: Symbol) then @@ -236449,9 +240330,13 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' makeObject(makeFloatFunction(f,x,y),xSeg,ySeg,l) + makeObject : (Ex, SegmentBinding(Float), SegmentBinding(Float)) -> + ThreeSpace(DoubleFloat) makeObject(f:Ex,xBind:BIND,yBind:BIND) == makeObject(f,xBind,yBind,nil()) + draw : (Ex, SegmentBinding(Float), SegmentBinding(Float), + List(DrawOption)) -> ThreeDimensionalViewport draw(f:Ex,xBind:BIND,yBind:BIND,l:L DROP) == -- create title if necessary if not option?(l,"title" :: Symbol) then @@ -236468,11 +240353,15 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' draw(makeFloatFunction(f,x,y),xSeg,ySeg,l) + draw : (Ex, SegmentBinding(Float), + SegmentBinding(Float)) -> ThreeDimensionalViewport draw(f:Ex,xBind:BIND,yBind:BIND) == draw(f,xBind,yBind,nil()) --% parametric surface + makeObject : (Ex, SegmentBinding(Float), SegmentBinding(Float), + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(s:PSF,uBind:BIND,vBind:BIND,l:L DROP) == f := coordinate(s,1); g := coordinate(s,2); h := coordinate(s,3) if not option?(l,"title" :: Symbol) then @@ -236489,9 +240378,13 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): makeFloatFunction(h,u,v)) makeObject(surf,uSeg,vSeg,l) + makeObject : (ParametricSurface(Ex), SegmentBinding(Float), + SegmentBinding(Float)) -> ThreeSpace(DoubleFloat) makeObject(s:PSF,uBind:BIND,vBind:BIND) == makeObject(s,uBind,vBind,nil()) + draw : (ParametricSurface(Ex), SegmentBinding(Float), + SegmentBinding(Float), List(DrawOption)) -> ThreeDimensionalViewport draw(s:PSF,uBind:BIND,vBind:BIND,l:L DROP) == f := coordinate(s,1); g := coordinate(s,2); h := coordinate(s,3) -- create title if necessary @@ -236513,6 +240406,8 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)): -- call 'draw' draw(surf,uSeg,vSeg,l) + draw : (ParametricSurface(Ex), SegmentBinding(Float), + SegmentBinding(Float)) -> ThreeDimensionalViewport draw(s:PSF,uBind:BIND,vBind:BIND) == draw(s,uBind,vBind,nil()) @@ -236729,6 +240624,8 @@ TopLevelDrawFunctionsForAlgebraicCurves(R,Ex): Exports == Implementation where error "draw: non-constant denominator" map(intConvert,numer rat)$PolynomialFunctions2(R,I) + draw : (Equation(Ex),Symbol,Symbol,List(DrawOption)) -> _ + TwoDimensionalViewport draw(eq,x,y,l) == -- obtain polynomial equation p := polyEquation eq @@ -237510,8 +241407,10 @@ SingleFloat value. EXTOVARERROR : String := _ "draw: when specifying function, left hand side must be a variable" + SMALLRANGEERROR : String := _ "draw: range is in interval with only one point" + DEPVARERROR : String := _ "draw: independent variable appears on lhs of function definition" @@ -237602,6 +241501,8 @@ SingleFloat value. --% Two Dimensional Function Plots + draw : ((DoubleFloat -> DoubleFloat), Segment(Float), + List(DrawOption)) -> TwoDimensionalViewport draw(f:SF -> SF,seg:SEG,l:L DROP) == -- set adaptive plotting off or on oldAdaptive := adaptive?()$PLOT @@ -237622,6 +241523,8 @@ SingleFloat value. -- draw drawPlot(pl,l) + draw : ((DoubleFloat -> DoubleFloat), + Segment(Float)) -> TwoDimensionalViewport draw(f:SF -> SF,seg:SEG) == draw(f,seg,nil()) --% Parametric Plane Curves @@ -237644,6 +241547,8 @@ SingleFloat value. -- draw drawPlot(pl,l) + draw : (ParametricPlaneCurve((DoubleFloat -> DoubleFloat)), + Segment(Float)) -> TwoDimensionalViewport draw(ppc:PPC,seg:SEG) == draw(ppc,seg,nil()) ------------------------------------------------------------------------ @@ -237669,6 +241574,9 @@ SingleFloat value. p.4 := func(p.1,p.2,p.3) llp + makeObject : (ParametricSpaceCurve((DoubleFloat -> DoubleFloat)), + Segment(Float), + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(psc:PSC,seg:SEG,l:L DROP) == sp := space l -- obtain dependent variable and coordinate functions @@ -237708,6 +241616,9 @@ SingleFloat value. for b in br repeat curve(s,b) s + makeObject : ((DoubleFloat -> Point(DoubleFloat)), + Segment(Float), + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(psc:PCFUN,seg:SEG,l:L DROP) == sp := space l -- create function SF -> Point SF with default or user-specified @@ -237739,16 +241650,25 @@ SingleFloat value. for b in br repeat curve(s,b) s + makeObject : (ParametricSpaceCurve((DoubleFloat -> DoubleFloat)), + Segment(Float)) -> ThreeSpace(DoubleFloat) makeObject(psc:PSC,seg:SEG) == makeObject(psc,seg,nil()) + makeObject : ((DoubleFloat -> Point(DoubleFloat)), + Segment(Float)) -> ThreeSpace(DoubleFloat) makeObject(psc:PCFUN,seg:SEG) == makeObject(psc,seg,nil()) + draw : (ParametricSpaceCurve((DoubleFloat -> DoubleFloat)), + Segment(Float), + List(DrawOption)) -> ThreeDimensionalViewport draw(psc:PSC,seg:SEG,l:L DROP) == sp := makeObject(psc,seg,l) makeViewport3D(sp, l) + draw : (ParametricSpaceCurve((DoubleFloat -> DoubleFloat)), + Segment(Float)) -> ThreeDimensionalViewport draw(psc:PSC,seg:SEG) == draw(psc,seg,nil()) @@ -237772,6 +241692,9 @@ SingleFloat value. r < min()$SF => min()$SF r + recolor : (((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + ((DoubleFloat,DoubleFloat,DoubleFloat) -> DoubleFloat)) -> + ((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)) recolor(ptFunc,colFunc) == (f1,f2) +-> pt := ptFunc(f1,f2) @@ -237783,6 +241706,9 @@ SingleFloat value. --% Three Dimensional Function Plots + makeObject : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + Segment(Float), Segment(Float), + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG,l:L DROP) == sp := space l -- process color function of two variables @@ -237811,18 +241737,28 @@ SingleFloat value. mesh := meshPar2Var(sp,first fcn,normalize xSeg,normalize ySeg,l) mesh + makeObject : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + Segment(Float), Segment(Float)) -> ThreeSpace(DoubleFloat) makeObject(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG) == makeObject(f,xSeg,ySeg,nil()) + draw : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + Segment(Float), Segment(Float), + List(DrawOption)) -> ThreeDimensionalViewport draw(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG,l:L DROP) == sp := makeObject(f, xSeg, ySeg, l) makeViewport3D(sp, l) + draw : (((DoubleFloat,DoubleFloat) -> DoubleFloat), + Segment(Float), Segment(Float)) -> ThreeDimensionalViewport draw(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG) == draw(f,xSeg,ySeg,nil()) --% parametric surface + makeObject: (ParametricSurface(((DoubleFloat,DoubleFloat) -> DoubleFloat)), + Segment(Float), Segment(Float), + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(s:PSF,uSeg:SEG,vSeg:SEG,l:L DROP) == sp := space l -- create functions from expressions @@ -237853,6 +241789,9 @@ SingleFloat value. mesh := meshPar2Var(sp,first fcn,normalize uSeg,normalize vSeg,l) mesh + makeObject : (((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + Segment(Float), Segment(Float), + List(DrawOption)) -> ThreeSpace(DoubleFloat) makeObject(s:PSFUN,uSeg:SEG,vSeg:SEG,l:L DROP) == sp := space l -- process color function of two variables @@ -237872,23 +241811,37 @@ SingleFloat value. mesh := meshPar2Var(sp,first fcn,normalize uSeg,normalize vSeg,l) mesh + makeObject: (ParametricSurface(((DoubleFloat,DoubleFloat) -> DoubleFloat)), + Segment(Float), Segment(Float)) -> ThreeSpace(DoubleFloat) makeObject(s:PSF,uSeg:SEG,vSeg:SEG) == makeObject(s,uSeg,vSeg,nil()) + draw : (ParametricSurface(((DoubleFloat,DoubleFloat) -> DoubleFloat)), + Segment(Float), Segment(Float), + List(DrawOption)) -> ThreeDimensionalViewport draw(s:PSF,uSeg:SEG,vSeg:SEG,l:L DROP) == mesh := makeObject(s,uSeg,vSeg,l) makeViewport3D(mesh,l) + draw : (ParametricSurface(((DoubleFloat,DoubleFloat) -> DoubleFloat)), + Segment(Float), Segment(Float)) -> ThreeDimensionalViewport draw(s:PSF,uSeg:SEG,vSeg:SEG) == draw(s,uSeg,vSeg,nil()) + makeObject : (((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + Segment(Float), Segment(Float)) -> ThreeSpace(DoubleFloat) makeObject(s:PSFUN,uSeg:SEG,vSeg:SEG) == makeObject(s,uSeg,vSeg,nil()) + draw : (((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + Segment(Float), Segment(Float), + List(DrawOption)) -> ThreeDimensionalViewport draw(s:PSFUN,uSeg:SEG,vSeg:SEG,l:L DROP) == mesh := makeObject(s,uSeg,vSeg,l) makeViewport3D(mesh,l) + draw : (((DoubleFloat,DoubleFloat) -> Point(DoubleFloat)), + Segment(Float), Segment(Float)) -> ThreeDimensionalViewport draw(s:PSFUN,uSeg:SEG,vSeg:SEG) == draw(s,uSeg,vSeg,nil()) @@ -238033,18 +241986,27 @@ TopLevelDrawFunctionsForPoints(): Exports == Implementation where (* package DRAWPT *) (* + draw: (List(Point(DoubleFloat)),List(DrawOption)) -> TwoDimensionalViewport draw(lp:L Pt,l:L DROP):VIEW2 == makeViewport2D(makeGraphImage([lp])$GraphImage,l)$VIEW2 + draw : List(Point(DoubleFloat)) -> TwoDimensionalViewport draw(lp:L Pt):VIEW2 == draw(lp,[]) + draw : (List(DoubleFloat),List(DoubleFloat),List(DrawOption)) -> _ + TwoDimensionalViewport draw(lx: L SF, ly: L SF, l:L DROP):VIEW2 == draw([point([x,y])$Pt for x in lx for y in ly],l) + draw : (List(DoubleFloat),List(DoubleFloat)) -> TwoDimensionalViewport draw(lx: L SF, ly: L SF):VIEW2 == draw(lx,ly,[]) + draw : (List(DoubleFloat),List(DoubleFloat),List(DoubleFloat)) -> _ + ThreeDimensionalViewport draw(x:L SF,y:L SF,z:L SF):VIEW3 == draw(x,y,z,[]) + draw : (List(DoubleFloat),List(DoubleFloat),List(DoubleFloat),_ + List(DrawOption)) -> ThreeDimensionalViewport draw(x:L SF,y:L SF,z:L SF,l:L DROP):VIEW3 == m : Integer := #x zero? m => error "No X values" @@ -238139,6 +242101,7 @@ TopLevelThreeSpace(): with (* package TOPSP *) (* + createThreeSpace : () -> ThreeSpace(DoubleFloat) createThreeSpace() == create3Space()$ThreeSpace(DoubleFloat) *) @@ -238267,8 +242230,9 @@ TranscendentalHermiteIntegration(F, UP): Exports == Implementation where import MonomialExtensionTools(F, UP) - normalHermiteIntegrate:(RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP) - + HermiteIntegrate : (Fraction(UP),(UP -> UP)) -> _ + Record(answer: Fraction(UP),logpart: Fraction(UP),_ + specpart: Fraction(UP),polypart: UP) HermiteIntegrate(f, derivation) == rec := decompose(f, derivation) hi := normalHermiteIntegrate(rec.normal, derivation) @@ -238282,6 +242246,7 @@ TranscendentalHermiteIntegration(F, UP): Exports == Implementation where -- reduction steps instead of O(n**2), like Mack's algorithm -- (D.Mack, On Rational Integration, Univ. of Utah C.S. Tech.Rep. UCP-38,1975) -- returns [g, b, d] s.t. f = g' + b/d and d is squarefree and normal wrt D + normalHermiteIntegrate:(RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP) normalHermiteIntegrate(f, derivation) == a := numer f q := denom f @@ -238840,35 +242805,26 @@ TranscendentalIntegration(F, UP): Exports == Implementation where import TranscendentalHermiteIntegration(F, UP) import CommuteUnivariatePolynomialCategory(F, UP, UP2) - primintegratepoly : (UP, F -> UF, F) -> Union(UPF, UPUP) - expintegratepoly : (GP, (Z, F) -> PSOL) -> Union(GPF, GPGP) - expextintfrac : (RF, UP -> UP, RF) -> Union(FFR, "failed") - explimintfrac : (RF, UP -> UP, List RF) -> Union(NL, "failed") - limitedLogs : (RF, RF -> RF, List RF) -> Union(LLG, "failed") - logprmderiv : (RF, UP -> UP) -> RF - logexpderiv : (RF, UP -> UP, F) -> RF - tanintegratespecial: (RF, RF -> RF, (Z, F, F) -> UF2) -> Union(RFF, RFRF) - UP2UP2 : UP -> UP2 - UP2UPR : UP -> UPR - UP22UPR : UP2 -> UPR - notelementary : REC -> IR - kappa : (UP, UP -> UP) -> UP - dummy:RF := 0 + logprmderiv : (RF, UP -> UP) -> RF logprmderiv(f, derivation) == differentiate(f, derivation) / f + UP2UP2 : UP -> UP2 UP2UP2 p == map(x+->x::UP, p)$UnivariatePolynomialCategoryFunctions2(F, UP, UP, UP2) + UP2UPR : UP -> UPR UP2UPR p == map(x+->x::UP::RF,p)$UnivariatePolynomialCategoryFunctions2(F,UP,RF,UPR) + UP22UPR : UP2 -> UPR UP22UPR p == map(x+->x::RF, p)$SparseUnivariatePolynomialFunctions2(UP, RF) -- given p in k[z] and a derivation on k[t] returns the coefficient lifting -- in k[z] of the restriction of D to k. + kappa : (UP, UP -> UP) -> UP kappa(p, derivation) == ans:UP := 0 while p ^= 0 repeat @@ -238877,6 +242833,9 @@ TranscendentalIntegration(F, UP): Exports == Implementation where ans -- works in any monomial extension + monomialIntegrate : (Fraction(UP),(UP -> UP)) -> _ + Record(ir: IntegrationResult(Fraction(UP)),specpart: Fraction(UP),_ + polypart: UP) monomialIntegrate(f, derivation) == zero? f => [0, 0, 0] r := HermiteIntegrate(f, derivation) @@ -238901,6 +242860,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns [q, r] such that p = q' + r and degree(r) < degree(dt) -- must have degree(derivation t) >= 2 + monomialIntPoly : (UP,(UP -> UP)) -> Record(answer: UP,polypart: UP) monomialIntPoly(p, derivation) == (d := degree(dt := derivation monomial(1,1))::Z) < 2 => error "monomIntPoly: monomial must have degree 2 or more" @@ -238914,6 +242874,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns either -- (q in GP, a in F) st p = q' + a, and a=0 or a has no integral in F -- or (q in GP, r in GP) st p = q' + r, and r has no integral elem/UP + expintegratepoly : (GP, (Z, F) -> PSOL) -> Union(GPF, GPGP) expintegratepoly(p, FRDE) == coef0:F := 0 notelm := answr := 0$GP @@ -238932,6 +242893,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns either -- (q in RF, a in F) st f = q' + a, and a=0 or a has no integral in F -- or (q in RF, r in RF) st f = q' + r, and r has no integral elem/UP + tanintegratespecial: (RF, RF -> RF, (Z, F, F) -> UF2) -> Union(RFF, RFRF) tanintegratespecial(f, derivation, FRDE) == ans:RF := 0 p := monomial(1, 2)$UP + 1 @@ -238952,6 +242914,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- g must have a squarefree denominator (always possible) -- g must have no polynomial part and no pole above t = 0 -- f must have no polynomial part and no pole above t = 0 + expextintfrac : (RF, UP -> UP, RF) -> Union(FFR, "failed") expextintfrac(f, derivation, g) == zero? f => [0, 0] degree numer f >= degree denom f => error "Not a proper fraction" @@ -238965,6 +242928,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where differentiate(c := r.logpart / g, derivation) ^= 0 => "failed" [r.answer, c] + limitedLogs : (RF, RF -> RF, List RF) -> Union(LLG, "failed") limitedLogs(f, logderiv, lu) == zero? f => empty() empty? lu => "failed" @@ -238998,12 +242962,18 @@ TranscendentalIntegration(F, UP): Exports == Implementation where ans -- returns q in UP s.t. p = q', or "failed" + primintfldpoly : + (UP,(F -> Union(Record(ratpart: F,coeff: F),"failed")),F) -> + Union(UP,"failed") primintfldpoly(p, extendedint, t') == (u := primintegratepoly(p, extendedint, t')) case UPUP => "failed" u.a0 ^= 0 => "failed" u.answer -- returns q in GP st p = q', or "failed" + expintfldpoly : (LaurentPolynomial(F,UP),_ + ((Integer,F) -> Record(ans: F,right: F,sol?: Boolean))) -> _ + Union(LaurentPolynomial(F,UP),"failed") expintfldpoly(p, FRDE) == (u := expintegratepoly(p, FRDE)) case GPGP => "failed" u.a0 ^= 0 => "failed" @@ -239012,6 +242982,12 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0, -- and f = v' + a + +/[ci * ui'/ui] -- and a = 0 or a has no integral in UP + primlimitedint : (Fraction(UP),(UP -> UP),_ + (F -> Union(Record(ratpart: F,coeff: F),"failed")),_ + List(Fraction(UP))) -> + Union(Record(answer: Record(mainpart: Fraction(UP), + limitedlogs: List(Record(coeff: Fraction(UP), + logand: Fraction(UP)))),a0: F),"failed") primlimitedint(f, derivation, extendedint, lu) == qr := divide(numer f, denom f) (u1 := primlimintfrac(qr.remainder / (denom f), derivation, lu)) @@ -239023,6 +242999,12 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0, -- and f = v' + a + +/[ci * ui'/ui] -- and a = 0 or a has no integral in F + explimitedint : (Fraction(UP),(UP -> UP), + ((Integer,F) -> Record(ans: F,right: F,sol?: Boolean)), + List(Fraction(UP))) -> + Union(Record(answer: Record(mainpart: Fraction(UP), + limitedlogs: List(Record(coeff: Fraction(UP), + logand: Fraction(UP)))),a0: F),"failed") explimitedint(f, derivation, FRDE, lu) == qr := separate(f)$GP (u1 := explimintfrac(qr.fracPart,derivation, lu)) case "failed" => @@ -239032,6 +243014,10 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui] -- f must have no polynomial part (degree numer f < degree denom f) + primlimintfrac : (Fraction(UP),(UP -> UP),List(Fraction(UP))) -> _ + Union(Record(mainpart: Fraction(UP),_ + limitedlogs: List(Record(coeff: Fraction(UP),_ + logand: Fraction(UP)))),"failed") primlimintfrac(f, derivation, lu) == zero? f => [0, empty()] degree numer f >= degree denom f => error "Not a proper fraction" @@ -239044,6 +243030,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui] -- f must have no polynomial part (degree numer f < degree denom f) -- f must be integral above t = 0 + explimintfrac : (RF, UP -> UP, List RF) -> Union(NL, "failed") explimintfrac(f, derivation, lu) == zero? f => [0, empty()] degree numer f >= degree denom f => error "Not a proper fraction" @@ -239057,15 +243044,20 @@ TranscendentalIntegration(F, UP): Exports == Implementation where +/[((degree numer(v.logand))::Z - (degree denom(v.logand))::Z) * v.coeff for v in u], u::LLG] + logexpderiv : (RF, UP -> UP, F) -> RF logexpderiv(f, derivation, eta') == (differentiate(f, derivation) / f) - (((degree numer f)::Z - (degree denom f)::Z) * eta')::UP::RF + notelementary : REC -> IR notelementary rec == rec.ir + integral(rec.polypart::RF + rec.specpart, monomial(1,1)$UP:: RF) -- returns -- (g in IR, a in F) st f = g'+ a, and a=0 or a has no integral in UP + primintegrate : (Fraction(UP),(UP -> UP), + (F -> Union(Record(ratpart: F,coeff: F),"failed"))) -> + Record(answer: IntegrationResult(Fraction(UP)),a0: F) primintegrate(f, derivation, extendedint) == rec := monomialIntegrate(f, derivation) not elem?(i1 := rec.ir) => [notelementary rec, 0] @@ -239077,6 +243069,9 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns -- (g in IR, a in F) st f = g' + a, and a = 0 or a has no integral in F + expintegrate : (Fraction(UP),(UP -> UP), + ((Integer,F) -> Record(ans: F,right: F,sol?: Boolean))) -> + Record(answer: IntegrationResult(Fraction(UP)),a0: F) expintegrate(f, derivation, FRDE) == rec := monomialIntegrate(f, derivation) not elem?(i1 := rec.ir) => [notelementary rec, 0] @@ -239090,6 +243085,9 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns -- (g in IR, a in F) st f = g' + a, and a = 0 or a has no integral in F + tanintegrate : (Fraction(UP),(UP -> UP), + ((Integer,F,F) -> Union(List(F),"failed"))) -> + Record(answer: IntegrationResult(Fraction(UP)),a0: F) tanintegrate(f, derivation, FRDE) == rec := monomialIntegrate(f, derivation) not elem?(i1 := rec.ir) => [notelementary rec, 0] @@ -239111,6 +243109,10 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 -- or (v in RF, a in F) s.t. f = v' + a -- and a = 0 or a has no integral in UP + primextendedint : (Fraction(UP),(UP -> UP), + (F -> Union(Record(ratpart: F,coeff: F),"failed")),Fraction(UP)) -> + Union(Record(answer: Fraction(UP),a0: F), + Record(ratpart: Fraction(UP),coeff: Fraction(UP)),"failed") primextendedint(f, derivation, extendedint, g) == fqr := divide(numer f, denom f) gqr := divide(numer g, denom g) @@ -239130,6 +243132,10 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 -- or (v in RF, a in F) s.t. f = v' + a -- and a = 0 or a has no integral in F + expextendedint : (Fraction(UP),(UP -> UP), + ((Integer,F) -> Record(ans: F,right: F,sol?: Boolean)),Fraction(UP)) -> + Union(Record(answer: Fraction(UP),a0: F), + Record(ratpart: Fraction(UP),coeff: Fraction(UP)),"failed") expextendedint(f, derivation, FRDE, g) == qf := separate(f)$GP qg := separate g @@ -239147,6 +243153,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- returns either -- (q in UP, a in F) st p = q'+ a, and a=0 or a has no integral in UP -- or (q in UP, r in UP) st p = q'+ r, and r has no integral elem/UP + primintegratepoly : (UP, F -> UF, F) -> Union(UPF, UPUP) primintegratepoly(p, extendedint, t') == zero? p => [0, 0$F] ans:UP := 0 @@ -239163,6 +243170,8 @@ TranscendentalIntegration(F, UP): Exports == Implementation where -- g must have a squarefree denominator (always possible) -- g must have no polynomial part (degree numer g < degree denom g) -- f must have no polynomial part (degree numer f < degree denom f) + primextintfrac : (Fraction(UP),(UP -> UP),Fraction(UP)) -> + Union(Record(ratpart: Fraction(UP),coeff: Fraction(UP)),"failed") primextintfrac(f, derivation, g) == zero? f => [0, 0] degree numer f >= degree denom f => error "Not a proper fraction" @@ -239524,7 +243533,7 @@ TranscendentalManipulations(R, F): Exports == Implementation where i := i+1 if is?(terms.i,"log"::Symbol) then args : List F := argument(retract(terms.i)@K) - setelt(terms,i, log simplifyLog1(first(args)**(*/exprs))) + setelt(terms,i, log simplifyLog1(first(args)**( */exprs))) foundLog := true -- The next line deals with a situation which shouldn't occur, -- since we have checked whether we are freeOf log already. @@ -239919,36 +243928,7 @@ so the result is 0 import FactoredFunctions(P) import PolynomialCategoryLifting(IndexedExponents K, K, R, P, F) - import - PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,P,F) - - smpexp : P -> F - termexp : P -> F - exlog : P -> F - smplog : P -> F - smpexpand : P -> F - smp2htrigs: P -> F - kerexpand : K -> F - expandpow : K -> F - logexpand : K -> F - sup2htrigs: (UP, F) -> F - supexp : (UP, F, F, Z) -> F - ueval : (F, String, F -> F) -> F - ueval2 : (F, String, F -> F) -> F - powersimp : (P, List K) -> F - t2t : F -> F - c2t : F -> F - c2s : F -> F - s2c : F -> F - s2c2 : F -> F - th2th : F -> F - ch2th : F -> F - ch2sh : F -> F - sh2ch : F -> F - sh2ch2 : F -> F - simplify0 : F -> F - simplifyLog1 : F -> F - logArgs : List F -> F + import PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,P,F) import F import List F @@ -239993,12 +243973,14 @@ so the result is 0 coshmcosh : RewriteRule(R,R,F) := rule(cosh(XX)-cosh(YY),(2*sinh(1/2*(XX+YY))*sinh(1/2*(XX-YY)))::F) + expandTrigProducts : F -> F expandTrigProducts(e:F):F == applyRules([sinCosRule,sinSinRule,cosCosRule, sinhSum,coshSum,tanhSum,cothSum, sinhpsinh,sinhmsinh,coshpcosh, coshmcosh],e,10)$ApplyRules(R,R,F) + logArgs : List F -> F logArgs(l:List F):F == -- This function will take a list of Expressions (implicitly a sum) and -- add them up, combining log terms. It also replaces n*log(x) by @@ -240016,17 +243998,17 @@ so the result is 0 sum := sum+term sum+log(arg) + simplifyLog : F -> F simplifyLog(e:F):F == simplifyLog1(numerator e)/simplifyLog1(denominator e) + simplifyLog1 : F -> F simplifyLog1(e:F):F == freeOf?(e,"log"::Symbol) => e - -- Check for n*log(u) prod : Union(PRODUCT, "failed") := isMult(e) (prod case PRODUCT) and is?(prod.var,"log"::Symbol) => log simplifyLog ((first argument(prod.var))**(prod.coef)) - termList : Union(List(F),"failed") := isTimes(e) -- I'm using two variables, termList and terms, to work round a -- bug in the old compiler. @@ -240048,29 +244030,32 @@ so the result is 0 i := i+1 if is?(terms.i,"log"::Symbol) then args : List F := argument(retract(terms.i)@K) - setelt(terms,i, log simplifyLog1(first(args)**(*/exprs))) + setelt(terms,i, log simplifyLog1(first(args)**( */exprs))) foundLog := true -- The next line deals with a situation which shouldn't occur, -- since we have checked whether we are freeOf log already. if not foundLog then terms := append(exprs,terms) */terms - terms : Union(List(F),"failed") := isPlus(e) not (terms case "failed") => logArgs(terms) - expt : Union(POW, "failed") := isPower(e) (expt case POW) and not (expt.exponent = 1) => simplifyLog(expt.val)**(expt.exponent) - kers : List K := kernels e not(((#kers) = 1)) => e -- Have a constant kernel(operator first kers,[simplifyLog(u) for u in argument first kers]) if R has RetractableTo Integer then + + simplify : F -> F simplify x == rootProduct(simplify0 x)$AlgebraicManipulations(R,F) - else simplify x == simplify0 x + else + simplify : F -> F + simplify x == simplify0 x + + expandpow : K -> F expandpow k == a := expandPower first(arg := argument k) b := expandPower second arg @@ -240078,6 +244063,7 @@ so the result is 0 de:F := (((denom a) = 1) => 1; denom(a)::F ** (-b)) ne * de + termexp : P -> F termexp p == exponent:F := 0 coef := (leadingCoefficient p)::P @@ -240095,11 +244081,13 @@ so the result is 0 [simplifyExp u for u in argument k], height k), d) coef::F * exp exponent * powersimp(p, lpow) + expandPower : F -> F expandPower f == l := select((z:K):Boolean +-> is?(z, POWER)$K, kernels f)$List(K) eval(f, l, [expandpow k for k in l]) -- l is a list of pure powers appearing as kernels in p + powersimp : (P, List K) -> F powersimp(p, l) == empty? l => 1 k := first l -- k = a**b @@ -240111,82 +244099,121 @@ so the result is 0 exponent := exponent + degree(p, k0) * second argument k0 (a ** exponent) * powersimp(p, setDifference(rest l, lk)) - t2t x == sin(x) / cos(x) + t2t : F -> F + t2t x == sin(x) / cos(x) - c2t x == cos(x) / sin(x) + c2t : F -> F + c2t x == cos(x) / sin(x) - c2s x == inv sin x + c2s : F -> F + c2s x == inv sin x - s2c x == inv cos x + s2c : F -> F + s2c x == inv cos x - s2c2 x == 1 - cos(x)**2 + s2c2 : F -> F + s2c2 x == 1 - cos(x)**2 - th2th x == sinh(x) / cosh(x) + th2th : F -> F + th2th x == sinh(x) / cosh(x) - ch2th x == cosh(x) / sinh(x) + ch2th : F -> F + ch2th x == cosh(x) / sinh(x) - ch2sh x == inv sinh x + ch2sh : F -> F + ch2sh x == inv sinh x - sh2ch x == inv cosh x + sh2ch : F -> F + sh2ch x == inv cosh x - sh2ch2 x == cosh(x)**2 - 1 + sh2ch2 : F -> F + sh2ch2 x == cosh(x)**2 - 1 + ueval : (F, String, F -> F) -> F ueval(x, s,f) == eval(x, s::Symbol, f) + ueval2 : (F, String, F -> F) -> F ueval2(x,s,f) == eval(x, s::Symbol, 2, f) - cos2sec x == ueval(x, "cos", (z1:F):F +-> inv sec z1) + cos2sec : F -> F + cos2sec x == ueval(x, "cos", (z1:F):F +-> inv sec z1) - sin2csc x == ueval(x, "sin", (z1:F):F +-> inv csc z1) + sin2csc : F -> F + sin2csc x == ueval(x, "sin", (z1:F):F +-> inv csc z1) - csc2sin x == ueval(x, "csc", c2s) + csc2sin : F -> F + csc2sin x == ueval(x, "csc", c2s) - sec2cos x == ueval(x, "sec", s2c) + sec2cos : F -> F + sec2cos x == ueval(x, "sec", s2c) - tan2cot x == ueval(x, "tan", (z1:F):F +-> inv cot z1) + tan2cot : F -> F + tan2cot x == ueval(x, "tan", (z1:F):F +-> inv cot z1) - cot2tan x == ueval(x, "cot", (z1:F):F +-> inv tan z1) + cot2tan : F -> F + cot2tan x == ueval(x, "cot", (z1:F):F +-> inv tan z1) - tan2trig x == ueval(x, "tan", t2t) + tan2trig : F -> F + tan2trig x == ueval(x, "tan", t2t) - cot2trig x == ueval(x, "cot", c2t) + cot2trig : F -> F + cot2trig x == ueval(x, "cot", c2t) - cosh2sech x == ueval(x, "cosh", (z1:F):F +-> inv sech z1) + cosh2sech : F -> F + cosh2sech x == ueval(x, "cosh", (z1:F):F +-> inv sech z1) - sinh2csch x == ueval(x, "sinh", (z1:F):F +-> inv csch z1) + sinh2csch : F -> F + sinh2csch x == ueval(x, "sinh", (z1:F):F +-> inv csch z1) - csch2sinh x == ueval(x, "csch", ch2sh) + csch2sinh : F -> F + csch2sinh x == ueval(x, "csch", ch2sh) - sech2cosh x == ueval(x, "sech", sh2ch) + sech2cosh : F -> F + sech2cosh x == ueval(x, "sech", sh2ch) - tanh2coth x == ueval(x, "tanh", (z1:F):F +-> inv coth z1) + tanh2coth : F -> F + tanh2coth x == ueval(x, "tanh", (z1:F):F +-> inv coth z1) - coth2tanh x == ueval(x, "coth", (z1:F):F +-> inv tanh z1) + coth2tanh : F -> F + coth2tanh x == ueval(x, "coth", (z1:F):F +-> inv tanh z1) + tanh2trigh : F -> F tanh2trigh x == ueval(x, "tanh", th2th) + coth2trigh : F -> F coth2trigh x == ueval(x, "coth", ch2th) + removeCosSq : F -> F removeCosSq x == ueval2(x, "cos", (z1:F):F +-> 1 - (sin z1)**2) + removeSinSq : F -> F removeSinSq x == ueval2(x, "sin", s2c2) + removeCoshSq : F -> F removeCoshSq x== ueval2(x, "cosh", (z1:F):F +-> 1 + (sinh z1)**2) + removeSinhSq : F -> F removeSinhSq x== ueval2(x, "sinh", sh2ch2) - expandLog x == smplog(numer x) / smplog(denom x) + expandLog : F -> F + expandLog x == smplog(numer x) / smplog(denom x) + simplifyExp : F -> F simplifyExp x == (smpexp numer x) / (smpexp denom x) - expand x == (smpexpand numer x) / (smpexpand denom x) + expand : F -> F + expand x == (smpexpand numer x) / (smpexpand denom x) - smpexpand p == map(kerexpand, (r1:R):F +-> r1::F, p) + smpexpand : P -> F + smpexpand p == map(kerexpand, (r1:R):F +-> r1::F, p) - smplog p == map(logexpand, (r1:R):F +-> r1::F, p) + smplog : P -> F + smplog p == map(logexpand, (r1:R):F +-> r1::F, p) + smp2htrigs: P -> F smp2htrigs p == map((k1:K):F +-> htrigs(k1::F), (r1:R):F +-> r1::F, p) + htrigs : F -> F htrigs f == (m := mainKernel f) case "failed" => f op := operator(k := m::K) @@ -240199,6 +244226,7 @@ so the result is 0 supexp(num,g1,g2,b:= (degree num)::Z quo 2)/supexp(den,g1,g2,b) sup2htrigs(num, g1:= op arg) / sup2htrigs(den, g1) + supexp : (UP, F, F, Z) -> F supexp(p, f1, f2, bse) == ans:F := 0 while p ^= 0 repeat @@ -240209,17 +244237,21 @@ so the result is 0 p := reductum p ans + sup2htrigs: (UP, F) -> F sup2htrigs(p, f) == (map(smp2htrigs, p)$SparseUnivariatePolynomialFunctions2(P, F)) f + exlog : P -> F exlog p == +/[r.coef * log(r.logand::F) for r in log squareFree p] + logexpand : K -> F logexpand k == nullary?(op := operator k) => k::F is?(op, "log"::Symbol) => exlog(numer(x := expandLog first argument k)) - exlog denom x op [expandLog x for x in argument k]$List(F) + kerexpand : K -> F kerexpand k == nullary?(op := operator k) => k::F is?(op, POWER) => expandpow k @@ -240248,6 +244280,7 @@ so the result is 0 op [expand x for x in argument k]$List(F) op [expand x for x in argument k]$List(F) + smpexp : P -> F smpexp p == ans:F := 0 while p ^= 0 repeat @@ -240259,6 +244292,7 @@ so the result is 0 -- pass1 rewrites trigs and htrigs in terms of sin,cos,sinh,cosh -- pass2 rewrites sin**2 and sinh**2 in terms of cos and cosh. -- pass3 groups exponentials together + simplify0 : F -> F simplify0 x == simplifyExp eval(eval(x, ["tan"::Symbol,"cot"::Symbol,"sec"::Symbol,"csc"::Symbol, @@ -240500,14 +244534,12 @@ TranscendentalRischDE(F, UP): Exports == Implementation where import MonomialExtensionTools(F, UP) - getBound : (UP, UP, Z) -> Z - SPDEnocancel1: (UP, UP, Z, UP -> UP) -> PSOL - SPDEnocancel2: (UP, UP, Z, Z, F, UP -> UP) -> ANS - SPDE : (UP, UP, UP, Z, UP -> UP) -> Union(SPE, "failed") - -- cancellation at infinity is possible, A is assumed nonzero -- needs tagged union because of branch choice problem -- always returns a PSOL in the base case (never a SPE) + polyRDE : (UP,UP,UP,Integer,(UP -> UP)) -> + Union(ans: Record(ans: UP,nosol: Boolean), + eq: Record(b: UP,c: UP,m: Integer,alpha: UP,beta: UP)) polyRDE(aa, bb, cc, d, derivation) == n:Z (u := SPDE(aa, bb, cc, d, derivation)) case "failed" => [[0, true]] @@ -240534,6 +244566,7 @@ TranscendentalRischDE(F, UP): Exports == Implementation where -- otherwise [B, C, m, \alpha, \beta] such that any soln p of degree at -- most d of a p' + b p = c must be of the form p = \alpha h + \beta, -- where h' + B h = C and h has degree at most m + SPDE : (UP, UP, UP, Z, UP -> UP) -> Union(SPE, "failed") SPDE(aa, bb, cc, d, derivation) == zero? cc => [0, 0, 0, 0, 0] d < 0 => "failed" @@ -240557,6 +244590,7 @@ TranscendentalRischDE(F, UP): Exports == Implementation where -- this implies no cancellation at infinity, BQ term dominates -- returns [Q, flag] such that Q is a solution if flag is false, -- a partial solution otherwise. + SPDEnocancel1: (UP, UP, Z, UP -> UP) -> PSOL SPDEnocancel1(bb, cc, d, derivation) == q:UP := 0 db := (degree bb)::Z @@ -240572,6 +244606,7 @@ TranscendentalRischDE(F, UP): Exports == Implementation where -- case (t is a nonlinear monomial) and (B = 0 or degree(B) < degree(Dt) - 1) -- this implies no cancellation at infinity, DQ term dominates or degree(Q) = 0 -- dtm1 = degree(Dt) - 1 + SPDEnocancel2: (UP, UP, Z, Z, F, UP -> UP) -> ANS SPDEnocancel2(bb, cc, d, dtm1, lt, derivation) == q:UP := 0 while cc ^= 0 repeat @@ -240591,6 +244626,8 @@ TranscendentalRischDE(F, UP): Exports == Implementation where q := q + r::UP [[q, false]] + monomRDE : (Fraction(UP),Fraction(UP),(UP -> UP)) -> + Union(Record(a: UP,b: Fraction(UP),c: Fraction(UP),t: UP),"failed") monomRDE(f, g, derivation) == gg := gcd(d := normalDenom(f,derivation), e := normalDenom(g,derivation)) tt := (gcd(e, differentiate e) exquo gcd(gg,differentiate gg))::UP @@ -240600,6 +244637,8 @@ TranscendentalRischDE(F, UP): Exports == Implementation where -- solve y' + f y = g for y in RF -- assumes that f is weakly normalized (no finite cancellation) -- base case: F' = 0 + baseRDE : (Fraction(UP),Fraction(UP)) -> + Record(ans: Fraction(UP),nosol: Boolean) baseRDE(f, g) == (u := monomRDE(f, g, differentiate)) case "failed" => [0, true] n := getBound(u.a,bb := retract(u.b)@UP,degree(cc := retract(u.c)@UP)::Z) @@ -240609,6 +244648,7 @@ TranscendentalRischDE(F, UP): Exports == Implementation where -- return an a bound on the degree of a solution of A P'+ B P = C,A ^= 0 -- cancellation at infinity is possible -- base case: F' = 0 + getBound : (UP, UP, Z) -> Z getBound(a, b, dc) == da := (degree a)::Z zero? b => max(0, dc - da + 1) @@ -240904,19 +244944,14 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where import MonomialExtensionTools(F, UP) import SmithNormalForm(UP, V, V, Matrix UP) - diophant: (UP, UP, UP, UP, UP) -> Union(REC, "failed") - getBound: (UP, UP, UP, UP, UP) -> Z - SPDEsys : (UP, UP, UP, UP, UP, Z, UP -> UP, (F, F, F, UP, UP, Z) -> U) -> U - DSPDEsys: (F, UP, UP, UP, UP, Z, UP -> UP) -> U - DSPDEmix: (UP, UP, F, F, N, Z, F) -> U - DSPDEhdom: (UP, UP, F, F, N, Z) -> U - DSPDEbdom: (UP, UP, F, F, N, Z) -> U - DSPDEsys0: (F, UP, UP, UP, UP, F, F, Z, UP -> UP, (UP,UP,F,F,N) -> U) -> U -- reduces (y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2) to -- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2), Q1 = y1 T, Q2 = y2 T -- where A and H are polynomials, and B,C1,C2,Q1 and Q2 have no normal poles. -- assumes that f is weakly normalized (no finite cancellation) + monomRDEsys : (Fraction(UP),Fraction(UP),Fraction(UP),(UP -> UP)) -> + Union(Record(a: UP,b: Fraction(UP),h: UP,c1: Fraction(UP), + c2: Fraction(UP),t: UP),"failed") monomRDEsys(f, g1, g2, derivation) == gg := gcd(d := normalDenom(f, derivation), e := lcm(normalDenom(g1,derivation),normalDenom(g2,derivation))) @@ -240927,6 +244962,8 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where -- solve (y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2) for y1,y2 in RF -- assumes that f is weakly normalized (no finite cancellation) and nonzero -- base case: F' = 0 + baseRDEsys : (Fraction(UP),Fraction(UP),Fraction(UP)) -> + Union(List(Fraction(UP)),"failed") baseRDEsys(f, g1, g2) == zero? f => error "baseRDEsys: f must be nonzero" zero? g1 and zero? g2 => [0, 0] @@ -240946,6 +244983,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where -- i.e. (D1,D2) = ((A, 0, B, -C), (0, A, C, B)) (Z1, Z2, R1, R2) -- for R1, R2 with degree(Ri) < degree(A) -- assumes (A,B,C) = (1) and A and C are nonzero + diophant: (UP, UP, UP, UP, UP) -> Union(REC, "failed") diophant(a, b, c, d1, d2) == (u := diophantineSystem(matrix [[a,0,b,-c], [0,a,c,b]], vector [d1,d2]).particular) case "failed" => "failed" @@ -240960,6 +244998,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where -- for polynomials Q1 and Q2 with degree <= n -- A and B are nonzero -- cancellation at infinity is possible + SPDEsys : (UP, UP, UP, UP, UP, Z, UP -> UP, (F, F, F, UP, UP, Z) -> U) -> U SPDEsys(a, b, h, c1, c2, n, derivation, degradation) == zero? c1 and zero? c2 => [0, 0] n < 0 => "failed" @@ -240990,6 +245029,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where -- for polynomials Q1 and Q2 with degree <= n -- a and B are nonzero, either B or H has positive degree -- cancellation at infinity is not possible + DSPDEsys: (F, UP, UP, UP, UP, Z, UP -> UP) -> U DSPDEsys(a, b, h, c1, c2, n, derivation) == bb := degree(b)::Z hh:Z := @@ -241007,6 +245047,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation, (z1,z2,z3,z4,z5) +-> DSPDEmix(z1,z2,z3,z4,z5,bb,det)) + DSPDEsys0: (F, UP, UP, UP, UP, F, F, Z, UP -> UP, (UP,UP,F,F,N) -> U) -> U DSPDEsys0(a, b, h, c1, c2, lb, lh, n, derivation, getlc) == ans1 := ans2 := 0::UP repeat @@ -241021,6 +245062,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where ans1 := ans1 + q1 ans2 := ans2 + q2 + DSPDEmix: (UP, UP, F, F, N, Z, F) -> U DSPDEmix(c1, c2, lb, lh, n, d, det) == rh1:F := zero? c1 => 0 @@ -241036,7 +245078,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where q2 := (rh2 * lh - rh1 * lb) / det [monomial(q1, n), monomial(q2, n)] - + DSPDEhdom: (UP, UP, F, F, N, Z) -> U DSPDEhdom(c1, c2, lb, lh, n, d) == q1:UP := zero? c1 => 0 @@ -241050,6 +245092,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where monomial(leadingCoefficient(c2) / lh, n) [q1, q2] + DSPDEbdom: (UP, UP, F, F, N, Z) -> U DSPDEbdom(c1, c2, lb, lh, n, d) == q1:UP := zero? c2 => 0 @@ -241068,6 +245111,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where -- cancellation at infinity is possible -- a and b are nonzero -- base case: F' = 0 + getBound: (UP, UP, UP, UP, UP) -> Z getBound(a, b, h, c1, c2) == da := (degree a)::Z dc := @@ -241925,31 +245969,8 @@ generates the error (reported as bug \# 102): import TransSolvePackageService(R) import MultivariateFactorize(K, IndexedExponents K, R, SMP(R, K)) - ---- Local Function Declarations ---- - - solveInner : (RE, S) -> L EQ RE - tryToTrans : ( RE , S) -> RE - - eliminateKernRoot: (RE , K) -> RE - eliminateRoot: (RE , S) -> RE - - combineLog : ( RE , S ) -> RE - testLog : ( RE , S ) -> Boolean - splitExpr : ( RE ) -> L RE - buildnexpr : ( RE , S ) -> L RE - logsumtolog : RE -> RE - logexpp : ( RE , RE ) -> RE - - testRootk : ( RE, S) -> Boolean - testkernel : ( RE , S ) -> Boolean - funcinv : ( RE , RE ) -> Union(RE,"failed") - testTrig : ( RE , S ) -> Boolean - testHTrig : ( RE , S ) -> Boolean - tableXkernels : ( RE , S ) -> L RE - subsTan : ( RE , S ) -> RE - -- exported functions - + solve : Expression(R) -> List(Equation(Expression(R))) solve(oside: RE) : L EQ RE == zero? oside => error "equation is always satisfied" lv := variables oside @@ -241957,13 +245978,16 @@ generates the error (reported as bug \# 102): #lv>1 => error "too many variables" solve(oside,lv.first) + solve : Equation(Expression(R)) -> List(Equation(Expression(R))) solve(equ:EQ RE) : L EQ RE == solve(lhs(equ)-rhs(equ)) + solve : (Equation(Expression(R)),Symbol) -> List(Equation(Expression(R))) solve(equ:EQ RE, x:S) : L EQ RE == oneside:=lhs(equ)-rhs(equ) solve(oneside,x) + testZero? : (RE,EQ RE) -> Boolean testZero?(lside:RE,sol:EQ RE):Boolean == if R has QuotientFieldCategory(Integer) then retractIfCan(rhs sol)@Union(Integer,"failed") case "failed" => true @@ -241973,13 +245997,14 @@ generates the error (reported as bug \# 102): zero? eval(lside,sol) => true false + solve : (Expression(R),Symbol) -> List(Equation(Expression(R))) solve(lside: RE, x:S) : L EQ RE == [sol for sol in solveInner(lside,x) | testZero?(lside,sol)] + solveInner : (RE, S) -> L EQ RE solveInner(lside: RE, x:S) : L EQ RE == lside:=eliminateRoot(lside,x) ausgabe1:=tableXkernels(lside,x) - X:=new()@Symbol Y:=new()@Symbol::RE (#ausgabe1) = 1 => @@ -242001,7 +246026,6 @@ generates the error (reported as bug \# 102): return "append"/[solve(bigX_back-ri, x) for ri in r1] newlist:=[]::L EQ RE - for i in 1..#r1 repeat elR := eliminateRoot((numer(bigX_back - r1(i))::RE ),x) f:=univariate(elR, kernel(x)) @@ -242022,10 +246046,9 @@ generates the error (reported as bug \# 102): sols return []::L EQ RE - -- local functions - -- This function was suggested by Manuel Bronstein as a simpler -- alternative to normalize. + simplifyingLog : RE -> RE simplifyingLog(f:RE):RE == (u:=isExpt(f,"exp"::Symbol)) case _ Record(var:Kernel RE,exponent:Integer) => @@ -242033,7 +246056,7 @@ generates the error (reported as bug \# 102): rec.exponent * first argument(rec.var) log f - + testkernel : ( RE , S ) -> Boolean testkernel(var1:RE,y:S) : Boolean == var1:=eliminateRoot(var1,y) listvar1:=tableXkernels(var1,y) @@ -242042,6 +246065,7 @@ generates the error (reported as bug \# 102): else if #listvar1 = 0 then true else false + solveRetract : (L RE,L S) -> Union(L L EQ RE, "failed") solveRetract(lexpr:L RE, lvar:L S):Union(L L EQ RE, "failed") == nlexpr : L Fraction Polynomial R := [] for expr in lexpr repeat @@ -242050,6 +246074,7 @@ generates the error (reported as bug \# 102): nlexpr := cons(rf, nlexpr) radicalSolve(nlexpr, lvar)$RadicalSolvePackage(R) + tryToTrans : ( RE , S) -> RE tryToTrans(lside: RE, x:S) : RE == if testTrig(lside,x) or testHTrig(lside,x) then convLside:=( simplify(lside) )::RE @@ -242059,7 +246084,6 @@ generates the error (reported as bug \# 102): NormConvLside:=normalize(convLside,x) NormConvLside:=( NormConvLside ) :: RE resultLside:=subsTan(NormConvLside , x) - else if testLog(lside,x) then numlside:=numer(lside)::RE resultLside:=combineLog(numlside,x) @@ -242079,7 +246103,7 @@ generates the error (reported as bug \# 102): resultLside:=combineLog(numlside,x) resultLside - + subsTan : ( RE , S ) -> RE subsTan(exprvar:RE,y:S) : RE == Z:=new()@Symbol listofkern:=tableXkernels(exprvar,y) @@ -242101,7 +246125,7 @@ generates the error (reported as bug \# 102): resultnew:=eval(result1,H=(( tan((Y::RE))::RE ) )) else return exprvar - + eliminateKernRoot: (RE , K) -> RE eliminateKernRoot(var: RE, varkern: K) : RE == X:=new()@Symbol var1:=eval(var, (varkern::RE)=(X::RE) ) @@ -242110,6 +246134,7 @@ generates the error (reported as bug \# 102): - monomial(first argument varkern, 0::NNI)@SUP RE resultvar:=resultant(var2, var3) + eliminateRoot: (RE , S) -> RE eliminateRoot(var:RE, y:S) : RE == var1:=var while testRootk(var1,y) repeat @@ -242119,7 +246144,7 @@ generates the error (reported as bug \# 102): var1:=eliminateKernRoot(var1,first kernels(i::RE)) var1 - + logsumtolog : RE -> RE logsumtolog(var:RE) : RE == (listofexpr:=isPlus(var)) case "failed" => var listofexpr:= listofexpr ::L RE @@ -242138,7 +246163,7 @@ generates the error (reported as bug \# 102): var2:=var2*(first argument i) gcdcoeff * log(var2) - + testLog : ( RE , S ) -> Boolean testLog(expr:RE,Z:S) : Boolean == testList:=[log]::L S kernelofexpr:=tableXkernels(expr,Z) @@ -242150,6 +246175,7 @@ generates the error (reported as bug \# 102): return false true + splitExpr : ( RE ) -> L RE splitExpr(expr:RE) : L RE == lcoeff:=leadingCoefficient((numer expr)) exprwcoeff:=expr @@ -242160,6 +246186,7 @@ generates the error (reported as bug \# 102): listexpr:=remove_!(lcoeff::RE , listexpr) cons(lcoeff::RE , listexpr) + buildnexpr : ( RE , S ) -> L RE buildnexpr(expr:RE, Z:S) : L RE == nlist:=splitExpr(expr) n2list:=remove_!(nlist.1, nlist) @@ -242172,9 +246199,11 @@ generates the error (reported as bug \# 102): ansmant:=(i::RE) [anscoeff, ansmant * nlist.1 ] + logexpp : ( RE , RE ) -> RE logexpp(expr1:RE, expr2:RE) : RE == log( (first argument first kernels(expr1))**expr2 ) + combineLog : ( RE , S ) -> RE combineLog(expr:RE,Y:S) : RE == exprtable:Table(RE,RE):=table() (isPlus(expr)) case "failed" => expr @@ -242194,7 +246223,7 @@ generates the error (reported as bug \# 102): ansexpr:=ansexpr + logsumtolog(exprtable.i) * (i::RE) ansexpr:=ansexpr + ans - + testRootk : ( RE, S) -> Boolean testRootk(varlistk:RE,y:S) : Boolean == testList:=[nthRoot]::L S kernelofeqnvar:=tableXkernels(varlistk,y) @@ -242205,6 +246234,7 @@ generates the error (reported as bug \# 102): return true false + tableXkernels : ( RE , S ) -> L RE tableXkernels(evar:RE,Z:S) : L RE == kOfvar:=kernels(evar) listkOfvar:=[]::L RE @@ -242213,6 +246243,7 @@ generates the error (reported as bug \# 102): listkOfvar:=cons(i::RE,listkOfvar) listkOfvar + testTrig : ( RE , S ) -> Boolean testTrig(eqnvar:RE,Z:S) : Boolean == testList:=[sin , cos , tan , cot , sec , csc]::L S kernelofeqnvar:=tableXkernels(eqnvar,Z) @@ -242224,7 +246255,7 @@ generates the error (reported as bug \# 102): return false true - + testHTrig : ( RE , S ) -> Boolean testHTrig(eqnvar:RE,Z:S) : Boolean == testList:=[sinh , cosh , tanh , coth , sech , csch]::L S kernelofeqnvar:=tableXkernels(eqnvar,Z) @@ -242237,12 +246268,14 @@ generates the error (reported as bug \# 102): true -- Auxiliary local function for use in funcinv. + makeInterval : R -> C INT F makeInterval(l:R):C INT F == if R has complex and R has ConvertibleTo(C F) then map(interval$INT(F),convert(l)$R)$ComplexFunctions2(F,INT F) else error "This should never happen" + funcinv : ( RE , RE ) -> Union(RE,"failed") funcinv(k:RE,l:RE) : Union(RE,"failed") == is?(k, "sin"::Symbol) => asin(l) is?(k, "cos"::Symbol) => acos(l) @@ -242303,32 +246336,39 @@ generates the error (reported as bug \# 102): import SystemSolvePackage(RE) + ker2Poly : (Kernel RE,L S) -> Polynomial RE ker2Poly(k:Kernel RE, lvar:L S):Polynomial RE == member?(nm:=name k, lvar) => nm :: Polynomial RE k :: RE :: Polynomial RE + smp2Poly : (SMP(R,Kernel RE),L S) -> Polynomial RE smp2Poly(pol:SMP(R,Kernel RE), lvar:L S):Polynomial RE == map(x +-> ker2Poly(x, lvar), y +-> y::RE::Polynomial RE, pol)$PolynomialCategoryLifting( IndexedExponents Kernel RE, Kernel RE, R, SMP(R, Kernel RE), Polynomial RE) + makeFracPoly : (RE,L S) -> Fraction Polynomial RE makeFracPoly(expr:RE, lvar:L S):Fraction Polynomial RE == smp2Poly(numer expr, lvar) / smp2Poly(denom expr, lvar) + makeREpol : Polynomial RE -> RE makeREpol(pol:Polynomial RE):RE == lvar := variables pol lval : List RE := [v::RE for v in lvar] ground eval(pol,lvar,lval) + makeRE : Fraction Polynomial RE -> RE makeRE(frac:Fraction Polynomial RE):RE == makeREpol(numer frac)/makeREpol(denom frac) + solve1Pol : (Polynomial RE,S,L EQ RE) -> L L EQ RE solve1Pol(pol:Polynomial RE, var: S, sol:L EQ RE):L L EQ RE == repol := eval(makeREpol pol, sol) vsols := solve(repol, var) [cons(vsol, sol) for vsol in vsols] + solve1Sys : (L Polynomial RE,L S) -> L L EQ RE solve1Sys(plist:L Polynomial RE, lvar:L S):L L EQ RE == rplist := reverse plist rlvar := reverse lvar @@ -242337,6 +246377,7 @@ generates the error (reported as bug \# 102): sols := "append"/[solve1Pol(p,v,sol) for sol in sols] sols + solveList : (L RE,L S) -> L L EQ RE solveList(lexpr:L RE, lvar:L S):L L EQ RE == ans1 := solveRetract(lexpr, lvar) not(ans1 case "failed") => ans1 :: L L EQ RE @@ -242346,6 +246387,8 @@ generates the error (reported as bug \# 102): l: L L L EQ RE := [solve1Sys(plist, lvar) for plist in trianglist] reduce(append, l, []) + solve : (List(Equation(Expression(R))),List(Symbol)) -> + List(List(Equation(Expression(R)))) solve(leqs:L EQ RE, lvar:L S):L L EQ RE == lexpr:L RE := [lhs(eq)-rhs(eq) for eq in leqs] solveList(lexpr, lvar) @@ -242542,14 +246585,9 @@ TransSolvePackageService(R) : Exports == Implementation where import LinearSystemMatrixPackage(RE,Vector RE,Vector RE,Matrix RE) import HomogeneousAggregate(R) - ---- Local Function Declarations ---- - - subsSolve : ( SUP RE, NonNegativeInteger, SUP RE, SUP RE, Integer, _ - Fraction SUP RE) -> Union(SUP RE , "failed" ) - --++ subsSolve(f, degf, g1, g2, m, h) - - -- exported functions - + unvectorise : (Vector(Expression(R)),_ + Fraction(SparseUnivariatePolynomial(Expression(R))),Integer) -> _ + Fraction(SparseUnivariatePolynomial(Expression(R))) unvectorise(vect:Vector RE, var:Fraction SUP RE,n:Integer) : _ Fraction SUP RE == Z:=new()@Symbol @@ -242559,7 +246597,10 @@ TransSolvePackageService(R) : Exports == Implementation where polyvar:=polyvar + ( vecti )*( var )**( (n-i+1)::NonNegativeInteger ) polyvar - + decomposeFunc : (Fraction(SparseUnivariatePolynomial(Expression(R))), + Fraction(SparseUnivariatePolynomial(Expression(R))), + Fraction(SparseUnivariatePolynomial(Expression(R)))) -> + Fraction(SparseUnivariatePolynomial(Expression(R))) decomposeFunc(exprf:Fraction SUP RE , exprg:Fraction SUP RE, _ newH:Fraction SUP RE ) : Fraction SUP RE == X:=new()@Symbol @@ -242585,6 +246626,8 @@ TransSolvePackageService(R) : Exports == Implementation where -- local functions + subsSolve : ( SUP RE, NonNegativeInteger, SUP RE, SUP RE, Integer, _ + Fraction SUP RE) -> Union(SUP RE , "failed" ) subsSolve(F:SUP RE, DegF:NonNegativeInteger, G1:SUP RE, G2:SUP RE, _ M:Integer, HH: Fraction SUP RE) : Union(SUP RE , "failed" ) == coeffmat:=new((DegF+1),1,0)@Matrix RE @@ -242726,6 +246769,7 @@ TriangularMatrixOperations(R,Row,Col,M): Exports == Implementation where (* package TRIMAT *) (* + UpTriBddDenomInv : (M,R) -> M UpTriBddDenomInv(A,denom) == AI := zero(nrows A, nrows A)$M offset := minColIndex AI - minRowIndex AI @@ -242739,6 +246783,7 @@ TriangularMatrixOperations(R,Row,Col,M): Exports == Implementation where exquo qelt(A, j-offset, j))::R)) AI + LowTriBddDenomInv : (M,R) -> M LowTriBddDenomInv(A, denom) == AI := zero(nrows A, nrows A)$M offset := minColIndex AI - minRowIndex AI @@ -242976,18 +247021,21 @@ TrigonometricManipulations(R, F): Exports == Implementation where s1 := sqrt(-1::F) ipi := pi()$F * s1 - K2KG : K -> Kernel FG - kcomplex : K -> Union(F, "failed") - locexplogs : F -> FG - localexplogs : (F, F, List SY) -> FG - complexKernels: F -> Record(ker: List K, val: List F) - K2KG k == retract(tan F2FG first argument k)@Kernel(FG) - real? f == empty?(complexKernels(f).ker) - real f == real complexForm f - imag f == imag complexForm f + K2KG : K -> Kernel FG + K2KG k == retract(tan F2FG first argument k)@Kernel(FG) + + real? : F -> Boolean + real? f == empty?(complexKernels(f).ker) + + real : F -> F + real f == real complexForm f + + imag : F -> F + imag f == imag complexForm f -- returns [[k1,...,kn], [v1,...,vn]] such that ki should be replaced by vi + complexKernels: F -> Record(ker: List K, val: List F) complexKernels f == lk:List(K) := empty() lv:List(F) := empty() @@ -242999,6 +247047,7 @@ TrigonometricManipulations(R, F): Exports == Implementation where -- returns f if it is certain that k is not a real kernel and k = f, -- "failed" otherwise + kcomplex : K -> Union(F, "failed") kcomplex k == op := operator k is?(k, "nthRoot"::SY) => @@ -243010,16 +247059,19 @@ TrigonometricManipulations(R, F): Exports == Implementation where and (u::Z < 0) => op(- a) + ipi "failed" + complexForm : F -> Complex(F) complexForm f == empty?((l := complexKernels f).ker) => complex(f, 0) explogs2trigs locexplogs eval(f, l.ker, l.val) + locexplogs : F -> FG locexplogs f == any?(x +-> has?(x, "rtrig"), operators(g := realElementary f))$List(BasicOperator) => localexplogs(f, g, variables g) F2FG g + complexNormalize : (F,Symbol) -> F complexNormalize(f, x) == any?(y +-> has?(operator y, "rtrig"), [k for k in tower(g := realElementary(f, x)) @@ -243027,6 +247079,7 @@ TrigonometricManipulations(R, F): Exports == Implementation where FG2F(rischNormalize(localexplogs(f, g, [x]), x).func) rischNormalize(g, x).func + complexNormalize : F -> F complexNormalize f == l := variables(g := realElementary f) any?(x +-> has?(x, "rtrig"), operators g)$List(BasicOperator) => @@ -243036,6 +247089,7 @@ TrigonometricManipulations(R, F): Exports == Implementation where for x in l repeat g := rischNormalize(g, x).func g + complexElementary : (F,Symbol) -> F complexElementary(f, x) == any?(y +-> has?(operator y, "rtrig"), [k for k in tower(g := realElementary(f, x)) @@ -243043,16 +247097,19 @@ TrigonometricManipulations(R, F): Exports == Implementation where FG2F localexplogs(f, g, [x]) g + complexElementary : F -> F complexElementary f == any?(x +-> has?(x, "rtrig"), operators(g := realElementary f))$List(BasicOperator) => FG2F localexplogs(f, g, variables g) g + localexplogs : (F, F, List SY) -> FG localexplogs(f, g, lx) == trigs2explogs(F2FG g, [K2KG k for k in tower f | is?(k, "tan"::SY) or is?(k, "cot"::SY)], lx) + trigs : F -> F trigs f == real? f => f g := explogs2trigs F2FG f @@ -243258,6 +247315,8 @@ TubePlotTools(): Exports == Implementation where import PointPackage(SF) + point : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat) -> + Point(DoubleFloat) point(x,y,z,c) == point(l : L SF := [x,y,z,c]) getColor: Pt -> SF @@ -243269,24 +247328,29 @@ TubePlotTools(): Exports == Implementation where maxIndex p1 > 3 => color p1 0 + ?*? : (DoubleFloat,Point(DoubleFloat)) -> Point(DoubleFloat) a * p == l : L SF := [a * xCoord p,a * yCoord p,a * zCoord p,getColor p] point l + ?+? : (Point(DoubleFloat),Point(DoubleFloat)) -> Point(DoubleFloat) p0 + p1 == l : L SF := [xCoord p0 + xCoord p1,yCoord p0 + yCoord p1,_ zCoord p0 + zCoord p1,getColor2(p0,p1)] point l + ?-? : (Point(DoubleFloat),Point(DoubleFloat)) -> Point(DoubleFloat) p0 - p1 == l : L SF := [xCoord p0 - xCoord p1,yCoord p0 - yCoord p1,_ zCoord p0 - zCoord p1,getColor2(p0,p1)] point l + dot : (Point(DoubleFloat),Point(DoubleFloat)) -> DoubleFloat dot(p0,p1) == (xCoord p0 * xCoord p1) + (yCoord p0 * yCoord p1) +_ (zCoord p0 * zCoord p1) + cross : (Point(DoubleFloat),Point(DoubleFloat)) -> Point(DoubleFloat) cross(p0,p1) == x0 := xCoord p0; y0 := yCoord p0; z0 := zCoord p0; x1 := xCoord p1; y1 := yCoord p1; z1 := zCoord p1; @@ -243294,8 +247358,10 @@ TubePlotTools(): Exports == Implementation where x0 * y1 - x1 * y0,getColor2(p0,p1)] point l + unitVector : Point(DoubleFloat) -> Point(DoubleFloat) unitVector p == (inv sqrt dot(p,p)) * p + cosSinInfo : Integer -> List(List(DoubleFloat)) cosSinInfo n == ans : L L SF := nil() theta : SF := 2 * pi()/n @@ -243304,6 +247370,8 @@ TubePlotTools(): Exports == Implementation where ans := concat([cos angle,sin angle],ans) ans + loopPoints : (Point(DoubleFloat),Point(DoubleFloat),Point(DoubleFloat), + DoubleFloat,List(List(DoubleFloat))) -> List(Point(DoubleFloat)) loopPoints(ctr,pNorm,bNorm,rad,cosSin) == ans : L Pt := nil() while not null cosSin repeat @@ -243671,22 +247739,14 @@ TwoDimensionalPlotClipping(): Exports == Implementation where import PointPackage(DoubleFloat) import ListFunctions2(Point DoubleFloat,DoubleFloat) - - point:(SF,SF) -> Pt - intersectWithHorizLine:(SF,SF,SF,SF,SF) -> Pt - intersectWithVertLine:(SF,SF,SF,SF,SF) -> Pt - intersectWithBdry:(SF,SF,SF,SF,Pt,Pt) -> Pt - discardAndSplit: (L Pt,Pt -> B,SF,SF,SF,SF) -> L L Pt - norm: Pt -> SF - iClipParametric: (L L Pt,RN,RN) -> CLIPPED - findPt: L L Pt -> Union(Pt,"failed") - Fnan?: SF ->Boolean - Pnan?:Pt ->Boolean + Fnan?: SF ->Boolean Fnan? x == x~=x + Pnan?:Pt ->Boolean Pnan? p == any?(Fnan?,p) + iClipParametric: (L L Pt,RN,RN) -> CLIPPED iClipParametric(pointLists,fraction,scale) == -- error checks and special cases (fraction < 0) or (fraction > 1) => @@ -243744,16 +247804,20 @@ TwoDimensionalPlotClipping(): Exports == Implementation where -- return original [pointLists,xseg,yseg]@CLIPPED + point:(SF,SF) -> Pt point(xx,yy) == point(l : L SF := [xx,yy]) + intersectWithHorizLine:(SF,SF,SF,SF,SF) -> Pt intersectWithHorizLine(x1,y1,x2,y2,yy) == x1 = x2 => point(x1,yy) point(x1 + (x2 - x1)*(yy - y1)/(y2 - y1),yy) + intersectWithVertLine:(SF,SF,SF,SF,SF) -> Pt intersectWithVertLine(x1,y1,x2,y2,xx) == y1 = y2 => point(xx,y1) point(xx,y1 + (y2 - y1)*(xx - x1)/(x2 - x1)) + intersectWithBdry:(SF,SF,SF,SF,Pt,Pt) -> Pt intersectWithBdry(xMin,xMax,yMin,yMax,pt1,pt2) == -- pt1 is in rectangle, pt2 is not x1 := xCoord pt1; y1 := yCoord pt1 @@ -243771,6 +247835,7 @@ TwoDimensionalPlotClipping(): Exports == Implementation where pt2 := intersectWithVertLine(x1,y1,x2,y2,xMin) pt2 + discardAndSplit: (L Pt,Pt -> B,SF,SF,SF,SF) -> L L Pt discardAndSplit(pointList,pred,xMin,xMax,yMin,yMax) == ans : L L Pt := nil() list : L Pt := nil() @@ -243796,6 +247861,9 @@ TwoDimensionalPlotClipping(): Exports == Implementation where empty? list => ans reverse_! cons(reverse_! list,ans) + clip : (Plot,Fraction(Integer),Fraction(Integer)) -> + Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clip(plot,fraction,scale) == (fraction < 0) or (fraction > 1/2) => error "clipDraw: fraction should be between 0 and 1/2" @@ -243834,8 +247902,11 @@ TwoDimensionalPlotClipping(): Exports == Implementation where yMax := max(yMax,yCoord pt) [lists,xVals,segment(yMin,yMax)] + clip : Plot -> Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clip(plot:PLOT) == clip(plot,1/4,5/1) + norm: Pt -> SF norm(pt) == x := xCoord(pt); y := yCoord(pt) if Fnan? x then @@ -243850,6 +247921,7 @@ TwoDimensionalPlotClipping(): Exports == Implementation where r:SF := x**2 + y**2 r + findPt: L L Pt -> Union(Pt,"failed") findPt lists == for list in lists repeat not empty? list => @@ -243857,6 +247929,10 @@ TwoDimensionalPlotClipping(): Exports == Implementation where not Pnan? p => return p "failed" + clipWithRanges : (List(List(Point(DoubleFloat))),DoubleFloat,DoubleFloat, + DoubleFloat,DoubleFloat) -> + Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clipWithRanges(pointLists,xMin,xMax,yMin,yMax) == lists : L L Pt := nil() for pointList in pointLists repeat @@ -243878,13 +247954,24 @@ TwoDimensionalPlotClipping(): Exports == Implementation where yMax := max(yMax,yCoord pt) [lists,segment(xMin,xMax),segment(yMin,yMax)] + clipParametric : (Plot,Fraction(Integer),Fraction(Integer)) -> + Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clipParametric(plot,fraction,scale) == iClipParametric(listBranches plot,fraction,scale) + clipParametric : Plot -> Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clipParametric plot == clipParametric(plot,1/2,5/1) + clip : List(Point(DoubleFloat)) -> + Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clip(l: L Pt) == iClipParametric(list l,1/2,5/1) + clip : List(List(Point(DoubleFloat))) -> + Record(brans: List(List(Point(DoubleFloat))), + xValues: Segment(DoubleFloat),yValues: Segment(DoubleFloat)) clip(l: L L Pt) == iClipParametric(l,1/2,5/1) *) @@ -244177,14 +248264,10 @@ TwoFactorize(F) : C == T NNI ==> NonNegativeInteger import CommuteUnivariatePolynomialCategory(F,R,P) - ---- Local Functions ---- - computeDegree : (P,Integer,Integer) -> PI - exchangeVars : P -> P - exchangeVarTerm: (R, NNI) -> P - pthRoot : (R, NNI, NNI) -> R -- compute the degree of the extension to reduce the polynomial to a -- univariate one + computeDegree : (P,Integer,Integer) -> PI computeDegree(m : P,mx:Integer,q:Integer): PI == my:=degree m n1:Integer:=length(10*mx*my) @@ -244192,16 +248275,19 @@ TwoFactorize(F) : C == T n:=(n1 quo n2)+1 n::PI + exchangeVars : P -> P exchangeVars(p : P) : P == p = 0 => 0 exchangeVarTerm(leadingCoefficient p, degree p) + exchangeVars(reductum p) + exchangeVarTerm: (R, NNI) -> P exchangeVarTerm(c:R, e:NNI) : P == c = 0 => 0 monomial(monomial(leadingCoefficient c, e)$R, degree c)$P + exchangeVarTerm(reductum c, e) + pthRoot : (R, NNI, NNI) -> R pthRoot(poly:R,p:NonNegativeInteger,PthRootPow:NonNegativeInteger):R == tmp:=divideExponents(map((x:F):F+->(x::F)**PthRootPow,poly),p) tmp case "failed" => error "consistency error in TwoFactor" @@ -244210,6 +248296,8 @@ TwoFactorize(F) : C == T fUnion ==> Union("nil", "sqfr", "irred", "prime") FF ==> Record(flg:fUnion, fctr:P, xpnt:Integer) + generalSqFr : SparseUnivariatePolynomial(SparseUnivariatePolynomial(F)) -> + Factored(SparseUnivariatePolynomial(SparseUnivariatePolynomial(F))) generalSqFr(m:P): Factored P == m = 0 => 0 degree m = 0 => @@ -244236,7 +248324,8 @@ TwoFactorize(F) : C == T makeFR(unit(sqp)*unitPart,pfaclist) makeFR(unitPart,pfaclist) - + generalTwoFactor:SparseUnivariatePolynomial(SparseUnivariatePolynomial(F)) + -> Factored(SparseUnivariatePolynomial(SparseUnivariatePolynomial(F))) generalTwoFactor(m:P): Factored P == m = 0 => 0 degree m = 0 => @@ -244285,6 +248374,9 @@ TwoFactorize(F) : C == T makeFR(unitPart,ll) -- factorization of a primitive square-free bivariate polynomial -- + twoFactor : (SparseUnivariatePolynomial(SparseUnivariatePolynomial(F)), + Integer) -> + Factored(SparseUnivariatePolynomial(SparseUnivariatePolynomial(F))) twoFactor(m:P,dx:Integer):Factored P == -- choose the degree for the extension n:PI:=computeDegree(m,dx,size()$F) @@ -244341,7 +248433,6 @@ TwoFactorize(F) : C == T lfacth:=completeHensel(mm,lfact,prime,dx1) lfactk: List P :=[] Normp := NormRetractPackage(F, extField, SUEx, TP, n) - while not empty? lfacth repeat ff := first lfacth lfacth := rest lfacth @@ -244724,21 +248815,6 @@ UnivariateFactorize(ZP) : public == private where (* package UNIFACT *) (* - --- local functions --- - - henselfact : ZP -> List(ZP) - quadratic : ZP -> List(ZP) - remp : (Z, PI) -> Z - negShiftz : (Z, PI) -> Z - negShiftp : (ZP,PI) -> ZP - bound : ZP -> PI - choose : ZP -> FirstStep - eisenstein : ZP -> Boolean - isPowerOf2 : Z -> Boolean - subMinusX : SUPZ -> ZP - sqroot : Z -> Z - - --- declarations --- CYC ==> CyclotomicPolynomialPackage() DDRecord ==> Record(factor: ZP,degree: Z) DDList ==> List DDRecord @@ -244748,13 +248824,14 @@ UnivariateFactorize(ZP) : public == private where import GeneralHenselPackage(Z,ZP) import ModularDistinctDegreeFactorizer ZP - + factor : ZP -> Factored(ZP) factor(m: ZP) == flist := henselFact(m,false) ctp:=unitNormal flist.contp makeFR((ctp.unit)::ZP,cons(["nil",ctp.canonical::ZP,1$Z]$FFE, [["prime",u.irr,u.pow]$FFE for u in flist.factors])) + factorSquareFree : ZP -> Factored(ZP) factorSquareFree(m: ZP) == flist := henselFact(m,true) ctp:=unitNormal flist.contp @@ -244763,6 +248840,7 @@ UnivariateFactorize(ZP) : public == private where -- Integer square root: returns 0 if t is non-positive + sqroot : Z -> Z sqroot(t: Z): Z == t <= 0 => 0 s:Integer:=t::Integer @@ -244772,6 +248850,7 @@ UnivariateFactorize(ZP) : public == private where -- Eisenstein criterion: returns true if polynomial is -- irreducible. Result of false in inconclusive. + eisenstein : ZP -> Boolean eisenstein(m : ZP): Boolean == -- calculate the content of the terms after the first c := content reductum m @@ -244794,15 +248873,18 @@ UnivariateFactorize(ZP) : public == private where (0 ^= (trail rem (r.factor ** 2))) then return true false + negShiftz : (Z, PI) -> Z negShiftz(n: Z,Modulus:PI): Z == if n < 0 then n := n+Modulus n > (Modulus quo 2) => n-Modulus n + negShiftp : (ZP,PI) -> ZP negShiftp(pp: ZP,Modulus:PI): ZP == map(x +-> negShiftz(x,Modulus),pp) -- Choose the bound for the coefficients of factors + bound : ZP -> PI bound(m: ZP):PI == nm,nmq2,lcm,bin0,bin1:NNI cbound,j : PI @@ -244822,8 +248904,10 @@ UnivariateFactorize(ZP) : public == private where if cbound Z remp(t: Z,q:PI): Z == ((t := t rem q)<0 => t+q ;t) + numFactors : DDList -> Z numFactors(ddlist:DDList): Z == ans: Z := 0 for dd in ddlist repeat @@ -244834,6 +248918,7 @@ UnivariateFactorize(ZP) : public == private where -- select the prime,try up to 4 primes, -- choose the one yielding the fewest factors, but stopping if -- fewer than 9 factors + choose : ZP -> FirstStep choose(m: ZP):FirstStep == qSave:PI := 1 ddSave:DDList := [] @@ -244863,6 +248948,7 @@ UnivariateFactorize(ZP) : public == private where -- Find the factors of m,primitive, square-free, with lc positive -- and mindeg m = 0 + henselfact1 : ZP -> List(ZP) henselfact1(m: ZP):List(ZP) == zero? degree m => (m = 1) => [] @@ -244877,6 +248963,7 @@ UnivariateFactorize(ZP) : public == private where -- check for possible degree reduction -- could use polynomial decomposition ? + henselfact : ZP -> List(ZP) henselfact(m: ZP):List ZP == deggcd:=degree m mm:= m @@ -244887,6 +248974,7 @@ UnivariateFactorize(ZP) : public == private where "append"/[henselfact1 multiplyExponents(mm, deggcd) for mm in faclist] henselfact1 m + quadratic : ZP -> List(ZP) quadratic(m: ZP):List(ZP) == d,d2: Z d := coefficient(m,1)**2-4*coefficient(m,0)*coefficient(m,2) @@ -244901,12 +248989,14 @@ UnivariateFactorize(ZP) : public == private where m0: ZP := monomial(beta,1)+monomial(alpha,0) cons(m0,[(m exquo m0):: ZP]) + isPowerOf2 : Z -> Boolean isPowerOf2(n : Z): Boolean == n = 1 => true qr : Record(quotient: Z, remainder: Z) := divide(n,2) qr.remainder = 1 => false isPowerOf2 qr.quotient + subMinusX : SUPZ -> ZP subMinusX(supPol : SUPZ): ZP == minusX : SUPZ := monomial(-1,1)$SUPZ (elt(supPol,minusX)$SUPZ) : ZP @@ -244915,6 +249005,8 @@ UnivariateFactorize(ZP) : public == private where -- square-free, false otherwise. -- FinalFact.contp=content m, FinalFact.factors=List of irreducible -- factors with exponent . + henselFact : (ZP,Boolean) -> Record(contp: Integer, + factors: List(Record(irr: ZP,pow: Integer))) henselFact(m: ZP,test:Boolean):FinalFact == factorlist : List(ParFact) := [] c : Z @@ -245062,6 +249154,8 @@ UnivariateFormalPowerSeriesFunctions(Coef: Ring): Exports == Implementation (* package UFPS1 *) (* + hadamard : (UnivariateFormalPowerSeries(Coef), + UnivariateFormalPowerSeries(Coef)) -> UnivariateFormalPowerSeries(Coef) hadamard(f, g) == series map((z1:Coef,z2:Coef):Coef +-> z1*z2, coefficients f, coefficients g) @@ -245161,6 +249255,8 @@ UnivariateLaurentSeriesFunctions2(Coef1,Coef2,var1,var2,cen1,cen2):_ (* package ULS2 *) (* + map : ((Coef1 -> Coef2),UnivariateLaurentSeries(Coef1,var1,cen1)) -> + UnivariateLaurentSeries(Coef2,var2,cen2) map(f,ups) == laurent(degree ups, map(f, taylorRep ups)$UTSF2) *) @@ -245253,6 +249349,7 @@ UnivariatePolynomialCategoryFunctions2(R,PR,S,PS): Exports == Impl where (* package UPOLYC2 *) (* + map : ((R -> S),PR) -> PS map(f, p) == ans:PS := 0 while p ^= 0 repeat @@ -245369,12 +249466,15 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where import CommonDenominator(R, Q, List Q) + commonDenominator : UP -> R commonDenominator p == commonDenominator coefficients p + clearDenominator : UP -> UP clearDenominator p == d := commonDenominator p map(x +-> numer(d*x)::Q, p) + splitDenominator : UP -> Record(num: UP,den: R) splitDenominator p == d := commonDenominator p [map(x +-> numer(d*x)::Q, p), d] @@ -245568,6 +249668,7 @@ UnivariatePolynomialDecompositionPackage(R,UP): Exports == Implementation where (* package UPDECOMP *) (* + rightFactorIfCan : (UP,NonNegativeInteger,R) -> Union(UP,"failed") rightFactorIfCan(p,dq,lcq) == dp := degree p zero? lcq => @@ -245592,10 +249693,12 @@ UnivariatePolynomialDecompositionPackage(R,UP): Exports == Implementation where q := q+monomial(cquo::R,subtractIfCan(dq,k)::N) q + monicRightFactorIfCan : (UP,NonNegativeInteger) -> Union(UP,"failed") monicRightFactorIfCan(p,dq) == rightFactorIfCan(p,dq,1$R) import UnivariatePolynomialDivisionPackage(R,UP) + leftFactorIfCan : (UP,UP) -> Union(UP,"failed") leftFactorIfCan(f,h) == g: UP := 0 zero? degree h => "failed" @@ -245609,6 +249712,7 @@ UnivariatePolynomialDecompositionPackage(R,UP): Exports == Implementation where f := qr.quotient g + monicDecomposeIfCan : UP -> Union(Record(left: UP,right: UP),"failed") monicDecomposeIfCan f == df := degree f zero? df => "failed" @@ -245619,6 +249723,7 @@ UnivariatePolynomialDecompositionPackage(R,UP): Exports == Implementation where g case UP => return [g::UP,h::UP] "failed" + monicCompleteDecompose : UP -> List(UP) monicCompleteDecompose f == cf := monicDecomposeIfCan f cf case "failed" => [ f ] @@ -245722,6 +249827,7 @@ UnivariatePolynomialDivisionPackage(R,UP): Exports == Implementation where (* package UPDIVP *) (* + divideIfCan : (UP,UP) -> Union(Record(quotient: UP,remainder: UP),"failed") divideIfCan(p1:UP,p2:UP):Union(QR,"failed") == zero? p2 => error "divideIfCan: division by zero" ((lc := leadingCoefficient p2) = 1) => monicDivide(p1,p2) @@ -245816,6 +249922,7 @@ UnivariatePolynomialFunctions2(x:Symbol, R:Ring, y:Symbol, S:Ring): with (* package UP2 *) (* + map : ((R -> S),UnivariatePolynomial(x,R)) -> UnivariatePolynomial(y,S) map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R, UnivariatePolynomial(x, R), S, UnivariatePolynomial(y, S)) @@ -245979,6 +250086,7 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego (* package UPMP *) (* + noKaratsuba : (U,U) -> U noKaratsuba(a,b) == zero? a => a zero? b => b @@ -245990,6 +250098,7 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego res := pomopo!(res, leadingCoefficient(u), degree(u), b) res + karatsubaOnce : (U,U) -> U karatsubaOnce(a:U,b:U): U == da := minimumDegree(a) db := minimumDegree(b) @@ -246011,6 +250120,7 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego zero? d => shiftLeft(v,2*n) + w shiftLeft(v,2*n + d) + shiftLeft(w,d) + karatsuba : (U,U,NonNegativeInteger,NonNegativeInteger) -> U karatsuba(a:U,b:U,l:NonNegativeInteger,k:NonNegativeInteger): U == zero? k => noKaratsuba(a,b) degree(a) < l => noKaratsuba(a,b) @@ -246235,20 +250345,28 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T if RC has CharacteristicZero then + squareFreePart : P -> P squareFreePart(p:P) == (p exquo gcd(p, differentiate p))::P else + squareFreePart : P -> P squareFreePart(p:P) == unit(s := squareFree(p)$%) * */[f.factor for f in factors s] if RC has FiniteFieldCategory then + BumInSepFFE : Record(flg: Union("nil","sqfr","irred","prime"), + fctr: P,xpnt: Integer) -> Record(flg: Union("nil","sqfr","irred", + "prime"),fctr: P,xpnt: Integer) BumInSepFFE(ffe:FF) == ["sqfr", map(charthRoot,ffe.fctr), characteristic$P*ffe.xpnt] else if RC has CharacteristicNonZero then + BumInSepFFE : Record(flg: Union("nil","sqfr","irred","prime"), + fctr: P,xpnt: Integer) -> Record(flg: Union("nil","sqfr","irred", + "prime"),fctr: P,xpnt: Integer) BumInSepFFE(ffe:FF) == np:=multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger) (nthrp := charthRoot(np)) case "failed" => @@ -246257,6 +250375,9 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T else + BumInSepFFE : Record(flg: Union("nil","sqfr","irred","prime"), + fctr: P,xpnt: Integer) -> Record(flg: Union("nil","sqfr","irred", + "prime"),fctr: P,xpnt: Integer) BumInSepFFE(ffe:FF) == ["nil", multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger), @@ -246264,6 +250385,7 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T if RC has CharacteristicZero then + squareFree : P -> Factored(P) squareFree(p:P) == --Yun's algorithm - see SYMSAC '76, p.27 --Note ci primitive is, so GCD's don't need to %do contents. --Change gcd to return cofctrs also? @@ -246285,6 +250407,7 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T else + squareFree : P -> Factored(P) squareFree(p:P) == --Musser's algorithm - see SYMSAC '76, p.27 --p MUST BE PRIMITIVE, Any characteristic. --Note ci primitive, so GCD's don't need to %do contents. @@ -246405,6 +250528,8 @@ UnivariatePuiseuxSeriesFunctions2(Coef1,Coef2,var1,var2,cen1,cen2):_ (* package UPXS2 *) (* + map : ((Coef1 -> Coef2),UnivariatePuiseuxSeries(Coef1,var1,cen1)) -> + UnivariatePuiseuxSeries(Coef2,var2,cen2) map(f,ups) == puiseux(rationalPower ups, map(f, laurentRep ups)$ULSP2) *) @@ -246614,10 +250739,8 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where (* package OREPCTO *) (* - termPoly: (R, N, C, MOR, R -> R) -> C - localLeftDivide : (C, C, MOR, R) -> QUOREM - localRightDivide: (C, C, MOR, R) -> QUOREM + times : (C,C,Automorphism(R),(R -> R)) -> C times(x, y, sigma, delta) == zero? y => 0 z:C := 0 @@ -246626,6 +250749,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where x := reductum x z + termPoly: (R, N, C, MOR, R -> R) -> C termPoly(a, n, y, sigma, delta) == zero? y => 0 (u := subtractIfCan(n, 1)) case "failed" => a * y @@ -246639,6 +250763,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where y := reductum y z + apply : (C,R,R,Automorphism(R),(R -> R)) -> R apply(p, c, x, sigma, delta) == w:R := 0 xn:R := x @@ -246649,6 +250774,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where -- localLeftDivide(a, b) returns [q, r] such that a = q b + r -- b1 is the inverse of the leadingCoefficient of b + localLeftDivide : (C, C, MOR, R) -> QUOREM localLeftDivide(a, b, sigma, b1) == zero? b => error "leftDivide: division by 0" zero? a or @@ -246660,6 +250786,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where -- localRightDivide(a, b) returns [q, r] such that a = q b + r -- b1 is the inverse of the leadingCoefficient of b + localRightDivide: (C, C, MOR, R) -> QUOREM localRightDivide(a, b, sigma, b1) == zero? b => error "rightDivide: division by 0" zero? a or @@ -246671,11 +250798,15 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where if R has IntegralDomain then + monicLeftDivide : (C,C,Automorphism(R)) -> + Record(quotient: C,remainder: C) monicLeftDivide(a, b, sigma) == unit?(u := leadingCoefficient b) => localLeftDivide(a, b, sigma, recip(u)::R) error "monicLeftDivide: divisor is not monic" + monicRightDivide : (C,C,Automorphism(R)) -> + Record(quotient: C,remainder: C) monicRightDivide(a, b, sigma) == unit?(u := leadingCoefficient b) => localRightDivide(a, b, sigma, recip(u)::R) @@ -246683,9 +250814,13 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where if R has Field then + leftDivide : (C,C,Automorphism(R)) -> + Record(quotient: C,remainder: C) leftDivide(a, b, sigma) == localLeftDivide(a, b, sigma, inv leadingCoefficient b) + rightDivide : (C,C,Automorphism(R)) -> + Record(quotient: C,remainder: C) rightDivide(a, b, sigma) == localRightDivide(a, b, sigma, inv leadingCoefficient b) @@ -246776,6 +250911,7 @@ UnivariateTaylorSeriesFunctions2(Coef1,Coef2,UTS1,UTS2):_ (* package UTS2 *) (* + map : ((Coef1 -> Coef2),UTS1) -> UTS2 map(f,uts) == series map(f,coefficients uts)$ST2 *) @@ -246978,8 +251114,14 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_ (* package UTSODE *) (* + + stFunc1 : (UTS -> UTS) -> (Stream(Coef) -> Stream(Coef)) stFunc1 f == s +-> coefficients f series(s) + + stFunc2:((UTS,UTS) -> UTS) -> ((Stream(Coef),Stream(Coef)) -> Stream(Coef)) stFunc2 f == (s1,s2) +-> coefficients f(series(s1),series(s2)) + + stFuncN : (List(UTS) -> UTS) -> (List(Stream(Coef)) -> Stream(Coef)) stFuncN f == ls +-> coefficients f map(series,ls)$ListFunctions2(ST,UTS) import StreamTaylorSeriesOperations(Coef) @@ -247001,6 +251143,7 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_ rhy case "failed" => error "stream division:no reciprocal" divloop(hx,tx,rhy::Coef,ty) + fixedPointExquo : (UTS,UTS) -> UTS fixedPointExquo(f,g) == series sdiv(coefficients f,coefficients g) -- first order @@ -247011,6 +251154,7 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_ iOde1: ((ST -> ST),Coef) -> ST iOde1(f,c) == YS(s +-> ode1re(f,c,s)) + ode1 : ((UTS -> UTS),Coef) -> UTS ode1(f,c) == series iOde1(stFunc1 f,c) -- second order @@ -247023,6 +251167,7 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_ iOde2: ((ST,ST) -> ST,Coef,Coef) -> ST iOde2(f,c0,c1) == YS(s +-> ode2re(f,c0,c1,s)) + ode2 : (((UTS,UTS) -> UTS),Coef,Coef) -> UTS ode2(f,c0,c1) == series iOde2(stFunc2 f,c0,c1) -- nth order @@ -247038,6 +251183,7 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_ iOde: ((L ST) -> ST,List Coef) -> ST iOde(f,cl) == first YS(ls +-> odeNre(f,cl,ls),#cl + 1) + ode : ((List(UTS) -> UTS),List(Coef)) -> UTS ode(f,cl) == series iOde(stFuncN f,cl) simulre:(L Coef,L ((L ST) -> ST),L ST) -> L ST @@ -247048,6 +251194,7 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_ iMpsode:(L Coef,L ((L ST) -> ST)) -> L ST iMpsode(cs,lsts) == YS(ls +-> simulre(cs,lsts,ls),# cs) + mpsode : (List(Coef),List((List(UTS) -> UTS))) -> List(UTS) mpsode(cs,lsts) == stSol := iMpsode(cs,[stFuncN(lst) for lst in lsts]) map(series,stSol)$L2(ST,UTS) @@ -247140,6 +251287,7 @@ UniversalSegmentFunctions2(R:Type, S:Type): with (* package UNISEG2 *) (* + map : ((R -> S),UniversalSegment(R)) -> UniversalSegment(S) map(f:R -> S, u:UniversalSegment R):UniversalSegment S == s := f lo u hasHi u => segment(s, f hi u) @@ -247147,6 +251295,7 @@ UniversalSegmentFunctions2(R:Type, S:Type): with if R has OrderedRing then + map : ((R -> S),UniversalSegment(R)) -> Stream(S) map(f:R -> S, u:UniversalSegment R): Stream S == map(f, expand u)$StreamFunctions2(R, S) @@ -247321,23 +251470,30 @@ UserDefinedPartialOrdering(S:SetCategory): with (* llow :Reference List S := ref nil() + lhigh:Reference List S := ref nil() + userOrdered? : () -> Boolean userOrdered?() == not(empty? deref llow) or not(empty? deref lhigh) + getOrder : () -> Record(low: List(S),high: List(S)) getOrder() == [deref llow, deref lhigh] + setOrder : List(S) -> Void setOrder l == setOrder(nil(), l) + setOrder : (List(S),List(S)) -> Void setOrder(l, h) == setref(llow, removeDuplicates l) setref(lhigh, removeDuplicates h) void + less? : (S,S,((S,S) -> Boolean)) -> Boolean less?(a, b, f) == (u := less?(a, b)) case "failed" => f(a, b) u::Boolean + largest : (List(S),((S,S) -> Boolean)) -> S largest(x, f) == empty? x => error "largest: empty list" empty? rest x => first x @@ -247345,6 +251501,7 @@ UserDefinedPartialOrdering(S:SetCategory): with less?(first x, a, f) => a first x + less? : (S,S) -> Union(Boolean,"failed") less?(a, b) == for x in deref llow repeat x = a => return(a ^= b) @@ -247363,8 +251520,10 @@ UserDefinedPartialOrdering(S:SetCategory): with if S has OrderedSet then + more? : (S,S) -> Boolean if S has ORDSET more?(a, b) == not less?(a, b, (y,z) +-> y <$S z) + largest : List(S) -> S if S has ORDSET largest x == largest(x, (y,z) +-> y <$S z) *) @@ -247478,12 +251637,16 @@ UserDefinedVariableOrdering(): with import UserDefinedPartialOrdering(Symbol) + setVariableOrder : List(Symbol) -> Void setVariableOrder l == setOrder reverse l + setVariableOrder : (List(Symbol),List(Symbol)) -> Void setVariableOrder(l1, l2) == setOrder(reverse l2, reverse l1) + resetVariableOrder : () -> Void resetVariableOrder() == setVariableOrder(nil(), nil()) + getVariableOrder : () -> Record(high: List(Symbol),low: List(Symbol)) getVariableOrder() == r := getOrder() [reverse(r.high), reverse(r.low)] @@ -247617,12 +251780,12 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where (* package UTSODETL *) (* - fun: (Vector UTS, List UTS) -> UTS - + UP2UTS : UP -> UTS UP2UTS p == q := p(monomial(1, 1) + center(0)::UP) +/[monomial(coefficient(q, i), i)$UTS for i in 0..degree q] + UTS2UP : (UTS,NonNegativeInteger) -> UP UTS2UP(s, n) == xmc := monomial(1, 1)$UP - center(0)::UP xmcn:UP := 1 @@ -247632,6 +251795,7 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where xmcn := xmc * xmcn ans + LODO2FUN : L -> (List(UTS) -> UTS) LODO2FUN op == a := recip(UP2UTS(- leadingCoefficient op))::UTS n := (degree(op) - 1)::NonNegativeInteger @@ -247639,6 +251803,7 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where r := (l1: List UTS): UTS +-> fun(v, l1) r + fun: (Vector UTS, List UTS) -> UTS fun(v, l) == ans:UTS := 0 for b in l for i in 1.. repeat ans := ans + v.i * b @@ -247646,6 +251811,7 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where if F has IntegralDomain then + RF2UTS : Fraction(UP) -> UTS RF2UTS f == UP2UTS(numer f) * recip(UP2UTS denom f)::UTS *) @@ -248276,11 +252442,13 @@ U32VectorPolynomialOperations() : Export == Implementation where Qrem ==> QSMOD6432$Lisp modInverse ==> invmod + copyfirst : (U32Vector,U32Vector,Integer) -> Void copy_first(np : PA, op : PA, n : Integer) : Void == ns := n pretend SingleInteger for j in 0..(ns - 1) repeat np(j) := op(j) + copyslice : (U32Vector,U32Vector,Integer,Integer) -> Void copy_slice(np : PA, op : PA, m : Integer, _ n : Integer) : Void == ms := m pretend SingleInteger @@ -248288,6 +252456,7 @@ U32VectorPolynomialOperations() : Export == Implementation where for j in ms..(ms + ns - 1) repeat np(j) := op(j) + evalat : (U32Vector,Integer,Integer,Integer) -> Integer eval_at(v : PA, deg : Integer, pt : Integer, _ p : Integer) : Integer == i : SingleInteger := deg::SingleInteger @@ -248297,6 +252466,7 @@ U32VectorPolynomialOperations() : Export == Implementation where i := i - 1 res + tomodpa : (SparseUnivariatePolynomial(Integer),Integer) -> U32Vector to_mod_pa(s : SparseUnivariatePolynomial Integer, p : Integer) : PA == zero?(s) => new(1, 0)$PA n0 := degree(s) pretend SingleInteger @@ -248307,6 +252477,8 @@ U32VectorPolynomialOperations() : Export == Implementation where s := reductum(s) ncoeffs + vectoraddmul : (U32Vector,U32Vector,Integer,Integer,Integer,Integer) + -> Void vector_add_mul(v1 : PA, v2 : PA, m : Integer, n : Integer, _ c : Integer, p : Integer) : Void == ms := m pretend SingleInteger @@ -248314,6 +252486,7 @@ U32VectorPolynomialOperations() : Export == Implementation where for i in ms..ns repeat v1(i) := Qmuladdmod(c, v2(i), v1(i), p) + mulbybinomial : (U32Vector,Integer,Integer,Integer) -> Void mul_by_binomial(v : PA, n : Integer, pt : Integer, _ p : Integer) : Void == prev_coeff : Integer := 0 @@ -248323,22 +252496,27 @@ U32VectorPolynomialOperations() : Export == Implementation where v(i) := Qmuladdmod(pt, pp, prev_coeff, p) prev_coeff := pp + mulbybinomial : (U32Vector,Integer,Integer) -> Void mul_by_binomial(v : PA, pt : Integer, _ p : Integer) : Void == mul_by_binomial(v, #v, pt, p) + mulbyscalar : (U32Vector,Integer,Integer,Integer) -> Void mul_by_scalar(v : PA, n : Integer, c : Integer, _ p : Integer) : Void == ns := n pretend SingleInteger for i in 0..ns repeat v(i) := Qmul(c, v(i), p) + degree : U32Vector -> Integer degree(v : PA) : Integer == n := #v for i in (n - 1)..0 by -1 repeat not(v(i) = 0) => return i -1 + vectorcombination : (U32Vector,Integer,U32Vector,Integer,Integer, + Integer,Integer) -> Void vector_combination(v1 : PA, c1 : Integer, _ v2 : PA, c2 : Integer, _ n : Integer, delta : Integer, _ @@ -248357,6 +252535,7 @@ U32VectorPolynomialOperations() : Export == Implementation where for i in ds..ns repeat v1(i) := Qmuladdmod(c2, v2(i - ds), v1(i), p) + divide! : (U32Vector,U32Vector,U32Vector,Integer) -> Void divide!(r0 : PA, r1 : PA, res : PA, p: Integer) : Void == dr0 := degree(r0) pretend SingleInteger dr1 := degree(r1) pretend SingleInteger @@ -248375,6 +252554,7 @@ U32VectorPolynomialOperations() : Export == Implementation where dr0 := dr0 - 1 if dr0 < 0 then break + remainder! : (U32Vector,U32Vector,Integer) -> Void remainder!(r0 : PA, r1 : PA, p: Integer) : Void == dr0 := degree(r0) pretend SingleInteger dr1 := degree(r1) pretend SingleInteger @@ -248392,6 +252572,7 @@ U32VectorPolynomialOperations() : Export == Implementation where dr0 := dr0 - 1 if dr0 < 0 then break + gcd : (U32Vector,U32Vector,Integer) -> U32Vector gcd(x : PA, y : PA, p : Integer) : PA == dr0 := degree(y) pretend SingleInteger dr1 : SingleInteger @@ -248442,6 +252623,7 @@ U32VectorPolynomialOperations() : Export == Implementation where mul_by_scalar(r0, dr0, c, p) r0 + gcd : (PrimitiveArray(U32Vector),Integer,Integer,Integer) -> U32Vector gcd(a : PrimitiveArray PA, lo : Integer, hi: Integer, p: Integer) _ : PA == res := a(lo) @@ -248449,6 +252631,7 @@ U32VectorPolynomialOperations() : Export == Implementation where res := gcd(a(i), res, p) res + lcm2 : (PA,PA,Integer) -> PA lcm2(v1 : PA, v2 : PA, p : Integer) : PA == pp := gcd(v1, v2, p) dv2 := degree(v2) @@ -248462,6 +252645,7 @@ U32VectorPolynomialOperations() : Export == Implementation where divide!(tmp1, pp, tmp2, p) mul(v1, tmp2, p) + lcm : (PrimitiveArray(U32Vector),Integer,Integer,Integer) -> U32Vector lcm(a : PrimitiveArray PA, lo : Integer, hi: Integer, p: Integer) _ : PA == res := a(lo) @@ -248469,9 +252653,7 @@ U32VectorPolynomialOperations() : Export == Implementation where res := lcm2(a(i), res, p) res - inner_mul : (PA, PA, PA, SingleInteger, SingleInteger, _ - SingleInteger, Integer) -> Void - + mul : (U32Vector,U32Vector,Integer) -> U32Vector mul(x : PA, y : PA, p : Integer) : PA == xdeg := degree(x) pretend SingleInteger ydeg := degree(y) pretend SingleInteger @@ -248492,6 +252674,8 @@ U32VectorPolynomialOperations() : Export == Implementation where inner_mul(xcoeffs, ycoeffs, zcoeffs, xdeg, ydeg, zdeg, p) zcoeffs + inner_mul : (PA, PA, PA, SingleInteger, SingleInteger, _ + SingleInteger, Integer) -> Void inner_mul(x, y, z, xdeg, ydeg, zdeg, p) == if ydeg < xdeg then tmpp := x @@ -248525,11 +252709,14 @@ U32VectorPolynomialOperations() : Export == Implementation where ss := Qmuladd(x(i - j), y(j), ss) z(i) := Qrem(ss, p) + truncatedmuladd:(U32Vector,U32Vector,U32Vector,Integer,Integer) -> Void truncated_mul_add(x, y, z, m, p) == xdeg := (#x - 1) pretend SingleInteger ydeg := (#y - 1) pretend SingleInteger inner_mul(x, y, z, xdeg, ydeg, m pretend SingleInteger, p) + truncatedmultiplication : (U32Vector,U32Vector,Integer,Integer) -> + U32Vector truncated_multiplication(x, y, m, p) == xdeg := (#x - 1) pretend SingleInteger ydeg := (#y - 1) pretend SingleInteger @@ -248538,6 +252725,7 @@ U32VectorPolynomialOperations() : Export == Implementation where inner_mul(x, y, z, xdeg, ydeg, m pretend SingleInteger, p) z + pow:(U32Vector,PositiveInteger,NonNegativeInteger,Integer) -> U32Vector pow(x : PA, n : PositiveInteger, d: NonNegativeInteger, _ p : Integer) : PA == one? n => x @@ -248554,6 +252742,7 @@ U32VectorPolynomialOperations() : Export == Implementation where d, p) + differentiate : (U32Vector,Integer) -> U32Vector differentiate(x: PA, p: Integer): PA == d := #x - 1 if zero? d then empty()$PA @@ -248564,6 +252753,7 @@ U32VectorPolynomialOperations() : Export == Implementation where r.i := Qmul(i1, x.i1, p) r + differentiate : (U32Vector,NonNegativeInteger,Integer) -> U32Vector differentiate(x: PA, n: NonNegativeInteger, p: Integer): PA == zero? n => x d := #x - 1 @@ -248577,6 +252767,7 @@ U32VectorPolynomialOperations() : Export == Implementation where r.(j pretend NonNegativeInteger) := Qmul(f, x.i, p) r + extendedgcd : (U32Vector,U32Vector,Integer) -> List(U32Vector) extended_gcd(x : PA, y : PA, p : Integer) : List(PA) == dr0 := degree(x) pretend SingleInteger dr1 : SingleInteger @@ -248653,6 +252844,7 @@ U32VectorPolynomialOperations() : Export == Implementation where mul_by_scalar(t0, dt, c, p) [r0, s0, t0] + resultant : (U32Vector,U32Vector,Integer) -> Integer resultant(x : PA, y : PA, p : Integer) : Integer == dr0 := degree(x) pretend SingleInteger dr0 < 0 => 0 @@ -248805,12 +252997,16 @@ VectorFunctions2(A, B): Exports == Implementation where (* package VECTOR2 *) (* - scan(f, v, b) == scan(f, v, b)$O2 + scan : (((A,B) -> B),Vector(A),B) -> Vector(B) + scan(f, v, b) == scan(f, v, b)$O2 + reduce : (((A,B) -> B),Vector(A),B) -> B reduce(f, v, b) == reduce(f, v, b)$O2 + map : ((A -> B),Vector(A)) -> Vector(B) map(f:(A->B), v:VA):VB == map(f, v)$O2 + map : ((A -> Union(B,"failed")),Vector(A)) -> Union(Vector(B),"failed") map(f:(A -> UB), a:VA):Union(VB,"failed") == res : List B := [] for u in entries(a) repeat @@ -249177,18 +253373,23 @@ ViewDefaultsPackage():Exports == Implementation where defaultClosed : Reference(B) := ref(false) --%Viewport window dimensions specifications + viewPosDefault : () -> List(NonNegativeInteger) viewPosDefault == [defaultXPos(),defaultYPos()] + viewPosDefault : List(NonNegativeInteger) -> List(NonNegativeInteger) viewPosDefault l == #l < 2 => error "viewPosDefault expects a list with two elements" [defaultXPos() := first l,defaultYPos() := last l] + viewSizeDefault : () -> List(PositiveInteger) viewSizeDefault == [defaultWidth(),defaultHeight()] + viewSizeDefault : List(PositiveInteger) -> List(PositiveInteger) viewSizeDefault l == #l < 2 => error "viewSizeDefault expects a list with two elements" [defaultWidth() := first l,defaultHeight() := last l] + viewDefaults : () -> Void viewDefaults == defaultPointColor : Reference(PAL) := ref bright red() defaultLineColor : Reference(PAL) := ref pastel green() --bright blue() @@ -249201,49 +253402,70 @@ ViewDefaultsPackage():Exports == Implementation where defaultHeight : Reference(PI) := ref(427::PI) --%2D graphical output specifications + pointColorDefault : () -> Palette pointColorDefault == defaultPointColor() + pointColorDefault : Palette -> Palette pointColorDefault p == defaultPointColor() := p + lineColorDefault : () -> Palette lineColorDefault == defaultLineColor() + lineColorDefault : Palette -> Palette lineColorDefault p == defaultLineColor() := p + axesColorDefault : () -> Palette axesColorDefault == defaultAxesColor() + axesColorDefault : Palette -> Palette axesColorDefault p == defaultAxesColor() := p + unitsColorDefault : () -> Palette unitsColorDefault == defaultUnitsColor() + unitsColorDefault : Palette -> Palette unitsColorDefault p == defaultUnitsColor() := p + pointSizeDefault : () -> PositiveInteger pointSizeDefault == defaultPointSize() + pointSizeDefault : PositiveInteger -> PositiveInteger pointSizeDefault x == defaultPointSize() := x --%3D specific stuff + var1StepsDefault : () -> PositiveInteger var1StepsDefault == defaultVar1Steps() + var1StepsDefault : PositiveInteger -> PositiveInteger var1StepsDefault i == defaultVar1Steps() := i + var2StepsDefault : () -> PositiveInteger var2StepsDefault == defaultVar2Steps() + var2StepsDefault : PositiveInteger -> PositiveInteger var2StepsDefault i == defaultVar2Steps() := i + tubePointsDefault : () -> PositiveInteger tubePointsDefault == defaultTubePoints() + tubePointsDefault : PositiveInteger -> PositiveInteger tubePointsDefault i == defaultTubePoints() := i + tubeRadiusDefault : () -> DoubleFloat tubeRadiusDefault == defaultTubeRadius() + tubeRadiusDefault : Float -> DoubleFloat tubeRadiusDefault f == defaultTubeRadius() := convert(f)@SF --%File output stuff + viewWriteAvailable : () -> List(String) viewWriteAvailable == writeAvailable + viewWriteDefault : () -> List(String) viewWriteDefault == defaultThingsToWrite() + viewWriteDefault : List(String) -> List(String) viewWriteDefault listOfThings == thingsToWrite : L S := [] for aTypeOfFile in listOfThings repeat @@ -249421,16 +253643,18 @@ ViewportPackage():Exports == Implementation where import ViewDefaultsPackage import DrawOptionFunctions0 ---% Functions that return GraphImages - + graphCurves : List(List(Point(DoubleFloat))) -> GraphImage graphCurves(listOfListsOfPoints) == graphCurves(listOfListsOfPoints, pointColorDefault(),_ lineColorDefault(), pointSizeDefault(),nil()) + graphCurves:(List(List(Point(DoubleFloat))),List(DrawOption)) -> GraphImage graphCurves(listOfListsOfPoints,optionsList) == graphCurves(listOfListsOfPoints, pointColorDefault(),_ lineColorDefault(), pointSizeDefault(),optionsList) + graphCurves : (List(List(Point(DoubleFloat))),Palette,Palette, + PositiveInteger,List(DrawOption)) -> GraphImage graphCurves(listOfListsOfPoints,ptColor,lineColor,ptSize,optionsList) == len := #listOfListsOfPoints listOfPointColors : L PAL := [ptColor for i in 1..len] @@ -249441,10 +253665,14 @@ ViewportPackage():Exports == Implementation where --% Functions that return Two Dimensional Viewports + drawCurves : (List(List(Point(DoubleFloat))),List(DrawOption)) -> + TwoDimensionalViewport drawCurves(listOfListsOfPoints,optionsList) == drawCurves(listOfListsOfPoints,pointColorDefault(),_ lineColorDefault(),pointSizeDefault(),optionsList) + drawCurves : (List(List(Point(DoubleFloat))),Palette,Palette, + PositiveInteger,List(DrawOption)) -> TwoDimensionalViewport drawCurves(ptLists:L L P,ptColor:PAL,lColor:PAL,ptSize:PI,optList:L DROP)== v := viewport2D() options(v,optList) @@ -249454,6 +253682,7 @@ ViewportPackage():Exports == Implementation where --% Coercions + coerce : GraphImage -> TwoDimensionalViewport coerce(graf:GRIMAGE):VIEW2D == if (key graf = 0) then makeGraphImage graf v := viewport2D() @@ -249721,6 +253950,8 @@ WeierstrassPreparation(R): Defn == Impl where cons(map2(first,smps:ST StS):SMPS, transback(map3(rest,smps:ST StS):(ST SMPS)))$(L SMPS) + clikeUniv : Symbol -> (Polynomial(R) -> + SparseUnivariatePolynomial(Polynomial(R))) clikeUniv(var)==p +-> likeUniv(p,var) mind:(NNI,StS)->NNI @@ -249730,6 +253961,8 @@ WeierstrassPreparation(R): Defn == Impl where else if first sts=0 then mind(n+1,rest sts) else n + + mindegree : StS -> NNI mindegree (sts:StS):NNI== mind(0,sts) streamlikeUniv:(SUP,NNI)->StS @@ -249746,6 +253979,8 @@ WeierstrassPreparation(R): Defn == Impl where zp==>map$StreamFunctions3(SUP,NNI,StS) + sts2stst : (Symbol,Stream(Polynomial(R))) -> + Stream(Stream(Polynomial(R))) sts2stst(var, sts)== zp((x,y) +-> streamlikeUniv(x,y), map1(clikeUniv var, sts),(integers 0):(ST NNI)) @@ -249782,19 +254017,26 @@ WeierstrassPreparation(R): Defn == Impl where q:=(YSS qqq(a,f:SMPS,rest p)) maptake(a,(p*q) pretend ST StS) + cfirst : NonNegativeInteger -> (Stream(Polynomial(R)) -> + Stream(Polynomial(R))) cfirst n == s +-> first(s,n)$StS + crest : NonNegativeInteger -> (Stream(Polynomial(R)) -> + Stream(Polynomial(R))) crest n == s +-> rest(s,n)$StS qq:(NNI,SMPS,ST SMPS,ST SMPS)->ST SMPS qq(a,e,p,c)== cons(e,(-e)*mapdrop(a,(p*c)pretend(ST StS))) + qqq : (NonNegativeInteger,TaylorSeries(R),Stream(TaylorSeries(R))) -> + (Stream(TaylorSeries(R)) -> Stream(TaylorSeries(R))) qqq(a,e,p)== s +-> qq(a,e,p,s) wei:(VarSet,SMPS)->ST SMPS wei(v:VarSet,s:SMPS)==weier(v,s:StS) + weierstrass : (Symbol,TaylorSeries(R)) -> List(TaylorSeries(R)) weierstrass(v,smps)== transback wei (v,smps) *) @@ -250136,6 +254378,8 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where (not sizeLess?(1,indexChange)) or ((disc exquo p2) case "failed") => return [rb, rbden, rbinv, disc] + integralBasis : () -> + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) integralBasis() == traceMat := traceMatrix()$F; n := rank()$F disc := determinant traceMat -- discriminant of current order @@ -250167,6 +254411,8 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) [runningRb, runningRbden, runningRbinv] + localIntegralBasis : R -> + Record(basis: Matrix(R),basisDen: R,basisInv: Matrix(R)) localIntegralBasis prime == traceMat := traceMatrix()$F; n := rank()$F disc := determinant traceMat -- discriminant of current order @@ -250312,6 +254558,7 @@ XExponentialPackage(R, VarSet, XPOLY): Public == Private where (* package XEXPPKG *) (* + log : (XPOLY,NonNegativeInteger) -> XPOLY log (p,n) == p1 : XPOLY := p - 1 not quasiRegular? p1 => @@ -250325,6 +254572,7 @@ XExponentialPackage(R, VarSet, XPOLY): Public == Private where k := k - 1 s + exp : (XPOLY,NonNegativeInteger) -> XPOLY exp (p,n) == not quasiRegular? p => error "constant term <> 0, exp impossible" @@ -250338,6 +254586,7 @@ XExponentialPackage(R, VarSet, XPOLY): Public == Private where k := k - 1 s + Hausdorff : (XPOLY,XPOLY,NonNegativeInteger) -> XPOLY Hausdorff(p,q,n) == p1: XPOLY := exp(p,n) q1: XPOLY := exp(q,n) @@ -254034,6 +258283,8 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where newv: V2 := (variable(news)$V2)::V2 newq: Q2 := newv :: Q2 + convert : NewSparseMultivariatePolynomial(R,OrderedVariableList(ls)) -> + NewSparseMultivariatePolynomial(R,OrderedVariableList(ls2)) convert(q:Q):Q2 == ground? q => (ground(q))::Q2 q2: Q2 := 0 @@ -254048,6 +258299,11 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where q := tail(q) q2 + (ground(q))::Q2 + squareFree : RegularChain(R,ls) -> + List(SquareFreeRegularTriangularSet(R, + IndexedExponents(OrderedVariableList(ls2)), + OrderedVariableList(ls2), + NewSparseMultivariatePolynomial(R,OrderedVariableList(ls2)))) squareFree(ts:TS):List(ST) == irred?: Boolean := false st: ST := [[newq]$(List Q2)] @@ -254080,15 +258336,21 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where toSee := cons([newlq,newts]$LQ2WT,toSee) toSave + triangSolve : (List(Polynomial(R)),Boolean,Boolean) -> + List(RegularChain(R,ls)) triangSolve(lp: LP, info?: B, lextri?: B): List TS == lq: List(Q) := [convert(p)$Q for p in lp] lextri? => zeroSetSplit(lq,false)$lextripack zeroSetSplit(lq,true,info?)$TS + triangSolve : (List(Polynomial(R)),Boolean) -> List(RegularChain(R,ls)) triangSolve(lp: LP, info?: B): List TS == triangSolve(lp,info?,false) + triangSolve : List(Polynomial(R)) -> List(RegularChain(R,ls)) triangSolve(lp: LP): List TS == triangSolve(lp,false) + convert : SparseUnivariatePolynomial(R) -> + SparseUnivariatePolynomial(RealClosure(Fraction(R))) convert(u: U): URC == zero? u => 0 ground? u => ((ground(u) :: K)::RC)::URC @@ -254098,21 +258360,30 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where u := reductum u uu + ((ground(u) :: K)::RC)::URC + coerceFromRtoRC : R -> RC coerceFromRtoRC(r:R): RC == (r::K)::RC + convert : Polynomial(R) -> Polynomial(RealClosure(Fraction(R))) convert(p:P): PRC == map(coerceFromRtoRC,p)$PolynomialFunctions2(R,RC) + convert : NewSparseMultivariatePolynomial(R,OrderedVariableList(ls2)) -> + Polynomial(RealClosure(Fraction(R))) convert(q2:Q2): PRC == p: P := coerce(q2)$Q2 convert(p)@PRC + convert : SquareFreeRegularTriangularSet(R, + IndexedExponents(OrderedVariableList(ls2)),OrderedVariableList(ls2), + NewSparseMultivariatePolynomial(R,OrderedVariableList(ls2))) -> + List(NewSparseMultivariatePolynomial(R,OrderedVariableList(ls2))) convert(sts:ST): List Q2 == lq2: List(Q2) := parts(sts)$ST lq2 := sort(infRittWu?,lq2) rest(lq2) + realSolve : RegularChain(R,ls) -> List(List(RealClosure(Fraction(R)))) realSolve(ts: TS): List REALSOL == lsts: List ST := squareFree(ts) lr: REALSOL := [] @@ -254137,6 +258408,8 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee) toSave + realSolve : (List(Polynomial(R)),Boolean,Boolean,Boolean) -> + List(List(RealClosure(Fraction(R)))) realSolve(lp: List(P), info?:Boolean, check?:Boolean, _ lextri?: Boolean): List REALSOL == lts: List TS @@ -254181,15 +258454,21 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where error "realSolve$ZDSOLVE: bad result" toSave + realSolve : (List(Polynomial(R)),Boolean,Boolean) -> + List(List(RealClosure(Fraction(R)))) realSolve(lp: List(P), info?:Boolean, check?:Boolean): List REALSOL == realSolve(lp,info?,check?,false) + realSolve : (List(Polynomial(R)),Boolean) -> + List(List(RealClosure(Fraction(R)))) realSolve(lp: List(P), info?:Boolean): List REALSOL == realSolve(lp,info?,false,false) + realSolve : List(Polynomial(R)) -> List(List(RealClosure(Fraction(R)))) realSolve(lp: List(P)): List REALSOL == realSolve(lp,false,false,false) + positiveSolve : RegularChain(R,ls) -> List(List(RealClosure(Fraction(R)))) positiveSolve(ts: TS): List REALSOL == lsts: List ST := squareFree(ts) lr: REALSOL := [] @@ -254216,6 +258495,8 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee) toSave + positiveSolve : (List(Polynomial(R)),Boolean,Boolean) -> + List(List(RealClosure(Fraction(R)))) positiveSolve(lp: List(P),info?:Boolean,lextri?: Boolean):List REALSOL == lts: List TS lq: List(Q) := [convert(p)$Q for p in lp] @@ -254252,12 +258533,18 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee) toSave + positiveSolve : (List(Polynomial(R)),Boolean) -> + List(List(RealClosure(Fraction(R)))) positiveSolve(lp: List(P), info?:Boolean): List REALSOL == positiveSolve(lp, info?, false) + positiveSolve: List(Polynomial(R)) -> List(List(RealClosure(Fraction(R)))) positiveSolve(lp: List(P)): List REALSOL == positiveSolve(lp, false, false) + univariateSolve : RegularChain(R,ls) -> + List(Record(complexRoots: SparseUnivariatePolynomial(R), + coordinates: List(Polynomial(R)))) univariateSolve(ts: TS): List RUR == toSee: List ST := squareFree(ts) toSave: List RUR := [] @@ -254269,6 +258556,9 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where toSave := cons([g,lc]$RUR, toSave) toSave + univariateSolve : (List(Polynomial(R)),Boolean,Boolean,Boolean) -> + List(Record(complexRoots: SparseUnivariatePolynomial(R), + coordinates: List(Polynomial(R)))) univariateSolve(lp: List(P), info?:Boolean, check?:Boolean, _ lextri?: Boolean): List RUR == lts: List TS @@ -254303,12 +258593,21 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where toSave := cons([g,lc]$RUR, toSave) toSave + univariateSolve : (List(Polynomial(R)),Boolean,Boolean) -> + List(Record(complexRoots: SparseUnivariatePolynomial(R), + coordinates: List(Polynomial(R)))) univariateSolve(lp: List(P), info?:Boolean, check?:Boolean): List RUR == univariateSolve(lp,info?,check?,false) + univariateSolve : (List(Polynomial(R)),Boolean) -> + List(Record(complexRoots: SparseUnivariatePolynomial(R), + coordinates: List(Polynomial(R)))) univariateSolve(lp: List(P), info?:Boolean): List RUR == univariateSolve(lp,info?,false,false) + univariateSolve : List(Polynomial(R)) -> + List(Record(complexRoots: SparseUnivariatePolynomial(R), + coordinates: List(Polynomial(R)))) univariateSolve(lp: List(P)): List RUR == univariateSolve(lp,false,false,false) diff --git a/changelog b/changelog index 7733a80..3016e45 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20150828 tpd src/axiom-website/patches.html 20150828.01.tpd.patch +20150828 tpd books/bookvol10.4 add signatures to all package functions 20150815 tpd src/axiom-website/patches.html 20150815.01.tpd.patch 20150815 tpd books/bookvolbib add additional references 20150815 tpd books/bookvol10.4 extract code for COQ proof system diff --git a/patch b/patch index b11eb59..cbdedf0 100644 --- a/patch +++ b/patch @@ -1,8 +1,6 @@ -books/bookvol10.* extract code for COQ proof system +books/bookvol10.4 add signatures to all package functions Goal: Proving Axiom Correct -Collect all of the functions in the categories, domains, and packages -into obj/sys/proofs/coq.v - - +For every function in the packages add the signature of the function +to the COQ extract. diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 1f55f62..19c8369 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -5118,6 +5118,8 @@ books/bookvol10.* add COQ stanzas
buglist bug 7303: Duplicate signature in )show ALIST
20150815.01.tpd.patch books/bookvol10.* extract code for COQ proof system
+20150828.01.tpd.patch +books/bookvol10.4 add signatures to all package functions
-- 1.7.5.4