diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index 5826491..d659141 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -3581,6 +3581,140 @@ AnyFunctions1(S:Type): with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package APPRULE ApplyRules} +\pagehead{ApplyRules}{APPRULE} +\pagepic{ps/v104applyrules.ps}{APPRULE}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package APPRULE ApplyRules +++ Applications of rules to expressions +++ Author: Manuel Bronstein +++ Date Created: 20 Mar 1990 +++ Date Last Updated: 5 Jul 1990 +++ Description: +++ This package apply rewrite rules to expressions, calling +++ the pattern matcher. +++ Keywords: pattern, matching, rule. +ApplyRules(Base, R, F): Exports == Implementation where + Base : SetCategory + R : Join(Ring, PatternMatchable Base, OrderedSet, + ConvertibleTo Pattern Base) + F : Join(FunctionSpace R, PatternMatchable Base, + ConvertibleTo Pattern Base) + + P ==> Pattern Base + PR ==> PatternMatchResult(Base, F) + RR ==> RewriteRule(Base, R, F) + K ==> Kernel F + + Exports ==> with + applyRules : (List RR, F) -> F + ++ applyRules([r1,...,rn], expr) applies the rules + ++ r1,...,rn to f an unlimited number of times, i.e. until + ++ none of r1,...,rn is applicable to the expression. + applyRules : (List RR, F, PositiveInteger) -> F + ++ applyRules([r1,...,rn], expr, n) applies the rules + ++ r1,...,rn to f a most n times. + localUnquote: (F, List Symbol) -> F + ++ localUnquote(f,ls) is a local function. + + Implementation ==> add + 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 l == + ncr := empty()$List(RR) + lk := empty()$List(K) + lv := empty()$List(F) + for r in l repeat + if (u := retractIfCan(r)@Union(Equation F, "failed")) + case "failed" then ncr := concat(r, ncr) + else + lk := concat(retract(lhs(u::Equation F))@K, lk) + lv := concat(rhs(u::Equation F), lv) + [lk, lv, ncr] + + applyRules(l, s) == + rec := splitRules l + repeat + (new:= localApply(rec.lker,rec.lval,rec.rl,s,1)) = s => return s + s := new + + applyRules(l, s, n) == + rec := splitRules l + localApply(rec.lker, rec.lval, rec.rl, s, n) + + localApply(lk, lv, lrule, subject, n) == + for i in 1..n repeat + for k in lk for v in lv repeat + subject := eval(subject, k, v) + subject := app(lrule, subject) + subject + + rewrite(f, res, l) == + lk := empty()$List(K) + lv := empty()$List(F) + for rec in destruct res repeat + lk := concat(kernel(rec.key), lk) + lv := concat(rec.entry, lv) + localUnquote(eval(f, lk, lv), l) + + if R has ConvertibleTo InputForm then + localUnquote(f, l) == + empty? l => f + eval(f, l) + else + localUnquote(f, l) == f + + isitwithpred(subject, pat, vars, bad) == + failed?(u := patternMatch(subject, pat, new()$PR)) => u + satisfy?(u, pat)::Boolean => u + member?(u, bad) => failed() + for v in vars repeat addBadValue(v, getMatch(v, u)::F) + isitwithpred(subject, pat, vars, concat(u, bad)) + + 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(lrule, subject) == + for r in lrule repeat + not failed?(u := isit(subject, pattern r)) => + return rewrite(rhs r, u, quotedOperators r) + (k := retractIfCan(subject)@Union(K, "failed")) case K => + operator(k::K) applist(lrule, argument(k::K)) + (l := isPlus subject) case List(F) => +/applist(lrule,l::List(F)) + (l := isTimes subject) case List(F) => */applist(lrule,l::List(F)) + (e := isPower subject) case Record(val:F, exponent:Integer) => + ee := e::Record(val:F, exponent:Integer) + f := app(lrule, ee.val) + positive?(ee.exponent) => f ** (ee.exponent)::NonNegativeInteger + recip(f)::F ** (- ee.exponent)::NonNegativeInteger + subject + +@ +<>= +"APPRULE" [color="#FF4488",href="bookvol10.4.pdf#nameddest=APPRULE"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"APPRULE" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package APPLYORE ApplyUnivariateSkewPolynomial} \pagehead{ApplyUnivariateSkewPolynomial}{APPLYORE} \pagepic{ps/v104applyunivariateskewpolynomial.ps}{APPLYORE}{1.00} @@ -15174,6 +15308,502 @@ See the above discussion for why this causes an infinite loop. @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RDEEF ElementaryRischDE} +\pagehead{ElementaryRischDE}{RDEEF} +\pagepic{ps/v104elementaryrischde.ps}{RDEEF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RDEEF ElementaryRischDE +++ Risch differential equation, elementary case. +++ Author: Manuel Bronstein +++ Date Created: 1 February 1988 +++ Date Last Updated: 2 November 1995 +++ Keywords: elementary, function, integration. +ElementaryRischDE(R, F): Exports == Implementation where + R : Join(GcdDomain, OrderedSet, CharacteristicZero, + RetractableTo Integer, LinearlyExplicitRingOver Integer) + F : Join(TranscendentalFunctionCategory, AlgebraicallyClosedField, + FunctionSpace R) + + N ==> NonNegativeInteger + Z ==> Integer + SE ==> Symbol + LF ==> List F + K ==> Kernel F + LK ==> List K + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + GP ==> LaurentPolynomial(F, UP) + Data ==> List Record(coeff:Z, argument:P) + RRF ==> Record(mainpart:F,limitedlogs:List NL) + NL ==> Record(coeff:F,logand:F) + U ==> Union(RRF, "failed") + UF ==> Union(F, "failed") + UUP ==> Union(UP, "failed") + UGP ==> Union(GP, "failed") + URF ==> Union(RF, "failed") + UEX ==> Union(Record(ratpart:F, coeff:F), "failed") + PSOL==> Record(ans:F, right:F, sol?:Boolean) + FAIL==> error("Function not supported by Risch d.e.") + ALGOP ==> "%alg" + + Exports ==> with + rischDE: (Z, F, F, SE, (F, LF) -> U, (F, F) -> UEX) -> PSOL + ++ rischDE(n, f, g, x, lim, ext) returns \spad{[y, h, b]} such that + ++ \spad{dy/dx + n df/dx y = h} and \spad{b := h = g}. + ++ The equation \spad{dy/dx + n df/dx y = g} has no solution + ++ if \spad{h \~~= g} (y is a partial solution in that case). + ++ Notes: lim is a limited integration function, and + ++ ext is an extended integration function. + + Implementation ==> add + import IntegrationTools(R, F) + import TranscendentalRischDE(F, UP) + import TranscendentalIntegration(F, UP) + import PureAlgebraicIntegration(R, F, F) + import FunctionSpacePrimitiveElement(R, F) + import ElementaryFunctionStructurePackage(R, F) + 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 f == (numer(f)::GP exquo denom(f)::GP)::GP + + logdiff(twr, bad) == + [u for u in twr | is?(u, "log"::SE) and not member?(u, bad)] + + 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, normal0(n, #1, #2, #3))) case "failed" + => [0, 0, false] + [u::F, g, true] + has?(operator kx, ALGOP) => + rec := primitiveElement(kx::F, k::F) + y := rootOf(rec.prim) + lk:LK := [kx, k] + lv:LF := [(rec.pol1) y, (rec.pol2) y] + rc := rischDE(n, eval(f, lk, lv), eval(g, lk, lv), x, limint, extint) + rc.sol? => [eval(rc.ans, retract(y)@K, rec.primelt), rc.right, true] + [0, 0, false] + FAIL + +-- solve y' + n f'y = g for a rational function y + rischDE(n, f, g, x, limitedint, extendedint) == + zero? g => [0, g, true] + zero?(nfp := n * differentiate(f, x)) => + (u := limitedint(g, empty())) case "failed" => [0, 0, false] + [u.mainpart, g, true] + freeOf?(y := g / nfp, x) => [y, g, true] + vl := varselect(union(kernels nfp, kernels g), x) + symbolIfCan(k := kmax vl) case SE => normalise0(n, f, g, x) + is?(k, "log"::SE) or is?(k, "exp"::SE) => + normalise(n, nfp, f, g, x, k, limitedint, extendedint) + has?(operator k, ALGOP) => + rischDEalg(n, nfp, f, g, k, vl, x, limitedint, extendedint) + FAIL + + normal0(n, f, g, x) == + rec := normalise0(n, f, g, x) + rec.sol? => rec.ans + "failed" + +-- solve y' + n f' y = g +-- when f' and g are rational functions over a constant field + normalise0(n, f, g, x) == + k := kernel(x)@K + if (data1 := search(f, tab)) case "failed" then + tab.f := data := makeData(f, x, k) + else data := data1::Data + f' := nfprime := n * differentiate(f, x) + p:P := 1 + for v in data | (m := n * v.coeff) > 0 repeat + p := p * v.argument ** (m::N) + f' := f' - m * differentiate(v.argument::F, x) / (v.argument::F) + rec := baseRDE(univariate(f', k), univariate(p::F * g, k)) + y := multivariate(rec.ans, k) / p::F + rec.nosol => [y, differentiate(y, x) + nfprime * y, false] + [y, g, true] + +-- make f weakly normalized, and solve y' + n f' y = g + normalise(n, nfp, f, g, x, k, limitedint, extendedint) == + if (data1:= search(f, tab)) case "failed" then + tab.f := data := makeData(f, x, k) + else data := data1::Data + p:P := 1 + for v in data | (m := n * v.coeff) > 0 repeat + p := p * v.argument ** (m::N) + f := f - v.coeff * log(v.argument::F) + nfp := nfp - m * differentiate(v.argument::F, x) / (v.argument::F) + newf := univariate(nfp, k) + newg := univariate(p::F * g, k) + twr := union(logdiff(tower f, empty()), logdiff(tower g, empty())) + ans1 := + is?(k, "log"::SE) => + rischDElog(twr, newf, newg, x, k, + differentiate(#1, differentiate(#1, x), + differentiate(k::F, x)::UP), + limitedint, extendedint) + is?(k, "exp"::SE) => + rischDEexp(twr, newf, newg, x, k, + differentiate(#1, differentiate(#1, x), + monomial(differentiate(first argument k, x), 1)), + limitedint, extendedint) + ans1 case "failed" => [0, 0, false] + [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, x, k) == + disasters := empty()$Data + fnum := numer f + fden := denom f + for u in varselect(kernels f, x) | is?(u, "log"::SE) repeat + logand := first argument u + if zero?(degree univariate(fden, u)) and +-- one?(degree(num := univariate(fnum, u))) then + (degree(num := univariate(fnum, u)) = 1) then + cf := (leadingCoefficient num) / fden + if (n := retractIfCan(cf)@Union(Z, "failed")) case Z then + if degree(numer logand, k) > 0 then + disasters := concat([n::Z, numer logand], disasters) + if degree(denom logand, k) > 0 then + disasters := concat([-(n::Z), denom logand], disasters) + disasters + + 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(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(twr, aa, bb, cc, x, t, driv, limint, extint) == + zero? cc => 0 + t' := differentiate(t::F, x) + zero? bb => + (u := cc exquo aa) case "failed" => "failed" + primintfldpoly(u::UP, extint(#1, t'), t') + n := degree(cc)::Z - (db := degree(bb)::Z) + if ((da := degree(aa)::Z) = db) and (da > 0) then + lk0 := tower(f0 := + - (leadingCoefficient bb) / (leadingCoefficient aa)) + lk1 := logdiff(twr, lk0) + (if0 := limint(f0, [first argument u for u in lk1])) + case "failed" => error "Risch's theorem violated" + (alph := validExponential(lk0, RRF2F(if0::RRF), x)) case F => + return + (ans := polyDElog(twr, alph::F * aa, + differentiate(alph::F, x) * aa + alph::F * bb, + cc, x, t, driv, limint, extint)) case "failed" => "failed" + alph::F * ans::UP + if (da > db + 1) then n := max(0, degree(cc)::Z - da + 1) + if (da = db + 1) then + i := limint(- (leadingCoefficient bb) / (leadingCoefficient aa), + [first argument t]) + if not(i case "failed") then + r := + null(i.limitedlogs) => 0$F + i.limitedlogs.first.coeff + if (nn := retractIfCan(r)@Union(Z, "failed")) case Z then + n := max(nn::Z, n) + (v := polyRDE(aa, bb, cc, n, driv)) case ans => + v.ans.nosol => "failed" + v.ans.ans + w := v.eq + zero?(w.b) => + degree(w.c) > w.m => "failed" + (u := primintfldpoly(w.c, extint(#1,t'), t')) case "failed" => "failed" + degree(u::UP) > w.m => "failed" + w.alpha * u::UP + w.beta + (u := logdegrad(twr, retract(w.b), w.c, w.m, x, t, limint, extint)) + case "failed" => "failed" + w.alpha * u::UP + w.beta + + gpolDEexp(twr, a, b, c, x, t, driv, limint, extint) == + zero? c => 0 + zero? b => + (u := c exquo (a::GP)) case "failed" => "failed" + expintfldpoly(u::GP, + rischDE(#1, first argument t, #2, x, limint, extint)) + lb := boundAt0(twr, - coefficient(b, 0) / coefficient(a, 0), + nb := order b, nc := order c, x, t, limint) + tm := monomial(1, (m := max(0, max(-nb, lb - nc)))::N)$UP + (v := polyDEexp(twr,a * tm,lb * differentiate(first argument t, x) + * a * tm + retract(b * tm::GP)@UP, + retract(c * monomial(1, m - lb))@UP, + x, t, driv, limint, extint)) case "failed" => "failed" + v::UP::GP * monomial(1, lb) + + polyDEexp(twr, aa, bb, cc, x, t, driv, limint, extint) == + zero? cc => 0 + zero? bb => + (u := cc exquo aa) case "failed" => "failed" + exppolyint(u::UP, rischDE(#1, first argument t, #2, x, limint, extint)) + n := boundInf(twr,-leadingCoefficient(bb) / (leadingCoefficient aa), + degree(aa)::Z, degree(bb)::Z, degree(cc)::Z, x, t, limint) + (v := polyRDE(aa, bb, cc, n, driv)) case ans => + v.ans.nosol => "failed" + v.ans.ans + w := v.eq + zero?(w.b) => + degree(w.c) > w.m => "failed" + (u := exppolyint(w.c, + rischDE(#1, first argument t, #2, x, limint, extint))) + case "failed" => "failed" + w.alpha * u::UP + w.beta + (u := expdegrad(twr, retract(w.b), w.c, w.m, x, t, limint, extint)) + case "failed" => "failed" + w.alpha * u::UP + w.beta + + exppolyint(p, rischdiffeq) == + (u := expintfldpoly(p::GP, rischdiffeq)) case "failed" => "failed" + retractIfCan(u::GP)@Union(UP, "failed") + + boundInf(twr, f0, da, db, dc, x, t, limitedint) == + da < db => dc - db + da > db => max(0, dc - da) + l1 := logdiff(twr, l0 := tower f0) + (if0 := limitedint(f0, [first argument u for u in l1])) + case "failed" => error "Risch's theorem violated" + (alpha := validExponential(concat(t, l0), RRF2F(if0::RRF), x)) + case F => + al := separate(univariate(alpha::F, t))$GP + zero?(al.fracPart) and monomial?(al.polyPart) => + max(0, max(degree(al.polyPart), dc - db)) + dc - db + dc - db + + boundAt0(twr, f0, nb, nc, x, t, limitedint) == + nb ^= 0 => min(0, nc - min(0, nb)) + l1 := logdiff(twr, l0 := tower f0) + (if0 := limitedint(f0, [first argument u for u in l1])) + case "failed" => error "Risch's theorem violated" + (alpha := validExponential(concat(t, l0), RRF2F(if0::RRF), x)) + case F => + al := separate(univariate(alpha::F, t))$GP + zero?(al.fracPart) and monomial?(al.polyPart) => + min(0, min(degree(al.polyPart), nc)) + min(0, nc) + min(0, nc) + +-- case a = 1, deg(B) = 0, B <> 0 +-- cancellation at infinity is possible + logdegrad(twr, b, c, n, x, t, limitedint, extint) == + t' := differentiate(t::F, x) + lk1 := logdiff(twr, lk0 := tower(f0 := - b)) + (if0 := limitedint(f0, [first argument u for u in lk1])) + case "failed" => error "Risch's theorem violated" + (alpha := validExponential(lk0, RRF2F(if0::RRF), x)) case F => + (u1 := primintfldpoly(inv(alpha::F) * c, extint(#1, t'), t')) + case "failed" => "failed" + degree(u1::UP)::Z > n => "failed" + alpha::F * u1::UP + logdeg(c, - if0.mainpart - + +/[v.coeff * log(v.logand) for v in if0.limitedlogs], + n, x, t', limitedint, extint) + +-- case a = 1, degree(b) = 0, and (exp integrate b) is not in F +-- this implies no cancellation at infinity + logdeg(c, f, n, x, t', limitedint, extint) == + answr:UP := 0 + repeat + zero? c => return answr + (n < 0) or ((m := degree c)::Z > n) => return "failed" + u := rischDE(1, f, leadingCoefficient c, x, limitedint, extint) + ~u.sol? => return "failed" + zero? m => return(answr + u.ans::UP) + n := m::Z - 1 + c := (reductum c) - monomial(m::Z * t' * u.ans, (m - 1)::N) + answr := answr + monomial(u.ans, m) + +-- case a = 1, deg(B) = 0, B <> 0 +-- cancellation at infinity is possible + 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])) + case "failed" => error "Risch's theorem violated" + intf0 := - if0.mainpart - + +/[v.coeff * log(v.logand) for v in if0.limitedlogs] + (alpha := validExponential(concat(t, lk0), RRF2F(if0::RRF), x)) + case F => + al := separate(univariate(alpha::F, t))$GP + zero?(al.fracPart) and monomial?(al.polyPart) and + (degree(al.polyPart) >= 0) => + (u1 := expintfldpoly(c::GP * recip(al.polyPart)::GP, + rischDE(#1, first argument t, #2, x, limint, extint))) + case "failed" => "failed" + degree(u1::GP) > n => "failed" + retractIfCan(al.polyPart * u1::GP)@Union(UP, "failed") + expdeg(c, intf0, n, x, first argument t, limint,extint) + expdeg(c, intf0, n, x, first argument t, limint, extint) + +-- case a = 1, degree(b) = 0, and (exp integrate b) is not a monomial +-- this implies no cancellation at infinity + expdeg(c, f, n, x, eta, limitedint, extint) == + answr:UP := 0 + repeat + zero? c => return answr + (n < 0) or ((m := degree c)::Z > n) => return "failed" + u := rischDE(1, f + m * eta, leadingCoefficient c, x,limitedint,extint) + ~u.sol? => return "failed" + zero? m => return(answr + u.ans::UP) + n := m::Z - 1 + c := reductum c + answr := answr + monomial(u.ans, m) + + RRF2F rrf == + rrf.mainpart + +/[v.coeff*log(v.logand) for v in rrf.limitedlogs] + +@ +<>= +"RDEEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDEEF"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"RDEEF" -> "ACF" +"RDEEF" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RDEEFS ElementaryRischDESystem} +\pagehead{ElementaryRischDESystem}{RDEEFS} +\pagepic{ps/v104elementaryrischdesystem.ps}{RDEEFS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RDEEFS ElementaryRischDESystem +++ Risch differential equation, elementary case. +++ Author: Manuel Bronstein +++ Date Created: 12 August 1992 +++ Date Last Updated: 17 August 1992 +++ Keywords: elementary, function, integration. +ElementaryRischDESystem(R, F): Exports == Implementation where + R : Join(GcdDomain, OrderedSet, CharacteristicZero, + RetractableTo Integer, LinearlyExplicitRingOver Integer) + F : Join(TranscendentalFunctionCategory, AlgebraicallyClosedField, + FunctionSpace R) + + Z ==> Integer + SE ==> Symbol + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + NL ==> Record(coeff:F,logand:F) + RRF ==> Record(mainpart:F,limitedlogs:List NL) + U ==> Union(RRF, "failed") + ULF ==> Union(List F, "failed") + UEX ==> Union(Record(ratpart:F, coeff:F), "failed") + + Exports ==> with + rischDEsys: (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF + ++ rischDEsys(n, f, g_1, g_2, x,lim,ext) returns \spad{y_1.y_2} such that + ++ \spad{(dy1/dx,dy2/dx) + ((0, - n df/dx),(n df/dx,0)) (y1,y2) = (g1,g2)} + ++ if \spad{y_1,y_2} exist, "failed" otherwise. + ++ lim is a limited integration function, + ++ ext is an extended integration function. + + Implementation ==> add + import IntegrationTools(R, F) + import ElementaryRischDE(R, F) + import TranscendentalRischDESystem(F, UP) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R, P, F) + +-- sm1 := sqrt(-1::F) +-- ks1 := retract(sm1)@K + +-- gcoeffs : P -> ULF +-- gets1coeffs: F -> ULF +-- cheat : (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF + basecase : (F, F, F, K) -> ULF + +-- solve (y1',y2') + ((0, -nfp), (nfp, 0)) (y1,y2) = (g1, g2), base case + basecase(nfp, g1, g2, k) == + (ans := baseRDEsys(univariate(nfp, k), univariate(g1, k), + univariate(g2, k))) case "failed" => "failed" + l := ans::List(RF) + [multivariate(first l, k), multivariate(second l, k)] + +-- returns [x,y] s.t. f = x + y %i +-- f can be of the form (a + b %i) / (c + d %i) +-- gets1coeffs f == +-- (lnum := gcoeffs(numer f)) case "failed" => "failed" +-- (lden := gcoeffs(denom f)) case "failed" => "failed" +-- a := first(lnum::List F) +-- b := second(lnum::List F) +-- c := first(lden::List F) +-- zero?(d := second(lden::List F)) => [a/c, b/c] +-- cd := c * c + d * d +-- [(a * c + b * d) / cd, (b * c - a * d) / cd] + +-- gcoeffs p == +-- degree(q := univariate(p, ks1)) > 1 => "failed" +-- [coefficient(q, 0)::F, coefficient(q, 1)::F] + +-- cheat(n, f, g1, g2, x, limint, extint) == +-- (u := rischDE(n, sm1 * f, g1 + sm1 * g2, x, limint, extint)) +-- case "failed" => "failed" +-- (l := gets1coeffs(u::F)) case "failed" => +-- error "rischDEsys: expect linear result in sqrt(-1)" +-- l::List F + +-- solve (y1',y2') + ((0, -n f'), (n f', 0)) (y1,y2) = (g1, g2) + rischDEsys(n, f, g1, g2, x, limint, extint) == + zero? g1 and zero? g2 => [0, 0] + zero?(nfp := n * differentiate(f, x)) => + ((u1 := limint(g1, empty())) case "failed") or + ((u2 := limint(g1, empty())) case "failed") => "failed" + [u1.mainpart, u2.mainpart] + freeOf?(y1 := g2 / nfp, x) and freeOf?(y2 := - g1 / nfp, x) => [y1, y2] + vl := varselect(union(kernels nfp, union(kernels g1, kernels g2)), x) + symbolIfCan(k := kmax vl) case SE => basecase(nfp, g1, g2, k) +-- cheat(n, f, g1, g2, x, limint, extint) + error "rischDEsys: can only handle rational functions for now" + +@ +<>= +"RDEEFS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDEEFS"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"RDEEFS" -> "ACF" +"RDEEFS" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package ELFUTS EllipticFunctionsUnivariateTaylorSeries} \pagehead{EllipticFunctionsUnivariateTaylorSeries}{ELFUTS} \pagepic{ps/v104ellipticfunctionsunivariatetaylorseries.ps}{ELFUTS}{1.00} @@ -37692,6 +38322,49 @@ InputFormFunctions1(R:Type):with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTBIT IntegerBits} +Bug! Cannot precompute params and return a function which +simply computes the last call. e.g. ridHack1, below. + +Functions related to the binary representation of integers. +These functions directly access the bits in the big integer +representation and so are much facter than using a quotient loop. +\pagehead{IntegerBits}{INTBIT} +\pagepic{ps/v104integerbits.ps}{INTBIT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTBIT IntegerBits +++ Description: +++ This package provides functions to lookup bits in integers +IntegerBits: with + -- bitLength(n) == # of bits to represent abs(n) + -- bitCoef (n,i) == coef of 2**i in abs(n) + -- bitTruth(n,i) == true if coef of 2**i in abs(n) is 1 + + bitLength: Integer -> Integer + ++ bitLength(n) returns the number of bits to represent abs(n) + bitCoef: (Integer, Integer) -> Integer + ++ bitCoef(n,m) returns the coefficient of 2**m in abs(n) + bitTruth: (Integer, Integer) -> Boolean + ++ bitTruth(n,m) returns true if coefficient of 2**m in abs(n) is 1 + + == add + bitLength n == INTEGER_-LENGTH(n)$Lisp + bitCoef (n,i) == if INTEGER_-BIT(n,i)$Lisp then 1 else 0 + bitTruth(n,i) == INTEGER_-BIT(n,i)$Lisp + +@ +<>= +"INTBIT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTBIT"] +"Package" [color="#FF4488"] +"INTBIT" -> "Package" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package COMBINAT IntegerCombinatoricFunctions} \pagehead{IntegerCombinatoricFunctions}{COMBINAT} \pagepic{ps/v104integercombinatoricfunctions.ps}{COMBINAT}{1.00} @@ -39658,6 +40331,42 @@ that is the square of the upper bound of the table range, in this case @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTRET IntegerRetractions} +\pagehead{IntegerRetractions}{INTRET} +\pagepic{ps/v104integerretractions.ps}{INTRET}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTRET IntegerRetractions +++ Author: Manuel Bronstein +++ Description: Provides integer testing and retraction functions. +++ Date Created: March 1990 +++ Date Last Updated: 9 April 1991 +IntegerRetractions(S:RetractableTo(Integer)): with + integer : S -> Integer + ++ integer(x) returns x as an integer; + ++ error if x is not an integer; + integer? : S -> Boolean + ++ integer?(x) is true if x is an integer, false otherwise; + integerIfCan: S -> Union(Integer, "failed") + ++ integerIfCan(x) returns x as an integer, + ++ "failed" if x is not an integer; + == add + integer s == retract s + integer? s == retractIfCan(s) case Integer + integerIfCan s == retractIfCan s + +@ +<>= +"INTRET" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTRET"] +"RETRACT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RETRACT"] +"INTRET" -> "RETRACT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package IROOT IntegerRoots} \pagehead{IntegerRoots}{IROOT} \pagepic{ps/v104integerroots.ps}{IROOT}{1.00} @@ -40520,6 +41229,156 @@ IntegrationResultToFunction(R, F): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTTOOLS IntegrationTools} +\pagehead{IntegrationTools}{INTTOOLS} +\pagepic{ps/v104integrationtools.ps}{INTTOOLS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTTOOLS IntegrationTools +++ Tools for the integrator +++ Author: Manuel Bronstein +++ Date Created: 25 April 1990 +++ Date Last Updated: 9 June 1993 +++ Keywords: elementary, function, integration. +IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where + K ==> Kernel F + SE ==> Symbol + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + IR ==> IntegrationResult F + ANS ==> Record(special:F, integrand:F) + U ==> Union(ANS, "failed") + ALGOP ==> "%alg" + + Exp ==> with + varselect: (List K, SE) -> List K + ++ varselect([k1,...,kn], x) returns the ki which involve x. + kmax : List K -> K + ++ kmax([k1,...,kn]) returns the top-level ki for integration. + ksec : (K, List K, SE) -> K + ++ ksec(k, [k1,...,kn], x) returns the second top-level ki + ++ after k involving x. + union : (List K, List K) -> List K + ++ union(l1, l2) returns set-theoretic union of l1 and l2. + vark : (List F, SE) -> List K + ++ vark([f1,...,fn],x) returns the set-theoretic union of + ++ \spad{(varselect(f1,x),...,varselect(fn,x))}. + if R has IntegralDomain then + removeConstantTerm: (F, SE) -> F + ++ removeConstantTerm(f, x) returns f minus any additive constant + ++ with respect to x. + if R has GcdDomain and F has ElementaryFunctionCategory then + mkPrim: (F, SE) -> F + ++ mkPrim(f, x) makes the logs in f which are linear in x + ++ primitive with respect to x. + if R has ConvertibleTo Pattern Integer and R has PatternMatchable Integer + and F has LiouvillianFunctionCategory and F has RetractableTo SE then + intPatternMatch: (F, SE, (F, SE) -> IR, (F, SE) -> U) -> IR + ++ intPatternMatch(f, x, int, pmint) tries to integrate \spad{f} + ++ first by using the integration function \spad{int}, and then + ++ by using the pattern match intetgration function \spad{pmint} + ++ on any remaining unintegrable part. + + Impl ==> add + better?: (K, K) -> Boolean + + union(l1, l2) == setUnion(l1, l2) + 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)) + + vark(l, x) == + varselect(reduce("setUnion",[kernels f for f in l],empty()$List(K)), x) + + kmax l == + ans := first l + for k in rest l repeat + if better?(k, ans) then ans := k + ans + +-- true if x should be considered before y in the tower + better?(x, y) == + height(y) ^= height(x) => height(y) < height(x) + has?(operator y, ALGOP) or + (is?(y, "exp"::SE) and not is?(x, "exp"::SE) + and not has?(operator x, ALGOP)) + + if R has IntegralDomain then + removeConstantTerm(f, x) == + not freeOf?((den := denom f)::F, x) => f + (u := isPlus(num := numer f)) case "failed" => + freeOf?(num::F, x) => 0 + f + ans:P := 0 + for term in u::List(P) repeat + if not freeOf?(term::F, x) then ans := ans + term + 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, 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, l) == + empty? l => p + q := univariate(p, first l) + cont(unitNormal(leadingCoefficient q).unit * content q, rest l) + + linearLog?(k, f, x) == + is?(k, "log"::SE) and + ((u := retractIfCan(univariate(f,k))@Union(UP,"failed")) case UP) +-- and one?(degree(u::UP)) + and (degree(u::UP) = 1) + and not member?(x, variables leadingCoefficient(u::UP)) + + 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, x) == + (u := isExpt(p := ((p exquo cont(p, varselect(variables p, x)))::P))) + case "failed" => [1, p::F] + [u.exponent, u.var::F] + + if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) + and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then + intPatternMatch(f, x, int, pmint) == + ir := int(f, x) + empty?(l := notelem ir) => ir + ans := ratpart ir + nl:List(Record(integrand:F, intvar:F)) := empty() + lg := logpart ir + for rec in l repeat + u := pmint(rec.integrand, retract(rec.intvar)) + if u case ANS then + rc := u::ANS + ans := ans + rc.special + if rc.integrand ^= 0 then + ir0 := intPatternMatch(rc.integrand, x, int, pmint) + ans := ans + ratpart ir0 + lg := concat(logpart ir0, lg) + nl := concat(notelem ir0, nl) + else nl := concat(rec, nl) + mkAnswer(ans, lg, nl) + +@ +<>= +"INTTOOLS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTTOOLS"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"INTTOOLS" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package IPRNTPK InternalPrintPackage} \pagehead{InternalPrintPackage}{IPRNTPK} \pagepic{ps/v104internalprintpackage.ps}{IPRNTPK}{1.00} @@ -62418,6 +63277,153 @@ PolynomialCategoryLifting(E,Vars,R,P,S): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package POLYCATQ PolynomialCategoryQuotientFunctions} +\pagehead{PolynomialCategoryQuotientFunctions}{POLYCATQ} +\pagepic{ps/v104polynomialcategoryquotientfunctions.ps}{POLYCATQ}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package POLYCATQ PolynomialCategoryQuotientFunctions +++ Manipulations on polynomial quotients +++ Author: Manuel Bronstein +++ Date Created: March 1988 +++ Date Last Updated: 9 July 1990 +++ Description: +++ This package transforms multivariate polynomials or fractions into +++ univariate polynomials or fractions, and back. +++ Keywords: polynomial, fraction, transformation +PolynomialCategoryQuotientFunctions(E, V, R, P, F): + Exports == Implementation where + E: OrderedAbelianMonoidSup + V: OrderedSet + R: Ring + P: PolynomialCategory(R, E, V) + F: Field with + coerce: P -> % + numer : % -> P + denom : % -> P + + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + + Exports ==> with + variables : F -> List V + ++ variables(f) returns the list of variables appearing + ++ in the numerator or the denominator of f. + mainVariable: F -> Union(V, "failed") + ++ mainVariable(f) returns the highest variable appearing + ++ in the numerator or the denominator of f, "failed" if + ++ f has no variables. + univariate : (F, V) -> RF + ++ univariate(f, v) returns f viewed as a univariate + ++ rational function in v. + multivariate: (RF, V) -> F + ++ multivariate(f, v) applies both the numerator and + ++ denominator of f to v. + univariate : (F, V, UP) -> UP + ++ univariate(f, x, p) returns f viewed as a univariate + ++ polynomial in x, using the side-condition \spad{p(x) = 0}. + isPlus : F -> Union(List F, "failed") + ++ isPlus(p) returns [m1,...,mn] if \spad{p = m1 + ... + mn} and + ++ \spad{n > 1}, "failed" otherwise. + isTimes : F -> Union(List F, "failed") + ++ isTimes(p) returns \spad{[a1,...,an]} if + ++ \spad{p = a1 ... an} and \spad{n > 1}, + ++ "failed" otherwise. + isExpt : F -> Union(Record(var:V, exponent:Integer), "failed") + ++ isExpt(p) returns \spad{[x, n]} if \spad{p = x**n} and \spad{n <> 0}, + ++ "failed" otherwise. + isPower : F -> Union(Record(val:F, exponent:Integer), "failed") + ++ isPower(p) returns \spad{[x, n]} if \spad{p = x**n} and \spad{n <> 0}, + ++ "failed" otherwise. + + Implementation ==> add + P2UP: (P, V) -> UP + + univariate(f, x) == P2UP(numer f, x) / P2UP(denom f, x) + + 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(f, x) == + v := x::P::F + ((numer f) v) / ((denom f) v) + + mymerge:(List V,List V) ->List V + mymerge(l:List V,m:List V):List V== + empty? l => m + empty? m => l + first l = first m => cons(first l,mymerge(rest l,rest m)) + first l > first m => cons(first l,mymerge(rest l,m)) + cons(first m,mymerge(l,rest m)) + + variables f == + mymerge(variables numer f, variables denom f) + + isPower f == + (den := denom f) ^= 1 => + numer f ^= 1 => "failed" + (ur := isExpt den) case "failed" => [den::F, -1] + r := ur::Record(var:V, exponent:NonNegativeInteger) + [r.var::P::F, - (r.exponent::Integer)] + (ur := isExpt numer f) case "failed" => "failed" + r := ur::Record(var:V, exponent:NonNegativeInteger) + [r.var::P::F, r.exponent::Integer] + + isExpt f == + (ur := isExpt numer f) case "failed" => +-- one? numer f => + (numer f) = 1 => + (ur := isExpt denom f) case "failed" => "failed" + r := ur::Record(var:V, exponent:NonNegativeInteger) + [r.var, - (r.exponent::Integer)] + "failed" + r := ur::Record(var:V, exponent:NonNegativeInteger) +-- one? denom f => [r.var, r.exponent::Integer] + (denom f) = 1 => [r.var, r.exponent::Integer] + "failed" + + isTimes f == + t := isTimes(num := numer f) + l:Union(List F, "failed") := + t case "failed" => "failed" + [x::F for x in t] +-- one?(den := denom f) => l + ((den := denom f) = 1) => l +-- one? num => "failed" + num = 1 => "failed" + d := inv(den::F) + l case "failed" => [num::F, d] + concat_!(l::List(F), d) + + isPlus f == + denom f ^= 1 => "failed" + (s := isPlus numer f) case "failed" => "failed" + [x::F for x in s] + + mainVariable f == + a := mainVariable numer f + (b := mainVariable denom f) case "failed" => a + a case "failed" => b + max(a::V, b::V) + + P2UP(p, x) == + map(#1::F, + univariate(p, x))$SparseUnivariatePolynomialFunctions2(P, F) + +@ +<>= +"POLYCATQ" [color="#FF4488",href="bookvol10.4.pdf#nameddest=POLYCATQ"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"POLYCATQ" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package PCOMP PolynomialComposition} \pagehead{PolynomialComposition}{PCOMP} \pagepic{ps/v104polynomialcomposition.ps}{PCOMP}{1.00} @@ -65195,6 +66201,278 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ODEPRRIC PrimitiveRatRicDE} +\pagehead{PrimitiveRatRicDE}{ODEPRRIC} +\pagepic{ps/v104primitiveratricde.ps}{ODEPRRIC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ODEPRRIC PrimitiveRatRicDE +++ Author: Manuel Bronstein +++ Date Created: 22 October 1991 +++ Date Last Updated: 2 February 1993 +++ Description: In-field solution of Riccati equations, primitive case. +PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where + F : Join(Field, CharacteristicZero, RetractableTo Fraction Integer) + UP : UnivariatePolynomialCategory F + L : LinearOrdinaryDifferentialOperatorCategory UP + LQ : LinearOrdinaryDifferentialOperatorCategory Fraction UP + + N ==> NonNegativeInteger + Z ==> Integer + RF ==> Fraction UP + UP2 ==> SparseUnivariatePolynomial UP + REC ==> Record(deg:N, eq:UP) + REC2 ==> Record(deg:N, eq:UP2) + POL ==> Record(poly:UP, eq:L) + FRC ==> Record(frac:RF, eq:L) + CNT ==> Record(constant:F, eq:L) + IJ ==> Record(ij: List Z, deg:N) + + Exports ==> with + denomRicDE: L -> UP + ++ denomRicDE(op) returns a polynomial \spad{d} such that any rational + ++ solution of the associated Riccati equation of \spad{op y = 0} is + ++ of the form \spad{p/d + q'/q + r} for some polynomials p and q + ++ and a reduced r. Also, \spad{deg(p) < deg(d)} and {gcd(d,q) = 1}. + leadingCoefficientRicDE: L -> List REC + ++ leadingCoefficientRicDE(op) returns + ++ \spad{[[m1, p1], [m2, p2], ... , [mk, pk]]} such that the polynomial + ++ part of any rational solution of the associated Riccati equation of + ++ \spad{op y = 0} must have degree mj for some j, and its leading + ++ coefficient is then a zero of pj. In addition,\spad{m1>m2> ... >mk}. + constantCoefficientRicDE: (L, UP -> List F) -> List CNT + ++ constantCoefficientRicDE(op, ric) returns + ++ \spad{[[a1, L1], [a2, L2], ... , [ak, Lk]]} such that any rational + ++ solution with no polynomial part of the associated Riccati equation of + ++ \spad{op y = 0} must be one of the ai's in which case the equation for + ++ \spad{z = y e^{-int ai}} is \spad{Li z = 0}. + ++ \spad{ric} is a Riccati equation solver over \spad{F}, whose input + ++ is the associated linear equation. + polyRicDE: (L, UP -> List F) -> List POL + ++ polyRicDE(op, zeros) returns + ++ \spad{[[p1, L1], [p2, L2], ... , [pk, Lk]]} such that the polynomial + ++ part of any rational solution of the associated Riccati equation of + ++ \spad{op y=0} must be one of the pi's (up to the constant coefficient), + ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z =0}. + ++ \spad{zeros} is a zero finder in \spad{UP}. + singRicDE: (L, (UP, UP2) -> List UP, UP -> Factored UP) -> List FRC + ++ singRicDE(op, zeros, ezfactor) returns + ++ \spad{[[f1, L1], [f2, L2], ... , [fk, Lk]]} such that the singular + ++ part of any rational solution of the associated Riccati equation of + ++ \spad{op y=0} must be one of the fi's (up to the constant coefficient), + ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z=0}. + ++ \spad{zeros(C(x),H(x,y))} returns all the \spad{P_i(x)}'s such that + ++ \spad{H(x,P_i(x)) = 0 modulo C(x)}. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + changeVar: (L, UP) -> L + ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}. + changeVar: (L, RF) -> L + ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}. + + Implementation ==> add + 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, order(#1, c)::Z) + infLambda l == innerlb(l, -(degree(#1)::Z)) + infmax(rec, l) == innermax(rec, l, degree(#1)::Z) + dmax(rec, c, l) == innermax(rec, l, - order(#1, c)::Z) + 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] + 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] + polyRicDE(l, zeros) == concat([0, l], polysol(l, 0, false, zeros)) + +-- refine([p1,...,pn], foo) refines the list of factors using foo + 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(c, op, b, finite?, zeros) == + ans:List(FRC) := empty() + finite? and zero? b => ans + lc := leadingDenomRicDE(c, op) + if finite? then lc := select_!(#1.deg <= b, lc) + for rec in lc repeat + for r in zeros(c, rec.eq) | r ^= 0 repeat + rcn := r /$RF (c ** rec.deg) + neweq := changeVar(op, rcn) + sols := padicsol(c, neweq, (rec.deg-1)::N, true, zeros) + ans := + empty? sols => concat([rcn, neweq], ans) + concat_!([[rcn + sol.frac, sol.eq] for sol in sols], ans) + ans + + leadingDenomRicDE(c, l) == + ind:List(Z) -- to cure the compiler... (won't compile without) + lb := lambda(c, l) + done:List(N) := empty() + ans:List(REC2) := empty() + for rec in lb | (not member?(rec.deg, done)) and + not(empty?(ind := dmax(rec, c, l))) repeat + ans := concat([rec.deg, getPol(rec, c, l, ind)], ans) + done := concat(rec.deg, done) + sort_!(#1.deg > #2.deg, ans) + + getPol(rec, c, l, ind) == +-- one?(rec.deg) => getPol1(ind, c, l) + (rec.deg = 1) => getPol1(ind, c, l) + +/[monomial(tau0(c, coefficient(l, i::N)), i::N)$UP2 for i in ind] + + getPol1(ind, c, l) == + cp := diff c + +/[tau0(c, coefficient(l, i::N)) * poly1(c, cp, i) for i in ind] + + 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(op, m) == + ans:UP := 0 + while op ^= 0 repeat + if degree(p := leadingCoefficient op) = m then + ans := ans + monomial(leadingCoefficient p, degree op) + op := reductum op + ans + + 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(rec, l, nu) == + n := degree l + i := first(rec.ij) + m := i * (d := rec.deg) + nu coefficient(l, i::N) + ans:List(Z) := empty() + for j in 0..n | (f := coefficient(l, j)) ^= 0 repeat + if ((k := (j * d + nu f)) > m) then return empty() + else if (k = m) then ans := concat(j, ans) + ans + + leadingCoefficientRicDE l == + ind:List(Z) -- to cure the compiler... (won't compile without) + lb := infLambda l + done:List(N) := empty() + ans:List(REC) := empty() + for rec in lb | (not member?(rec.deg, done)) and + not(empty?(ind := infmax(rec, l))) repeat + ans := concat([rec.deg, getPoly(rec, l, ind)], ans) + done := concat(rec.deg, done) + sort_!(#1.deg > #2.deg, ans) + + factoredDenomRicDE l == + bd := factors balancedFactorisation(leadingCoefficient l, coefficients l) + [dd.factor for dd in bd] + + changeVar(l:L, a:UP) == + dpa := diff + a::L -- the operator (D + a) + dpan:L := 1 -- will accumulate the powers of (D + a) + op:L := 0 + for i in 0..degree l repeat + op := op + coefficient(l, i) * dpan + dpan := dpa * dpan + primitivePart op + + changeVar(l:L, a:RF) == + dpa := diffq + a::LQ -- the operator (D + a) + dpan:LQ := 1 -- will accumulate the powers of (D + a) + op:LQ := 0 + for i in 0..degree l repeat + op := op + coefficient(l, i)::RF * dpan + dpan := dpa * dpan + splitDenominator(op, empty()).eq + + 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, nu) == + lb:List(IJ) := empty() + n := degree l + for i in 0..n | (li := coefficient(l, i)) ^= 0repeat + for j in i+1..n | (lj := coefficient(l, j)) ^= 0 repeat + u := (nu li - nu lj) exquo (i-j) + if (u case Z) and ((b := u::Z) > 0) then + lb := concat([[i, j], b::N], lb) + lb + + 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, zeros, lc) == + ans:List(FRC) := empty() + empty? lc => ans + empty?(sols := padicsol(first lc, l, 0, false, zeros)) => + fracsol(l, zeros, rest lc) + for rec in sols repeat + neweq := changeVar(l, rec.frac) + sols := fracsol(neweq, zeros, rest lc) + ans := + empty? sols => concat(rec, ans) + concat_!([[rec.frac + sol.frac, sol.eq] for sol in sols], ans) + ans + +-- returns [] if the solutions of l have no polynomial component + polysol(l, b, finite?, zeros) == + ans:List(POL) := empty() + finite? and zero? b => ans + lc := leadingCoefficientRicDE l + if finite? then lc := select_!(#1.deg <= b, lc) + for rec in lc repeat + for a in zeros(rec.eq) | a ^= 0 repeat + atn:UP := monomial(a, rec.deg) + neweq := changeVar(l, atn) + sols := polysol(neweq, (rec.deg - 1)::N, true, zeros) + ans := + empty? sols => concat([atn, neweq], ans) + concat_!([[atn + sol.poly, sol.eq] for sol in sols], ans) + ans + +@ +<>= +"ODEPRRIC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ODEPRRIC"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"ODEPRRIC" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package PRINT PrintPackage} \pagehead{PrintPackage}{PRINT} \pagepic{ps/v104printpackage.ps}{PRINT}{1.00} @@ -66882,6 +68160,521 @@ PushVariables(R,E,OV,PPR):C == T where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter Q} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package QALGSET2 QuasiAlgebraicSet2} +\pagehead{QuasiAlgebraicSet2}{QALGSET2} +\pagepic{ps/v104quasialgebraicset2.ps}{QALGSET2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package QALGSET2 QuasiAlgebraicSet2 +++ Author: William Sit +++ Date Created: March 13, 1992 +++ Date Last Updated: June 12, 1992 +++ Basic Operations: +++ Related Constructors:GroebnerPackage, IdealDecompositionPackage, +++ PolynomialIdeals +++ See Also: QuasiAlgebraicSet +++ AMS Classifications: +++ Keywords: Zariski closed sets, quasi-algebraic sets +++ References:William Sit, "An Algorithm for Parametric Linear Systems" +++ J. Sym. Comp., April, 1992 +++ Description: +++ \spadtype{QuasiAlgebraicSet2} adds a function \spadfun{radicalSimplify} +++ which uses \spadtype{IdealDecompositionPackage} to simplify +++ the representation of a quasi-algebraic set. A quasi-algebraic set +++ is the intersection of a Zariski +++ closed set, defined as the common zeros of a given list of +++ polynomials (the defining polynomials for equations), and a principal +++ Zariski open set, defined as the complement of the common +++ zeros of a polynomial f (the defining polynomial for the inequation). +++ Quasi-algebraic sets are implemented in the domain +++ \spadtype{QuasiAlgebraicSet}, where two simplification routines are +++ provided: +++ \spadfun{idealSimplify} and \spadfun{simplify}. +++ The function +++ \spadfun{radicalSimplify} is added +++ for comparison study only. Because the domain +++ \spadtype{IdealDecompositionPackage} provides facilities for +++ computing with radical ideals, it is necessary to restrict +++ the ground ring to the domain \spadtype{Fraction Integer}, +++ and the polynomial ring to be of type +++ \spadtype{DistributedMultivariatePolynomial}. +++ The routine \spadfun{radicalSimplify} uses these to compute groebner +++ basis of radical ideals and +++ is inefficient and restricted when compared to the +++ two in \spadtype{QuasiAlgebraicSet}. +QuasiAlgebraicSet2(vl,nv) : C == T where + vl : List Symbol + nv : NonNegativeInteger + R ==> Integer + F ==> Fraction R + Var ==> OrderedVariableList vl + NNI ==> NonNegativeInteger + Expon ==> DirectProduct(nv,NNI) + Dpoly ==> DistributedMultivariatePolynomial(vl,F) + QALG ==> QuasiAlgebraicSet(F, Var, Expon, Dpoly) + newExpon ==> DirectProduct(#newvl, NNI) + newPoly ==> DistributedMultivariatePolynomial(newvl,F) + newVar ==> OrderedVariableList newvl + Status ==> Union(Boolean,"failed") -- empty or not, or don't know + + C == with + radicalSimplify:QALG -> QALG + ++ radicalSimplify(s) returns a different and presumably simpler + ++ representation of s with the defining polynomials for the + ++ equations + ++ forming a groebner basis, and the defining polynomial for the + ++ inequation reduced with respect to the basis, using + ++ using groebner basis of radical ideals + T == add + ---- 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) + import IdealDecompositionPackage(newvl,#newvl) + import QuasiAlgebraicSet(F, Var, Expon, Dpoly) + import PolynomialCategoryLifting(Expon,Var,F,Dpoly,newPoly) + import PolynomialCategoryLifting(newExpon,newVar,F,newPoly,Dpoly) + f(v:Var):newPoly == + variable((convert v)@Symbol)@Union(newVar,"failed")::newVar + ::newPoly + g(v:newVar):Dpoly == + v = tv => 0 + variable((convert v)@Symbol)@Union(Var,"failed")::Var::Dpoly + + npoly(p:Dpoly) : newPoly == map(f #1, #1::newPoly, p) + + oldpoly(q:newPoly) : Union(Dpoly,"failed") == + (x:=mainVariable q) case "failed" => (leadingCoefficient q)::Dpoly + (x::newVar = tv) => "failed" + map(g #1,#1::Dpoly, q) + + radicalSimplify x == + status(x)$QALG = true => x -- x is empty + z0:=definingEquations x + n0:=definingInequation x + t:newPoly:= coerce(tv)$newPoly + tp:newPoly:= t * (npoly n0) - 1$newPoly + gen:List newPoly:= concat(tp, [npoly g for g in z0]) + id:=ideal gen + ngb:=generators radical(id) + member? (1$newPoly, ngb) => empty()$QALG + gb:List Dpoly:=nil + while not empty? ngb repeat + if ((k:=oldpoly ngb.first) case Dpoly) then gb:=concat(k, gb) + ngb:=ngb.rest + y:=quasiAlgebraicSet(gb, primitivePart normalForm(n0, gb)) + setStatus(y,false::Status) + +@ +<>= +"QALGSET2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=QALGSET2"] +"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] +"QALGSET2" -> "ALIST" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package QCMPACK QuasiComponentPackage} +\pagehead{QuasiComponentPackage}{QCMPACK} +\pagepic{ps/v104quasicomponentpackage.ps}{QCMPACK}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package QCMPACK QuasiComponentPackage +++ Author: Marc Moreno Maza +++ marc@nag.co.uk +++ Date Created: 08/30/1998 +++ Date Last Updated: 12/16/1998 +++ Basic Functions: +++ Related Constructors: +++ Also See: `tosedom.spad' +++ AMS Classifications: +++ Keywords: +++ Description: +++ A package for removing redundant quasi-components and redundant +++ branches when decomposing a variety by means of quasi-components +++ of regular triangular sets. \newline +++ References : +++ [1] D. LAZARD "A new method for solving algebraic systems of +++ positive dimension" Discr. App. Math. 33:147-160,1991 +++ [2] M. MORENO MAZA "Calculs de pgcd au-dessus des tours +++ d'extensions simples et resolution des systemes d'equations +++ algebriques" These, Universite P.etM. Curie, Paris, 1997. +++ [3] M. MORENO MAZA "A new algorithm for computing triangular +++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. +++ Version: 3. + +QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where + + R : GcdDomain + E : OrderedAbelianMonoidSup + V : OrderedSet + P : RecursivePolynomialCategory(R,E,V) + TS : RegularTriangularSetCategory(R,E,V,P) + N ==> NonNegativeInteger + Z ==> Integer + B ==> Boolean + S ==> String + LP ==> List P + PtoP ==> P -> P + PS ==> GeneralPolynomialSet(R,E,V,P) + PWT ==> Record(val : P, tower : TS) + BWT ==> Record(val : Boolean, tower : TS) + LpWT ==> Record(val : (List P), tower : TS) + Branch ==> Record(eq: List P, tower: TS, ineq: List P) + UBF ==> Union(Branch,"failed") + Split ==> List TS + Key ==> Record(left:TS, right:TS) + Entry ==> Boolean + H ==> TabulatedComputationPackage(Key, Entry) + polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) + + Exports == with + startTable!: (S,S,S) -> Void + ++ \axiom{startTableGcd!(s1,s2,s3)} + ++ is an internal subroutine, exported only for developement. + stopTable!: () -> Void + ++ \axiom{stopTableGcd!()} + ++ is an internal subroutine, exported only for developement. + supDimElseRittWu?: (TS,TS) -> Boolean + ++ \axiom{supDimElseRittWu(ts,us)} returns true iff \axiom{ts} + ++ has less elements than \axiom{us} otherwise if \axiom{ts} + ++ has higher rank than \axiom{us} w.r.t. Riit and Wu ordering. + algebraicSort: Split -> Split + ++ \axiom{algebraicSort(lts)} sorts \axiom{lts} w.r.t + ++ \axiomOpFrom{supDimElseRittWu?}{QuasiComponentPackage}. + moreAlgebraic?: (TS,TS) -> Boolean + ++ \axiom{moreAlgebraic?(ts,us)} returns false iff \axiom{ts} + ++ and \axiom{us} are both empty, or \axiom{ts} + ++ has less elements than \axiom{us}, or some variable is + ++ algebraic w.r.t. \axiom{us} and is not w.r.t. \axiom{ts}. + subTriSet?: (TS,TS) -> Boolean + ++ \axiom{subTriSet?(ts,us)} returns true iff \axiom{ts} is + ++ a sub-set of \axiom{us}. + subPolSet?: (LP, LP) -> Boolean + ++ \axiom{subPolSet?(lp1,lp2)} returns true iff \axiom{lp1} is + ++ a sub-set of \axiom{lp2}. + internalSubPolSet?: (LP, LP) -> Boolean + ++ \axiom{internalSubPolSet?(lp1,lp2)} returns true iff \axiom{lp1} is + ++ a sub-set of \axiom{lp2} assuming that these lists are sorted + ++ increasingly w.r.t. \axiomOpFrom{infRittWu?}{RecursivePolynomialCategory}. + internalInfRittWu?: (LP, LP) -> Boolean + ++ \axiom{internalInfRittWu?(lp1,lp2)} + ++ is an internal subroutine, exported only for developement. + infRittWu?: (LP, LP) -> Boolean + ++ \axiom{infRittWu?(lp1,lp2)} + ++ is an internal subroutine, exported only for developement. + internalSubQuasiComponent?: (TS,TS) -> Union(Boolean,"failed") + ++ \axiom{internalSubQuasiComponent?(ts,us)} returns a boolean \spad{b} value + ++ if the fact that the regular zero set of \axiom{us} contains that of + ++ \axiom{ts} can be decided (and in that case \axiom{b} gives this + ++ inclusion) otherwise returns \axiom{"failed"}. + subQuasiComponent?: (TS,TS) -> Boolean + ++ \axiom{subQuasiComponent?(ts,us)} returns true iff + ++ \axiomOpFrom{internalSubQuasiComponent?}{QuasiComponentPackage} + ++ returs true. + subQuasiComponent?: (TS,Split) -> Boolean + ++ \axiom{subQuasiComponent?(ts,lus)} returns true iff + ++ \axiom{subQuasiComponent?(ts,us)} holds for one \spad{us} in \spad{lus}. + removeSuperfluousQuasiComponents: Split -> Split + ++ \axiom{removeSuperfluousQuasiComponents(lts)} removes from \axiom{lts} + ++ any \spad{ts} such that \axiom{subQuasiComponent?(ts,us)} holds for + ++ another \spad{us} in \axiom{lts}. + subCase?: (LpWT,LpWT) -> Boolean + ++ \axiom{subCase?(lpwt1,lpwt2)} + ++ is an internal subroutine, exported only for developement. + removeSuperfluousCases: List LpWT -> List LpWT + ++ \axiom{removeSuperfluousCases(llpwt)} + ++ is an internal subroutine, exported only for developement. + prepareDecompose: (LP, List(TS),B,B) -> List Branch + ++ \axiom{prepareDecompose(lp,lts,b1,b2)} + ++ is an internal subroutine, exported only for developement. + branchIfCan: (LP,TS,LP,B,B,B,B,B) -> Union(Branch,"failed") + ++ \axiom{branchIfCan(leq,ts,lineq,b1,b2,b3,b4,b5)} + ++ is an internal subroutine, exported only for developement. + + Implementation == add + + squareFreeFactors(lp: LP): LP == + lsflp: LP := [] + for p in lp repeat + lsfp := squareFreeFactors(p)$polsetpack + lsflp := concat(lsfp,lsflp) + sort(infRittWu?,removeDuplicates lsflp) + + 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 == + if makingStats?()$H then printStats!()$H + clearTable!()$H + + supDimElseRittWu? (ts:TS,us:TS): Boolean == + #ts < #us => true + #ts > #us => false + lp1 :LP := members(ts) + lp2 :LP := members(us) + while (not empty? lp1) and (not infRittWu?(first(lp2),first(lp1))) repeat + lp1 := rest lp1 + lp2 := rest lp2 + not empty? lp1 + + algebraicSort (lts:Split): Split == + lts := removeDuplicates lts + sort(supDimElseRittWu?,lts) + + moreAlgebraic?(ts:TS,us:TS): Boolean == + empty? ts => empty? us + empty? us => true + #ts < #us => false + for p in (members us) repeat + not algebraic?(mvar(p),ts) => return false + true + + subTriSet?(ts:TS,us:TS): Boolean == + empty? ts => true + empty? us => false + mvar(ts) > mvar(us) => false + mvar(ts) < mvar(us) => subTriSet?(ts,rest(us)::TS) + first(ts)::P = first(us)::P => subTriSet?(rest(ts)::TS,rest(us)::TS) + false + + internalSubPolSet?(lp1: LP, lp2: LP): Boolean == + empty? lp1 => true + empty? lp2 => false + associates?(first lp1, first lp2) => + internalSubPolSet?(rest lp1, rest lp2) + infRittWu?(first lp1, first lp2) => false + internalSubPolSet?(lp1, rest lp2) + + subPolSet?(lp1: LP, lp2: LP): Boolean == + lp1 := sort(infRittWu?, lp1) + lp2 := sort(infRittWu?, lp2) + internalSubPolSet?(lp1,lp2) + + infRittWu?(lp1: LP, lp2: LP): Boolean == + lp1 := sort(infRittWu?, lp1) + lp2 := sort(infRittWu?, lp2) + internalInfRittWu?(lp1,lp2) + + internalInfRittWu?(lp1: LP, lp2: LP): Boolean == + empty? lp1 => not empty? lp2 + empty? lp2 => false + infRittWu?(first lp1, first lp2)$P => true + infRittWu?(first lp2, first lp1)$P => false + infRittWu?(rest lp1, rest lp2)$$ + + 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,us:TS): Union(Boolean,"failed") == + -- "failed" is false iff saturate(us) is radical + subTriSet?(us,ts) => true + not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed") + for p in (members us) repeat + mdeg(p) < mdeg(select(ts,mvar(p))::P) => + return("failed"::Union(Boolean,"failed")) + for p in (members us) repeat + not zero? initiallyReduce(p,ts) => + return("failed"::Union(Boolean,"failed")) + lsfp := squareFreeFactors(initials us) + for p in lsfp repeat + not invertible?(p,ts)@B => + return(false::Union(Boolean,"failed")) + true::Union(Boolean,"failed") + + subQuasiComponent?(ts:TS,us:TS): Boolean == + k: Key := [ts, us] + e := extractIfCan(k)$H + e case Entry => e::Entry + ubf: Union(Boolean,"failed") := internalSubQuasiComponent?(ts,us) + b: Boolean := (ubf case Boolean) and (ubf::Boolean) + insert!(k,b)$H + b + + subQuasiComponent?(ts:TS,lus:Split): Boolean == + for us in lus repeat + subQuasiComponent?(ts,us)@B => return true + false + + removeSuperfluousCases (cases:List LpWT) == + #cases < 2 => cases + toSee := sort(supDimElseRittWu?(#1.tower,#2.tower),cases) + lpwt1,lpwt2 : LpWT + toSave,headmaxcases,maxcases,copymaxcases : List LpWT + while not empty? toSee repeat + lpwt1 := first toSee + toSee := rest toSee + toSave := [] + for lpwt2 in toSee repeat + if subCase?(lpwt1,lpwt2) + then + lpwt1 := lpwt2 + else + if not subCase?(lpwt2,lpwt1) + then + toSave := cons(lpwt2,toSave) + if empty? maxcases + then + headmaxcases := [lpwt1] + maxcases := headmaxcases + else + copymaxcases := maxcases + while (not empty? copymaxcases) and _ + (not subCase?(lpwt1,first(copymaxcases))) repeat + copymaxcases := rest copymaxcases + if empty? copymaxcases + then + setrest!(headmaxcases,[lpwt1]) + headmaxcases := rest headmaxcases + toSee := reverse toSave + maxcases + + removeSuperfluousQuasiComponents(lts: Split): Split == + lts := removeDuplicates lts + #lts < 2 => lts + toSee := algebraicSort lts + toSave,headmaxlts,maxlts,copymaxlts : Split + while not empty? toSee repeat + ts := first toSee + toSee := rest toSee + toSave := [] + for us in toSee repeat + if subQuasiComponent?(ts,us)@B + then + ts := us + else + if not subQuasiComponent?(us,ts)@B + then + toSave := cons(us,toSave) + if empty? maxlts + then + headmaxlts := [ts] + maxlts := headmaxlts + else + copymaxlts := maxlts + while (not empty? copymaxlts) and _ + (not subQuasiComponent?(ts,first(copymaxlts))@B) repeat + copymaxlts := rest copymaxlts + if empty? copymaxlts + then + setrest!(headmaxlts,[ts]) + headmaxlts := rest headmaxlts + toSee := reverse toSave + algebraicSort maxlts + + removeAssociates (lp:LP):LP == + removeDuplicates [primitivePart(p) for p in lp] + + 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 + -- if b2 then CLEAN UP lineq + -- if b3 then SEARCH for ZERO in lineq with leq + -- if b4 then SEARCH for ZERO in lineq with ts + -- if b5 then SEARCH for ONE in leq with lineq + if b1 + then + leq := removeAssociates(leq) + leq := remove(zero?,leq) + any?(ground?,leq) => + return("failed"::Union(Branch,"failed")) + if b2 + then + any?(zero?,lineq) => + return("failed"::Union(Branch,"failed")) + lineq := removeRedundantFactors(lineq)$polsetpack + if b3 + then + ps: PS := construct(leq)$PS + for q in lineq repeat + zero? remainder(q,ps).polnum => + return("failed"::Union(Branch,"failed")) + (empty? leq) or (empty? lineq) => ([leq, ts, lineq]$Branch)::UBF + if b4 + then + for q in lineq repeat + zero? initiallyReduce(q,ts) => + return("failed"::Union(Branch,"failed")) + if b5 + then + newleq: LP := [] + for p in leq repeat + for q in lineq repeat + if mvar(p) = mvar(q) + then + g := gcd(p,q) + newp := (p exquo g)::P + ground? newp => + return("failed"::Union(Branch,"failed")) + newleq := cons(newp,newleq) + else + newleq := cons(p,newleq) + leq := newleq + leq := sort(infRittWu?, removeDuplicates leq) + ([leq, ts, lineq]$Branch)::UBF + + 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 + lp := sort(infRittWu?, remove(zero?,removeAssociates(lp))) + any?(ground?,lp) => [] + empty? lts => [] + if b1 then lts := removeSuperfluousQuasiComponents lts + not b2 => + [[lp,ts,squareFreeFactors(initials ts)]$Branch for ts in lts] + toSee: List Branch + lq: LP := [] + toSee := [[lq,ts,squareFreeFactors(initials ts)]$Branch for ts in lts] + empty? lp => toSee + for p in lp repeat + lsfp := squareFreeFactors(p)$polsetpack + branches: List Branch := [] + lq := [] + for f in lsfp repeat + for branch in toSee repeat + leq : LP := branch.eq + ts := branch.tower + lineq : LP := branch.ineq + ubf1: UBF := branchIfCan(leq,ts,lq,false,false,true,true,true)@UBF + ubf1 case "failed" => "leave" + ubf2: UBF := branchIfCan([f],ts,lineq,false,false,true,true,true)@UBF + ubf2 case "failed" => "leave" + leq := sort(infRittWu?,removeDuplicates concat(ubf1.eq,ubf2.eq)) + lineq := sort(infRittWu?,removeDuplicates concat(ubf1.ineq,ubf2.ineq)) + newBranch := branchIfCan(leq,ts,lineq,false,false,false,false,false) + branches:= cons(newBranch::Branch,branches) + lq := cons(f,lq) + toSee := branches + sort(supDimElseRittWu?(#1.tower,#2.tower),toSee) + +@ +<>= +"QCMPACK" [color="#FF4488",href="bookvol10.4.pdf#nameddest=QCMPACK"] +"RSETCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RSETCAT"] +"QCMPACK" -> "RSETCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package QFCAT2 QuotientFieldCategoryFunctions2} \pagehead{QuotientFieldCategoryFunctions2}{QFCAT2} \pagepic{ps/v104quotientfieldcategoryfunctions2.ps}{QFCAT2}{1.00} @@ -66927,6 +68720,716 @@ QuotientFieldCategoryFunctions2(A, B, R, S): Exports == Impl where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter R} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package REP RadicalEigenPackage} +\pagehead{RadicalEigenPackage}{REP} +\pagepic{ps/v104radicaleigenpackage.ps}{REP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package REP RadicalEigenPackage +++ Author: P.Gianni +++ Date Created: Summer 1987 +++ Date Last Updated: October 1992 +++ Basic Functions: +++ Related Constructors: EigenPackage, RadicalSolve +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Package for the computation of eigenvalues and eigenvectors. +++ This package works for matrices with coefficients which are +++ rational functions over the integers. +++ (see \spadtype{Fraction Polynomial Integer}). +++ The eigenvalues and eigenvectors are expressed in terms of radicals. +RadicalEigenPackage() : C == T + where + R ==> Integer + P ==> Polynomial R + F ==> Fraction P + RE ==> Expression R + SE ==> Symbol() + M ==> Matrix(F) + MRE ==> Matrix(RE) + ST ==> SuchThat(SE,P) + NNI ==> NonNegativeInteger + + EigenForm ==> Record(eigval:Union(F,ST),eigmult:NNI,eigvec:List(M)) + RadicalForm ==> Record(radval:RE,radmult:Integer,radvect:List(MRE)) + + + + C == with + radicalEigenvectors : M -> List(RadicalForm) + ++ radicalEigenvectors(m) computes + ++ the eigenvalues and the corresponding eigenvectors of the + ++ matrix m; + ++ when possible, values are expressed in terms of radicals. + + radicalEigenvector : (RE,M) -> List(MRE) + ++ radicalEigenvector(c,m) computes the eigenvector(s) of the + ++ matrix m corresponding to the eigenvalue c; + ++ when possible, values are + ++ expressed in terms of radicals. + + radicalEigenvalues : M -> List RE + ++ radicalEigenvalues(m) computes the eigenvalues of the matrix m; + ++ when possible, the eigenvalues are expressed in terms of radicals. + + eigenMatrix : M -> Union(MRE,"failed") + ++ eigenMatrix(m) returns the matrix b + ++ such that \spad{b*m*(inverse b)} is diagonal, + ++ or "failed" if no such b exists. + + normalise : MRE -> MRE + ++ normalise(v) returns the column + ++ vector v + ++ divided by its euclidean norm; + ++ when possible, the vector v is expressed in terms of radicals. + + gramschmidt : List(MRE) -> List(MRE) + ++ gramschmidt(lv) converts the list of column vectors lv into + ++ a set of orthogonal column vectors + ++ of euclidean length 1 using the Gram-Schmidt algorithm. + + orthonormalBasis : M -> List(MRE) + ++ orthonormalBasis(m) returns the orthogonal matrix b such that + ++ \spad{b*m*(inverse b)} is diagonal. + ++ Error: if m is not a symmetric matrix. + + T == add + PI ==> PositiveInteger + RSP := RadicalSolvePackage R + import EigenPackage R + + ---- Local Functions ---- + evalvect : (M,RE,SE) -> MRE + innerprod : (MRE,MRE) -> RE + + ---- eval a vector of F in a radical expression ---- + evalvect(vect:M,alg:RE,x:SE) : MRE == + n:=nrows vect + xx:=kernel(x)$Kernel(RE) + w:MRE:=zero(n,1)$MRE + for i in 1..n repeat + v:=eval(vect(i,1) :: RE,xx,alg) + setelt(w,i,1,v) + w + ---- inner product ---- + innerprod(v1:MRE,v2:MRE): RE == (((transpose v1)* v2)::MRE)(1,1) + + ---- normalization of a vector ---- + normalise(v:MRE) : MRE == + normv:RE := sqrt(innerprod(v,v)) + normv = 0$RE => v + (1/normv)*v + + ---- Eigenvalues of the matrix A ---- + radicalEigenvalues(A:M): List(RE) == + x:SE :=new()$SE + pol:= characteristicPolynomial(A,x) :: F + radicalRoots(pol,x)$RSP + + ---- Eigenvectors belonging to a given eigenvalue ---- + ---- expressed in terms of radicals ---- + radicalEigenvector(alpha:RE,A:M) : List(MRE) == + n:=nrows A + B:MRE := zero(n,n)$MRE + for i in 1..n repeat + for j in 1..n repeat B(i,j):=(A(i,j))::RE + B(i,i):= B(i,i) - alpha + [v::MRE for v in nullSpace B] + + ---- eigenvectors and eigenvalues ---- + radicalEigenvectors(A:M) : List(RadicalForm) == + leig:List EigenForm := eigenvectors A + n:=nrows A + sln:List RadicalForm := empty() + veclist: List MRE + for eig in leig repeat + eig.eigval case F => + veclist := empty() + for ll in eig.eigvec repeat + m:MRE:=zero(n,1) + for i in 1..n repeat m(i,1):=(ll(i,1))::RE + veclist:=cons(m,veclist) + sln:=cons([(eig.eigval)::F::RE,eig.eigmult,veclist]$RadicalForm,sln) + sym := eig.eigval :: ST + xx:= lhs sym + lval : List RE := radicalRoots((rhs sym) :: F ,xx)$RSP + for alg in lval repeat + nsl:=[alg,eig.eigmult, + [evalvect(ep,alg,xx) for ep in eig.eigvec]]$RadicalForm + sln:=cons(nsl,sln) + sln + + ---- orthonormalization of a list of vectors ---- + ---- Grahm - Schmidt process ---- + + gramschmidt(lvect:List(MRE)) : List(MRE) == + lvect=[] => [] + v:=lvect.first + n := nrows v + RMR:=RectangularMatrix(n:PI,1,RE) + orth:List(MRE):=[(normalise v)] + for v in lvect.rest repeat + pol:=((v:RMR)-(+/[(innerprod(w,v)*w):RMR for w in orth])):MRE + orth:=cons(normalise pol,orth) + orth + + + ---- The matrix of eigenvectors ---- + + eigenMatrix(A:M) : Union(MRE,"failed") == + lef:List(MRE):=[:eiv.radvect for eiv in radicalEigenvectors(A)] + n:=nrows A + #lef "failed" + d:MRE:=copy(lef.first) + for v in lef.rest repeat d:=(horizConcat(d,v))::MRE + d + + ---- orthogonal basis for a symmetric matrix ---- + + orthonormalBasis(A:M):List(MRE) == + ^symmetric?(A) => error "the matrix is not symmetric" + basis:List(MRE):=[] + lvec:List(MRE) := [] + alglist:List(RadicalForm):=radicalEigenvectors(A) + n:=nrows A + for alterm in alglist repeat + if (lvec:=alterm.radvect)=[] then error "sorry " + if #(lvec)>1 then + lvec:= gramschmidt(lvec) + basis:=[:lvec,:basis] + else basis:=[normalise(lvec.first),:basis] + basis + +@ +<>= +"REP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=REP"] +"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"] +"REP" -> "ACFS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RADUTIL RadixUtilities} +\pagehead{RadixUtilities}{RADUTIL} +\pagepic{ps/v104radixutilities.ps}{RADUTIL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RADUTIL RadixUtilities +++ Author: Stephen M. Watt +++ Date Created: October 1986 +++ Date Last Updated: May 15, 1991 +++ Basic Operations: +++ Related Domains: RadixExpansion +++ Also See: +++ AMS Classifications: +++ Keywords: radix, base, repeading decimal +++ Examples: +++ References: +++ Description: +++ This package provides tools for creating radix expansions. +RadixUtilities: Exports == Implementation where + Exports ==> with + radix: (Fraction Integer,Integer) -> Any + ++ radix(x,b) converts x to a radix expansion in base b. + Implementation ==> add + radix(q, b) == + coerce(q :: RadixExpansion(b))$AnyFunctions1(RadixExpansion b) + +@ +<>= +"RADUTIL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RADUTIL"] +"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"] +"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"] +"RADUTIL" -> "PID" +"RADUTIL" -> "OAGROUP" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RDIST RandomDistributions} +\pagehead{RandomDistributions}{RDIST} +\pagepic{ps/v104randomdistributions.ps}{RDIST}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RDIST RandomDistributions +++ Description: +++ This package exports random distributions +RandomDistributions(S: SetCategory): with + uniform: Set S -> (() -> S) + ++ uniform(s) \undocumented + weighted: List Record(value: S, weight: Integer) -> (()->S) + ++ weighted(l) \undocumented + rdHack1: (Vector S,Vector Integer,Integer)->(()->S) + ++ rdHack1(v,u,n) \undocumented + == add + import RandomNumberSource() + + weighted lvw == + -- Collapse duplicates, adding weights. + t: Table(S, Integer) := table() + for r in lvw repeat + 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(kv, wv, totwt) == + w := randnum totwt + -- do binary search in wv + kv.1 + + uniform fset == + l := members fset + n := #l + l.(randnum(n)+1) + +@ +<>= +"RDIST" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDIST"] +"FSAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FSAGG"] +"RDIST" -> "FSAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RFDIST RandomFloatDistributions} +\pagehead{RandomFloatDistributions}{RFDIST} +\pagepic{ps/v104randomfloatdistributions.ps}{RFDIST}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RFDIST RandomFloatDistributions +++ Description: +++ This package exports random floating-point distributions +RationalNumber==> Fraction Integer +RandomFloatDistributions(): Cat == Body where + NNI ==> NonNegativeInteger + + Cat ==> with + uniform01: () -> Float + ++ uniform01() \undocumented + normal01: () -> Float + ++ normal01() \undocumented + exponential1:() -> Float + ++ exponential1() \undocumented + chiSquare1: NNI -> Float + ++ chiSquare1(n) \undocumented + + uniform: (Float, Float) -> (() -> Float) + ++ uniform(f,g) \undocumented + normal: (Float, Float) -> (() -> Float) + ++ normal(f,g) \undocumented + exponential: (Float) -> (() -> Float) + ++ exponential(f) \undocumented + chiSquare: (NNI) -> (() -> Float) + ++ chiSquare(n) \undocumented + Beta: (NNI, NNI) -> (() -> Float) + ++ Beta(n,m) \undocumented + F: (NNI, NNI) -> (() -> Float) + ++ F(n,m) \undocumented + t: (NNI) -> (() -> Float) + ++ t(n) \undocumented + + + Body ==> add + import RandomNumberSource() +-- FloatPackage0() + + -- random() generates numbers in 0..rnmax + rnmax := (size()$RandomNumberSource() - 1)::Float + + uniform01() == + randnum()::Float/rnmax + uniform(a,b) == + a + uniform01()*(b-a) + + 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(mean) == + mean*exponential1() + + -- This method is correct but slow. + normal01() == + s := 2::Float + while s >= 1 repeat + v1 := 2 * uniform01() - 1 + v2 := 2 * uniform01() - 1 + s := v1**2 + v2**2 + v1 * sqrt(-2 * log s/s) + normal(mean, stdev) == + mean + stdev*normal01() + + chiSquare1 dgfree == + x: Float := 0 + for i in 1..dgfree quo 2 repeat + x := x + 2*exponential1() + if odd? dgfree then + x := x + normal01()**2 + x + chiSquare dgfree == + chiSquare1 dgfree + + Beta(dgfree1, dgfree2) == + y1 := chiSquare1 dgfree1 + y2 := chiSquare1 dgfree2 + y1/(y1 + y2) + + F(dgfree1, dgfree2) == + y1 := chiSquare1 dgfree1 + y2 := chiSquare1 dgfree2 + (dgfree2 * y1)/(dgfree1 * y2) + + t dgfree == + n := normal01() + d := chiSquare1(dgfree) / (dgfree::Float) + n / sqrt d + +@ +<>= +"RFDIST" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RFDIST"] +"Package" [color="#FF4488"] +"RFDIST" -> "Package" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RIDIST RandomIntegerDistributions} +\pagehead{RandomIntegerDistributions}{RIDIST} +\pagepic{ps/v104randomintegerdistributions.ps}{RIDIST}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RIDIST RandomIntegerDistributions +++ Description: +++ This package exports integer distributions +RandomIntegerDistributions(): with + uniform: Segment Integer -> (() -> Integer) + ++ uniform(s) \undocumented + binomial: (Integer, RationalNumber) -> (() -> Integer) + ++ binomial(n,f) \undocumented + poisson: RationalNumber -> (() -> Integer) + ++ poisson(f) \undocumented + geometric: RationalNumber -> (() -> Integer) + ++ geometric(f) \undocumented + + ridHack1: (Integer,Integer,Integer,Integer) -> Integer + ++ ridHack1(i,j,k,l) \undocumented + == add + import RandomNumberSource() + import IntegerBits() + + -- Compute uniform(a..b) as + -- + -- l + U0 + w*U1 + w**2*U2 +...+ w**(n-1)*U-1 + w**n*M + -- + -- where + -- l = min(a,b) + -- m = abs(b-a) + 1 + -- w**n < m < w**(n+1) + -- U0,...,Un-1 are uniform on 0..w-1 + -- M is uniform on 0..(m quo w**n)-1 + + 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 + n := n + 1 + mq := mqnext + ridHack1(mq, n, w, l) + + ridHack1(mq, n, w, l) == + r := randnum mq + for i in 1..n repeat r := r*w + randnum w + r + l + +@ +<>= +"RIDIST" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RIDIST"] +"Package" [color="#FF4488"] +"RIDIST" -> "Package" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RANDSRC RandomNumberSource} +\pagehead{RandomNumberSource}{RANDSRC} +\pagepic{ps/v104randomnumbersource.ps}{RANDSRC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RANDSRC RandomNumberSource +++ Author:S.M.Watt +++ Date Created: April 87 +++ Date Last Updated:Jan 92, May 1995 (MCD) +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description:Random number generators +--% RandomNumberSource +++ All random numbers used in the system should originate from +++ the same generator. This package is intended to be the source. +-- +-- Possible improvements: +-- 1) Start where the user left off +-- 2) Be able to switch between methods in the random number source. +RandomNumberSource(): with + -- If r := randnum() then 0 <= r < size(). + randnum: () -> Integer + ++ randnum() is a random number between 0 and size(). + -- If r := randnum() then 0 <= r < size(). + size: () -> Integer + ++ size() is the base of the random number generator + + -- If r := randnum n and n <= size() then 0 <= r < n. + randnum: Integer -> Integer + ++ randnum(n) is a random number between 0 and n. + reseed: Integer -> Void + ++ reseed(n) restarts the random number generator at n. + seed : () -> Integer + ++ seed() returns the current seed value. + + == add + -- This random number generator passes the spectral test + -- with flying colours. [Knuth vol2, 2nd ed, p105] + ranbase: Integer := 2**31-1 + x0: Integer := 1231231231 + x1: Integer := 3243232987 + + randnum() == + t := (271828183 * x1 - 314159269 * x0) rem ranbase + if t < 0 then t := t + ranbase + x0:= x1 + x1:= t + + size() == ranbase + reseed n == + x0 := n rem ranbase + -- x1 := (n quo ranbase) rem ranbase + x1 := n quo ranbase + + seed() == x1*ranbase + x0 + + -- Compute an integer in 0..n-1. + randnum n == + (n * randnum()) quo ranbase + +@ +<>= +"RANDSRC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RANDSRC"] +"ALGEBRA-" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALGEBRA"] +"RANDSRC" -> "ALGEBRA-" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RATFACT RationalFactorize} +\pagehead{RationalFactorize}{RATFACT} +\pagepic{ps/v104rationalfactorize.ps}{RATFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RATFACT RationalFactorize +++ Author: P. Gianni +++ Date created: ?? +++ Date last updated: December 1993 +++ Factorization of extended polynomials with rational coefficients. +++ This package implements factorization of extended polynomials +++ whose coefficients are rational numbers. It does this by taking the +++ lcm of the coefficients of the polynomial and creating a polynomial +++ with integer coefficients. The algorithm in \spadtype{GaloisGroupFactorizer} is then +++ used to factor the integer polynomial. The result is normalized +++ with respect to the original lcm of the denominators. +++ Keywords: factorization, hensel, rational number +I ==> Integer +RN ==> Fraction Integer + +RationalFactorize(RP) : public == private where + BP ==> SparseUnivariatePolynomial(I) + RP : UnivariatePolynomialCategory RN + + public ==> with + + factor : RP -> Factored RP + ++ factor(p) factors an extended polynomial p over the rational numbers. + factorSquareFree : RP -> Factored RP + ++ factorSquareFree(p) factors an extended squareFree + ++ polynomial p over the rational numbers. + + private ==> add + import GaloisGroupFactorizer (BP) + ParFact ==> Record(irr:BP,pow:I) + FinalFact ==> Record(contp:I,factors:List(ParFact)) + URNI ==> UnivariatePolynomialCategoryFunctions2(RN,RP,I,BP) + UIRN ==> UnivariatePolynomialCategoryFunctions2(I,BP,RN,RP) + fUnion ==> Union("nil", "sqfr", "irred", "prime") + FFE ==> Record(flg:fUnion, fctr:RP, xpnt:I) + + factor(p:RP) : Factored(RP) == + p = 0 => 0 + pden: I := lcm([denom c for c in coefficients p]) + pol : RP := pden*p + ipol: BP := map(numer,pol)$URNI + ffact: FinalFact := henselFact(ipol,false) + makeFR(((ffact.contp)/pden)::RP, + [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE + for u in ffact.factors]) + + factorSquareFree(p:RP) : Factored(RP) == + p = 0 => 0 + pden: I := lcm([denom c for c in coefficients p]) + pol : RP := pden*p + ipol: BP := map(numer,pol)$URNI + ffact: FinalFact := henselFact(ipol,true) + makeFR(((ffact.contp)/pden)::RP, + [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE + for u in ffact.factors]) + +@ +<>= +"RATFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RATFACT"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"RATFACT" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RF RationalFunction} +\pagehead{RationalFunction}{RF} +\pagepic{ps/v104rationalfunction.ps}{RF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RF RationalFunction +++ Top-level manipulations of rational functions +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 18 April 1991 +++ Description: +++ Utilities that provide the same top-level manipulations on +++ fractions than on polynomials. +++ Keywords: polynomial, fraction +-- Do not make into a domain! +RationalFunction(R:IntegralDomain): Exports == Implementation where + V ==> Symbol + P ==> Polynomial R + Q ==> Fraction P + QF ==> PolynomialCategoryQuotientFunctions(IndexedExponents Symbol, + Symbol, R, P, Q) + + Exports ==> with + variables : Q -> List V + ++ variables(f) returns the list of variables appearing + ++ in the numerator or the denominator of f. + mainVariable: Q -> Union(V, "failed") + ++ mainVariable(f) returns the highest variable appearing + ++ in the numerator or the denominator of f, "failed" if + ++ f has no variables. + univariate : (Q, V) -> Fraction SparseUnivariatePolynomial Q + ++ univariate(f, v) returns f viewed as a univariate + ++ rational function in v. + multivariate: (Fraction SparseUnivariatePolynomial Q, V) -> Q + ++ multivariate(f, v) applies both the numerator and + ++ denominator of f to v. + eval : (Q, V, Q) -> Q + ++ eval(f, v, g) returns f with v replaced by g. + eval : (Q, List V, List Q) -> Q + ++ eval(f, [v1,...,vn], [g1,...,gn]) returns f with + ++ each vi replaced by gi in parallel, i.e. vi's appearing + ++ inside the gi's are not replaced. + eval : (Q, Equation Q) -> Q + ++ eval(f, v = g) returns f with v replaced by g. + ++ Error: if v is not a symbol. + eval : (Q, List Equation Q) -> Q + ++ eval(f, [v1 = g1,...,vn = gn]) returns f with + ++ each vi replaced by gi in parallel, i.e. vi's appearing + ++ inside the gi's are not replaced. + ++ Error: if any vi is not a symbol. + coerce : R -> Q + ++ coerce(r) returns r viewed as a rational function over R. + + Implementation ==> add + foo : (List V, List Q, V) -> Q + peval: (P, List V, List Q) -> Q + + coerce(r:R):Q == r::P::Q + variables f == variables(f)$QF + mainVariable f == mainVariable(f)$QF + univariate(f, x) == univariate(f, x)$QF + multivariate(f, x) == multivariate(f, x)$QF + eval(x:Q, s:V, y:Q) == eval(x, [s], [y]) + eval(x:Q, eq:Equation Q) == eval(x, [eq]) + foo(ls, lv, x) == match(ls, lv, x, x::Q)$ListToMap(V, Q) + + 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(x:Q, ls:List V, lv:List Q) == + peval(numer x, ls, lv) / peval(denom x, ls, lv) + + peval(p, ls, lv) == + map(foo(ls, lv, #1), #1::Q, + p)$PolynomialCategoryLifting(IndexedExponents V,V,R,P,Q) + +@ +<>= +"RF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RF"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"RF" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package DEFINTRF RationalFunctionDefiniteIntegration} \pagehead{RationalFunctionDefiniteIntegration}{DEFINTRF} \pagepic{ps/v104rationalfunctiondefiniteintegration.ps}{DEFINTRF}{1.00} @@ -67303,6 +69806,141 @@ RationalIntegration(F, UP): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RINTERP RationalInterpolation} +\subsection{Introduction} +This file contains a crude na\"ive implementation of rational interpolation, +where the coefficients of the rational function are in any given field. + +\subsection{Questions and Outlook} +\begin{itemize} +\item Maybe this file should be joined with pinterp.spad, where polynomial + Lagrange interpolation is implemented. I have a second version that parallels + the structure of pinterp.spad closely. +\item There are probably better ways to implement rational interpolation. Maybe + {http://www.cs.ucsb.edu/~omer/personal/abstracts/rational.html} contains + something useful, but I don't know. +\item Comments welcome! +\end{itemize} + +\pagehead{RationalInterpolation}{RINTERP} +\pagepic{ps/v104rationalinterpolation.ps}{RINTERP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RINTERP RationalInterpolation +++ Description: +++ This package exports rational interpolation algorithms +RationalInterpolation(xx,F): Exports == Implementation where + xx: Symbol + F: Field + Exports == with + interpolate: (List F, List F, NonNegativeInteger, + NonNegativeInteger) -> Fraction Polynomial F +@ + +The implementation sets up a system of linear equations and solves it. +<>= + Implementation == add + interpolate(xlist, ylist, m, k) == +@ + +First we check whether we have the right number of points and +values. Clearly the number of points and the number of values must be +identical. Note that we want to determine the numerator and +denominator polynomials only up to a factor. Thus, we want to +determine $m+k+1$ coefficients, where $m$ is the degree of the +polynomial in the numerator and $k$ is the degree of the polynomial in +the denominator. + +In fact, we could also leave -- for example -- $k$ unspecified and determine it +as $k=[[#xlist]]-m-1$: I don't know whether this would be better. +<>= + #xlist ^= #ylist => + error "Different number of points and values." + #xlist ^= m+k+1 => + error "wrong number of points" +@ + +The next step is to set up the matrix. Suppose that our numerator polynomial is +$p(x)=a_0+a_1x+\dots+a_mx^m$ and that our denominator polynomial is +$q(x)=b_0+b_1x+\dots+b_mx^m$. Then we have the following equations, writing $n$ +for $m+k+1$: +\noindent +$$ +\begin{array}{rl} + p(x_1)-y_1q(x_1)&=a_0+a_1x_1+\dots +a_mx_1^m-y_1(b_0+b_1x_1+\dots +b_kx_1^k)=0\\ + p(x_2)-y_2q(x_2)&=a_0+a_1x_2+\dots +a_mx_2^m-y_2(b_0+b_1x_2+\dots +b_kx_2^k)=0\\ + &\;\;\vdots\\ + p(x_n)-y_nq(x_n)&=a_0+a_1x_n+\dots +a_mx_n^m-y_n(b_0+b_1x_n+\dots +b_kx_n^k)=0 +\end{array} +$$ +This can be written as +$$ +\left[ +\begin{array}{cccccccc} +1&x_1&\dots&x_1^m&-y_1&-y_1x_1&\dots&-y_1x_1^k\\ +1&x_2&\dots&x_2^m&-y_2&-y_2x_2&\dots&-y_2x_2^k\\ +&&&\vdots&&&&\\ +1&x_n&\dots&x_n^m&-y_n&-y_nx_n&\dots&-y_nx_2^k +\end{array} +\right] +\left[ +\begin{array}{c} +a_0\\a_1\\\vdots\\a_m\\b_0\\b_1\\\vdots\\b_k +\end{array} +\right] +=\mathbf 0 +$$ +We generate this matrix columnwise: +<>= + tempvec: List F := [1 for i in 1..(m+k+1)] + + collist: List List F := cons(tempvec, + [(tempvec := [tempvec.i * xlist.i _ + for i in 1..(m+k+1)]) _ + for j in 1..max(m,k)]) + + collist := append([collist.j for j in 1..(m+1)], _ + [[- collist.j.i * ylist.i for i in 1..(m+k+1)] _ + for j in 1..(k+1)]) +@ +Now we can solve the system: +<>= + res: List Vector F := nullSpace((transpose matrix collist) _ + ::Matrix F) +@ + +Note that it may happen that the system has several solutions. In this case, +some of the data points may not be interpolated correctly. However, the +solution is often still useful, thus we do not signal an error. + +<>= + if #res~=1 then output("Warning: unattainable points!" _ + ::OutputForm)$OutputPackage +@ + +In this situation, all the solutions will be equivalent, thus we can always +simply take the first one: + +<>= + reslist: List List Polynomial F := _ + [[(res.1).(i+1)*(xx::Polynomial F)**i for i in 0..m], _ + [(res.1).(i+m+2)*(xx::Polynomial F)**i for i in 0..k]] +@ +Finally, we generate the rational function: +<>= + reduce((_+),reslist.1)/reduce((_+),reslist.2) +@ +<>= +"RINTERP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RINTERP"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"RINTERP" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package ODERAT RationalLODE} \pagehead{RationalLODE}{ODERAT} \pagepic{ps/v104rationallode.ps}{ODERAT}{1.00} @@ -67545,6 +70183,516 @@ RationalLODE(F, UP): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RATRET RationalRetractions} +\pagehead{RationalRetractions}{RATRET} +\pagepic{ps/v104rationalretractions.ps}{RATRET}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RATRET RationalRetractions +++ Author: Manuel Bronstein +++ Description: rational number testing and retraction functions. +++ Date Created: March 1990 +++ Date Last Updated: 9 April 1991 +RationalRetractions(S:RetractableTo(Fraction Integer)): with + rational : S -> Fraction Integer + ++ rational(x) returns x as a rational number; + ++ error if x is not a rational number; + rational? : S -> Boolean + ++ rational?(x) returns true if x is a rational number, + ++ false otherwise; + rationalIfCan: S -> Union(Fraction Integer, "failed") + ++ rationalIfCan(x) returns x as a rational number, + ++ "failed" if x is not a rational number; + == add + rational s == retract s + rational? s == retractIfCan(s) case Fraction(Integer) + rationalIfCan s == retractIfCan s + +@ +<>= +"RATRET" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RATRET"] +"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"] +"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"] +"RATRET" -> "PID" +"RATRET" -> "OAGROUP" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ODERTRIC RationalRicDE} +\pagehead{RationalRicDE}{ODERTRIC} +\pagepic{ps/v104rationalricde.ps}{ODERTRIC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ODERTRIC RationalRicDE +++ Author: Manuel Bronstein +++ Date Created: 22 October 1991 +++ Date Last Updated: 11 April 1994 +++ Description: In-field solution of Riccati equations, rational case. +RationalRicDE(F, UP): Exports == Implementation where + F : Join(Field, CharacteristicZero, RetractableTo Integer, + RetractableTo Fraction Integer) + UP : UnivariatePolynomialCategory F + + N ==> NonNegativeInteger + Z ==> Integer + SY ==> Symbol + P ==> Polynomial F + RF ==> Fraction P + EQ ==> Equation RF + QF ==> Fraction UP + UP2 ==> SparseUnivariatePolynomial UP + SUP ==> SparseUnivariatePolynomial P + REC ==> Record(poly:SUP, vars:List SY) + SOL ==> Record(var:List SY, val:List F) + POL ==> Record(poly:UP, eq:L) + FRC ==> Record(frac:QF, eq:L) + CNT ==> Record(constant:F, eq:L) + UTS ==> UnivariateTaylorSeries(F, dummy, 0) + UPS ==> SparseUnivariatePolynomial UTS + L ==> LinearOrdinaryDifferentialOperator2(UP, QF) + LQ ==> LinearOrdinaryDifferentialOperator1 QF + + Exports ==> with + ricDsolve: (LQ, UP -> List F) -> List QF + ++ ricDsolve(op, zeros) returns the rational solutions of the associated + ++ Riccati equation of \spad{op y = 0}. + ++ \spad{zeros} is a zero finder in \spad{UP}. + ricDsolve: (LQ, UP -> List F, UP -> Factored UP) -> List QF + ++ ricDsolve(op, zeros, ezfactor) returns the rational + ++ solutions of the associated Riccati equation of \spad{op y = 0}. + ++ \spad{zeros} is a zero finder in \spad{UP}. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + ricDsolve: (L, UP -> List F) -> List QF + ++ ricDsolve(op, zeros) returns the rational solutions of the associated + ++ Riccati equation of \spad{op y = 0}. + ++ \spad{zeros} is a zero finder in \spad{UP}. + ricDsolve: (L, UP -> List F, UP -> Factored UP) -> List QF + ++ ricDsolve(op, zeros, ezfactor) returns the rational + ++ solutions of the associated Riccati equation of \spad{op y = 0}. + ++ \spad{zeros} is a zero finder in \spad{UP}. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + singRicDE: (L, UP -> Factored UP) -> List FRC + ++ singRicDE(op, ezfactor) returns \spad{[[f1,L1], [f2,L2],..., [fk,Lk]]} + ++ such that the singular ++ part of any rational solution of the + ++ associated Riccati equation of \spad{op y = 0} must be one of the fi's + ++ (up to the constant coefficient), in which case the equation for + ++ \spad{z = y e^{-int ai}} is \spad{Li z = 0}. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + polyRicDE: (L, UP -> List F) -> List POL + ++ polyRicDE(op, zeros) returns \spad{[[p1, L1], [p2, L2], ... , [pk,Lk]]} + ++ such that the polynomial part of any rational solution of the + ++ associated Riccati equation of \spad{op y = 0} must be one of the pi's + ++ (up to the constant coefficient), in which case the equation for + ++ \spad{z = y e^{-int p}} is \spad{Li z = 0}. + ++ \spad{zeros} is a zero finder in \spad{UP}. + if F has AlgebraicallyClosedField then + ricDsolve: LQ -> List QF + ++ ricDsolve(op) returns the rational solutions of the associated + ++ Riccati equation of \spad{op y = 0}. + ricDsolve: (LQ, UP -> Factored UP) -> List QF + ++ ricDsolve(op, ezfactor) returns the rational solutions of the + ++ associated Riccati equation of \spad{op y = 0}. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + ricDsolve: L -> List QF + ++ ricDsolve(op) returns the rational solutions of the associated + ++ Riccati equation of \spad{op y = 0}. + ricDsolve: (L, UP -> Factored UP) -> List QF + ++ ricDsolve(op, ezfactor) returns the rational solutions of the + ++ associated Riccati equation of \spad{op y = 0}. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + + Implementation ==> add + import RatODETools(P, SUP) + import RationalLODE(F, UP) + import NonLinearSolvePackage F + 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]]}. + + dummy := new()$SY + + UP2SUP p == map(#1::P,p)$UnivariatePolynomialCategoryFunctions2(F,UP,P,SUP) + 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) + 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(p, ls, lv) == + map(ground eval(#1, ls, lv), + p)$UnivariatePolynomialCategoryFunctions2(P, SUP, F, UP) + + FifCan f == + ((n := retractIfCan(numer f))@Union(F, "failed") case F) and + ((d := retractIfCan(denom f))@Union(F, "failed") case F) => + (n::F) / (d::F) + "failed" + +-- returns [0, []] if n < 0 + genericPolynomial(s, n) == + ans:SUP := 0 + l:List(SY) := empty() + for i in 0..n repeat + ans := ans + monomial((sy := new s)::P, i::N) + l := concat(sy, l) + [ans, reverse_! l] + + ratsln l == + ls:List(SY) := empty() + lv:List(F) := empty() + for eq in l repeat + ((u := FifCan rhs eq) case "failed") or + ((v := retractIfCan(lhs eq)@Union(SY, "failed")) case "failed") + => return "failed" + lv := concat(u::F, lv) + ls := concat(v::SY, ls) + [ls, lv] + + ratsol l == + ans:List(SOL) := empty() + for sol in l repeat + if ((u := ratsln sol) case SOL) then ans := concat(u::SOL, ans) + ans + +-- returns [] if the solutions of l have no polynomial component + polyRicDE(l, zeros) == + ans:List(POL) := [[0, l]] + empty?(lc := leadingCoefficientRicDE l) => ans + rec := first lc -- one with highest degree + for a in zeros(rec.eq) | a ^= 0 repeat + if (p := newtonSolution(l, a, rec.deg, zeros)) ^= 0 then + ans := concat([p, changeVar(l, p)], ans) + ans + +-- reverseUP(a_0 + a_1 x + ... + an x^n) = a_n + ... + a_0 x^n + reverseUP p == + ans:UTS := 0 + n := degree(p)::Z + while p ^= 0 repeat + ans := ans + monomial(leadingCoefficient p, (n - degree p)::N) + p := reductum p + ans + +-- reverseUTS(a_0 + a_1 x + ..., n) = a_n + ... + a_0 x^n + reverseUTS(s, n) == + +/[monomial(coefficient(s, i), (n - i)::N)$UP for i in 0..n] + +-- returns a potential polynomial solution p with leading coefficient a*?**n + newtonSolution(l, a, n, zeros) == + i:N + m:Z := 0 + aeq:UPS := 0 + op := l + while op ^= 0 repeat + mu := degree(op) * n + degree leadingCoefficient op + op := reductum op + if mu > m then m := mu + while l ^= 0 repeat + c := leadingCoefficient l + d := degree l + s:UTS := monomial(1, (m - d * n - degree c)::N)$UTS * reverseUP c + aeq := aeq + monomial(s, d) + l := reductum l + (u := newtonSolve(aeq, a, n)) case UTS => reverseUTS(u::UTS, n) + -- newton lifting failed, so revert to traditional method + atn := monomial(a, n)$UP + neq := changeVar(l, atn) + sols := [sol.poly for sol in polyRicDE(neq, zeros) | degree(sol.poly) < n] + empty? sols => atn + atn + first sols + +-- solves the algebraic equation eq for y, returns a solution of degree n with +-- initial term a +-- 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(eq, a, n) == + deq := differentiate eq + sol := a::UTS + for i in 1..n repeat + (xquo := eq(sol) exquo deq(sol)) case "failed" => return "failed" + sol := truncate(sol - xquo::UTS, i) + sol + +-- 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(l:L, zeros:UP -> List F, ezfactor:UP -> Factored UP) == + n := degree l + ans:List(QF) := empty() + for rec in singRicDE(l, ezfactor) repeat + ans := removeDuplicates_! concat_!(ans, + [rec.frac + f for f in nonSingSolve(n, rec.eq, zeros)]) + #ans = n => return ans + ans + +-- 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, zeros) == + ans:List(QF) := empty() + for rec in polyRicDE(l, zeros) repeat + ans := removeDuplicates_! concat_!(ans, nopoly(n,rec.poly,rec.eq,zeros)) + #ans = n => return ans + ans + + 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, p, l, zeros) == + ans:List(QF) := empty() + for rec in constantCoefficientRicDE(l, constantRic(#1, zeros)) repeat + ans := removeDuplicates_! concat_!(ans, + [(rec.constant::UP + p)::QF + f for f in logDerOnly(rec.eq)]) + #ans = n => return ans + ans + +-- returns [p1,...,pn] s.t. h(x,pi(x)) = 0 mod c(x) + solveModulo(c, h) == + rec := genericPolynomial(dummy, degree(c)::Z - 1) + unk:SUP := 0 + while not zero? h repeat + unk := unk + UP2SUP(leadingCoefficient h) * (rec.poly ** degree h) + h := reductum h + sol := ratsol solve(coefficients(monicDivide(unk,UP2SUP c).remainder), + rec.vars) + [mapeval(rec.poly, s.var, s.val) for s in sol] + + if F has AlgebraicallyClosedField then + zro1: UP -> List F + zro : (UP, UP -> Factored UP) -> List F + + ricDsolve(l:L) == ricDsolve(l, squareFree) + ricDsolve(l:LQ) == ricDsolve(l, squareFree) + + ricDsolve(l:L, ezfactor:UP -> Factored UP) == + ricDsolve(l, zro(#1, ezfactor), ezfactor) + + ricDsolve(l:LQ, ezfactor:UP -> Factored UP) == + ricDsolve(l, zro(#1, ezfactor), ezfactor) + + zro(p, ezfactor) == + concat [zro1(r.factor) for r in factors ezfactor p] + + zro1 p == + [zeroOf(map(#1, p)$UnivariatePolynomialCategoryFunctions2(F, UP, + F, SparseUnivariatePolynomial F))] + +@ +<>= +"ODERTRIC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ODERTRIC"] +"UTSCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=UTSCAT"] +"ODERTRIC" -> "UTSCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package POLUTIL RealPolynomialUtilitiesPackage} +This file describes the Real Closure 1.0 package which consists of different +packages, categoris and domains : + +The package RealPolynomialUtilitiesPackage whichs receives a field and a +univariate polynomial domain with coefficients in the field. It computes some +simple functions such as Strum and Sylvester sequences. + +The category RealRootCharacterizationCategory provides abstarct +functionalities to work with "real roots" of univariate polynomials. These +resemble variables with some functionalities needed to compute important +operations. + +RealClosedField is a category with provides common operations available over +real closed fiels. These include finding all the roots of univariate +polynomial, taking square roots, ... + + +CAVEATS + +Since real algebraic expressions are stored as depending on "real roots" which +are managed like variables, there is an ordering on these. This ordering is +dynamical in the sense that any new algebraic takes precedence over older +ones. In particular every cretaion function raises a new "real root". This has +the effect that when you type something like sqrt(2) + sqrt(2) you have two +new variables which happen to be equal. To avoid this name the expression such +as in s2 := sqrt(2) ; s2 + s2 + +Also note that computing times depend strongly on the ordering you implicitly +provide. Please provide algebraics in the order which most natural to you. + +LIMITATIONS + +The file reclos.input show some basic use of the package. This packages uses +algorithms which are published in [1] and [2] which are based on field +arithmetics, in particular for polynomial gcd related algorithms. This can be +quite slow for high degree polynomials and subresultants methods usually work +best. Betas versions of the package try to use these techniques in a better +way and work significantly faster. These are mostly based on unpublished +algorithms and cannot be distributed. Please contact the author if you have a +particular problem to solve or want to use these versions. + +Be aware that approximations behave as post-processing and that all +computations are done excatly. They can thus be quite time consuming when +depending on several ``real roots''. + +\pagehead{RealPolynomialUtilitiesPackage}{POLUTIL} +\pagepic{ps/v104realpolynomialutilitiespackage.ps}{POLUTIL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package POLUTIL RealPolynomialUtilitiesPackage +++ Author: Renaud Rioboo +++ Date Created: summer 1992 +++ Basic Functions: provides polynomial utilities +++ Related Constructors: RealClosure, +++ Date Last Updated: July 2004 +++ Also See: +++ AMS Classifications: +++ Keywords: Sturm sequences +++ References: +++ Description: +++ \axiomType{RealPolynomialUtilitiesPackage} provides common functions used +++ by interval coding. +RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where + + TheField : Field + ThePols : UnivariatePolynomialCategory(TheField) + + Z ==> Integer + N ==> NonNegativeInteger + P ==> ThePols + + PUB == with + + sylvesterSequence : (ThePols,ThePols) -> List ThePols + ++ \axiom{sylvesterSequence(p,q)} is the negated remainder sequence + ++ of p and q divided by the last computed term + sturmSequence : ThePols -> List ThePols + ++ \axiom{sturmSequence(p) = sylvesterSequence(p,p')} + if TheField has OrderedRing then + boundOfCauchy : ThePols -> TheField + ++ \axiom{boundOfCauchy(p)} bounds the roots of p + sturmVariationsOf : List TheField -> N + ++ \axiom{sturmVariationsOf(l)} is the number of sign variations + ++ in the list of numbers l, + ++ note that the first term counts as a sign + lazyVariations : (List(TheField), Z, Z) -> N + ++ \axiom{lazyVariations(l,s1,sn)} is the number of sign variations + ++ in the list of non null numbers [s1::l]@sn, + + + PRIV == add + + sturmSequence(p) == + sylvesterSequence(p,differentiate(p)) + + sylvesterSequence(p1,p2) == + res : List(ThePols) := [p1] + while (p2 ^= 0) repeat + res := cons(p2 , res) + (p1 , p2) := (p2 , -(p1 rem p2)) + if degree(p1) > 0 + then + p1 := unitCanonical(p1) + res := [ term quo p1 for term in res ] + reverse! res + + if TheField has OrderedRing + then + + 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(l) == +-- res : N := 0 +-- lsg := sign(first(l)) +-- for term in l repeat +-- if ^( (sg := sign(term) ) = 0 ) then +-- if (sg ^= lsg) then res := res + 1 +-- lsg := sg +-- res + + sturmVariationsOf(l) == + null(l) => error "POLUTIL: sturmVariationsOf: empty list !" + l1 := first(l) + -- first 0 counts as a sign + ll : List(TheField) := [] + for term in rest(l) repeat + -- zeros don't count + if not(zero?(term)) then ll := cons(term,ll) + -- if l1 is not zero then ll = reverse(l) + null(ll) => error "POLUTIL: sturmVariationsOf: Bad sequence" + ln := first(ll) + ll := reverse(rest(ll)) + -- if l1 is not zero then first(l) = first(ll) + -- if l1 is zero then first zero should count as a sign + zero?(l1) => 1 + lazyVariations(rest(ll),sign(first(ll)),sign(ln)) + lazyVariations(ll, sign(l1), sign(ln)) + + lazyVariations(l,sl,sh) == + zero?(sl) or zero?(sh) => error "POLUTIL: lazyVariations: zero sign!" + null(l) => + if sl = sh then 0 else 1 + null(rest(l)) => + if zero?(first(l)) + then error "POLUTIL: lazyVariations: zero sign!" + else + if sl = sh + then + if (sl = sign(first(l))) + then 0 + else 2 + -- in this case we save one test + else 1 + s := sign(l.2) + lazyVariations([first(l)],sl,s) + + lazyVariations(rest(rest(l)),s,sh) + +@ +<>= +"POLUTIL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=POLUTIL"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"POLUTIL" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package REALSOLV RealSolvePackage} <>= -- acplot.spad.pamphlet RealSolvePackage.input @@ -67762,6 +70910,402 @@ RealSolvePackage(): _ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package REAL0 RealZeroPackage} +\pagehead{RealZeroPackage}{REAL0} +\pagepic{ps/v104realzeropackage.ps}{REAL0}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package REAL0 RealZeroPackage +++ Author: Andy Neff +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: UnivariatePolynomial, RealZeroPackageQ +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package provides functions for finding the real zeros +++ of univariate polynomials over the integers to arbitrary user-specified +++ precision. The results are returned as a list of +++ isolating intervals which are expressed as records with "left" and "right" rational number +++ components. + +RealZeroPackage(Pol): T == C where + Pol: UnivariatePolynomialCategory Integer + RN ==> Fraction Integer + Interval ==> Record(left : RN, right : RN) + isoList ==> List(Interval) + T == with + -- next two functions find isolating intervals + realZeros: (Pol) -> isoList + ++ realZeros(pol) returns a list of isolating intervals for + ++ all the real zeros of the univariate polynomial pol. + realZeros: (Pol, Interval) -> isoList + ++ realZeros(pol, range) returns a list of isolating intervals + ++ for all the real zeros of the univariate polynomial pol which + ++ lie in the interval expressed by the record range. + -- next two functions return intervals smaller then tolerence + realZeros: (Pol, RN) -> isoList + ++ realZeros(pol, eps) returns a list of intervals of length less + ++ than the rational number eps for all the real roots of the + ++ polynomial pol. + realZeros: (Pol, Interval, RN) -> isoList + ++ realZeros(pol, int, eps) returns a list of intervals of length + ++ less than the rational number eps for all the real roots of the + ++ polynomial pol which lie in the interval expressed by the + ++ record int. + refine: (Pol, Interval, RN) -> Interval + ++ refine(pol, int, eps) refines the interval int containing + ++ exactly one root of the univariate polynomial pol to size less + ++ than the rational number eps. + refine: (Pol, Interval, Interval) -> Union(Interval,"failed") + ++ refine(pol, int, range) takes a univariate polynomial pol and + ++ and isolating interval int containing exactly one real + ++ root of pol; the operation returns an isolating interval which + ++ is contained within range, or "failed" if no such isolating interval exists. + midpoint: Interval -> RN + ++ midpoint(int) returns the midpoint of the interval int. + midpoints: isoList -> List RN + ++ midpoints(isolist) returns the list of midpoints for the list + ++ of intervals isolist. + C == add + --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(int : Interval):Interval == [-int.right,-int.left] + + midpoint(i : Interval):RN == (1/2)*(i.left + i.right) + + midpoints(li : isoList) : List RN == + [midpoint x for x in li] + + makeSqfr(F : Pol):Pol == + sqfr := squareFree F + F := */[s.factor for s in factors(sqfr)] + + realZeros(F : Pol) == + ReZeroSqfr makeSqfr F + + realZeros(F : Pol, rn : RN) == + F := makeSqfr F + [refine(F,int,rn) for int in ReZeroSqfr(F)] + + realZeros(F : Pol, bounds : Interval) == + F := makeSqfr F + [rint::Interval for int in ReZeroSqfr(F) | + (rint:=refine(F,int,bounds)) case Interval] + + realZeros(F : Pol, bounds : Interval, rn : RN) == + F := makeSqfr F + [refine(F,int,rn) for int in realZeros(F,bounds)] + + ReZeroSqfr(F : Pol) == + F = 0 => error "ReZeroSqfr: zero polynomial" + L : isoList := [] + degree(F) = 0 => L + if (r := minimumDegree(F)) > 0 then + L := [[0,0]$Interval] + tempF := F exquo monomial(1, r) + if not (tempF case "failed") then + F := tempF + J:isoList := [negate int for int in reverse(PosZero(minus(F)))] + K : isoList := PosZero(F) + append(append(J, L), K) + + 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(F : Pol) == --returns isoList for roots of F in (0,1) + J : isoList + K : isoList + L : isoList + L := [] + (v := var(transAdd1(invert(F)))) = 0 => [] + v = 1 => L := [[0,1]$Interval] + G : Pol := transMultInv(2, F) + H : Pol := transAdd1(G) + if minimumDegree H > 0 then + -- H has a root at 0 => F has one at 1/2, and G at 1 + L := [[1/2,1/2]$Interval] + Q : Pol := monomial(1, 1) + tempH : Union(Pol, "failed") := H exquo Q + if not (tempH case "failed") then H := tempH + Q := Q + monomial(-1, 0) + tempG : Union(Pol, "failed") := G exquo Q + if not (tempG case "failed") then G := tempG + int : Interval + J := [[(int.left+1)* (1/2),(int.right+1) * (1/2)]$Interval + for int in Zero1(H)] + K := [[int.left * (1/2), int.right * (1/2)]$Interval + for int in Zero1(G)] + append(append(J, L), K) + + rootBound(F : Pol) == --returns power of 2 that is a bound + --for the positive roots of F + if leadingCoefficient(F) < 0 then F := -F + lcoef := leadingCoefficient(F) + F := reductum(F) + i : Integer := 0 + while not (F = 0) repeat + if (an := leadingCoefficient(F)) < 0 then i := i - an + F := reductum(F) + b : Integer := 1 + while (b * lcoef) <= i repeat + b := 2 * b + b + + transMult(c : Integer, F : Pol) == + --computes Pol G such that G(x) = F(c*x) + G : Pol := 0 + while not (F = 0) repeat + n := degree(F) + G := G + monomial((c**n) * leadingCoefficient(F), n) + F := reductum(F) + G + + transMultInv(c : Integer, F : Pol) == + --computes Pol G such that G(x) = (c**n) * F(x/c) + d := degree(F) + cc : Integer := 1 + G : Pol := monomial(leadingCoefficient F,d) + while (F:=reductum(F)) ^= 0 repeat + n := degree(F) + cc := cc*(c**(d-n):NonNegativeInteger) + G := G + monomial(cc * leadingCoefficient(F), n) + d := n + G + +-- otransAdd1(F : Pol) == +-- --computes Pol G such that G(x) = F(x+1) +-- G : Pol := F +-- n : Integer := 1 +-- while (F := differentiate(F)) ^= 0 repeat +-- if not ((tempF := F exquo n) case "failed") then F := tempF +-- G := G + F +-- n := n + 1 +-- G + + transAdd1(F : Pol) == + --computes Pol G such that G(x) = F(x+1) + n := degree F + v := vectorise(F, n+1) + for i in 0..(n-1) repeat + for j in (n-i)..n repeat + qsetelt_!(v,j, qelt(v,j) + qelt(v,(j+1))) + ans : Pol := 0 + for i in 0..n repeat + ans := ans + monomial(qelt(v,(i+1)),i) + ans + + + minus(F : Pol) == + --computes Pol G such that G(x) = F(-x) + G : Pol := 0 + while not (F = 0) repeat + n := degree(F) + coef := leadingCoefficient(F) + odd? n => + G := G + monomial(-coef, n) + F := reductum(F) + G := G + monomial(coef, n) + F := reductum(F) + G + + invert(F : Pol) == + --computes Pol G such that G(x) = (x**n) * F(1/x) + G : Pol := 0 + n := degree(F) + while not (F = 0) repeat + G := G + monomial(leadingCoefficient(F), + (n-degree(F))::NonNegativeInteger) + F := reductum(F) + G + + var(F : Pol) == --number of sign variations in coefs of F + i : Integer := 0 + LastCoef : Boolean + next : Boolean + LastCoef := leadingCoefficient(F) < 0 + while not ((F := reductum(F)) = 0) repeat + next := leadingCoefficient(F) < 0 + if ((not LastCoef) and next) or + ((not next) and LastCoef) then i := i+1 + LastCoef := next + i + + refine(F : Pol, int : Interval, bounds : Interval) == + lseg := min(int.right,bounds.right) - max(int.left,bounds.left) + lseg < 0 => "failed" + lseg = 0 => + pt := + int.left = bounds.right => int.left + int.right + elt(transMultInv(denom(pt),F),numer pt) = 0 => [pt,pt] + "failed" + lseg = int.right - int.left => int + refine(F, refine(F, int, lseg), bounds) + + refine(F : Pol, int : Interval, eps : RN) == + a := int.left + b := int.right + a=b => [a,b]$Interval + an : Integer := numer(a) + ad : Integer := denom(a) + bn : Integer := numer(b) + bd : Integer := denom(b) + xfl : Boolean := false + if (u:=elt(transMultInv(ad, F), an)) = 0 then + F := (F exquo (monomial(ad,1)-monomial(an,0)))::Pol + u:=elt(transMultInv(ad, F), an) + if (v:=elt(transMultInv(bd, F), bn)) = 0 then + F := (F exquo (monomial(bd,1)-monomial(bn,0)))::Pol + v:=elt(transMultInv(bd, F), bn) + u:=elt(transMultInv(ad, F), an) + if u > 0 then (F:=-F;v:=-v) + if v < 0 then + error [int, "is not a valid isolation interval for", F] + if eps <= 0 then error "precision must be positive" + while (b - a) >= eps repeat + mid : RN := (b + a) * (1/2) + midn : Integer := numer(mid) + midd : Integer := denom(mid) + (v := elt(transMultInv(midd, F), midn)) < 0 => + a := mid + an := midn + ad := midd + v > 0 => + b := mid + bn := midn + bd := midd + v = 0 => + a := mid + b := mid + an := midn + ad := midd + xfl := true + [a, b]$Interval + +@ +<>= +"REAL0" [color="#FF4488",href="bookvol10.4.pdf#nameddest=REAL0"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"REAL0" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package REAL0Q RealZeroPackageQ} +\pagehead{RealZeroPackageQ}{REAL0Q} +\pagepic{ps/v104realzeropackageq.ps}{REAL0Q}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package REAL0Q RealZeroPackageQ +++ Author: Andy Neff, Barry Trager +++ Date Created: +++ Date Last Updated: 7 April 1991 +++ Basic Functions: +++ Related Constructors: UnivariatePolynomial, RealZeroPackageQ +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package provides functions for finding the real zeros +++ of univariate polynomials over the rational numbers to arbitrary user-specified +++ precision. The results are returned as a list of +++ isolating intervals, expressed as records with "left" and "right" rational number components. + +RealZeroPackageQ(Pol): T == C where + RN ==> Fraction Integer + I ==> Integer + SUP ==> SparseUnivariatePolynomial + Pol: UnivariatePolynomialCategory RN + Interval ==> Record(left : RN, right : RN) + isoList ==> List(Interval) + ApproxInfo ==> Record(approx : RN, exFlag : Boolean) + T == with + -- next two functions find isolating intervals + realZeros: (Pol) -> isoList + ++ realZeros(pol) returns a list of isolating intervals for + ++ all the real zeros of the univariate polynomial pol. + realZeros: (Pol, Interval) -> isoList + ++ realZeros(pol, range) returns a list of isolating intervals + ++ for all the real zeros of the univariate polynomial pol which + ++ lie in the interval expressed by the record range. + -- next two functions return intervals smaller then tolerence + realZeros: (Pol, RN) -> isoList + ++ realZeros(pol, eps) returns a list of intervals of length less + ++ than the rational number eps for all the real roots of the + ++ polynomial pol. + realZeros: (Pol, Interval, RN) -> isoList + ++ realZeros(pol, int, eps) returns a list of intervals of length + ++ less than the rational number eps for all the real roots of the + ++ polynomial pol which lie in the interval expressed by the + ++ record int. + refine: (Pol, Interval, RN) -> Interval + ++ refine(pol, int, eps) refines the interval int containing + ++ exactly one root of the univariate polynomial pol to size less + ++ than the rational number eps. + refine: (Pol, Interval, Interval) -> Union(Interval,"failed") + ++ refine(pol, int, range) takes a univariate polynomial pol and + ++ and isolating interval int which must contain exactly one real + ++ root of pol, and returns an isolating interval which + ++ is contained within range, or "failed" if no such isolating interval exists. + C == add + 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(f : Pol) == realZeros(convert2PolInt f) + realZeros(f : Pol, rn : RN) == realZeros(convert2PolInt f, rn) + realZeros(f : Pol, bounds : Interval) == + realZeros(convert2PolInt f, bounds) + realZeros(f : Pol, bounds : Interval, rn : RN) == + realZeros(convert2PolInt f, bounds, rn) + refine(f : Pol, int : Interval, eps : RN) == + refine(convert2PolInt f, int, eps) + refine(f : Pol, int : Interval, bounds : Interval) == + refine(convert2PolInt f, int, bounds) + +@ +<>= +"REAL0Q" [color="#FF4488",href="bookvol10.4.pdf#nameddest=REAL0Q"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"REAL0Q" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package RMCAT2 RectangularMatrixCategoryFunctions2} \pagehead{RectangularMatrixCategoryFunctions2}{RMCAT2} \pagepic{ps/v104rectangularmatrixcategoryfunctions2.ps}{RMCAT2}{1.00} @@ -67836,6 +71380,507 @@ RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RECOP RecurrenceOperator} +The package defined in this file provide an operator for the +$n^{th}$ term of a recurrence and an operator for the +coefficient of $x^n$ in a function specified by a functional equation. +\pagehead{RecurrenceOperator}{RECOP} +\pagepic{ps/v104recurrenceoperator.ps}{RECOP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RECOP RecurrenceOperator +++ Author: Martin Rubey +++ Description: +++ This package provides an operator for the n-th term of a recurrence and an +++ operator for the coefficient of x^n in a function specified by a functional +++ equation. +RecurrenceOperator(R, F): Exports == Implementation where + R: Join(OrderedSet, IntegralDomain, ConvertibleTo InputForm) + F: Join(FunctionSpace R, AbelianMonoid, RetractableTo Integer, _ + RetractableTo Symbol, PartialDifferentialRing Symbol, _ + CombinatorialOpsCategory) +--RecurrenceOperator(F): Exports == Implementation where +-- F: Join(ExpressionSpace, AbelianMonoid, RetractableTo Integer, +-- RetractableTo Symbol, PartialDifferentialRing Symbol) + + Exports == with + + evalRec: (BasicOperator, Symbol, F, F, F, List F) -> F + ++ \spad{evalRec(u, dummy, n, n0, eq, values)} creates an expression that + ++ stands for u(n0), where u(n) is given by the equation eq. However, for + ++ technical reasons the variable n has to be replaced by a dummy + ++ variable dummy in eq. The argument values specifies the initial values + ++ of the recurrence u(0), u(1),... + ++ For the moment we don't allow recursions that contain u inside of + ++ another operator. + + evalADE: (BasicOperator, Symbol, F, F, F, List F) -> F + ++ \spad{evalADE(f, dummy, x, n, eq, values)} creates an expression that + ++ stands for the coefficient of x^n in the Taylor expansion of f(x), + ++ where f(x) is given by the functional equation eq. However, for + ++ technical reasons the variable x has to be replaced by a dummy + ++ variable dummy in eq. The argument values specifies the first few + ++ Taylor coefficients. + + getEq: F -> F + ++ \spad{getEq f} returns the defining equation, if f represents the + ++ coefficient of an ADE or a recurrence. + + getOp: F -> BasicOperator + ++ \spad{getOp f}, if f represents the coefficient of a recurrence or + ++ ADE, returns the operator representing the solution + + +-- should be local + numberOfValuesNeeded: (Integer, BasicOperator, Symbol, F) -> Integer + +-- should be local + if R has Ring then + getShiftRec: (BasicOperator, Kernel F, Symbol) -> Union(Integer, "failed") + + shiftInfoRec: (BasicOperator, Symbol, F) -> + Record(max: Union(Integer, "failed"), + ord: Union(Integer, "failed"), + ker: Kernel F) + + Implementation == add +<> +@ + +\subsection{Defining new operators} + +We define two new operators, one for recurrences, the other for functional +equations. The operators for recurrences represents the $n$\textsuperscript{th} +term of the corresponding sequence, the other the coefficient of $x^n$ in the +Taylor series expansion. + +<>= + oprecur := operator("rootOfRec"::Symbol)$BasicOperator + + opADE := operator("rootOfADE"::Symbol)$BasicOperator + + setProperty(oprecur, "%dummyVar", 2 pretend None) + setProperty(opADE, "%dummyVar", 2 pretend None) +@ + +Setting these properties implies that the second and third arguments of oprecur +are dummy variables and affects [[tower$ES]]: the second argument will not +appear in [[tower$ES]], if it does not appear in any argument but the first and +second. The third argument will not appear in [[tower$ES]], if it does not appear +in any other argument. ([[%defsum]] is a good example) + +The arguments of the two operators are as follows: + +\begin{enumerate} +\item [[eq]], i.e. the vanishing expression + +<>= + eqAsF: List F -> F + eqAsF l == l.1 +@ + +\item [[dummy]], a dummy variable to make substitutions possible + +<>= + dummy: List F -> Symbol + dummy l == retract(l.2)@Symbol + + dummyAsF: List F -> F + dummyAsF l == l.2 +@ + +\item the variable for display + +<>= + displayVariable: List F -> F + displayVariable l == l.3 +@ + +\item [[operatorName(argument)]] + +<>= + operatorName: List F -> BasicOperator + operatorName l == operator(kernels(l.4).1) + + operatorNameAsF: List F -> F + operatorNameAsF l == l.4 + + operatorArgument: List F -> F + operatorArgument l == argument(kernels(l.4).1).1 +@ + +Concerning [[rootOfADE]], note that although we have [[arg]] as argument of the +operator, it is intended to indicate the coefficient, not the argument of the +power series. + + +\item [[values]] in reversed order. + + \begin{itemize} + \item [[rootOfRec]]: maybe [[values]] should be preceded by the index of the + first given value. Currently, the last value is interpreted as $f(0)$. + + \item [[rootOfADE]]: values are the first few coefficients of the power + series expansion in order. + \end{itemize} + +<>= + initialValues: List F -> List F + initialValues l == rest(l, 4) +@ +\end{enumerate} + +\subsection{Recurrences} + +\subsubsection{Extracting some information from the recurrence} + +We need to find out wether we can determine the next term of the sequence, and +how many initial values are necessary. + +<>= + if R has Ring then + getShiftRec(op: BasicOperator, f: Kernel F, n: Symbol) + : Union(Integer, "failed") == + a := argument f + if every?(freeOf?(#1, n::F), a) then return 0 + + if #a ~= 1 then error "RECOP: operator should have only one argument" + + p := univariate(a.1, retract(n::F)@Kernel(F)) + if denominator p ~= 1 then return "failed" + + num := numer p + + if degree num = 1 and coefficient(num, 1) = 1 + and every?(freeOf?(#1, n::F), coefficients num) + then return retractIfCan(coefficient(num, 0)) + else return "failed" + +-- if the recurrence is of the form +-- $p(n, f(n+m-o), f(n+m-o+1), \dots, f(n+m)) = 0$ +-- in which case shiftInfoRec returns [m, o, f(n+m)]. + + shiftInfoRec(op: BasicOperator, argsym: Symbol, eq: F): + Record(max: Union(Integer, "failed"), + ord: Union(Integer, "failed"), + ker: Kernel F) == + +-- ord and ker are valid only if all shifts are Integers +-- ker is the kernel of the maximal shift. + maxShift: Integer + minShift: Integer + nextKernel: Kernel F + +-- We consider only those kernels that have op as operator. If there is none, +-- we raise an error. For the moment we don't allow recursions that contain op +-- inside of another operator. + + error? := true + + for f in kernels eq repeat + if is?(f, op) then + shift := getShiftRec(op, f, argsym) + if error? then + error? := false + nextKernel := f + if shift case Integer then + maxShift := shift + minShift := shift + else return ["failed", "failed", nextKernel] + else + if shift case Integer then + if maxShift < shift then + maxShift := shift + nextKernel := f + if minShift > shift then + minShift := shift + else return ["failed", "failed", nextKernel] + + if error? then error "evalRec: equation does not contain operator" + + [maxShift, maxShift - minShift, nextKernel] +@ + +\subsubsection{Evaluating a recurrence} + +<>= + evalRec(op, argsym, argdisp, arg, eq, values) == + if ((n := retractIfCan(arg)@Union(Integer, "failed")) case "failed") + or (n < 0) + then + shiftInfo := shiftInfoRec(op, argsym, eq) + + if (shiftInfo.ord case "failed") or ((shiftInfo.ord)::Integer > 0) + then + kernel(oprecur, + append([eq, argsym::F, argdisp, op(arg)], values)) + else + p := univariate(eq, shiftInfo.ker) + num := numer p + +-- If the degree is 1, we can return the function explicitly. + + if degree num = 1 then + eval(-coefficient(num, 0)/coefficient(num, 1), argsym::F, + arg::F-(shiftInfo.max)::Integer::F) + else + kernel(oprecur, + append([eq, argsym::F, argdisp, op(arg)], values)) + else + len: Integer := #values + if n < len + then values.(len-n) + else + shiftInfo := shiftInfoRec(op, argsym, eq) + + if shiftInfo.max case Integer then + p := univariate(eq, shiftInfo.ker) + + num := numer p + + if degree num = 1 then + + next := -coefficient(num, 0)/coefficient(num, 1) + nextval := eval(next, argsym::F, + (len-(shiftInfo.max)::Integer)::F) + newval := eval(nextval, op, + evalRec(op, argsym, argdisp, #1, eq, values)) + evalRec(op, argsym, argdisp, arg, eq, cons(newval, values)) + else + kernel(oprecur, + append([eq, argsym::F, argdisp, op(arg)], values)) + + else + kernel(oprecur, + append([eq, argsym::F, argdisp, op(arg)], values)) + + numberOfValuesNeeded(numberOfValues: Integer, + op: BasicOperator, argsym: Symbol, eq: F): Integer == + order := shiftInfoRec(op, argsym, eq).ord + if order case Integer + then min(numberOfValues, retract(order)@Integer) + else numberOfValues + + + else + evalRec(op, argsym, argdisp, arg, eq, values) == + kernel(oprecur, + append([eq, argsym::F, argdisp, op(arg)], values)) + + numberOfValuesNeeded(numberOfValues: Integer, + op: BasicOperator, argsym: Symbol, eq: F): Integer == + numberOfValues +@ + +\subsubsection{Setting the evaluation property of [[oprecur]]} + +[[irecur]] is just a wrapper that allows us to write a recurrence relation as +an operator. + +<>= + irecur: List F -> F + irecur l == + evalRec(operatorName l, + dummy l, displayVariable l, + operatorArgument l, eqAsF l, initialValues l) + + evaluate(oprecur, irecur)$BasicOperatorFunctions1(F) + +@ + +\subsubsection{Displaying a recurrence relation} + +<>= + ddrec: List F -> OutputForm + ddrec l == + op := operatorName l + values := reverse l + eq := eqAsF l + + numberOfValues := numberOfValuesNeeded(#values-4, op, dummy l, eq) + + vals: List OutputForm + := cons(eval(eq, dummyAsF l, displayVariable l)::OutputForm = _ + 0::OutputForm, + [elt(op::OutputForm, [(i-1)::OutputForm]) = _ + (values.i)::OutputForm + for i in 1..numberOfValues]) + + bracket(hconcat([(operatorNameAsF l)::OutputForm, + ": ", + commaSeparate vals])) + + setProperty(oprecur, "%specialDisp", + ddrec@(List F -> OutputForm) pretend None) + +@ + +\subsection{Functional Equations} + +\subsubsection{Determining the number of initial values for ADE's} + +We use Joris van der Hoeven's instructions for ADE's. Given +$Q=p(f,f',\dots,f^{(r)})$ we first need to differentiate $Q$ with respect to +$f^{(i)}$ for $i\in\{0,1,\dots,r\}$, plug in the given truncated power series +solution and determine the valuation. + +<>= + getValuation(op, argsym, eq, maxorder, values): Integer == + max: Integer := -1; + ker: Kernel F + for i in 0..maxorder repeat + ker := D(op(argsym), argsym, i)::Kernel F + pol := univariate(eq, ker) + dif := D pol + ground numer(dif.D(op(argsym), argsym, i)) +@ + +\subsubsection{Extracting some information from the functional equation} + +[[getOrder]] returns the maximum derivative of [[op]] occurring in [[f]]. + +<>= + getOrder(op: BasicOperator, f: Kernel F): NonNegativeInteger == + res: NonNegativeInteger := 0 + g := f + while is?(g, %diff) repeat + g := kernels(argument(g).1).1 + res := res+1 + + if is?(g, op) then res else 0 + +@ + +\subsubsection{Extracting a coefficient given a functional equation} + +<>= + evalADE(op, argsym, argdisp, arg, eq, values) == + if not freeOf?(eq, retract(argdisp)@Symbol) + then error "RECOP: The argument should not be used in the equation of the_ + ADE" + + if ((n := retractIfCan(arg)@Union(Integer, "failed")) case "failed") + then +-- try to determine the necessary number of initial values + keq := kernels eq + order := getOrder(op, keq.1) + for k in rest keq repeat order := max(order, getOrder(op, k)) + + p: Fraction SparseUnivariatePolynomial F + := univariate(eq, kernels(D(op(argsym::F), argsym, order)).1)$F + + if one? degree numer p +-- the equation is holonomic + then kernel(opADE, + append([eq, argsym::F, argdisp, op(arg)], + reverse first(reverse values, order))) + else kernel(opADE, + append([eq, argsym::F, argdisp, op(arg)], values)) + else + if n < 0 + then 0 + else + keq := kernels eq + order := getOrder(op, keq.1) +-- output(hconcat("The order is ", order::OutputForm))$OutputPackage + for k in rest keq repeat order := max(order, getOrder(op, k)) + + p: Fraction SparseUnivariatePolynomial F + := univariate(eq, kernels(D(op(argsym::F), argsym, order)).1)$F + +-- output(hconcat("p: ", p::OutputForm))$OutputPackage + + if degree numer p > 1 + then +-- kernel(opADE, +-- append([eq, argsym::F, argdisp, op(arg)], values)) + + s := seriesSolve(eq, op, argsym, reverse values) + $ExpressionSolve(R, F, + UnivariateFormalPowerSeries F, + UnivariateFormalPowerSeries + SparseUnivariatePolynomialExpressions F) + + elt(s, n::Integer::NonNegativeInteger) + + else + s := seriesSolve(eq, op, argsym, first(reverse values, order)) + $ExpressionSolve(R, F, + UnivariateFormalPowerSeries F, + UnivariateFormalPowerSeries + SparseUnivariatePolynomialExpressions F) + + elt(s, n::Integer::NonNegativeInteger) + + + iADE: List F -> F +-- This is just a wrapper that allows us to write a recurrence relation as an +-- operator. + iADE l == + evalADE(operatorName l, + dummy l, displayVariable l, + operatorArgument l, eqAsF l, initialValues l) + + evaluate(opADE, iADE)$BasicOperatorFunctions1(F) + + getEq(f: F): F == + ker := kernels f + if one?(#ker) and _ + (is?(operator(ker.1), "rootOfADE"::Symbol) or _ + is?(operator(ker.1), "rootOfRec"::Symbol)) then + l := argument(ker.1) + eval(eqAsF l, dummyAsF l, displayVariable l) + else + error "getEq: argument should be a single rootOfADE or rootOfRec object" + + getOp(f: F): BasicOperator == + ker := kernels f + if one?(#ker) and _ + (is?(operator(ker.1), "rootOfADE"::Symbol) or _ + is?(operator(ker.1), "rootOfRec"::Symbol)) then + operatorName argument(ker.1) + else + error "getOp: argument should be a single rootOfADE or rootOfRec object" + + +@ +%$ +\subsubsection{Displaying a functional equation} + +<>= + ddADE: List F -> OutputForm + ddADE l == + op := operatorName l + values := reverse l + + vals: List OutputForm + := cons(eval(eqAsF l, dummyAsF l, displayVariable l)::OutputForm = _ + 0::OutputForm, + [eval(D(op(dummyAsF l), dummy l, i), _ + dummyAsF l=0)::OutputForm = _ + (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, ": ", + commaSeparate vals])) + + setProperty(opADE, "%specialDisp", + ddADE@(List F -> OutputForm) pretend None) +@ +<>= +"RECOP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RECOP"] +"EXPRSOL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=EXPRSOL"] +"RECOP" -> "EXPRSOL" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package RDIV ReducedDivisor} \pagehead{ReducedDivisor}{RDIV} \pagepic{ps/v104reduceddivisor.ps}{RDIV}{1.00} @@ -68052,6 +72097,670 @@ ReductionOfOrder(F, L): Exports == Impl where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RSDCMPK RegularSetDecompositionPackage} +\pagehead{RegularSetDecompositionPackage}{RSDCMPK} +\pagepic{ps/v104regularsetdecompositionpackage.ps}{RSDCMPK}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RSDCMPK RegularSetDecompositionPackage +++ Author: Marc Moreno Maza +++ Date Created: 09/16/1998 +++ Date Last Updated: 12/16/1998 +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Description: +++ A package providing a new algorithm for solving polynomial systems +++ by means of regular chains. Two ways of solving are proposed: +++ in the sense of Zariski closure (like in Kalkbrener's algorithm) +++ or in the sense of the regular zeros (like in Wu, Wang or Lazard +++ methods). This algorithm is valid for nay type +++ of regular set. It does not care about the way a polynomial is +++ added in an regular set, or how two quasi-components are compared +++ (by an inclusion-test), or how the invertibility test is made in +++ the tower of simple extensions associated with a regular set. +++ These operations are realized respectively by the domain \spad{TS} +++ and the packages +++ \axiomType{QCMPACK}(R,E,V,P,TS) and \axiomType{RSETGCD}(R,E,V,P,TS). +++ The same way it does not care about the way univariate polynomial +++ gcd (with coefficients in the tower of simple extensions associated +++ with a regular set) are computed. The only requirement is that these +++ gcd need to have invertible initials (normalized or not). +++ WARNING. There is no need for a user to call diectly any operation +++ of this package since they can be accessed by the domain \axiom{TS}. +++ Thus, the operations of this package are not documented.\newline +++ References : +++ [1] M. MORENO MAZA "A new algorithm for computing triangular +++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. +++ Version: 5. Same as 4 but Does NOT use any unproved criteria. + +RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where + + R : GcdDomain + E : OrderedAbelianMonoidSup + V : OrderedSet + P : RecursivePolynomialCategory(R,E,V) + TS : RegularTriangularSetCategory(R,E,V,P) + N ==> NonNegativeInteger + Z ==> Integer + B ==> Boolean + LP ==> List P + PS ==> GeneralPolynomialSet(R,E,V,P) + PWT ==> Record(val : P, tower : TS) + BWT ==> Record(val : Boolean, tower : TS) + LpWT ==> Record(val : (List P), tower : TS) + Wip ==> Record(done: Split, todo: List LpWT) + Branch ==> Record(eq: List P, tower: TS, ineq: List P) + UBF ==> Union(Branch,"failed") + Split ==> List TS + iprintpack ==> InternalPrintPackage() + polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) + quasicomppack ==> QuasiComponentPackage(R,E,V,P,TS) + regsetgcdpack ==> RegularTriangularSetGcdPackage(R,E,V,P,TS) + + Exports == with + + KrullNumber: (LP, Split) -> N + numberOfVariables: (LP, Split) -> N + algebraicDecompose: (P,TS,B) -> Record(done: Split, todo: List LpWT) + transcendentalDecompose: (P,TS,N) -> Record(done: Split, todo: List LpWT) + transcendentalDecompose: (P,TS) -> Record(done: Split, todo: List LpWT) + internalDecompose: (P,TS,N,B) -> Record(done: Split, todo: List LpWT) + internalDecompose: (P,TS,N) -> Record(done: Split, todo: List LpWT) + internalDecompose: (P,TS) -> Record(done: Split, todo: List LpWT) + decompose: (LP, Split, B, B) -> Split + decompose: (LP, Split, B, B, B, B, B) -> Split + upDateBranches: (LP,Split,List LpWT,Wip,N) -> List LpWT + convert: Record(val: List P,tower: TS) -> String + printInfo: (List Record(val: List P,tower: TS), N) -> Void + + Implementation == add + + KrullNumber(lp: LP, lts: Split): N == + ln: List N := [#(ts) for ts in lts] + n := #lp + reduce(max,ln) + + 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: P, ts: TS, clos?: B): Record(done: Split, todo: List LpWT) == + ground? p => + error " in algebraicDecompose$REGSET: should never happen !" + v := mvar(p); n := #ts + ts_v_- := collectUnder(ts,v) + ts_v_+ := collectUpper(ts,v) + ts_v := select(ts,v)::P + if mdeg(p) < mdeg(ts_v) + then + lgwt := internalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack + else + lgwt := internalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack + lts: Split := [] + llpwt: List LpWT := [] + for gwt in lgwt repeat + g := gwt.val; us := gwt.tower + zero? g => + error " in algebraicDecompose$REGSET: should never happen !!" + ground? g => "leave" + if mvar(g) = v then lts := concat(augment(members(ts_v_+),augment(g,us)),lts) + h := leadingCoefficient(g,v) + b: Boolean := purelyAlgebraic?(us) + lsfp := squareFreeFactors(h)$polsetpack + lus := augment(members(ts_v_+),augment(ts_v,us)@Split) + for f in lsfp repeat + ground? f => "leave" + b and purelyAlgebraic?(f,us) => "leave" + for vs in lus repeat + llpwt := cons([[f,p],vs]$LpWT, llpwt) + [lts,llpwt] + + transcendentalDecompose(p: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) == + lts: Split + if #ts < bound + then + lts := augment(p,ts) + else + lts := [] + llpwt: List LpWT := [] + [lts,llpwt] + + transcendentalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == + lts: Split:= augment(p,ts) + llpwt: List LpWT := [] + [lts,llpwt] + + 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: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) == + -- ASSUME p not constant + llpwt: List LpWT := [] + lts: Split := [] + -- EITHER mvar(p) is null + if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p))) + then + llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt) + p := (p exquo lmp)::P + ip := squareFreePart init(p); tp := tail p + p := mainPrimitivePart p + -- OR init(p) is null or not + lbwt := invertible?(ip,ts)@(List BWT) + for bwt in lbwt repeat + bwt.val => + if algebraic?(mvar(p),bwt.tower) + then + rsl := algebraicDecompose(p,bwt.tower,true) + else + rsl := transcendentalDecompose(p,bwt.tower,bound) + lts := concat(rsl.done,lts) + llpwt := concat(rsl.todo,llpwt) + -- purelyAlgebraicLeadingMonomial?(ip,bwt.tower) => "leave" -- UNPROVED CRITERIA + purelyAlgebraic?(ip,bwt.tower) and purelyAlgebraic?(bwt.tower) => "leave" -- SAFE + (not ground? ip) => + zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt) + (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt) + riv := removeZero(ip,bwt.tower) + (zero? riv) => + zero? tp => lts := cons(bwt.tower,lts) + (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt) + llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) + [lts,llpwt] + + internalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == + -- ASSUME p not constant + llpwt: List LpWT := [] + lts: Split := [] + -- EITHER mvar(p) is null + if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p))) + then + llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt) + p := (p exquo lmp)::P + ip := squareFreePart init(p); tp := tail p + p := mainPrimitivePart p + -- OR init(p) is null or not + lbwt := invertible?(ip,ts)@(List BWT) + for bwt in lbwt repeat + bwt.val => + if algebraic?(mvar(p),bwt.tower) + then + rsl := algebraicDecompose(p,bwt.tower,false) + else + rsl := transcendentalDecompose(p,bwt.tower) + lts := concat(rsl.done,lts) + llpwt := concat(rsl.todo,llpwt) + purelyAlgebraic?(ip,bwt.tower) and purelyAlgebraic?(bwt.tower) => "leave" + (not ground? ip) => + zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt) + (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt) + riv := removeZero(ip,bwt.tower) + (zero? riv) => + zero? tp => lts := cons(bwt.tower,lts) + (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt) + llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) + [lts,llpwt] + + decompose(lp: LP, lts: Split, clos?: B, info?: B): Split == + decompose(lp,lts,false,false,clos?,true,info?) + + convert(lpwt: LpWT): String == + ls: List String := ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ] + concat ls + + printInfo(toSee: List LpWT, n: N): Void == + lpwt := first toSee + s: String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String] + m: N := #(lpwt.val) + toSee := rest toSee + for lpwt in toSee repeat + m := m + #(lpwt.val) + s := concat [s, ",", convert(lpwt)@String] + s := concat [s, " -> |", string(m::Z), "|; {", string(n::Z),"}]"] + iprint(s)$iprintpack + void() + + decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, rem?: B, info?: B): Split == + -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts + -- if sqfr? then SPLIT the system with SQUARE-FREE FACTORIZATION + -- if clos? then SOLVE in the closure sense + -- if rem? then REDUCE the current p by using remainder + -- if info? then PRINT info + empty? lp => lts + branches: List Branch := prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack + empty? branches => [] + toSee: List LpWT := [[br.eq,br.tower]$LpWT for br in branches] + toSave: Split := [] + if clos? then bound := KrullNumber(lp,lts) else bound := numberOfVariables(lp,lts) + while (not empty? toSee) repeat + if info? then printInfo(toSee,#toSave) + lpwt := first toSee; toSee := rest toSee + lp := lpwt.val; ts := lpwt.tower + empty? lp => + toSave := cons(ts, toSave) + p := first lp; lp := rest lp + if rem? and (not ground? p) and (not empty? ts) + then + p := remainder(p,ts).polnum + p := removeZero(p,ts) + zero? p => toSee := cons([lp,ts]$LpWT, toSee) + ground? p => "leave" + rsl := internalDecompose(p,ts,bound,clos?) + toSee := upDateBranches(lp,toSave,toSee,rsl,bound) + removeSuperfluousQuasiComponents(toSave)$quasicomppack + + upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N): List LpWT == + newBranches: List LpWT := wip.todo + newComponents: Split := wip.done + branches1, branches2: List LpWT + branches1 := []; branches2 := [] + for branch in newBranches repeat + us := branch.tower + #us > n => "leave" + newleq := sort(infRittWu?,concat(leq,branch.val)) + --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?) + --any?(ground?,foo) => "leave" + branches1 := cons([newleq,us]$LpWT, branches1) + for us in newComponents repeat + #us > n => "leave" + subQuasiComponent?(us,lts)$quasicomppack => "leave" + --newleq := leq + --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?) + --any?(ground?,foo) => "leave" + branches2 := cons([leq,us]$LpWT, branches2) + empty? branches1 => + empty? branches2 => current + concat(branches2, current) + branches := concat [branches2, branches1, current] + -- branches := concat(branches,current) + removeSuperfluousCases(branches)$quasicomppack + +@ +<>= +"RSDCMPK" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RSDCMPK"] +"RSETCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RSETCAT"] +"RSDCMPK" -> "RSETCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RSETGCD RegularTriangularSetGcdPackage} +\pagehead{RegularTriangularSetGcdPackage}{RSETGCD} +\pagepic{ps/v104regulartriangularsetgcdpackage.ps}{RSETGCD}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RSETGCD RegularTriangularSetGcdPackage +++ Author: Marc Moreno Maza (marc@nag.co.uk) +++ Date Created: 08/30/1998 +++ Date Last Updated: 12/15/1998 +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Description: +++ An internal package for computing gcds and resultants of univariate +++ polynomials with coefficients in a tower of simple extensions of a field.\newline +++ References : +++ [1] M. MORENO MAZA and R. RIOBOO "Computations of gcd over +++ algebraic towers of simple extensions" In proceedings of AAECC11 +++ Paris, 1995. +++ [2] M. MORENO MAZA "Calculs de pgcd au-dessus des tours +++ d'extensions simples et resolution des systemes d'equations +++ algebriques" These, Universite P.etM. Curie, Paris, 1997. +++ [3] M. MORENO MAZA "A new algorithm for computing triangular +++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. +++ Version: 4. + +RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where + + R : GcdDomain + E : OrderedAbelianMonoidSup + V : OrderedSet + P : RecursivePolynomialCategory(R,E,V) + TS : RegularTriangularSetCategory(R,E,V,P) + N ==> NonNegativeInteger + Z ==> Integer + B ==> Boolean + S ==> String + LP ==> List P + PtoP ==> P -> P + PS ==> GeneralPolynomialSet(R,E,V,P) + PWT ==> Record(val : P, tower : TS) + BWT ==> Record(val : Boolean, tower : TS) + LpWT ==> Record(val : (List P), tower : TS) + Branch ==> Record(eq: List P, tower: TS, ineq: List P) + UBF ==> Union(Branch,"failed") + Split ==> List TS + KeyGcd ==> Record(arg1: P, arg2: P, arg3: TS, arg4: B) + EntryGcd ==> List PWT + HGcd ==> TabulatedComputationPackage(KeyGcd, EntryGcd) + KeyInvSet ==> Record(arg1: P, arg3: TS) + EntryInvSet ==> List TS + HInvSet ==> TabulatedComputationPackage(KeyInvSet, EntryInvSet) + polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) + quasicomppack ==> QuasiComponentPackage(R,E,V,P,TS) + + Exports == with + startTableGcd!: (S,S,S) -> Void + ++ \axiom{startTableGcd!(s1,s2,s3)} + ++ is an internal subroutine, exported only for developement. + stopTableGcd!: () -> Void + ++ \axiom{stopTableGcd!()} + ++ is an internal subroutine, exported only for developement. + startTableInvSet!: (S,S,S) -> Void + ++ \axiom{startTableInvSet!(s1,s2,s3)} + ++ is an internal subroutine, exported only for developement. + stopTableInvSet!: () -> Void + ++ \axiom{stopTableInvSet!()} is an internal subroutine, + ++ exported only for developement. + prepareSubResAlgo: (P,P,TS) -> List LpWT + ++ \axiom{prepareSubResAlgo(p1,p2,ts)} + ++ is an internal subroutine, exported only for developement. + internalLastSubResultant: (P,P,TS,B,B) -> List PWT + ++ \axiom{internalLastSubResultant(p1,p2,ts,inv?,break?)} + ++ is an internal subroutine, exported only for developement. + internalLastSubResultant: (List LpWT,V,B) -> List PWT + ++ \axiom{internalLastSubResultant(lpwt,v,flag)} is an internal + ++ subroutine, exported only for developement. + integralLastSubResultant: (P,P,TS) -> List PWT + ++ \axiom{integralLastSubResultant(p1,p2,ts)} + ++ is an internal subroutine, exported only for developement. + toseLastSubResultant: (P,P,TS) -> List PWT + ++ \axiom{toseLastSubResultant(p1,p2,ts)} has the same specifications as + ++ \axiomOpFrom{lastSubResultant}{RegularTriangularSetCategory}. + toseInvertible?: (P,TS) -> B + ++ \axiom{toseInvertible?(p1,p2,ts)} has the same specifications as + ++ \axiomOpFrom{invertible?}{RegularTriangularSetCategory}. + toseInvertible?: (P,TS) -> List BWT + ++ \axiom{toseInvertible?(p1,p2,ts)} has the same specifications as + ++ \axiomOpFrom{invertible?}{RegularTriangularSetCategory}. + toseInvertibleSet: (P,TS) -> Split + ++ \axiom{toseInvertibleSet(p1,p2,ts)} has the same specifications as + ++ \axiomOpFrom{invertibleSet}{RegularTriangularSetCategory}. + toseSquareFreePart: (P,TS) -> List PWT + ++ \axiom{toseSquareFreePart(p,ts)} has the same specifications as + ++ \axiomOpFrom{squareFreePart}{RegularTriangularSetCategory}. + + Implementation == add + + startTableGcd!(ok: S, ko: S, domainName: S): Void == + initTable!()$HGcd + printInfo!(ok,ko)$HGcd + startStats!(domainName)$HGcd + void() + + stopTableGcd!(): Void == + if makingStats?()$HGcd then printStats!()$HGcd + clearTable!()$HGcd + + startTableInvSet!(ok: S, ko: S, domainName: S): Void == + initTable!()$HInvSet + printInfo!(ok,ko)$HInvSet + startStats!(domainName)$HInvSet + void() + + stopTableInvSet!(): Void == + if makingStats?()$HInvSet then printStats!()$HInvSet + clearTable!()$HInvSet + + toseInvertible?(p:P,ts:TS): Boolean == + q := primitivePart initiallyReduce(p,ts) + zero? q => false + normalized?(q,ts) => true + v := mvar(q) + not algebraic?(v,ts) => + toCheck: List BWT := toseInvertible?(p,ts)@(List BWT) + for bwt in toCheck repeat + bwt.val = false => return false + return true + ts_v := select(ts,v)::P + ts_v_- := collectUnder(ts,v) + lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,true) + for gwt in lgwt repeat + g := gwt.val; + (not ground? g) and (mvar(g) = v) => + return false + true + + toseInvertible?(p:P,ts:TS): List BWT == + q := primitivePart initiallyReduce(p,ts) + zero? q => [[false,ts]$BWT] + normalized?(q,ts) => [[true,ts]$BWT] + v := mvar(q) + not algebraic?(v,ts) => + lbwt: List BWT := [] + toCheck: List BWT := toseInvertible?(init(q),ts)@(List BWT) + for bwt in toCheck repeat + bwt.val => lbwt := cons(bwt,lbwt) + newq := removeZero(q,bwt.tower) + zero? newq => lbwt := cons(bwt,lbwt) + lbwt := concat(toseInvertible?(newq,bwt.tower)@(List BWT), lbwt) + return lbwt + ts_v := select(ts,v)::P + ts_v_- := collectUnder(ts,v) + ts_v_+ := collectUpper(ts,v) + lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,false) + lbwt: List BWT := [] + for gwt in lgwt repeat + g := gwt.val; ts := gwt.tower + (ground? g) or (mvar(g) < v) => + ts := internalAugment(ts_v,ts) + ts := internalAugment(members(ts_v_+),ts) + lbwt := cons([true, ts]$BWT,lbwt) + g := mainPrimitivePart g + ts_g := internalAugment(g,ts) + ts_g := internalAugment(members(ts_v_+),ts_g) + -- USE internalAugment with parameters ?? + lbwt := cons([false, ts_g]$BWT,lbwt) + h := lazyPquo(ts_v,g) + (ground? h) or (mvar(h) < v) => "leave" + h := mainPrimitivePart h + ts_h := internalAugment(h,ts) + ts_h := internalAugment(members(ts_v_+),ts_h) + -- USE internalAugment with parameters ?? + -- CAN BE OPTIMIZED if the input tower is separable + inv := toseInvertible?(q,ts_h)@(List BWT) + lbwt := concat([bwt for bwt in inv | bwt.val],lbwt) + sort(#1.val < #2.val,lbwt) + + toseInvertibleSet(p:P,ts:TS): Split == + k: KeyInvSet := [p,ts] + e := extractIfCan(k)$HInvSet + e case EntryInvSet => e::EntryInvSet + q := primitivePart initiallyReduce(p,ts) + zero? q => [] + normalized?(q,ts) => [ts] + v := mvar(q) + toSave: Split := [] + not algebraic?(v,ts) => + toCheck: List BWT := toseInvertible?(init(q),ts)@(List BWT) + for bwt in toCheck repeat + bwt.val => toSave := cons(bwt.tower,toSave) + newq := removeZero(q,bwt.tower) + zero? newq => "leave" + toSave := concat(toseInvertibleSet(newq,bwt.tower), toSave) + toSave := removeDuplicates toSave + return algebraicSort(toSave)$quasicomppack + ts_v := select(ts,v)::P + ts_v_- := collectUnder(ts,v) + ts_v_+ := collectUpper(ts,v) + lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,false) + for gwt in lgwt repeat + g := gwt.val; ts := gwt.tower + (ground? g) or (mvar(g) < v) => + ts := internalAugment(ts_v,ts) + ts := internalAugment(members(ts_v_+),ts) + toSave := cons(ts,toSave) + g := mainPrimitivePart g + h := lazyPquo(ts_v,g) + h := mainPrimitivePart h + (ground? h) or (mvar(h) < v) => "leave" + ts_h := internalAugment(h,ts) + ts_h := internalAugment(members(ts_v_+),ts_h) + inv := toseInvertibleSet(q,ts_h) + toSave := removeDuplicates concat(inv,toSave) + toSave := algebraicSort(toSave)$quasicomppack + insert!(k,toSave)$HInvSet + toSave + + 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 + -- ASSUME p is mainly primitive +-- one? mdeg(p) => [[p,ts]$PWT] + mdeg(p) = 1 => [[p,ts]$PWT] + v := mvar(p)$P + q: P := mainPrimitivePart D(p,v) + lgwt: List PWT := internalLastSubResultant(p,q,ts,true,false) + lpwt : List PWT := [] + sfp : P + for gwt in lgwt repeat + g := gwt.val; us := gwt.tower + (ground? g) or (mvar(g) < v) => + lpwt := cons([p,us],lpwt) + g := mainPrimitivePart g + sfp := lazyPquo(p,g) + sfp := mainPrimitivePart stronglyReduce(sfp,us) + lpwt := cons([sfp,us],lpwt) + lpwt + + toseSquareFreePart_base(p:P, ts: TS): List PWT == [[p,ts]$PWT] + + toseSquareFreePart(p:P, ts: TS): List PWT == toseSquareFreePart_wip(p,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 !!! + toSee: List LpWT := [[[p1,p2],ts]$LpWT] + toSave: List LpWT := [] + v := mvar(p1) + while (not empty? toSee) repeat + lpwt := first toSee; toSee := rest toSee + p1 := lpwt.val.1; p2 := lpwt.val.2 + ts := lpwt.tower + lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT) + for bwt in lbwt repeat + (bwt.val = true) and (degree(p2,v) > 0) => + p3 := prem(p1, -p2) + s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N + toSave := cons([[p2,p3,s],bwt.tower]$LpWT,toSave) + -- p2 := initiallyReduce(p2,bwt.tower) + newp2 := primitivePart initiallyReduce(p2,bwt.tower) + (bwt.val = true) => + -- toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave) + toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave) + -- zero? p2 => + zero? newp2 => + toSave := cons([[p1,0,1],bwt.tower]$LpWT,toSave) + -- toSee := cons([[p1,p2],ts]$LpWT,toSee) + toSee := cons([[p1,newp2],bwt.tower]$LpWT,toSee) + toSave + + 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 + lsr := lastSubResultant(p1, p2) + ground?(lsr) => [[lsr,ts]$PWT] + mvar(lsr) < mvar(p1) => [[lsr,ts]$PWT] + gi1i2 := gcd(init(p1),init(p2)) + ex: Union(P,"failed") := (gi1i2 * lsr) exquo$P init(lsr) + ex case "failed" => [[lsr,ts]$PWT] + [[ex::P,ts]$PWT] + + 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 + -- if b2 BREAK with the first non-trivial gcd + k: KeyGcd := [p1,p2,ts,b2] + e := extractIfCan(k)$HGcd + e case EntryGcd => e::EntryGcd + toSave: List PWT + empty? ts => + toSave := integralLastSubResultant(p1,p2,ts) + insert!(k,toSave)$HGcd + return toSave + toSee: List LpWT + if b1 + then + p3 := prem(p1, -p2) + s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N + toSee := [[[p2,p3,s],ts]$LpWT] + else + toSee := prepareSubResAlgo(p1,p2,ts) + toSave := internalLastSubResultant(toSee,mvar(p1),b2) + insert!(k,toSave)$HGcd + toSave + + internalLastSubResultant(llpwt: List LpWT,v:V,b2:B): List PWT == + toReturn: List PWT := []; toSee: List LpWT; + while (not empty? llpwt) repeat + toSee := llpwt; llpwt := [] + -- CONSIDER FIRST the vanishing current last subresultant + for lpwt in toSee repeat + p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3; ts := lpwt.tower + lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT) + for bwt in lbwt repeat + bwt.val = false => + toReturn := cons([p1,bwt.tower]$PWT, toReturn) + b2 and positive?(degree(p1,v)) => return toReturn + llpwt := cons([[p1,p2,s],bwt.tower]$LpWT, llpwt) + empty? llpwt => "leave" + -- CONSIDER NOW the branches where the computations continue + toSee := llpwt; llpwt := [] + lpwt := first toSee; toSee := rest toSee + p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3 + delta: N := (mdeg(p1) - degree(p2,v))::N + p3: P := LazardQuotient2(p2, leadingCoefficient(p2,v), s, delta) + zero?(degree(p3,v)) => + toReturn := cons([p3,lpwt.tower]$PWT, toReturn) + for lpwt in toSee repeat + toReturn := cons([p3,lpwt.tower]$PWT, toReturn) + (p1, p2) := (p3, next_subResultant2(p1, p2, p3, s)) + s := leadingCoefficient(p1,v) + llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) + for lpwt in toSee repeat + llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) + toReturn + + toseLastSubResultant(p1:P,p2:P,ts:TS): List PWT == + ground? p1 => + error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" + ground? p2 => + error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2" + not (mvar(p2) = mvar(p1)) => + error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2" + algebraic?(mvar(p1),ts) => + error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" + not initiallyReduced?(p1,ts) => + error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" + not initiallyReduced?(p2,ts) => + error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2" + purelyTranscendental?(p1,ts) and purelyTranscendental?(p2,ts) => + integralLastSubResultant(p1,p2,ts) + if mdeg(p1) < mdeg(p2) then + (p1, p2) := (p2, p1) + if odd?(mdeg(p1)) and odd?(mdeg(p2)) then p2 := - p2 + internalLastSubResultant(p1,p2,ts,false,false) + +@ +<>= +"RSETGCD" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RSETGCD"] +"RPOLCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RPOLCAT"] +"RSETGCD" -> "RPOLCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package REPDB RepeatedDoubling} \pagehead{RepeatedDoubling}{REPDB} \pagepic{ps/v104repeateddoubling.ps}{REPDB}{1.00} @@ -68147,6 +72856,1133 @@ RepeatedSquaring(S): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package REP1 RepresentationPackage1} +\pagehead{RepresentationPackage1}{REP1} +\pagepic{ps/v104representationpackage1.ps}{REP1}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package REP1 RepresentationPackage1 +++ Authors: Holger Gollan, Johannes Grabmeier, Thorsten Werther +++ Date Created: 12 September 1987 +++ Date Last Updated: 24 May 1991 +++ Basic Operations: antisymmetricTensors,symmetricTensors, +++ tensorProduct, permutationRepresentation +++ Related Constructors: RepresentationPackage1, Permutation +++ Also See: IrrRepSymNatPackage +++ AMS Classifications: +++ Keywords: representation, symmetrization, tensor product +++ References: +++ G. James, A. Kerber: The Representation Theory of the Symmetric +++ Group. Encycl. of Math. and its Appl. Vol 16., Cambr. Univ Press 1981; +++ J. Grabmeier, A. Kerber: The Evaluation of Irreducible +++ Polynomial Representations of the General Linear Groups +++ and of the Unitary Groups over Fields of Characteristic 0, +++ Acta Appl. Math. 8 (1987), 271-291; +++ H. Gollan, J. Grabmeier: Algorithms in Representation Theory and +++ their Realization in the Computer Algebra System Scratchpad, +++ Bayreuther Mathematische Schriften, Heft 33, 1990, 1-23 +++ Description: +++ RepresentationPackage1 provides functions for representation theory +++ for finite groups and algebras. +++ The package creates permutation representations and uses tensor products +++ and its symmetric and antisymmetric components to create new +++ representations of larger degree from given ones. +++ Note: instead of having parameters from \spadtype{Permutation} +++ this package allows list notation of permutations as well: +++ e.g. \spad{[1,4,3,2]} denotes permutes 2 and 4 and fixes 1 and 3. + +RepresentationPackage1(R): public == private where + + R : Ring + OF ==> OutputForm + NNI ==> NonNegativeInteger + PI ==> PositiveInteger + I ==> Integer + L ==> List + M ==> Matrix + P ==> Polynomial + SM ==> SquareMatrix + V ==> Vector + ICF ==> IntegerCombinatoricFunctions Integer + SGCF ==> SymmetricGroupCombinatoricFunctions + PERM ==> Permutation + + public ==> with + + if R has commutative("*") then + antisymmetricTensors : (M R,PI) -> M R + ++ antisymmetricTensors(a,n) applies to the square matrix + ++ {\em a} the irreducible, polynomial representation of the + ++ general linear group {\em GLm}, where m is the number of + ++ rows of {\em a}, which corresponds to the partition + ++ {\em (1,1,...,1,0,0,...,0)} of n. + ++ Error: if n is greater than m. + ++ Note: this corresponds to the symmetrization of the representation + ++ with the sign representation of the symmetric group {\em Sn}. + ++ The carrier spaces of the representation are the antisymmetric + ++ tensors of the n-fold tensor product. + if R has commutative("*") then + antisymmetricTensors : (L M R, PI) -> L M R + ++ antisymmetricTensors(la,n) applies to each + ++ m-by-m square matrix in + ++ the list {\em la} the irreducible, polynomial representation + ++ of the general linear group {\em GLm} + ++ which corresponds + ++ to the partition {\em (1,1,...,1,0,0,...,0)} of n. + ++ Error: if n is greater than m. + ++ Note: this corresponds to the symmetrization of the representation + ++ with the sign representation of the symmetric group {\em Sn}. + ++ The carrier spaces of the representation are the antisymmetric + ++ tensors of the n-fold tensor product. + createGenericMatrix : NNI -> M P R + ++ createGenericMatrix(m) creates a square matrix of dimension k + ++ whose entry at the i-th row and j-th column is the + ++ indeterminate {\em x[i,j]} (double subscripted). + symmetricTensors : (M R, PI) -> M R + ++ symmetricTensors(a,n) applies to the m-by-m + ++ square matrix {\em a} the + ++ irreducible, polynomial representation of the general linear + ++ group {\em GLm} + ++ which corresponds to the partition {\em (n,0,...,0)} of n. + ++ Error: if {\em a} is not a square matrix. + ++ Note: this corresponds to the symmetrization of the representation + ++ with the trivial representation of the symmetric group {\em Sn}. + ++ The carrier spaces of the representation are the symmetric + ++ tensors of the n-fold tensor product. + symmetricTensors : (L M R, PI) -> L M R + ++ symmetricTensors(la,n) applies to each m-by-m square matrix in the + ++ list {\em la} the irreducible, polynomial representation + ++ of the general linear group {\em GLm} + ++ which corresponds + ++ to the partition {\em (n,0,...,0)} of n. + ++ Error: if the matrices in {\em la} are not square matrices. + ++ Note: this corresponds to the symmetrization of the representation + ++ with the trivial representation of the symmetric group {\em Sn}. + ++ The carrier spaces of the representation are the symmetric + ++ tensors of the n-fold tensor product. + tensorProduct : (M R, M R) -> M R + ++ tensorProduct(a,b) calculates the Kronecker product + ++ of the matrices {\em a} and b. + ++ Note: if each matrix corresponds to a group representation + ++ (repr. of generators) of one group, then these matrices + ++ correspond to the tensor product of the two representations. + tensorProduct : (L M R, L M R) -> L M R + ++ tensorProduct([a1,...,ak],[b1,...,bk]) calculates the list of + ++ Kronecker products of the matrices {\em ai} and {\em bi} + ++ for {1 <= i <= k}. + ++ Note: If each list of matrices corresponds to a group representation + ++ (repr. of generators) of one group, then these matrices + ++ correspond to the tensor product of the two representations. + tensorProduct : M R -> M R + ++ tensorProduct(a) calculates the Kronecker product + ++ of the matrix {\em a} with itself. + tensorProduct : L M R -> L M R + ++ tensorProduct([a1,...ak]) calculates the list of + ++ Kronecker products of each matrix {\em ai} with itself + ++ for {1 <= i <= k}. + ++ Note: If the list of matrices corresponds to a group representation + ++ (repr. of generators) of one group, then these matrices correspond + ++ to the tensor product of the representation with itself. + permutationRepresentation : (PERM I, I) -> M I + ++ permutationRepresentation(pi,n) returns the matrix + ++ {\em (deltai,pi(i))} (Kronecker delta) for a permutation + ++ {\em pi} of {\em {1,2,...,n}}. + permutationRepresentation : L I -> M I + ++ permutationRepresentation(pi,n) returns the matrix + ++ {\em (deltai,pi(i))} (Kronecker delta) if the permutation + ++ {\em pi} is in list notation and permutes {\em {1,2,...,n}}. + permutationRepresentation : (L PERM I, I) -> L M I + ++ permutationRepresentation([pi1,...,pik],n) returns the list + ++ of matrices {\em [(deltai,pi1(i)),...,(deltai,pik(i))]} + ++ (Kronecker delta) for the permutations {\em pi1,...,pik} + ++ of {\em {1,2,...,n}}. + permutationRepresentation : L L I -> L M I + ++ permutationRepresentation([pi1,...,pik],n) returns the list + ++ of matrices {\em [(deltai,pi1(i)),...,(deltai,pik(i))]} + ++ if the permutations {\em pi1},...,{\em pik} are in + ++ list notation and are permuting {\em {1,2,...,n}}. + + private ==> add + + -- import of domains and packages + + import OutputForm + + -- 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) == + prod : I := 1 + for i in 1..maxIndex beta repeat + prod := prod * multinomial(beta(i), entries row(C,i))$ICF + prod + + + invContent(alpha) == + n : NNI := (+/alpha)::NNI + f : V I := new(n,0) + i : NNI := 1 + j : I := - 1 + for og in alpha repeat + j := j + 1 + for k in 1..og repeat + f(i) := j + i := i + 1 + f + + + -- exported functions: + + + + if R has commutative("*") then + antisymmetricTensors ( a : M R , k : PI ) == + + n : NNI := nrows a + k = 1 => a + k > n => + error("second parameter for antisymmetricTensors is too large") + m : I := binomial(n,k)$ICF + il : L L I := [subSet(n,k,i)$SGCF for i in 0..m-1] + b : M R := zero(m::NNI, m::NNI) + for i in 1..m repeat + for j in 1..m repeat + c : M R := zero(k,k) + lr: L I := il.i + lt: L I := il.j + for r in 1..k repeat + for t in 1..k repeat + rr : I := lr.r + tt : I := lt.t + --c.r.t := a.(1+rr).(1+tt) + setelt(c,r,t,elt(a, 1+rr, 1+tt)) + setelt(b, i, j, determinant c) + b + + + if R has commutative("*") then + antisymmetricTensors(la: L M R, k: PI) == + [antisymmetricTensors(ma,k) for ma in la] + + + + symmetricTensors (a : M R, n : PI) == + + m : NNI := nrows a + m ^= ncols a => + error("Input to symmetricTensors is no square matrix") + n = 1 => a + + dim : NNI := (binomial(m+n-1,n)$ICF)::NNI + c : M R := new(dim,dim,0) + f : V I := new(n,0) + g : V I := new(n,0) + nullMatrix : M I := new(1,1,0) + colemanMatrix : M I + + for i in 1..dim repeat + -- unrankImproperPartitions1 starts counting from 0 + alpha := unrankImproperPartitions1(n,m,i-1)$SGCF + f := invContent(alpha) + for j in 1..dim repeat + -- unrankImproperPartitions1 starts counting from 0 + beta := unrankImproperPartitions1(n,m,j-1)$SGCF + g := invContent(beta) + colemanMatrix := nextColeman(alpha,beta,nullMatrix)$SGCF + while colemanMatrix ^= nullMatrix repeat + gamma := inverseColeman(alpha,beta,colemanMatrix)$SGCF + help : R := calcCoef(beta,colemanMatrix)::R + for k in 1..n repeat + help := help * a( (1+f k)::NNI, (1+g(gamma k))::NNI ) + c(i,j) := c(i,j) + help + colemanMatrix := nextColeman(alpha,beta,colemanMatrix)$SGCF + -- end of while + -- end of j-loop + -- end of i-loop + + c + + + symmetricTensors(la : L M R, k : PI) == + [symmetricTensors (ma, k) for ma in la] + + + tensorProduct(a: M R, b: M R) == + n : NNI := nrows a + m : NNI := nrows b + nc : NNI := ncols a + mc : NNI := ncols b + c : M R := zero(n * m, nc * mc) + indexr : NNI := 1 -- row index + for i in 1..n repeat + for k in 1..m repeat + indexc : NNI := 1 -- column index + for j in 1..nc repeat + for l in 1..mc repeat + c(indexr,indexc) := a(i,j) * b(k,l) + indexc := indexc + 1 + indexr := indexr + 1 + c + + + tensorProduct (la: L M R, lb: L M R) == + [tensorProduct(la.i, lb.i) for i in 1..maxIndex la] + + + tensorProduct(a : M R) == tensorProduct(a, a) + + tensorProduct(la : L M R) == + tensorProduct(la :: L M R, la :: L M R) + + permutationRepresentation (p : PERM I, n : I) == + -- permutations are assumed to permute {1,2,...,n} + a : M I := zero(n :: NNI, n :: NNI) + for i in 1..n repeat + a(eval(p,i)$(PERM I),i) := 1 + a + + + permutationRepresentation (p : L I) == + -- permutations are assumed to permute {1,2,...,n} + n : I := #p + a : M I := zero(n::NNI, n::NNI) + for i in 1..n repeat + a(p.i,i) := 1 + a + + + permutationRepresentation(listperm : L PERM I, n : I) == + -- permutations are assumed to permute {1,2,...,n} + [permutationRepresentation(perm, n) for perm in listperm] + + permutationRepresentation (listperm : L L I) == + -- permutations are assumed to permute {1,2,...,n} + [permutationRepresentation perm for perm in listperm] + + createGenericMatrix(m) == + res : M P R := new(m,m,0$(P R)) + for i in 1..m repeat + for j in 1..m repeat + iof : OF := coerce(i)$Integer + jof : OF := coerce(j)$Integer + le : L OF := cons(iof,list jof) + sy : Symbol := subscript(x::Symbol, le)$Symbol + res(i,j) := (sy :: P R) + res + +@ +<>= +"REP1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=REP1"] +"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] +"REP1" -> "ALIST" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package REP2 RepresentationPackage2} +\pagehead{RepresentationPackage2}{REP2} +\pagepic{ps/v104representationpackage2.ps}{REP2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package REP2 RepresentationPackage2 +++ Authors: Holger Gollan, Johannes Grabmeier +++ Date Created: 10 September 1987 +++ Date Last Updated: 20 August 1990 +++ Basic Operations: areEquivalent?, isAbsolutelyIrreducible?, +++ split, meatAxe +++ Related Constructors: RepresentationTheoryPackage1 +++ Also See: IrrRepSymNatPackage +++ AMS Classifications: +++ Keywords: meat-axe, modular representation +++ Reference: +++ R. A. Parker: The Computer Calculation of Modular Characters +++ (The Meat-Axe), in M. D. Atkinson (Ed.), Computational Group Theory +++ Academic Press, Inc., London 1984 +++ H. Gollan, J. Grabmeier: Algorithms in Representation Theory and +++ their Realization in the Computer Algebra System Scratchpad, +++ Bayreuther Mathematische Schriften, Heft 33, 1990, 1-23. +++ Description: +++ RepresentationPackage2 provides functions for working with +++ modular representations of finite groups and algebra. +++ The routines in this package are created, using ideas of R. Parker, +++ (the meat-Axe) to get smaller representations from bigger ones, +++ i.e. finding sub- and factormodules, or to show, that such the +++ representations are irreducible. +++ Note: most functions are randomized functions of Las Vegas type +++ i.e. every answer is correct, but with small probability +++ the algorithm fails to get an answer. +RepresentationPackage2(R): public == private where + + R : Ring + OF ==> OutputForm + I ==> Integer + L ==> List + SM ==> SquareMatrix + M ==> Matrix + NNI ==> NonNegativeInteger + V ==> Vector + PI ==> PositiveInteger + B ==> Boolean + RADIX ==> RadixExpansion + + public ==> with + + completeEchelonBasis : V V R -> M R + ++ completeEchelonBasis(lv) completes the basis {\em lv} assumed + ++ to be in echelon form of a subspace of {\em R**n} (n the length + ++ of all the vectors in {\em lv}) with unit vectors to a basis of + ++ {\em R**n}. It is assumed that the argument is not an empty + ++ vector and that it is not the basis of the 0-subspace. + ++ Note: the rows of the result correspond to the vectors of the basis. + createRandomElement : (L M R, M R) -> M R + ++ createRandomElement(aG,x) creates a random element of the group + ++ algebra generated by {\em aG}. + -- randomWord : (L L I, L M) -> M R + --++ You can create your own 'random' matrix with "randomWord(lli, lm)". + --++ Each li in lli determines a product of matrices, the entries in li + --++ determine which matrix from lm is chosen. Finally we sum over all + --++ products. The result "sm" can be used to call split with (e.g.) + --++ second parameter "first nullSpace sm" + if R has EuclideanDomain then -- using rowEchelon + cyclicSubmodule : (L M R, V R) -> V V R + ++ cyclicSubmodule(lm,v) generates a basis as follows. + ++ It is assumed that the size n of the vector equals the number + ++ of rows and columns of the matrices. Then the matrices generate + ++ a subalgebra, say \spad{A}, of the algebra of all square matrices of + ++ dimension n. {\em V R} is an \spad{A}-module in the natural way. + ++ cyclicSubmodule(lm,v) generates the R-Basis of {\em Av} as + ++ described in section 6 of R. A. Parker's "The Meat-Axe". + ++ Note: in contrast to the description in "The Meat-Axe" and to + ++ {\em standardBasisOfCyclicSubmodule} the result is in + ++ echelon form. + standardBasisOfCyclicSubmodule : (L M R, V R) -> M R + ++ standardBasisOfCyclicSubmodule(lm,v) returns a matrix as follows. + ++ It is assumed that the size n of the vector equals the number + ++ of rows and columns of the matrices. Then the matrices generate + ++ a subalgebra, say \spad{A}, + ++ of the algebra of all square matrices of + ++ dimension n. {\em V R} is an \spad{A}-module in the natural way. + ++ standardBasisOfCyclicSubmodule(lm,v) calculates a matrix whose + ++ non-zero column vectors are the R-Basis of {\em Av} achieved + ++ in the way as described in section 6 + ++ of R. A. Parker's "The Meat-Axe". + ++ Note: in contrast to {\em cyclicSubmodule}, the result is not + ++ in echelon form. + if R has Field then -- only because of inverse in SM + areEquivalent? : (L M R, L M R, B, I) -> M R + ++ areEquivalent?(aG0,aG1,randomelements,numberOfTries) tests + ++ whether the two lists of matrices, all assumed of same + ++ square shape, can be simultaneously conjugated by a non-singular + ++ matrix. If these matrices represent the same group generators, + ++ the representations are equivalent. + ++ The algorithm tries + ++ {\em numberOfTries} times to create elements in the + ++ generated algebras in the same fashion. If their ranks differ, + ++ they are not equivalent. If an + ++ isomorphism is assumed, then + ++ the kernel of an element of the first algebra + ++ is mapped to the kernel of the corresponding element in the + ++ second algebra. Now consider the one-dimensional ones. + ++ If they generate the whole space (e.g. irreducibility !) + ++ we use {\em standardBasisOfCyclicSubmodule} to create the + ++ only possible transition matrix. The method checks whether the + ++ matrix conjugates all corresponding matrices from {\em aGi}. + ++ The way to choose the singular matrices is as in {\em meatAxe}. + ++ If the two representations are equivalent, this routine + ++ returns the transformation matrix {\em TM} with + ++ {\em aG0.i * TM = TM * aG1.i} for all i. If the representations + ++ are not equivalent, a small 0-matrix is returned. + ++ Note: the case + ++ with different sets of group generators cannot be handled. + areEquivalent? : (L M R, L M R) -> M R + ++ areEquivalent?(aG0,aG1) calls {\em areEquivalent?(aG0,aG1,true,25)}. + ++ Note: the choice of 25 was rather arbitrary. + areEquivalent? : (L M R, L M R, I) -> M R + ++ areEquivalent?(aG0,aG1,numberOfTries) calls + ++ {\em areEquivalent?(aG0,aG1,true,25)}. + ++ Note: the choice of 25 was rather arbitrary. + isAbsolutelyIrreducible? : (L M R, I) -> B + ++ isAbsolutelyIrreducible?(aG, numberOfTries) uses + ++ Norton's irreducibility test to check for absolute + ++ irreduciblity, assuming if a one-dimensional kernel is found. + ++ As no field extension changes create "new" elements + ++ in a one-dimensional space, the criterium stays true + ++ for every extension. The method looks for one-dimensionals only + ++ by creating random elements (no fingerprints) since + ++ a run of {\em meatAxe} would have proved absolute irreducibility + ++ anyway. + isAbsolutelyIrreducible? : L M R -> B + ++ isAbsolutelyIrreducible?(aG) calls + ++ {\em isAbsolutelyIrreducible?(aG,25)}. + ++ Note: the choice of 25 was rather arbitrary. + split : (L M R, V R) -> L L M R + ++ split(aG, vector) returns a subalgebra \spad{A} of all + ++ square matrix of dimension n as a list of list of matrices, + ++ generated by the list of matrices aG, where n denotes both + ++ the size of vector as well as the dimension of each of the + ++ square matrices. + ++ {\em V R} is an A-module in the natural way. + ++ split(aG, vector) then checks whether the cyclic submodule + ++ generated by {\em vector} is a proper submodule of {\em V R}. + ++ If successful, it returns a two-element list, which contains + ++ first the list of the representations of the submodule, + ++ then the list of the representations of the factor module. + ++ If the vector generates the whole module, a one-element list + ++ of the old representation is given. + ++ Note: a later version this should call the other split. + split: (L M R, V V R) -> L L M R + ++ split(aG,submodule) uses a proper submodule of {\em R**n} + ++ to create the representations of the submodule and of + ++ the factor module. + if (R has Finite) and (R has Field) then + meatAxe : (L M R, B, I, I) -> L L M R + ++ meatAxe(aG,randomElements,numberOfTries, maxTests) returns + ++ a 2-list of representations as follows. + ++ All matrices of argument aG are assumed to be square + ++ and of equal size. + ++ Then \spad{aG} generates a subalgebra, say \spad{A}, of the algebra + ++ of all square matrices of dimension n. {\em V R} is an A-module + ++ in the usual way. + ++ meatAxe(aG,numberOfTries, maxTests) creates at most + ++ {\em numberOfTries} random elements of the algebra, tests + ++ them for singularity. If singular, it tries at most {\em maxTests} + ++ elements of its kernel to generate a proper submodule. + ++ If successful, a 2-list is returned: first, a list + ++ containing first the list of the + ++ representations of the submodule, then a list of the + ++ representations of the factor module. + ++ Otherwise, if we know that all the kernel is already + ++ scanned, Norton's irreducibility test can be used either + ++ to prove irreducibility or to find the splitting. + ++ If {\em randomElements} is {\em false}, the first 6 tries + ++ use Parker's fingerprints. + meatAxe : L M R -> L L M R + ++ meatAxe(aG) calls {\em meatAxe(aG,false,25,7)} returns + ++ a 2-list of representations as follows. + ++ All matrices of argument \spad{aG} are assumed to be square + ++ and of + ++ equal size. Then \spad{aG} generates a subalgebra, + ++ say \spad{A}, of the algebra + ++ of all square matrices of dimension n. {\em V R} is an A-module + ++ in the usual way. + ++ meatAxe(aG) creates at most 25 random elements + ++ of the algebra, tests + ++ them for singularity. If singular, it tries at most 7 + ++ elements of its kernel to generate a proper submodule. + ++ If successful a list which contains first the list of the + ++ representations of the submodule, then a list of the + ++ representations of the factor module is returned. + ++ Otherwise, if we know that all the kernel is already + ++ scanned, Norton's irreducibility test can be used either + ++ to prove irreducibility or to find the splitting. + ++ Notes: the first 6 tries use Parker's fingerprints. + ++ Also, 7 covers the case of three-dimensional kernels over + ++ the field with 2 elements. + meatAxe: (L M R, B) -> L L M R + ++ meatAxe(aG, randomElements) calls {\em meatAxe(aG,false,6,7)}, + ++ only using Parker's fingerprints, if {\em randomElemnts} is false. + ++ If it is true, it calls {\em meatAxe(aG,true,25,7)}, + ++ only using random elements. + ++ Note: the choice of 25 was rather arbitrary. + ++ Also, 7 covers the case of three-dimensional kernels over the field + ++ with 2 elements. + meatAxe : (L M R, PI) -> L L M R + ++ meatAxe(aG, numberOfTries) calls + ++ {\em meatAxe(aG,true,numberOfTries,7)}. + ++ Notes: 7 covers the case of three-dimensional + ++ kernels over the field with 2 elements. + scanOneDimSubspaces: (L V R, I) -> V R + ++ scanOneDimSubspaces(basis,n) gives a canonical representative + ++ of the {\em n}-th one-dimensional subspace of the vector space + ++ generated by the elements of {\em basis}, all from {\em R**n}. + ++ The coefficients of the representative are of shape + ++ {\em (0,...,0,1,*,...,*)}, {\em *} in R. If the size of R + ++ is q, then there are {\em (q**n-1)/(q-1)} of them. + ++ We first reduce n modulo this number, then find the + ++ largest i such that {\em +/[q**i for i in 0..i-1] <= n}. + ++ Subtracting this sum of powers from n results in an + ++ i-digit number to basis q. This fills the positions of the + ++ stars. + -- would prefer to have (V V R,.... but nullSpace results + -- in L V R + + private ==> add + + -- import of domain and packages + import OutputForm + + -- declarations and definitions of local variables and + -- local function + + blockMultiply: (M R, M R, L I, I) -> M R + -- blockMultiply(a,b,li,n) assumes that a has n columns + -- and b has n rows, li is a sublist of the rows of a and + -- a sublist of the columns of b. The result is the + -- multiplication of the (li x n) part of a with the + -- (n x li) part of b. We need this, because just matrix + -- multiplying the parts would require extra storage. + blockMultiply(a, b, li, n) == + matrix([[ +/[a(i,s) * b(s,j) for s in 1..n ] _ + for j in li ] for i in li]) + + fingerPrint: (NNI, M R, M R, M R) -> M R + -- is local, because one should know all the results for smaller i + fingerPrint (i : NNI, a : M R, b : M R, x :M R) == + -- i > 2 only gives the correct result if the value of x from + -- the parameter list equals the result of fingerprint(i-1,...) + (i::PI) = 1 => x := a + b + a*b + (i::PI) = 2 => x := (x + a*b)*b + (i::PI) = 3 => x := a + b*x + (i::PI) = 4 => x := x + b + (i::PI) = 5 => x := x + a*b + (i::PI) = 6 => x := x - a + b*a + error "Sorry, but there are only 6 fingerprints!" + x + + + -- definition of exported functions + + + --randomWord(lli,lm) == + -- -- we assume that all matrices are square of same size + -- numberOfMatrices := #lm + -- +/[*/[lm.(1+i rem numberOfMatrices) for i in li ] for li in lli] + + completeEchelonBasis(basis) == + + dimensionOfSubmodule : NNI := #basis + n : NNI := # basis.1 + indexOfVectorToBeScanned : NNI := 1 + row : NNI := dimensionOfSubmodule + + completedBasis : M R := zero(n, n) + for i in 1..dimensionOfSubmodule repeat + completedBasis := setRow_!(completedBasis, i, basis.i) + if #basis <= n then + newStart : NNI := 1 + for j in 1..n + while indexOfVectorToBeScanned <= dimensionOfSubmodule repeat + if basis.indexOfVectorToBeScanned.j = 0 then + completedBasis(1+row,j) := 1 --put unit vector into basis + row := row + 1 + else + indexOfVectorToBeScanned := indexOfVectorToBeScanned + 1 + newStart : NNI := j + 1 + for j in newStart..n repeat + completedBasis(j,j) := 1 --put unit vector into basis + completedBasis + + + createRandomElement(aG,algElt) == + numberOfGenerators : NNI := #aG + -- randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + algElt := algElt * aG.randomIndex + -- randomIndxElement := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + algElt + aG.randomIndex + + + if R has EuclideanDomain then + cyclicSubmodule (lm : L M R, v : V R) == + basis : M R := rowEchelon matrix list entries v + -- normalizing the vector + -- all these elements lie in the submodule generated by v + furtherElts : L V R := [(lm.i*v)::V R for i in 1..maxIndex lm] + --furtherElts has elements of the generated submodule. It will + --will be checked whether they are in the span of the vectors + --computed so far. Of course we stop if we have got the whole + --space. + while (^null furtherElts) and (nrows basis < #v) repeat + w : V R := first furtherElts + nextVector : M R := matrix list entries w -- normalizing the vector + -- will the rank change if we add this nextVector + -- to the basis so far computed? + addedToBasis : M R := vertConcat(basis, nextVector) + if rank addedToBasis ^= nrows basis then + basis := rowEchelon addedToBasis -- add vector w to basis + updateFurtherElts : L V R := _ + [(lm.i*w)::V R for i in 1..maxIndex lm] + furtherElts := append (rest furtherElts, updateFurtherElts) + else + -- the vector w lies in the span of matrix, no updating + -- of the basis + furtherElts := rest furtherElts + vector [row(basis, i) for i in 1..maxRowIndex basis] + + + standardBasisOfCyclicSubmodule (lm : L M R, v : V R) == + dim : NNI := #v + standardBasis : L L R := list(entries v) + basis : M R := rowEchelon matrix list entries v + -- normalizing the vector + -- all these elements lie in the submodule generated by v + furtherElts : L V R := [(lm.i*v)::V R for i in 1..maxIndex lm] + --furtherElts has elements of the generated submodule. It will + --will be checked whether they are in the span of the vectors + --computed so far. Of course we stop if we have got the whole + --space. + while (^null furtherElts) and (nrows basis < #v) repeat + w : V R := first furtherElts + nextVector : M R := matrix list entries w -- normalizing the vector + -- will the rank change if we add this nextVector + -- to the basis so far computed? + addedToBasis : M R := vertConcat(basis, nextVector) + if rank addedToBasis ^= nrows basis then + standardBasis := cons(entries w, standardBasis) + basis := rowEchelon addedToBasis -- add vector w to basis + updateFurtherElts : L V R := _ + [lm.i*w for i in 1..maxIndex lm] + furtherElts := append (rest furtherElts, updateFurtherElts) + else + -- the vector w lies in the span of matrix, therefore + -- no updating of matrix + furtherElts := rest furtherElts + transpose matrix standardBasis + + + if R has Field then -- only because of inverse in Matrix + + -- as conditional local functions, *internal have to be here + + splitInternal: (L M R, V R, B) -> L L M R + splitInternal(algebraGenerators : L M R, vector: V R,doSplitting? : B) == + + n : I := # vector -- R-rank of representation module = + -- degree of representation + submodule : V V R := cyclicSubmodule (algebraGenerators,vector) + rankOfSubmodule : I := # submodule -- R-Rank of submodule + submoduleRepresentation : L M R := nil() + factormoduleRepresentation : L M R := nil() + if n ^= rankOfSubmodule then + messagePrint " A proper cyclic submodule is found." + if doSplitting? then -- no else !! + submoduleIndices : L I := [i for i in 1..rankOfSubmodule] + factormoduleIndices : L I := [i for i in (1+rankOfSubmodule)..n] + transitionMatrix : M R := _ + transpose completeEchelonBasis submodule + messagePrint " Transition matrix computed" + inverseTransitionMatrix : M R := _ + autoCoerce(inverse transitionMatrix)$Union(M R,"failed") + messagePrint " The inverse of the transition matrix computed" + messagePrint " Now transform the matrices" + for i in 1..maxIndex algebraGenerators repeat + helpMatrix : M R := inverseTransitionMatrix * algebraGenerators.i + -- in order to not create extra space and regarding the fact + -- that we only want the two blocks in the main diagonal we + -- multiply with the aid of the local function blockMultiply + submoduleRepresentation := cons( blockMultiply( _ + helpMatrix,transitionMatrix,submoduleIndices,n), _ + submoduleRepresentation) + factormoduleRepresentation := cons( blockMultiply( _ + helpMatrix,transitionMatrix,factormoduleIndices,n), _ + factormoduleRepresentation) + [reverse submoduleRepresentation, reverse _ + factormoduleRepresentation] + else -- represesentation is irreducible + messagePrint " The generated cyclic submodule was not proper" + [algebraGenerators] + + + + irreducibilityTestInternal: (L M R, M R, B) -> L L M R + irreducibilityTestInternal(algebraGenerators,_ + singularMatrix,split?) == + algebraGeneratorsTranspose : L M R := [transpose _ + algebraGenerators.j for j in 1..maxIndex algebraGenerators] + xt : M R := transpose singularMatrix + messagePrint " We know that all the cyclic submodules generated by all" + messagePrint " non-trivial element of the singular matrix under view are" + messagePrint " not proper, hence Norton's irreducibility test can be done:" + -- actually we only would need one (!) non-trivial element from + -- the kernel of xt, such an element must exist as the transpose + -- of a singular matrix is of course singular. Question: Can + -- we get it more easily from the kernel of x = singularMatrix? + kernel : L V R := nullSpace xt + result : L L M R := _ + splitInternal(algebraGeneratorsTranspose,first kernel,split?) + if null rest result then -- this means first kernel generates + -- the whole module + if 1 = #kernel then + messagePrint " Representation is absolutely irreducible" + else + messagePrint " Representation is irreducible, but we don't know " + messagePrint " whether it is absolutely irreducible" + else + if split? then + messagePrint " Representation is not irreducible and it will be split:" + -- these are the dual representations, so calculate the + -- dual to get the desired result, i.e. "transpose inverse" + -- improvements?? + for i in 1..maxIndex result repeat + for j in 1..maxIndex (result.i) repeat + mat : M R := result.i.j + result.i.j := _ + transpose autoCoerce(inverse mat)$Union(M R,"failed") + else + messagePrint " Representation is not irreducible, use meatAxe to split" + -- if "split?" then dual representation interchange factor + -- and submodules, hence reverse + reverse result + + + + -- exported functions for FiniteField-s. + + + areEquivalent? (aG0, aG1) == + areEquivalent? (aG0, aG1, true, 25) + + + areEquivalent? (aG0, aG1, numberOfTries) == + areEquivalent? (aG0, aG1, true, numberOfTries) + + + areEquivalent? (aG0, aG1, randomelements, numberOfTries) == + result : B := false + transitionM : M R := zero(1, 1) + numberOfGenerators : NNI := #aG0 + -- need a start value for creating random matrices: + -- if we switch to randomelements later, we take the last + -- fingerprint. + if randomelements then -- random should not be from I + --randomIndex : I := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x0 : M R := aG0.randomIndex + x1 : M R := aG1.randomIndex + n : NNI := #row(x0,1) -- degree of representation + foundResult : B := false + for i in 1..numberOfTries until foundResult repeat + -- try to create a non-singular element of the algebra + -- generated by "aG". If only two generators, + -- i < 7 and not "randomelements" use Parker's fingerprints + -- i >= 7 create random elements recursively: + -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly + -- chosen elements form "aG". + if i = 7 then randomelements := true + if randomelements then + --randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x0 := x0 * aG0.randomIndex + x1 := x1 * aG1.randomIndex + --randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x0 := x0 + aG0.randomIndex + x1 := x1 + aG1.randomIndex + else + x0 := fingerPrint (i, aG0.0, aG0.1 ,x0) + x1 := fingerPrint (i, aG1.0, aG1.1 ,x1) + -- test singularity of x0 and x1 + rk0 : NNI := rank x0 + rk1 : NNI := rank x1 + rk0 ^= rk1 => + messagePrint "Dimensions of kernels differ" + foundResult := true + result := false + -- can assume dimensions are equal + rk0 ^= n - 1 => + -- not of any use here if kernel not one-dimensional + if randomelements then + messagePrint "Random element in generated algebra does" + messagePrint " not have a one-dimensional kernel" + else + messagePrint "Fingerprint element in generated algebra does" + messagePrint " not have a one-dimensional kernel" + -- can assume dimensions are equal and equal to n-1 + if randomelements then + messagePrint "Random element in generated algebra has" + messagePrint " one-dimensional kernel" + else + messagePrint "Fingerprint element in generated algebra has" + messagePrint " one-dimensional kernel" + kernel0 : L V R := nullSpace x0 + kernel1 : L V R := nullSpace x1 + baseChange0 : M R := standardBasisOfCyclicSubmodule(_ + aG0,kernel0.1) + baseChange1 : M R := standardBasisOfCyclicSubmodule(_ + aG1,kernel1.1) + (ncols baseChange0) ^= (ncols baseChange1) => + messagePrint " Dimensions of generated cyclic submodules differ" + foundResult := true + result := false + -- can assume that dimensions of cyclic submodules are equal + (ncols baseChange0) = n => -- full dimension + transitionM := baseChange0 * _ + autoCoerce(inverse baseChange1)$Union(M R,"failed") + foundResult := true + result := true + for j in 1..numberOfGenerators while result repeat + if (aG0.j*transitionM) ^= (transitionM*aG1.j) then + result := false + transitionM := zero(1 ,1) + messagePrint " There is no isomorphism, as the only possible one" + messagePrint " fails to do the necessary base change" + -- can assume that dimensions of cyclic submodules are not "n" + messagePrint " Generated cyclic submodules have equal, but not full" + messagePrint " dimension, hence we can not draw any conclusion" + -- here ends the for-loop + if not foundResult then + messagePrint " " + messagePrint "Can neither prove equivalence nor inequivalence." + messagePrint " Try again." + else + if result then + messagePrint " " + messagePrint "Representations are equivalent." + else + messagePrint " " + messagePrint "Representations are not equivalent." + transitionM + + + isAbsolutelyIrreducible?(aG) == isAbsolutelyIrreducible?(aG,25) + + + isAbsolutelyIrreducible?(aG, numberOfTries) == + result : B := false + numberOfGenerators : NNI := #aG + -- need a start value for creating random matrices: + -- randomIndex : I := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x : M R := aG.randomIndex + n : NNI := #row(x,1) -- degree of representation + foundResult : B := false + for i in 1..numberOfTries until foundResult repeat + -- try to create a non-singular element of the algebra + -- generated by "aG", dimension of its kernel being 1. + -- create random elements recursively: + -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly + -- chosen elements form "aG". + -- randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x := x * aG.randomIndex + --randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x := x + aG.randomIndex + -- test whether rank of x is n-1 + rk : NNI := rank x + if rk = n - 1 then + foundResult := true + messagePrint "Random element in generated algebra has" + messagePrint " one-dimensional kernel" + kernel : L V R := nullSpace x + if n=#cyclicSubmodule(aG, first kernel) then + result := (irreducibilityTestInternal(aG,x,false)).1 ^= nil()$(L M R) + -- result := not null? first irreducibilityTestInternal(aG,x,false) -- this down't compile !! + else -- we found a proper submodule + result := false + --split(aG,kernel.1) -- to get the splitting + else -- not of any use here if kernel not one-dimensional + messagePrint "Random element in generated algebra does" + messagePrint " not have a one-dimensional kernel" + -- here ends the for-loop + if not foundResult then + messagePrint "We have not found a one-dimensional kernel so far," + messagePrint " as we do a random search you could try again" + --else + -- if not result then + -- messagePrint "Representation is not irreducible." + -- else + -- messagePrint "Representation is irreducible." + result + + + + split(algebraGenerators: L M R, vector: V R) == + splitInternal(algebraGenerators, vector, true) + + + split(algebraGenerators : L M R, submodule: V V R) == --not zero submodule + n : NNI := #submodule.1 -- R-rank of representation module = + -- degree of representation + rankOfSubmodule : I := (#submodule) :: I --R-Rank of submodule + submoduleRepresentation : L M R := nil() + factormoduleRepresentation : L M R := nil() + submoduleIndices : L I := [i for i in 1..rankOfSubmodule] + factormoduleIndices : L I := [i for i in (1+rankOfSubmodule)..(n::I)] + transitionMatrix : M R := _ + transpose completeEchelonBasis submodule + messagePrint " Transition matrix computed" + inverseTransitionMatrix : M R := + autoCoerce(inverse transitionMatrix)$Union(M R,"failed") + messagePrint " The inverse of the transition matrix computed" + messagePrint " Now transform the matrices" + for i in 1..maxIndex algebraGenerators repeat + helpMatrix : M R := inverseTransitionMatrix * algebraGenerators.i + -- in order to not create extra space and regarding the fact + -- that we only want the two blocks in the main diagonal we + -- multiply with the aid of the local function blockMultiply + submoduleRepresentation := cons( blockMultiply( _ + helpMatrix,transitionMatrix,submoduleIndices,n), _ + submoduleRepresentation) + factormoduleRepresentation := cons( blockMultiply( _ + helpMatrix,transitionMatrix,factormoduleIndices,n), _ + factormoduleRepresentation) + 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". + + + -- we are scanning through the vectorspaces + if (R has Finite) and (R has Field) then + + meatAxe(algebraGenerators, randomelements, numberOfTries, _ + maxTests) == + numberOfGenerators : NNI := #algebraGenerators + result : L L M R := nil()$(L L M R) + q : PI := size()$R:PI + -- need a start value for creating random matrices: + -- if we switch to randomelements later, we take the last + -- fingerprint. + if randomelements then -- random should not be from I + --randomIndex : I := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x : M R := algebraGenerators.randomIndex + foundResult : B := false + for i in 1..numberOfTries until foundResult repeat + -- try to create a non-singular element of the algebra + -- generated by "algebraGenerators". If only two generators, + -- i < 7 and not "randomelements" use Parker's fingerprints + -- i >= 7 create random elements recursively: + -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly + -- chosen elements form "algebraGenerators". + if i = 7 then randomelements := true + if randomelements then + --randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x := x * algebraGenerators.randomIndex + --randomIndex := randnum numberOfGenerators + randomIndex := 1+(random()$Integer rem numberOfGenerators) + x := x + algebraGenerators.randomIndex + else + x := fingerPrint (i, algebraGenerators.1,_ + algebraGenerators.2 , x) + -- test singularity of x + n : NNI := #row(x, 1) -- degree of representation + if (rank x) ^= n then -- x singular + if randomelements then + messagePrint "Random element in generated algebra is singular" + else + messagePrint "Fingerprint element in generated algebra is singular" + kernel : L V R := nullSpace x + -- the first number is the maximal number of one dimensional + -- subspaces of the kernel, the second is a user given + -- constant + numberOfOneDimSubspacesInKernel : I := (q**(#kernel)-1)quo(q-1) + numberOfTests : I := _ + min(numberOfOneDimSubspacesInKernel, maxTests) + for j in 1..numberOfTests repeat + --we create an element in the kernel, there is a good + --probability for it to generate a proper submodule, the + --called "split" does the further work: + result := _ + split(algebraGenerators,scanOneDimSubspaces(kernel,j)) + -- we had "not null rest result" directly in the following + -- if .. then, but the statment there foundResult := true + -- didn't work properly + foundResult := not null rest result + if foundResult then + leave -- inner for-loop + -- finish here with result + else -- no proper submodule + -- we were not successfull, i.e gen. submodule was + -- not proper, if the whole kernel is already scanned, + -- Norton's irreducibility test is used now. + if (j+1)>numberOfOneDimSubspacesInKernel then + -- we know that all the cyclic submodules generated + -- by all non-trivial elements of the kernel are proper. + foundResult := true + result : L L M R := irreducibilityTestInternal (_ + algebraGenerators,x,true) + leave -- inner for-loop + -- here ends the inner for-loop + else -- x non-singular + if randomelements then + messagePrint "Random element in generated algebra is non-singular" + else + messagePrint "Fingerprint element in generated algebra is non-singular" + -- here ends the outer for-loop + if not foundResult then + result : L L M R := [nil()$(L M R), nil()$(L M R)] + messagePrint " " + messagePrint "Sorry, no result, try meatAxe(...,true)" + messagePrint " or consider using an extension field." + result + + + meatAxe (algebraGenerators) == + meatAxe(algebraGenerators, false, 25, 7) + + + meatAxe (algebraGenerators, randomElements?) == + randomElements? => meatAxe (algebraGenerators, true, 25, 7) + meatAxe(algebraGenerators, false, 6, 7) + + + meatAxe (algebraGenerators:L M R, numberOfTries:PI) == + meatAxe (algebraGenerators, true, numberOfTries, 7) + + + + scanOneDimSubspaces(basis,n) == + -- "dimension" of subspace generated by "basis" + dim : NNI := #basis + -- "dimension of the whole space: + nn : NNI := #(basis.1) + q : NNI := size()$R + -- number of all one-dimensional subspaces: + nred : I := n rem ((q**dim -1) quo (q-1)) + pos : I := nred + i : I := 0 + for i in 0..dim-1 while nred >= 0 repeat + pos := nred + nred := nred - (q**i) + i := if i = 0 then 0 else i-1 + coefficients : V R := new(dim,0$R) + coefficients.(dim-i) := 1$R + iR : L I := wholeRagits(pos::RADIX q) + for j in 1..(maxIndex iR) repeat + coefficients.(dim-((#iR)::I) +j) := index((iR.j+(q::I))::PI)$R + result : V R := new(nn,0) + for i in 1..maxIndex coefficients repeat + newAdd : V R := coefficients.i * basis.i + for j in 1..nn repeat + result.j := result.j + newAdd.j + result + +@ +<>= +"REP2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=REP2"] +"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"] +"REP2" -> "IVECTOR" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package RETSOL RetractSolvePackage} \pagehead{RetractSolvePackage}{RETSOL} \pagepic{ps/v104retractsolvepackage.ps}{RETSOL}{1.00} @@ -72059,6 +77895,415 @@ TranscendentalManipulations(R, F): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RDETR TranscendentalRischDE} +\pagehead{TranscendentalRischDE}{RDETR} +\pagepic{ps/v104transcendentalrischde.ps}{RDETR}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RDETR TranscendentalRischDE +++ Risch differential equation, transcendental case. +++ Author: Manuel Bronstein +++ Date Created: Jan 1988 +++ Date Last Updated: 2 November 1995 +TranscendentalRischDE(F, UP): Exports == Implementation where + F : Join(Field, CharacteristicZero, RetractableTo Integer) + UP : UnivariatePolynomialCategory F + + N ==> NonNegativeInteger + Z ==> Integer + RF ==> Fraction UP + REC ==> Record(a:UP, b:UP, c:UP, t:UP) + SPE ==> Record(b:UP, c:UP, m:Z, alpha:UP, beta:UP) + PSOL==> Record(ans:UP, nosol:Boolean) + ANS ==> Union(ans:PSOL, eq:SPE) + PSQ ==> Record(ans:RF, nosol:Boolean) + + Exports ==> with + monomRDE: (RF,RF,UP->UP) -> Union(Record(a:UP,b:RF,c:RF,t:UP), "failed") + ++ monomRDE(f,g,D) returns \spad{[A, B, C, T]} such that + ++ \spad{y' + f y = g} has a solution if and only if \spad{y = Q / T}, + ++ where Q satisfies \spad{A Q' + B Q = C} and has no normal pole. + ++ A and T are polynomials and B and C have no normal poles. + ++ D is the derivation to use. + baseRDE : (RF, RF) -> PSQ + ++ baseRDE(f, g) returns a \spad{[y, b]} such that \spad{y' + fy = g} + ++ if \spad{b = true}, y is a partial solution otherwise (no solution + ++ in that case). + ++ D is the derivation to use. + polyRDE : (UP, UP, UP, Z, UP -> UP) -> ANS + ++ polyRDE(a, B, C, n, D) returns either: + ++ 1. \spad{[Q, b]} such that \spad{degree(Q) <= n} and + ++ \spad{a Q'+ B Q = C} if \spad{b = true}, Q is a partial solution + ++ otherwise. + ++ 2. \spad{[B1, C1, m, \alpha, \beta]} such that any polynomial solution + ++ of degree at most n of \spad{A Q' + BQ = C} must be of the form + ++ \spad{Q = \alpha H + \beta} where \spad{degree(H) <= m} and + ++ H satisfies \spad{H' + B1 H = C1}. + ++ D is the derivation to use. + + Implementation ==> add + 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(aa, bb, cc, d, derivation) == + n:Z + (u := SPDE(aa, bb, cc, d, derivation)) case "failed" => [[0, true]] + zero?(u.c) => [[u.beta, false]] +-- baseCase? := one?(dt := derivation monomial(1, 1)) + baseCase? := ((dt := derivation monomial(1, 1)) = 1) + n := degree(dt)::Z - 1 + b0? := zero?(u.b) + (~b0?) and (baseCase? or degree(u.b) > max(0, n)) => + answ := SPDEnocancel1(u.b, u.c, u.m, derivation) + [[u.alpha * answ.ans + u.beta, answ.nosol]] + (n > 0) and (b0? or degree(u.b) < n) => + uansw := SPDEnocancel2(u.b,u.c,u.m,n,leadingCoefficient dt,derivation) + uansw case ans=> [[u.alpha * uansw.ans.ans + u.beta, uansw.ans.nosol]] + [[uansw.eq.b, uansw.eq.c, uansw.eq.m, + u.alpha * uansw.eq.alpha, u.alpha * uansw.eq.beta + u.beta]] + b0? and baseCase? => + degree(u.c) >= u.m => [[0, true]] + [[u.alpha * integrate(u.c) + u.beta, false]] + [u::SPE] + +-- cancellation at infinity is possible, A is assumed nonzero +-- if u.b = 0 then u.a = 1 already, but no degree check is done +-- returns "failed" if a p' + b p = c has no soln of degree at most d, +-- 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(aa, bb, cc, d, derivation) == + zero? cc => [0, 0, 0, 0, 0] + d < 0 => "failed" + (u := cc exquo (g := gcd(aa, bb))) case "failed" => "failed" + aa := (aa exquo g)::UP + bb := (bb exquo g)::UP + cc := u::UP + (ra := retractIfCan(aa)@Union(F, "failed")) case F => + a1 := inv(ra::F) + [a1 * bb, a1 * cc, d, 1, 0] + bc := extendedEuclidean(bb, aa, cc)::Record(coef1:UP, coef2:UP) + qr := divide(bc.coef1, aa) + r := qr.remainder -- z = bc.coef2 + b * qr.quotient + (v := SPDE(aa, bb + derivation aa, + bc.coef2 + bb * qr.quotient - derivation r, + d - degree(aa)::Z, derivation)) case "failed" => "failed" + [v.b, v.c, v.m, aa * v.alpha, aa * v.beta + r] + +-- solves q' + b q = c with deg(q) <= d +-- case (B <> 0) and (D = d/dt or degree(B) > max(0, degree(Dt) - 1)) +-- 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(bb, cc, d, derivation) == + q:UP := 0 + db := (degree bb)::Z + lb := leadingCoefficient bb + while cc ^= 0 repeat + d < 0 or (n := (degree cc)::Z - db) < 0 or n > d => return [q, true] + r := monomial((leadingCoefficient cc) / lb, n::N) + cc := cc - bb * r - derivation r + d := n - 1 + q := q + r + [q, false] + +-- 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(bb, cc, d, dtm1, lt, derivation) == + q:UP := 0 + while cc ^= 0 repeat + d < 0 or (n := (degree cc)::Z - dtm1) < 0 or n > d => return [[q, true]] + if n > 0 then + r := monomial((leadingCoefficient cc) / (n * lt), n::N) + cc := cc - bb * r - derivation r + d := n - 1 + q := q + r + else -- n = 0 so solution must have degree 0 + db:N := (zero? bb => 0; degree bb); + db ^= degree(cc) => return [[q, true]] + zero? db => return [[bb, cc, 0, 1, q]] + r := leadingCoefficient(cc) / leadingCoefficient(bb) + cc := cc - r * bb - derivation(r::UP) + d := - 1 + q := q + r::UP + [[q, false]] + + 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 + (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed" + [aa, aa * f - (d * derivation tt)::RF, u::UP * e * g, tt] + +-- solve y' + f y = g for y in RF +-- assumes that f is weakly normalized (no finite cancellation) +-- base case: F' = 0 + 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) + v := polyRDE(u.a, bb, cc, n, differentiate).ans + [v.ans / u.t, v.nosol] + +-- 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(a, b, dc) == + da := (degree a)::Z + zero? b => max(0, dc - da + 1) + db := (degree b)::Z + da > (db + 1) => max(0, dc - da + 1) + da < (db + 1) => dc - db + (n := retractIfCan(- leadingCoefficient(b) / leadingCoefficient(a) + )@Union(Z, "failed")) case Z => max(n::Z, dc - db) + dc - db + +@ +<>= +"RDETR" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDETR"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"RDETR" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RDETRS TranscendentalRischDESystem} +\pagehead{TranscendentalRischDESystem}{RDETRS} +\pagepic{ps/v104transcendentalrischdesystem.ps}{RDETRS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RDETRS TranscendentalRischDESystem +++ Risch differential equation system, transcendental case. +++ Author: Manuel Bronstein +++ Date Created: 17 August 1992 +++ Date Last Updated: 3 February 1994 +TranscendentalRischDESystem(F, UP): Exports == Implementation where + F : Join(Field, CharacteristicZero, RetractableTo Integer) + UP : UnivariatePolynomialCategory F + + N ==> NonNegativeInteger + Z ==> Integer + RF ==> Fraction UP + V ==> Vector UP + U ==> Union(List UP, "failed") + REC ==> Record(z1:UP, z2:UP, r1:UP, r2:UP) + + Exports ==> with + monomRDEsys: (RF, RF, RF, UP -> UP) -> _ + Union(Record(a:UP, b:RF, h:UP, c1:RF, c2:RF, t:UP),"failed") + ++ monomRDEsys(f,g1,g2,D) returns \spad{[A, B, H, C1, C2, T]} such that + ++ \spad{(y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2)} has a solution + ++ if and only if \spad{y1 = Q1 / T, y2 = Q2 / T}, + ++ where \spad{B,C1,C2,Q1,Q2} have no normal poles and satisfy + ++ A \spad{(Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2)} + ++ D is the derivation to use. + baseRDEsys: (RF, RF, RF) -> Union(List RF, "failed") + ++ baseRDEsys(f, g1, g2) returns fractions \spad{y_1.y_2} such that + ++ \spad{(y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2)} + ++ if \spad{y_1,y_2} exist, "failed" otherwise. + + Implementation ==> add + 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(f, g1, g2, derivation) == + gg := gcd(d := normalDenom(f, derivation), + e := lcm(normalDenom(g1,derivation),normalDenom(g2,derivation))) + tt := (gcd(e, differentiate e) exquo gcd(gg,differentiate gg))::UP + (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed" + [aa, tt * d * f, - d * derivation tt, u::UP * e * g1, u::UP * e * g2, tt] + +-- 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(f, g1, g2) == + zero? f => error "baseRDEsys: f must be nonzero" + zero? g1 and zero? g2 => [0, 0] + (u := monomRDEsys(f, g1, g2, differentiate)) case "failed" => "failed" + n := getBound(u.a, bb := retract(u.b), u.h, + cc1 := retract(u.c1), cc2 := retract(u.c2)) + (v := SPDEsys(u.a, bb, u.h, cc1, cc2, n, differentiate, + DSPDEsys(#1, #2::UP, #3::UP, #4, #5, #6, differentiate))) + case "failed" => "failed" + l := v::List(UP) + [first(l) / u.t, second(l) / u.t] + +-- solve +-- D1 = A Z1 + B R1 - C R2 +-- D2 = A Z2 + C R1 + B R2 +-- 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(a, b, c, d1, d2) == + (u := diophantineSystem(matrix [[a,0,b,-c], [0,a,c,b]], + vector [d1,d2]).particular) case "failed" => "failed" + v := u::V + qr1 := divide(v 3, a) + qr2 := divide(v 4, a) + [v.1 + b * qr1.quotient - c * qr2.quotient, + v.2 + c * qr1.quotient + b * qr2.quotient, qr1.remainder, qr2.remainder] + +-- solve +-- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2) +-- for polynomials Q1 and Q2 with degree <= n +-- A and B are nonzero +-- cancellation at infinity is possible + SPDEsys(a, b, h, c1, c2, n, derivation, degradation) == + zero? c1 and zero? c2 => [0, 0] + n < 0 => "failed" + g := gcd(a, gcd(b, h)) + ((u1 := c1 exquo g) case "failed") or + ((u2 := c2 exquo g) case "failed") => "failed" + a := (a exquo g)::UP + b := (b exquo g)::UP + h := (h exquo g)::UP + c1 := u1::UP + c2 := u2::UP + (da := degree a) > 0 => + (u := diophant(a, h, b, c1, c2)) case "failed" => "failed" + rec := u::REC + v := SPDEsys(a, b, h + derivation a, rec.z1 - derivation(rec.r1), + rec.z2 - derivation(rec.r2),n-da::Z,derivation,degradation) + v case "failed" => "failed" + l := v::List(UP) + [a * first(l) + rec.r1, a * second(l) + rec.r2] + ra := retract(a)@F + ((rb := retractIfCan(b)@Union(F, "failed")) case "failed") or + ((rh := retractIfCan(h)@Union(F, "failed")) case "failed") => + DSPDEsys(ra, b, h, c1, c2, n, derivation) + degradation(ra, rb::F, rh::F, c1, c2, n) + +-- solve +-- a (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2) +-- 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(a, b, h, c1, c2, n, derivation) == + bb := degree(b)::Z + hh:Z := + zero? h => 0 + degree(h)::Z + lb := leadingCoefficient b + lh := leadingCoefficient h + bb < hh => + DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,DSPDEhdom(#1,#2,#3,#4,#5,hh)) + bb > hh => + DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,DSPDEbdom(#1,#2,#3,#4,#5,bb)) + det := lb * lb + lh * lh + DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,DSPDEmix(#1,#2,#3,#4,#5,bb,det)) + + DSPDEsys0(a, b, h, c1, c2, lb, lh, n, derivation, getlc) == + ans1 := ans2 := 0::UP + repeat + zero? c1 and zero? c2 => return [ans1, ans2] + n < 0 or (u := getlc(c1,c2,lb,lh,n::N)) case "failed" => return "failed" + lq := u::List(UP) + q1 := first lq + q2 := second lq + c1 := c1 - a * derivation(q1) - h * q1 + b * q2 + c2 := c2 - a * derivation(q2) - b * q1 - h * q2 + n := n - 1 + ans1 := ans1 + q1 + ans2 := ans2 + q2 + + DSPDEmix(c1, c2, lb, lh, n, d, det) == + rh1:F := + zero? c1 => 0 + (d1 := degree(c1)::Z - d) < n => 0 + d1 > n => return "failed" + leadingCoefficient c1 + rh2:F := + zero? c2 => 0 + (d2 := degree(c2)::Z - d) < n => 0 + d2 > n => return "failed" + leadingCoefficient c2 + q1 := (rh1 * lh + rh2 * lb) / det + q2 := (rh2 * lh - rh1 * lb) / det + [monomial(q1, n), monomial(q2, n)] + + + DSPDEhdom(c1, c2, lb, lh, n, d) == + q1:UP := + zero? c1 => 0 + (d1 := degree(c1)::Z - d) < n => 0 + d1 > n => return "failed" + monomial(leadingCoefficient(c1) / lh, n) + q2:UP := + zero? c2 => 0 + (d2 := degree(c2)::Z - d) < n => 0 + d2 > n => return "failed" + monomial(leadingCoefficient(c2) / lh, n) + [q1, q2] + + DSPDEbdom(c1, c2, lb, lh, n, d) == + q1:UP := + zero? c2 => 0 + (d2 := degree(c2)::Z - d) < n => 0 + d2 > n => return "failed" + monomial(leadingCoefficient(c2) / lb, n) + q2:UP := + zero? c1 => 0 + (d1 := degree(c1)::Z - d) < n => 0 + d1 > n => return "failed" + monomial(- leadingCoefficient(c1) / lb, n) + [q1, q2] + +-- return a common bound on the degrees of a solution of +-- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2), Q1 = y1 T, Q2 = y2 T +-- cancellation at infinity is possible +-- a and b are nonzero +-- base case: F' = 0 + getBound(a, b, h, c1, c2) == + da := (degree a)::Z + dc := + zero? c1 => degree(c2)::Z + zero? c2 => degree(c1)::Z + max(degree c1, degree c2)::Z + hh:Z := + zero? h => 0 + degree(h)::Z + db := max(hh, bb := degree(b)::Z) + da < db + 1 => dc - db + da > db + 1 => max(0, dc - da + 1) + bb >= hh => dc - db + (n := retractIfCan(leadingCoefficient(h) / leadingCoefficient(a) + )@Union(Z, "failed")) case Z => max(n::Z, dc - db) + dc - db + +@ +<>= +"RDETRS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDETRS"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"RDETRS" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package TRIMAT TriangularMatrixOperations} \pagehead{TriangularMatrixOperations}{TRIMAT} \pagepic{ps/v104triangularmatrixoperations.ps}{TRIMAT}{1.00} @@ -73598,6 +79843,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> @@ -73658,6 +79904,8 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> +<> <> <> <> @@ -73761,11 +80009,13 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> <> <> +<> <> <> <> @@ -73773,6 +80023,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> @@ -73910,6 +80161,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> @@ -73927,6 +80179,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> @@ -73934,21 +80187,42 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> +<> +<> <> +<> +<> +<> +<> +<> +<> +<> +<> <> <> <> <> <> +<> <> +<> +<> +<> <> +<> +<> <> +<> <> <> <> +<> +<> <> <> +<> +<> <> <> @@ -73976,6 +80250,8 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> +<> <> <> <> diff --git a/books/ps/v104applyrules.ps b/books/ps/v104applyrules.ps new file mode 100644 index 0000000..915a059 --- /dev/null +++ b/books/ps/v104applyrules.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% APPRULE +gsave +[ /Rect [ 0 72 78 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=APPRULE) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 78 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +78 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 78 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +78 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 62 (APPRULE) alignedtext +grestore +% FS +gsave +[ /Rect [ 12 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +12 36 lineto +12 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +12 36 lineto +12 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +31.5 13.9 moveto 15 (FS) alignedtext +grestore +% APPRULE->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 152 +end +restore +%%EOF diff --git a/books/ps/v104elementaryrischde.ps b/books/ps/v104elementaryrischde.ps new file mode 100644 index 0000000..eb250de --- /dev/null +++ b/books/ps/v104elementaryrischde.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 170 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 134 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RDEEF +gsave +[ /Rect [ 33 72 93 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RDEEF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 93 108 moveto +33 108 lineto +33 72 lineto +93 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 93 108 moveto +33 108 lineto +33 72 lineto +93 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +41 85.9 moveto 44 (RDEEF) alignedtext +grestore +% ACF +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 27 (ACF) alignedtext +grestore +% RDEEF->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 54 72 moveto +50 64 45 54 40 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath stroke +grestore +% FS +gsave +[ /Rect [ 72 0 126 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +91.5 13.9 moveto 15 (FS) alignedtext +grestore +% RDEEF->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 72 72 moveto +76 64 81 54 86 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 170 152 +end +restore +%%EOF diff --git a/books/ps/v104elementaryrischdesystem.ps b/books/ps/v104elementaryrischdesystem.ps new file mode 100644 index 0000000..bff9c45 --- /dev/null +++ b/books/ps/v104elementaryrischdesystem.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 170 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 134 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RDEEFS +gsave +[ /Rect [ 29 72 97 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RDEEFS) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 97 108 moveto +29 108 lineto +29 72 lineto +97 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 97 108 moveto +29 108 lineto +29 72 lineto +97 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +37 85.9 moveto 52 (RDEEFS) alignedtext +grestore +% ACF +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 27 (ACF) alignedtext +grestore +% RDEEFS->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 54 72 moveto +50 64 45 54 40 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath stroke +grestore +% FS +gsave +[ /Rect [ 72 0 126 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +91.5 13.9 moveto 15 (FS) alignedtext +grestore +% RDEEFS->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 72 72 moveto +76 64 81 54 86 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 170 152 +end +restore +%%EOF diff --git a/books/ps/v104integerbits.ps b/books/ps/v104integerbits.ps new file mode 100644 index 0000000..ee3d772 --- /dev/null +++ b/books/ps/v104integerbits.ps @@ -0,0 +1,276 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INTBIT +gsave +[ /Rect [ 2 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTBIT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10 85.9 moveto 46 (INTBIT) alignedtext +grestore +% Package +gsave +0.939 0.733 1.000 nodecolor +newpath 66 36 moveto +2.13163e-14 36 lineto +0 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 36 moveto +2.13163e-14 36 lineto +0 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 50 (Package) alignedtext +grestore +% INTBIT->Package +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104integerretractions.ps b/books/ps/v104integerretractions.ps new file mode 100644 index 0000000..9160de0 --- /dev/null +++ b/books/ps/v104integerretractions.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 124 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 88 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INTRET +gsave +[ /Rect [ 7 72 73 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTRET) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 73 108 moveto +7 108 lineto +7 72 lineto +73 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 73 108 moveto +7 108 lineto +7 72 lineto +73 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +15 85.9 moveto 50 (INTRET) alignedtext +grestore +% RETRACT +gsave +[ /Rect [ 0 0 80 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=RETRACT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 80 36 moveto +3.02917e-14 36 lineto +9.23914e-15 1.06581e-14 lineto +80 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 80 36 moveto +3.02917e-14 36 lineto +9.23914e-15 1.06581e-14 lineto +80 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 65 (RETRACT) alignedtext +grestore +% INTRET->RETRACT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 40 72 moveto +40 64 40 55 40 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.5001 46 moveto +40 36 lineto +36.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.5001 46 moveto +40 36 lineto +36.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 124 152 +end +restore +%%EOF diff --git a/books/ps/v104integrationtools.ps b/books/ps/v104integrationtools.ps new file mode 100644 index 0000000..fee1e58 --- /dev/null +++ b/books/ps/v104integrationtools.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 128 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 92 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INTTOOLS +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTTOOLS) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.63123e-14 108 lineto +5.2458e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.63123e-14 108 lineto +5.2458e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 69 (INTTOOLS) alignedtext +grestore +% FS +gsave +[ /Rect [ 15 0 69 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 69 36 moveto +15 36 lineto +15 1.06581e-14 lineto +69 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 69 36 moveto +15 36 lineto +15 1.06581e-14 lineto +69 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +34.5 13.9 moveto 15 (FS) alignedtext +grestore +% INTTOOLS->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 42 72 moveto +42 64 42 55 42 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 128 152 +end +restore +%%EOF diff --git a/books/ps/v104polynomialcategoryquotientfunctions.ps b/books/ps/v104polynomialcategoryquotientfunctions.ps new file mode 100644 index 0000000..4f4d569 --- /dev/null +++ b/books/ps/v104polynomialcategoryquotientfunctions.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 132 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 96 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% POLYCATQ +gsave +[ /Rect [ 0 72 88 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=POLYCATQ) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 88 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +88 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 88 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +88 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 72 (POLYCATQ) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 11 0 77 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 77 36 moveto +11 36 lineto +11 1.06581e-14 lineto +77 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 77 36 moveto +11 36 lineto +11 1.06581e-14 lineto +77 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +18.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% POLYCATQ->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 44 72 moveto +44 64 44 55 44 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 132 152 +end +restore +%%EOF diff --git a/books/ps/v104primitiveratricde.ps b/books/ps/v104primitiveratricde.ps new file mode 100644 index 0000000..7dfce8c --- /dev/null +++ b/books/ps/v104primitiveratricde.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 128 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 92 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% ODEPRRIC +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ODEPRRIC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.63123e-14 108 lineto +5.2458e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.63123e-14 108 lineto +5.2458e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 69 (ODEPRRIC) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 9 0 75 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% ODEPRRIC->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 42 72 moveto +42 64 42 55 42 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 128 152 +end +restore +%%EOF diff --git a/books/ps/v104quasialgebraicset2.ps b/books/ps/v104quasialgebraicset2.ps new file mode 100644 index 0000000..5c37194 --- /dev/null +++ b/books/ps/v104quasialgebraicset2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 130 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 94 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% QALGSET2 +gsave +[ /Rect [ 0 72 86 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=QALGSET2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2.7485e-14 108 lineto +6.41154e-15 72 lineto +86 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2.7485e-14 108 lineto +6.41154e-15 72 lineto +86 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 71 (QALGSET2) alignedtext +grestore +% ALIST +gsave +[ /Rect [ 16 0 70 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ALIST) >> + /Subtype /Link +/ANN pdfmark +0.273 0.733 1.000 nodecolor +newpath 70 36 moveto +16 36 lineto +16 1.06581e-14 lineto +70 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 70 36 moveto +16 36 lineto +16 1.06581e-14 lineto +70 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +23.5 13.9 moveto 39 (ALIST) alignedtext +grestore +% QALGSET2->ALIST +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 43 72 moveto +43 64 43 55 43 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 130 152 +end +restore +%%EOF diff --git a/books/ps/v104quasicomponentpackage.ps b/books/ps/v104quasicomponentpackage.ps new file mode 100644 index 0000000..6186c37 --- /dev/null +++ b/books/ps/v104quasicomponentpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 128 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 92 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% QCMPACK +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=QCMPACK) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 68 (QCMPACK) alignedtext +grestore +% RSETCAT +gsave +[ /Rect [ 3 0 81 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=RSETCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 81 36 moveto +3 36 lineto +3 1.06581e-14 lineto +81 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 81 36 moveto +3 36 lineto +3 1.06581e-14 lineto +81 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 13.9 moveto 62 (RSETCAT) alignedtext +grestore +% QCMPACK->RSETCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 42 72 moveto +42 64 42 55 42 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 128 152 +end +restore +%%EOF diff --git a/books/ps/v104radicaleigenpackage.ps b/books/ps/v104radicaleigenpackage.ps new file mode 100644 index 0000000..cf0299d --- /dev/null +++ b/books/ps/v104radicaleigenpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 62 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% REP +gsave +[ /Rect [ 0 72 54 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=REP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14 85.9 moveto 26 (REP) alignedtext +grestore +% ACFS +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACFS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 13.9 moveto 35 (ACFS) alignedtext +grestore +% REP->ACFS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 27 72 moveto +27 64 27 55 27 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 98 152 +end +restore +%%EOF diff --git a/books/ps/v104radixutilities.ps b/books/ps/v104radixutilities.ps new file mode 100644 index 0000000..6044197 --- /dev/null +++ b/books/ps/v104radixutilities.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 200 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 164 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RADUTIL +gsave +[ /Rect [ 32 72 108 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RADUTIL) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 108 108 moveto +32 108 lineto +32 72 lineto +108 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 108 108 moveto +32 108 lineto +32 72 lineto +108 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +39.5 85.9 moveto 61 (RADUTIL) alignedtext +grestore +% PID +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PID) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16 13.9 moveto 22 (PID) alignedtext +grestore +% RADUTIL->PID +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 59 72 moveto +54 64 48 54 43 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.916 43.0418 moveto +38 36 lineto +39.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.916 43.0418 moveto +38 36 lineto +39.7969 46.4414 lineto +closepath stroke +grestore +% OAGROUP +gsave +[ /Rect [ 72 0 156 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=OAGROUP) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 156 36 moveto +72 36 lineto +72 1.06581e-14 lineto +156 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 156 36 moveto +72 36 lineto +72 1.06581e-14 lineto +156 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +80 13.9 moveto 68 (OAGROUP) alignedtext +grestore +% RADUTIL->OAGROUP +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 81 72 moveto +86 64 92 54 98 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 101.203 46.4414 moveto +103 36 lineto +95.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 101.203 46.4414 moveto +103 36 lineto +95.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 200 152 +end +restore +%%EOF diff --git a/books/ps/v104randomdistributions.ps b/books/ps/v104randomdistributions.ps new file mode 100644 index 0000000..15c1dfc --- /dev/null +++ b/books/ps/v104randomdistributions.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 106 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 70 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RDIST +gsave +[ /Rect [ 3 72 59 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RDIST) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 59 108 moveto +3 108 lineto +3 72 lineto +59 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 59 108 moveto +3 108 lineto +3 72 lineto +59 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 85.9 moveto 40 (RDIST) alignedtext +grestore +% FSAGG +gsave +[ /Rect [ 0 0 62 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FSAGG) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 62 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +62 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 62 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +62 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 46 (FSAGG) alignedtext +grestore +% RDIST->FSAGG +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 31 72 moveto +31 64 31 55 31 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 34.5001 46 moveto +31 36 lineto +27.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 34.5001 46 moveto +31 36 lineto +27.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 106 152 +end +restore +%%EOF diff --git a/books/ps/v104randomfloatdistributions.ps b/books/ps/v104randomfloatdistributions.ps new file mode 100644 index 0000000..1ce8ed7 --- /dev/null +++ b/books/ps/v104randomfloatdistributions.ps @@ -0,0 +1,276 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RFDIST +gsave +[ /Rect [ 2 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RFDIST) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 85.9 moveto 47 (RFDIST) alignedtext +grestore +% Package +gsave +0.939 0.733 1.000 nodecolor +newpath 66 36 moveto +2.13163e-14 36 lineto +0 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 36 moveto +2.13163e-14 36 lineto +0 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 50 (Package) alignedtext +grestore +% RFDIST->Package +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104randomintegerdistributions.ps b/books/ps/v104randomintegerdistributions.ps new file mode 100644 index 0000000..3f900d3 --- /dev/null +++ b/books/ps/v104randomintegerdistributions.ps @@ -0,0 +1,276 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RIDIST +gsave +[ /Rect [ 3 72 63 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RIDIST) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 63 108 moveto +3 108 lineto +3 72 lineto +63 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 63 108 moveto +3 108 lineto +3 72 lineto +63 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 85.9 moveto 44 (RIDIST) alignedtext +grestore +% Package +gsave +0.939 0.733 1.000 nodecolor +newpath 66 36 moveto +2.13163e-14 36 lineto +0 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 36 moveto +2.13163e-14 36 lineto +0 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 50 (Package) alignedtext +grestore +% RIDIST->Package +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104randomnumbersource.ps b/books/ps/v104randomnumbersource.ps new file mode 100644 index 0000000..048cbe7 --- /dev/null +++ b/books/ps/v104randomnumbersource.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 130 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 94 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RANDSRC +gsave +[ /Rect [ 3 72 83 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RANDSRC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 83 108 moveto +3 108 lineto +3 72 lineto +83 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 83 108 moveto +3 108 lineto +3 72 lineto +83 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10.5 85.9 moveto 65 (RANDSRC) alignedtext +grestore +% ALGEBRA- +gsave +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ALGEBRA) >> + /Subtype /Link +/ANN pdfmark +0.273 0.733 1.000 nodecolor +newpath 86 36 moveto +2.7485e-14 36 lineto +6.41154e-15 1.06581e-14 lineto +86 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 86 36 moveto +2.7485e-14 36 lineto +6.41154e-15 1.06581e-14 lineto +86 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 71 (ALGEBRA-) alignedtext +grestore +% RANDSRC->ALGEBRA- +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 43 72 moveto +43 64 43 55 43 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 130 152 +end +restore +%%EOF diff --git a/books/ps/v104rationalfactorize.ps b/books/ps/v104rationalfactorize.ps new file mode 100644 index 0000000..0e96373 --- /dev/null +++ b/books/ps/v104rationalfactorize.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RATFACT +gsave +[ /Rect [ 0 72 78 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RATFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 78 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +78 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 78 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +78 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 62 (RATFACT) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 6 0 72 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 72 36 moveto +6 36 lineto +6 1.06581e-14 lineto +72 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 72 36 moveto +6 36 lineto +6 1.06581e-14 lineto +72 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% RATFACT->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 152 +end +restore +%%EOF diff --git a/books/ps/v104rationalfunction.ps b/books/ps/v104rationalfunction.ps new file mode 100644 index 0000000..1d4daab --- /dev/null +++ b/books/ps/v104rationalfunction.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RF +gsave +[ /Rect [ 6 72 60 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 60 108 moveto +6 108 lineto +6 72 lineto +60 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 60 108 moveto +6 108 lineto +6 72 lineto +60 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +24.5 85.9 moveto 17 (RF) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% RF->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104rationalinterpolation.ps b/books/ps/v104rationalinterpolation.ps new file mode 100644 index 0000000..fb4ee38 --- /dev/null +++ b/books/ps/v104rationalinterpolation.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 118 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 82 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RINTERP +gsave +[ /Rect [ 0 72 74 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RINTERP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 74 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +74 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 74 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +74 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 58 (RINTERP) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 4 0 70 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 70 36 moveto +4 36 lineto +4 1.06581e-14 lineto +70 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 70 36 moveto +4 36 lineto +4 1.06581e-14 lineto +70 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% RINTERP->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 37 72 moveto +37 64 37 55 37 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 40.5001 46 moveto +37 36 lineto +33.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 40.5001 46 moveto +37 36 lineto +33.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 118 152 +end +restore +%%EOF diff --git a/books/ps/v104rationalretractions.ps b/books/ps/v104rationalretractions.ps new file mode 100644 index 0000000..f87b9cc --- /dev/null +++ b/books/ps/v104rationalretractions.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 200 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 164 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RATRET +gsave +[ /Rect [ 36 72 104 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RATRET) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 104 108 moveto +36 108 lineto +36 72 lineto +104 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 104 108 moveto +36 108 lineto +36 72 lineto +104 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +43.5 85.9 moveto 53 (RATRET) alignedtext +grestore +% PID +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PID) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16 13.9 moveto 22 (PID) alignedtext +grestore +% RATRET->PID +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 59 72 moveto +54 64 48 54 43 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.916 43.0418 moveto +38 36 lineto +39.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.916 43.0418 moveto +38 36 lineto +39.7969 46.4414 lineto +closepath stroke +grestore +% OAGROUP +gsave +[ /Rect [ 72 0 156 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=OAGROUP) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 156 36 moveto +72 36 lineto +72 1.06581e-14 lineto +156 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 156 36 moveto +72 36 lineto +72 1.06581e-14 lineto +156 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +80 13.9 moveto 68 (OAGROUP) alignedtext +grestore +% RATRET->OAGROUP +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 81 72 moveto +86 64 92 54 98 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 101.203 46.4414 moveto +103 36 lineto +95.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 101.203 46.4414 moveto +103 36 lineto +95.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 200 152 +end +restore +%%EOF diff --git a/books/ps/v104rationalricde.ps b/books/ps/v104rationalricde.ps new file mode 100644 index 0000000..6b006e2 --- /dev/null +++ b/books/ps/v104rationalricde.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 130 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 94 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% ODERTRIC +gsave +[ /Rect [ 0 72 86 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ODERTRIC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +86 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +86 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 70 (ODERTRIC) alignedtext +grestore +% UTSCAT +gsave +[ /Rect [ 8 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=UTSCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +8 36 lineto +8 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +8 36 lineto +8 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16 13.9 moveto 54 (UTSCAT) alignedtext +grestore +% ODERTRIC->UTSCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 43 72 moveto +43 64 43 55 43 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 130 152 +end +restore +%%EOF diff --git a/books/ps/v104realpolynomialutilitiespackage.ps b/books/ps/v104realpolynomialutilitiespackage.ps new file mode 100644 index 0000000..5c5cf5c --- /dev/null +++ b/books/ps/v104realpolynomialutilitiespackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 118 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 82 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% POLUTIL +gsave +[ /Rect [ 0 72 74 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=POLUTIL) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 74 108 moveto +2.00881e-14 108 lineto +6.06806e-15 72 lineto +74 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 74 108 moveto +2.00881e-14 108 lineto +6.06806e-15 72 lineto +74 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 59 (POLUTIL) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 4 0 70 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 70 36 moveto +4 36 lineto +4 1.06581e-14 lineto +70 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 70 36 moveto +4 36 lineto +4 1.06581e-14 lineto +70 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% POLUTIL->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 37 72 moveto +37 64 37 55 37 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 40.5001 46 moveto +37 36 lineto +33.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 40.5001 46 moveto +37 36 lineto +33.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 118 152 +end +restore +%%EOF diff --git a/books/ps/v104realzeropackage.ps b/books/ps/v104realzeropackage.ps new file mode 100644 index 0000000..82c27e1 --- /dev/null +++ b/books/ps/v104realzeropackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% REAL0 +gsave +[ /Rect [ 3 72 63 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=REAL0) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 63 108 moveto +3 108 lineto +3 72 lineto +63 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 63 108 moveto +3 108 lineto +3 72 lineto +63 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 85.9 moveto 44 (REAL0) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% REAL0->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104realzeropackageq.ps b/books/ps/v104realzeropackageq.ps new file mode 100644 index 0000000..9c566ba --- /dev/null +++ b/books/ps/v104realzeropackageq.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 114 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 78 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% REAL0Q +gsave +[ /Rect [ 0 72 70 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=REAL0Q) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +70 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +70 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 54 (REAL0Q) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 2 0 68 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 68 36 moveto +2 36 lineto +2 1.06581e-14 lineto +68 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 68 36 moveto +2 36 lineto +2 1.06581e-14 lineto +68 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% REAL0Q->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 35 72 moveto +35 64 35 55 35 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 114 152 +end +restore +%%EOF diff --git a/books/ps/v104recurrenceoperator.ps b/books/ps/v104recurrenceoperator.ps new file mode 100644 index 0000000..63bb164 --- /dev/null +++ b/books/ps/v104recurrenceoperator.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RECOP +gsave +[ /Rect [ 8 72 70 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RECOP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +8 108 lineto +8 72 lineto +70 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +8 108 lineto +8 72 lineto +70 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16 85.9 moveto 46 (RECOP) alignedtext +grestore +% EXPRSOL +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=EXPRSOL) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (EXPRSOL) alignedtext +grestore +% RECOP->EXPRSOL +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 152 +end +restore +%%EOF diff --git a/books/ps/v104regularsetdecompositionpackage.ps b/books/ps/v104regularsetdecompositionpackage.ps new file mode 100644 index 0000000..4b17f95 --- /dev/null +++ b/books/ps/v104regularsetdecompositionpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RSDCMPK +gsave +[ /Rect [ 0 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RSDCMPK) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 66 (RSDCMPK) alignedtext +grestore +% RSETCAT +gsave +[ /Rect [ 2 0 80 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=RSETCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 80 36 moveto +2 36 lineto +2 1.06581e-14 lineto +80 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 80 36 moveto +2 36 lineto +2 1.06581e-14 lineto +80 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10 13.9 moveto 62 (RSETCAT) alignedtext +grestore +% RSDCMPK->RSETCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/books/ps/v104regulartriangularsetgcdpackage.ps b/books/ps/v104regulartriangularsetgcdpackage.ps new file mode 100644 index 0000000..af80116 --- /dev/null +++ b/books/ps/v104regulartriangularsetgcdpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 124 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 88 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RSETGCD +gsave +[ /Rect [ 0 72 80 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RSETGCD) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +3.02917e-14 108 lineto +9.23914e-15 72 lineto +80 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +3.02917e-14 108 lineto +9.23914e-15 72 lineto +80 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 65 (RSETGCD) alignedtext +grestore +% RPOLCAT +gsave +[ /Rect [ 1 0 79 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=RPOLCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 79 36 moveto +1 36 lineto +1 1.06581e-14 lineto +79 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 79 36 moveto +1 36 lineto +1 1.06581e-14 lineto +79 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9 13.9 moveto 62 (RPOLCAT) alignedtext +grestore +% RSETGCD->RPOLCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 40 72 moveto +40 64 40 55 40 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.5001 46 moveto +40 36 lineto +36.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.5001 46 moveto +40 36 lineto +36.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 124 152 +end +restore +%%EOF diff --git a/books/ps/v104representationpackage1.ps b/books/ps/v104representationpackage1.ps new file mode 100644 index 0000000..b015014 --- /dev/null +++ b/books/ps/v104representationpackage1.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 62 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% REP1 +gsave +[ /Rect [ 0 72 54 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=REP1) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 85.9 moveto 32 (REP1) alignedtext +grestore +% ALIST +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ALIST) >> + /Subtype /Link +/ANN pdfmark +0.273 0.733 1.000 nodecolor +newpath 54 36 moveto +1.41189e-14 36 lineto +3.65506e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 54 36 moveto +1.41189e-14 36 lineto +3.65506e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 39 (ALIST) alignedtext +grestore +% REP1->ALIST +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 27 72 moveto +27 64 27 55 27 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 98 152 +end +restore +%%EOF diff --git a/books/ps/v104representationpackage2.ps b/books/ps/v104representationpackage2.ps new file mode 100644 index 0000000..daf6530 --- /dev/null +++ b/books/ps/v104representationpackage2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% REP2 +gsave +[ /Rect [ 12 72 66 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=REP2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +12 108 lineto +12 72 lineto +66 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +12 108 lineto +12 72 lineto +66 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +23 85.9 moveto 32 (REP2) alignedtext +grestore +% IVECTOR +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IVECTOR) >> + /Subtype /Link +/ANN pdfmark +0.273 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (IVECTOR) alignedtext +grestore +% REP2->IVECTOR +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 152 +end +restore +%%EOF diff --git a/books/ps/v104transcendentalrischde.ps b/books/ps/v104transcendentalrischde.ps new file mode 100644 index 0000000..0e70602 --- /dev/null +++ b/books/ps/v104transcendentalrischde.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RDETR +gsave +[ /Rect [ 2 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RDETR) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10 85.9 moveto 46 (RDETR) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% RDETR->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104transcendentalrischdesystem.ps b/books/ps/v104transcendentalrischdesystem.ps new file mode 100644 index 0000000..75d76b7 --- /dev/null +++ b/books/ps/v104transcendentalrischdesystem.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 112 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 76 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RDETRS +gsave +[ /Rect [ 0 72 68 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RDETRS) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 53 (RDETRS) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 1 0 67 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +1 36 lineto +1 1.06581e-14 lineto +67 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +1 36 lineto +1 1.06581e-14 lineto +67 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% RDETRS->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 34 72 moveto +34 64 34 55 34 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 37.5001 46 moveto +34 36 lineto +30.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 37.5001 46 moveto +34 36 lineto +30.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 112 152 +end +restore +%%EOF diff --git a/changelog b/changelog index f783eac..6738779 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,57 @@ +20090208 tpd src/axiom-website/patches.html 20090208.02.tpd.patch +20090208 tpd books/bookvol10.4 add packages +20090208 tpd src/algebra/Makefile remove spad files +20090208 tpd books/ps/v104rationalricde.ps added +20090208 tpd src/algebra/rule.spad removed +20090208 tpd books/ps/v104applyrules.ps added +20090208 tpd src/algebra/rinterp.spad removed +20090208 tpd books/ps/v104rationalinterpolation.ps added +20090208 tpd src/algebra/riccati.spad removed +20090208 tpd books/ps/v104primitiveratricde.ps added +20090208 tpd src/algebra/rf.spad removed +20090208 tpd books/ps/v104rationalfunction.ps added +20090208 tpd books/ps/v104polynomialcategoryquotientfunctions.ps added +20090208 tpd src/algebra/retract.spad removed +20090208 tpd books/ps/v104rationalretractions.ps added +20090208 tpd books/ps/v104integerretractions.ps added +20090208 tpd src/algebra/rep2.spad removed +20090208 tpd books/ps/v104representationpackage2.ps added +20090208 tpd src/algebra/rep1.spad removed +20090208 tpd books/ps/v104representationpackage1.ps added +20090208 tpd src/algebra/regset.spad removed +20090208 tpd books/ps/v104regularsetdecompositionpackage.ps added +20090208 tpd books/ps/v104regulartriangularsetgcdpackage.ps added +20090208 tpd books/ps/v104quasicomponentpackage.ps added +20090208 tpd src/algebra/rec.spad removed +20090208 tpd books/ps/v104recurrenceoperator.ps added +20090208 tpd src/algebra/reclos.spad removed +20090208 tpd books/ps/v104realpolynomialutilitiespackage.ps added +20090208 tpd src/algebra/realzero.spad removed +20090208 tpd books/ps/v104realzeropackage.ps added +20090208 tpd src/algebra/real0q.spad removed +20090208 tpd books/ps/v104realzeropackageq.ps added +20090208 tpd src/algebra/rdesys.spad removed +20090208 tpd books/ps/v104elementaryrischdesystem.ps added +20090208 tpd books/ps/v104transcendentalrischdesystem.ps added +20090208 tpd src/algebra/rderf.spad removed +20090208 tpd books/ps/v104transcendentalrischde.ps added +20090208 tpd src/algebra/rdeef.spad removed +20090208 tpd books/ps/v104elementaryrischde.ps added +20090208 tpd books/ps/v104integrationtools.ps added +20090208 tpd src/algebra/ratfact.spad removed +20090208 tpd books/ps/v104rationalfactorize.ps added +20090208 tpd src/algebra/random.spad removed +20090208 tpd books/ps/v104randomfloatdistributions.ps added +20090208 tpd books/ps/v104randomintegerdistributions.ps added +20090208 tpd books/ps/v104integerbits.ps added +20090208 tpd books/ps/v104randomdistributions.ps added +20090208 tpd books/ps/v104randomnumbersource.ps added +20090208 tpd src/algebra/radix.spad removed +20090208 tpd books/ps/v104radixutilities.ps added +20090208 tpd src/algebra/radeigen.spad removed +20090208 tpd books/ps/v104radicaleigenpackage.ps added +20090208 tpd src/algebra/qalgset.spad removed +20090208 tpd books/ps/v104quasialgebraicset2.ps added 20090208 tpd src/axiom-website/patches.html 20090208.01.tpd.patch 20090208 tpd books/bookvol10.4.pamphlet add packages 20090208 tpd src/algebra/Makefile remove spad files diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 607b64d..70c2e7e 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -15771,14 +15771,7 @@ We need to figure out which mlift.spad to keep. <>= SPADFILES= \ - ${OUTSRC}/qalgset.spad ${OUTSRC}/quat.spad \ - ${OUTSRC}/radeigen.spad ${OUTSRC}/radix.spad ${OUTSRC}/random.spad \ - ${OUTSRC}/ratfact.spad ${OUTSRC}/rdeef.spad ${OUTSRC}/rderf.spad \ - ${OUTSRC}/rdesys.spad ${OUTSRC}/real0q.spad ${OUTSRC}/realzero.spad \ - ${OUTSRC}/reclos.spad ${OUTSRC}/regset.spad ${OUTSRC}/rep1.spad \ - ${OUTSRC}/rep2.spad ${OUTSRC}/retract.spad \ - ${OUTSRC}/rf.spad ${OUTSRC}/riccati.spad ${OUTSRC}/rinterp.spad \ - ${OUTSRC}/rule.spad \ + ${OUTSRC}/quat.spad \ ${OUTSRC}/seg.spad ${OUTSRC}/setorder.spad \ ${OUTSRC}/sgcf.spad \ ${OUTSRC}/sign.spad ${OUTSRC}/smith.spad \ @@ -15835,14 +15828,7 @@ DOCFILES= \ ${DOC}/nepip.as.dvi \ ${DOC}/noptip.as.dvi ${DOC}/nqip.as.dvi \ ${DOC}/nrc.as.dvi ${DOC}/nsfip.as.dvi \ - ${DOC}/qalgset.spad.dvi ${DOC}/quat.spad.dvi \ - ${DOC}/radeigen.spad.dvi ${DOC}/radix.spad.dvi ${DOC}/random.spad.dvi \ - ${DOC}/ratfact.spad.dvi ${DOC}/rdeef.spad.dvi ${DOC}/rderf.spad.dvi \ - ${DOC}/rdesys.spad.dvi ${DOC}/real0q.spad.dvi ${DOC}/realzero.spad.dvi \ - ${DOC}/reclos.spad.dvi ${DOC}/regset.spad.dvi ${DOC}/rep1.spad.dvi \ - ${DOC}/rep2.spad.dvi ${DOC}/retract.spad.dvi \ - ${DOC}/rf.spad.dvi ${DOC}/riccati.spad.dvi ${DOC}/rinterp.spad.dvi \ - ${DOC}/rule.spad.dvi \ + ${DOC}/quat.spad.dvi \ ${DOC}/seg.spad.dvi ${DOC}/setorder.spad.dvi \ ${DOC}/sgcf.spad.dvi \ ${DOC}/sign.spad.dvi ${DOC}/smith.spad.dvi \ diff --git a/src/algebra/qalgset.spad.pamphlet b/src/algebra/qalgset.spad.pamphlet deleted file mode 100644 index 87fdd02..0000000 --- a/src/algebra/qalgset.spad.pamphlet +++ /dev/null @@ -1,165 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra qalgset.spad} -\author{William Sit} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package QALGSET2 QuasiAlgebraicSet2} -<>= -)abbrev package QALGSET2 QuasiAlgebraicSet2 -++ Author: William Sit -++ Date Created: March 13, 1992 -++ Date Last Updated: June 12, 1992 -++ Basic Operations: -++ Related Constructors:GroebnerPackage, IdealDecompositionPackage, -++ PolynomialIdeals -++ See Also: QuasiAlgebraicSet -++ AMS Classifications: -++ Keywords: Zariski closed sets, quasi-algebraic sets -++ References:William Sit, "An Algorithm for Parametric Linear Systems" -++ J. Sym. Comp., April, 1992 -++ Description: -++ \spadtype{QuasiAlgebraicSet2} adds a function \spadfun{radicalSimplify} -++ which uses \spadtype{IdealDecompositionPackage} to simplify -++ the representation of a quasi-algebraic set. A quasi-algebraic set -++ is the intersection of a Zariski -++ closed set, defined as the common zeros of a given list of -++ polynomials (the defining polynomials for equations), and a principal -++ Zariski open set, defined as the complement of the common -++ zeros of a polynomial f (the defining polynomial for the inequation). -++ Quasi-algebraic sets are implemented in the domain -++ \spadtype{QuasiAlgebraicSet}, where two simplification routines are -++ provided: -++ \spadfun{idealSimplify} and \spadfun{simplify}. -++ The function -++ \spadfun{radicalSimplify} is added -++ for comparison study only. Because the domain -++ \spadtype{IdealDecompositionPackage} provides facilities for -++ computing with radical ideals, it is necessary to restrict -++ the ground ring to the domain \spadtype{Fraction Integer}, -++ and the polynomial ring to be of type -++ \spadtype{DistributedMultivariatePolynomial}. -++ The routine \spadfun{radicalSimplify} uses these to compute groebner -++ basis of radical ideals and -++ is inefficient and restricted when compared to the -++ two in \spadtype{QuasiAlgebraicSet}. -QuasiAlgebraicSet2(vl,nv) : C == T where - vl : List Symbol - nv : NonNegativeInteger - R ==> Integer - F ==> Fraction R - Var ==> OrderedVariableList vl - NNI ==> NonNegativeInteger - Expon ==> DirectProduct(nv,NNI) - Dpoly ==> DistributedMultivariatePolynomial(vl,F) - QALG ==> QuasiAlgebraicSet(F, Var, Expon, Dpoly) - newExpon ==> DirectProduct(#newvl, NNI) - newPoly ==> DistributedMultivariatePolynomial(newvl,F) - newVar ==> OrderedVariableList newvl - Status ==> Union(Boolean,"failed") -- empty or not, or don't know - - C == with - radicalSimplify:QALG -> QALG - ++ radicalSimplify(s) returns a different and presumably simpler - ++ representation of s with the defining polynomials for the - ++ equations - ++ forming a groebner basis, and the defining polynomial for the - ++ inequation reduced with respect to the basis, using - ++ using groebner basis of radical ideals - T == add - ---- 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) - import IdealDecompositionPackage(newvl,#newvl) - import QuasiAlgebraicSet(F, Var, Expon, Dpoly) - import PolynomialCategoryLifting(Expon,Var,F,Dpoly,newPoly) - import PolynomialCategoryLifting(newExpon,newVar,F,newPoly,Dpoly) - f(v:Var):newPoly == - variable((convert v)@Symbol)@Union(newVar,"failed")::newVar - ::newPoly - g(v:newVar):Dpoly == - v = tv => 0 - variable((convert v)@Symbol)@Union(Var,"failed")::Var::Dpoly - - npoly(p:Dpoly) : newPoly == map(f #1, #1::newPoly, p) - - oldpoly(q:newPoly) : Union(Dpoly,"failed") == - (x:=mainVariable q) case "failed" => (leadingCoefficient q)::Dpoly - (x::newVar = tv) => "failed" - map(g #1,#1::Dpoly, q) - - radicalSimplify x == - status(x)$QALG = true => x -- x is empty - z0:=definingEquations x - n0:=definingInequation x - t:newPoly:= coerce(tv)$newPoly - tp:newPoly:= t * (npoly n0) - 1$newPoly - gen:List newPoly:= concat(tp, [npoly g for g in z0]) - id:=ideal gen - ngb:=generators radical(id) - member? (1$newPoly, ngb) => empty()$QALG - gb:List Dpoly:=nil - while not empty? ngb repeat - if ((k:=oldpoly ngb.first) case Dpoly) then gb:=concat(k, gb) - ngb:=ngb.rest - y:=quasiAlgebraicSet(gb, primitivePart normalForm(n0, gb)) - setStatus(y,false::Status) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/radeigen.spad.pamphlet b/src/algebra/radeigen.spad.pamphlet deleted file mode 100644 index 04e006f..0000000 --- a/src/algebra/radeigen.spad.pamphlet +++ /dev/null @@ -1,235 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra radeigen.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package REP RadicalEigenPackage} -<>= -)abbrev package REP RadicalEigenPackage -++ Author: P.Gianni -++ Date Created: Summer 1987 -++ Date Last Updated: October 1992 -++ Basic Functions: -++ Related Constructors: EigenPackage, RadicalSolve -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ Package for the computation of eigenvalues and eigenvectors. -++ This package works for matrices with coefficients which are -++ rational functions over the integers. -++ (see \spadtype{Fraction Polynomial Integer}). -++ The eigenvalues and eigenvectors are expressed in terms of radicals. -RadicalEigenPackage() : C == T - where - R ==> Integer - P ==> Polynomial R - F ==> Fraction P - RE ==> Expression R - SE ==> Symbol() - M ==> Matrix(F) - MRE ==> Matrix(RE) - ST ==> SuchThat(SE,P) - NNI ==> NonNegativeInteger - - EigenForm ==> Record(eigval:Union(F,ST),eigmult:NNI,eigvec:List(M)) - RadicalForm ==> Record(radval:RE,radmult:Integer,radvect:List(MRE)) - - - - C == with - radicalEigenvectors : M -> List(RadicalForm) - ++ radicalEigenvectors(m) computes - ++ the eigenvalues and the corresponding eigenvectors of the - ++ matrix m; - ++ when possible, values are expressed in terms of radicals. - - radicalEigenvector : (RE,M) -> List(MRE) - ++ radicalEigenvector(c,m) computes the eigenvector(s) of the - ++ matrix m corresponding to the eigenvalue c; - ++ when possible, values are - ++ expressed in terms of radicals. - - radicalEigenvalues : M -> List RE - ++ radicalEigenvalues(m) computes the eigenvalues of the matrix m; - ++ when possible, the eigenvalues are expressed in terms of radicals. - - eigenMatrix : M -> Union(MRE,"failed") - ++ eigenMatrix(m) returns the matrix b - ++ such that \spad{b*m*(inverse b)} is diagonal, - ++ or "failed" if no such b exists. - - normalise : MRE -> MRE - ++ normalise(v) returns the column - ++ vector v - ++ divided by its euclidean norm; - ++ when possible, the vector v is expressed in terms of radicals. - - gramschmidt : List(MRE) -> List(MRE) - ++ gramschmidt(lv) converts the list of column vectors lv into - ++ a set of orthogonal column vectors - ++ of euclidean length 1 using the Gram-Schmidt algorithm. - - orthonormalBasis : M -> List(MRE) - ++ orthonormalBasis(m) returns the orthogonal matrix b such that - ++ \spad{b*m*(inverse b)} is diagonal. - ++ Error: if m is not a symmetric matrix. - - T == add - PI ==> PositiveInteger - RSP := RadicalSolvePackage R - import EigenPackage R - - ---- Local Functions ---- - evalvect : (M,RE,SE) -> MRE - innerprod : (MRE,MRE) -> RE - - ---- eval a vector of F in a radical expression ---- - evalvect(vect:M,alg:RE,x:SE) : MRE == - n:=nrows vect - xx:=kernel(x)$Kernel(RE) - w:MRE:=zero(n,1)$MRE - for i in 1..n repeat - v:=eval(vect(i,1) :: RE,xx,alg) - setelt(w,i,1,v) - w - ---- inner product ---- - innerprod(v1:MRE,v2:MRE): RE == (((transpose v1)* v2)::MRE)(1,1) - - ---- normalization of a vector ---- - normalise(v:MRE) : MRE == - normv:RE := sqrt(innerprod(v,v)) - normv = 0$RE => v - (1/normv)*v - - ---- Eigenvalues of the matrix A ---- - radicalEigenvalues(A:M): List(RE) == - x:SE :=new()$SE - pol:= characteristicPolynomial(A,x) :: F - radicalRoots(pol,x)$RSP - - ---- Eigenvectors belonging to a given eigenvalue ---- - ---- expressed in terms of radicals ---- - radicalEigenvector(alpha:RE,A:M) : List(MRE) == - n:=nrows A - B:MRE := zero(n,n)$MRE - for i in 1..n repeat - for j in 1..n repeat B(i,j):=(A(i,j))::RE - B(i,i):= B(i,i) - alpha - [v::MRE for v in nullSpace B] - - ---- eigenvectors and eigenvalues ---- - radicalEigenvectors(A:M) : List(RadicalForm) == - leig:List EigenForm := eigenvectors A - n:=nrows A - sln:List RadicalForm := empty() - veclist: List MRE - for eig in leig repeat - eig.eigval case F => - veclist := empty() - for ll in eig.eigvec repeat - m:MRE:=zero(n,1) - for i in 1..n repeat m(i,1):=(ll(i,1))::RE - veclist:=cons(m,veclist) - sln:=cons([(eig.eigval)::F::RE,eig.eigmult,veclist]$RadicalForm,sln) - sym := eig.eigval :: ST - xx:= lhs sym - lval : List RE := radicalRoots((rhs sym) :: F ,xx)$RSP - for alg in lval repeat - nsl:=[alg,eig.eigmult, - [evalvect(ep,alg,xx) for ep in eig.eigvec]]$RadicalForm - sln:=cons(nsl,sln) - sln - - ---- orthonormalization of a list of vectors ---- - ---- Grahm - Schmidt process ---- - - gramschmidt(lvect:List(MRE)) : List(MRE) == - lvect=[] => [] - v:=lvect.first - n := nrows v - RMR:=RectangularMatrix(n:PI,1,RE) - orth:List(MRE):=[(normalise v)] - for v in lvect.rest repeat - pol:=((v:RMR)-(+/[(innerprod(w,v)*w):RMR for w in orth])):MRE - orth:=cons(normalise pol,orth) - orth - - - ---- The matrix of eigenvectors ---- - - eigenMatrix(A:M) : Union(MRE,"failed") == - lef:List(MRE):=[:eiv.radvect for eiv in radicalEigenvectors(A)] - n:=nrows A - #lef "failed" - d:MRE:=copy(lef.first) - for v in lef.rest repeat d:=(horizConcat(d,v))::MRE - d - - ---- orthogonal basis for a symmetric matrix ---- - - orthonormalBasis(A:M):List(MRE) == - ^symmetric?(A) => error "the matrix is not symmetric" - basis:List(MRE):=[] - lvec:List(MRE) := [] - alglist:List(RadicalForm):=radicalEigenvectors(A) - n:=nrows A - for alterm in alglist repeat - if (lvec:=alterm.radvect)=[] then error "sorry " - if #(lvec)>1 then - lvec:= gramschmidt(lvec) - basis:=[:lvec,:basis] - else basis:=[normalise(lvec.first),:basis] - basis - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/radix.spad.pamphlet b/src/algebra/radix.spad.pamphlet deleted file mode 100644 index 028ec95..0000000 --- a/src/algebra/radix.spad.pamphlet +++ /dev/null @@ -1,78 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra radix.spad} -\author{Stephen M. Watt, Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package RADUTIL RadixUtilities} -<>= -)abbrev package RADUTIL RadixUtilities -++ Author: Stephen M. Watt -++ Date Created: October 1986 -++ Date Last Updated: May 15, 1991 -++ Basic Operations: -++ Related Domains: RadixExpansion -++ Also See: -++ AMS Classifications: -++ Keywords: radix, base, repeading decimal -++ Examples: -++ References: -++ Description: -++ This package provides tools for creating radix expansions. -RadixUtilities: Exports == Implementation where - Exports ==> with - radix: (Fraction Integer,Integer) -> Any - ++ radix(x,b) converts x to a radix expansion in base b. - Implementation ==> add - radix(q, b) == - coerce(q :: RadixExpansion(b))$AnyFunctions1(RadixExpansion b) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/random.spad.pamphlet b/src/algebra/random.spad.pamphlet deleted file mode 100644 index 9699789..0000000 --- a/src/algebra/random.spad.pamphlet +++ /dev/null @@ -1,348 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra random.spad} -\author{Stephen M. Watt, Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package RANDSRC RandomNumberSource} -<>= -)abbrev package RANDSRC RandomNumberSource -++ Author:S.M.Watt -++ Date Created: April 87 -++ Date Last Updated:Jan 92, May 1995 (MCD) -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description:Random number generators ---% RandomNumberSource -++ All random numbers used in the system should originate from -++ the same generator. This package is intended to be the source. --- --- Possible improvements: --- 1) Start where the user left off --- 2) Be able to switch between methods in the random number source. -RandomNumberSource(): with - -- If r := randnum() then 0 <= r < size(). - randnum: () -> Integer - ++ randnum() is a random number between 0 and size(). - -- If r := randnum() then 0 <= r < size(). - size: () -> Integer - ++ size() is the base of the random number generator - - -- If r := randnum n and n <= size() then 0 <= r < n. - randnum: Integer -> Integer - ++ randnum(n) is a random number between 0 and n. - reseed: Integer -> Void - ++ reseed(n) restarts the random number generator at n. - seed : () -> Integer - ++ seed() returns the current seed value. - - == add - -- This random number generator passes the spectral test - -- with flying colours. [Knuth vol2, 2nd ed, p105] - ranbase: Integer := 2**31-1 - x0: Integer := 1231231231 - x1: Integer := 3243232987 - - randnum() == - t := (271828183 * x1 - 314159269 * x0) rem ranbase - if t < 0 then t := t + ranbase - x0:= x1 - x1:= t - - size() == ranbase - reseed n == - x0 := n rem ranbase - -- x1 := (n quo ranbase) rem ranbase - x1 := n quo ranbase - - seed() == x1*ranbase + x0 - - -- Compute an integer in 0..n-1. - randnum n == - (n * randnum()) quo ranbase - -@ -\section{package RDIST RandomDistributions} -<>= -)abbrev package RDIST RandomDistributions -++ Description: -++ This package exports random distributions -RandomDistributions(S: SetCategory): with - uniform: Set S -> (() -> S) - ++ uniform(s) \undocumented - weighted: List Record(value: S, weight: Integer) -> (()->S) - ++ weighted(l) \undocumented - rdHack1: (Vector S,Vector Integer,Integer)->(()->S) - ++ rdHack1(v,u,n) \undocumented - == add - import RandomNumberSource() - - weighted lvw == - -- Collapse duplicates, adding weights. - t: Table(S, Integer) := table() - for r in lvw repeat - 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(kv, wv, totwt) == - w := randnum totwt - -- do binary search in wv - kv.1 - - uniform fset == - l := members fset - n := #l - l.(randnum(n)+1) - -@ -\section{package INTBIT IntegerBits} -<>= -)abbrev package INTBIT IntegerBits -----> Bug! Cannot precompute params and return a function which -----> simpy computes the last call. e.g. ridHack1, below. - ---% IntegerBits --- Functions related to the binary representation of integers. --- These functions directly access the bits in the big integer --- representation and so are much facter than using a quotient loop. --- SMW Sept 86. - - -++ Description: -++ This package provides functions to lookup bits in integers -IntegerBits: with - -- bitLength(n) == # of bits to represent abs(n) - -- bitCoef (n,i) == coef of 2**i in abs(n) - -- bitTruth(n,i) == true if coef of 2**i in abs(n) is 1 - - bitLength: Integer -> Integer - ++ bitLength(n) returns the number of bits to represent abs(n) - bitCoef: (Integer, Integer) -> Integer - ++ bitCoef(n,m) returns the coefficient of 2**m in abs(n) - bitTruth: (Integer, Integer) -> Boolean - ++ bitTruth(n,m) returns true if coefficient of 2**m in abs(n) is 1 - - == add - bitLength n == INTEGER_-LENGTH(n)$Lisp - bitCoef (n,i) == if INTEGER_-BIT(n,i)$Lisp then 1 else 0 - bitTruth(n,i) == INTEGER_-BIT(n,i)$Lisp - -@ -\section{package RIDIST RandomIntegerDistributions} -<>= -)abbrev package RIDIST RandomIntegerDistributions -++ Description: -++ This package exports integer distributions -RandomIntegerDistributions(): with - uniform: Segment Integer -> (() -> Integer) - ++ uniform(s) \undocumented - binomial: (Integer, RationalNumber) -> (() -> Integer) - ++ binomial(n,f) \undocumented - poisson: RationalNumber -> (() -> Integer) - ++ poisson(f) \undocumented - geometric: RationalNumber -> (() -> Integer) - ++ geometric(f) \undocumented - - ridHack1: (Integer,Integer,Integer,Integer) -> Integer - ++ ridHack1(i,j,k,l) \undocumented - == add - import RandomNumberSource() - import IntegerBits() - - -- Compute uniform(a..b) as - -- - -- l + U0 + w*U1 + w**2*U2 +...+ w**(n-1)*U-1 + w**n*M - -- - -- where - -- l = min(a,b) - -- m = abs(b-a) + 1 - -- w**n < m < w**(n+1) - -- U0,...,Un-1 are uniform on 0..w-1 - -- M is uniform on 0..(m quo w**n)-1 - - 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 - n := n + 1 - mq := mqnext - ridHack1(mq, n, w, l) - - ridHack1(mq, n, w, l) == - r := randnum mq - for i in 1..n repeat r := r*w + randnum w - r + l - -@ -\section{package RFDIST RandomFloatDistributions} -<>= -)abbrev package RFDIST RandomFloatDistributions -++ Description: -++ This package exports random floating-point distributions -RationalNumber==> Fraction Integer -RandomFloatDistributions(): Cat == Body where - NNI ==> NonNegativeInteger - - Cat ==> with - uniform01: () -> Float - ++ uniform01() \undocumented - normal01: () -> Float - ++ normal01() \undocumented - exponential1:() -> Float - ++ exponential1() \undocumented - chiSquare1: NNI -> Float - ++ chiSquare1(n) \undocumented - - uniform: (Float, Float) -> (() -> Float) - ++ uniform(f,g) \undocumented - normal: (Float, Float) -> (() -> Float) - ++ normal(f,g) \undocumented - exponential: (Float) -> (() -> Float) - ++ exponential(f) \undocumented - chiSquare: (NNI) -> (() -> Float) - ++ chiSquare(n) \undocumented - Beta: (NNI, NNI) -> (() -> Float) - ++ Beta(n,m) \undocumented - F: (NNI, NNI) -> (() -> Float) - ++ F(n,m) \undocumented - t: (NNI) -> (() -> Float) - ++ t(n) \undocumented - - - Body ==> add - import RandomNumberSource() --- FloatPackage0() - - -- random() generates numbers in 0..rnmax - rnmax := (size()$RandomNumberSource() - 1)::Float - - uniform01() == - randnum()::Float/rnmax - uniform(a,b) == - a + uniform01()*(b-a) - - 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(mean) == - mean*exponential1() - - -- This method is correct but slow. - normal01() == - s := 2::Float - while s >= 1 repeat - v1 := 2 * uniform01() - 1 - v2 := 2 * uniform01() - 1 - s := v1**2 + v2**2 - v1 * sqrt(-2 * log s/s) - normal(mean, stdev) == - mean + stdev*normal01() - - chiSquare1 dgfree == - x: Float := 0 - for i in 1..dgfree quo 2 repeat - x := x + 2*exponential1() - if odd? dgfree then - x := x + normal01()**2 - x - chiSquare dgfree == - chiSquare1 dgfree - - Beta(dgfree1, dgfree2) == - y1 := chiSquare1 dgfree1 - y2 := chiSquare1 dgfree2 - y1/(y1 + y2) - - F(dgfree1, dgfree2) == - y1 := chiSquare1 dgfree1 - y2 := chiSquare1 dgfree2 - (dgfree2 * y1)/(dgfree1 * y2) - - t dgfree == - n := normal01() - d := chiSquare1(dgfree) / (dgfree::Float) - n / sqrt d - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -<> -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/ratfact.spad.pamphlet b/src/algebra/ratfact.spad.pamphlet deleted file mode 100644 index 68a83a3..0000000 --- a/src/algebra/ratfact.spad.pamphlet +++ /dev/null @@ -1,113 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra ratfact.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package RATFACT RationalFactorize} -<>= -)abbrev package RATFACT RationalFactorize -++ Author: P. Gianni -++ Date created: ?? -++ Date last updated: December 1993 -++ Factorization of extended polynomials with rational coefficients. -++ This package implements factorization of extended polynomials -++ whose coefficients are rational numbers. It does this by taking the -++ lcm of the coefficients of the polynomial and creating a polynomial -++ with integer coefficients. The algorithm in \spadtype{GaloisGroupFactorizer} is then -++ used to factor the integer polynomial. The result is normalized -++ with respect to the original lcm of the denominators. -++ Keywords: factorization, hensel, rational number -I ==> Integer -RN ==> Fraction Integer - -RationalFactorize(RP) : public == private where - BP ==> SparseUnivariatePolynomial(I) - RP : UnivariatePolynomialCategory RN - - public ==> with - - factor : RP -> Factored RP - ++ factor(p) factors an extended polynomial p over the rational numbers. - factorSquareFree : RP -> Factored RP - ++ factorSquareFree(p) factors an extended squareFree - ++ polynomial p over the rational numbers. - - private ==> add - import GaloisGroupFactorizer (BP) - ParFact ==> Record(irr:BP,pow:I) - FinalFact ==> Record(contp:I,factors:List(ParFact)) - URNI ==> UnivariatePolynomialCategoryFunctions2(RN,RP,I,BP) - UIRN ==> UnivariatePolynomialCategoryFunctions2(I,BP,RN,RP) - fUnion ==> Union("nil", "sqfr", "irred", "prime") - FFE ==> Record(flg:fUnion, fctr:RP, xpnt:I) - - factor(p:RP) : Factored(RP) == - p = 0 => 0 - pden: I := lcm([denom c for c in coefficients p]) - pol : RP := pden*p - ipol: BP := map(numer,pol)$URNI - ffact: FinalFact := henselFact(ipol,false) - makeFR(((ffact.contp)/pden)::RP, - [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE - for u in ffact.factors]) - - factorSquareFree(p:RP) : Factored(RP) == - p = 0 => 0 - pden: I := lcm([denom c for c in coefficients p]) - pol : RP := pden*p - ipol: BP := map(numer,pol)$URNI - ffact: FinalFact := henselFact(ipol,true) - makeFR(((ffact.contp)/pden)::RP, - [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE - for u in ffact.factors]) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rdeef.spad.pamphlet b/src/algebra/rdeef.spad.pamphlet deleted file mode 100644 index 662c1f2..0000000 --- a/src/algebra/rdeef.spad.pamphlet +++ /dev/null @@ -1,568 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rdeef.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INTTOOLS IntegrationTools} -<>= -)abbrev package INTTOOLS IntegrationTools -++ Tools for the integrator -++ Author: Manuel Bronstein -++ Date Created: 25 April 1990 -++ Date Last Updated: 9 June 1993 -++ Keywords: elementary, function, integration. -IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where - K ==> Kernel F - SE ==> Symbol - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - IR ==> IntegrationResult F - ANS ==> Record(special:F, integrand:F) - U ==> Union(ANS, "failed") - ALGOP ==> "%alg" - - Exp ==> with - varselect: (List K, SE) -> List K - ++ varselect([k1,...,kn], x) returns the ki which involve x. - kmax : List K -> K - ++ kmax([k1,...,kn]) returns the top-level ki for integration. - ksec : (K, List K, SE) -> K - ++ ksec(k, [k1,...,kn], x) returns the second top-level ki - ++ after k involving x. - union : (List K, List K) -> List K - ++ union(l1, l2) returns set-theoretic union of l1 and l2. - vark : (List F, SE) -> List K - ++ vark([f1,...,fn],x) returns the set-theoretic union of - ++ \spad{(varselect(f1,x),...,varselect(fn,x))}. - if R has IntegralDomain then - removeConstantTerm: (F, SE) -> F - ++ removeConstantTerm(f, x) returns f minus any additive constant - ++ with respect to x. - if R has GcdDomain and F has ElementaryFunctionCategory then - mkPrim: (F, SE) -> F - ++ mkPrim(f, x) makes the logs in f which are linear in x - ++ primitive with respect to x. - if R has ConvertibleTo Pattern Integer and R has PatternMatchable Integer - and F has LiouvillianFunctionCategory and F has RetractableTo SE then - intPatternMatch: (F, SE, (F, SE) -> IR, (F, SE) -> U) -> IR - ++ intPatternMatch(f, x, int, pmint) tries to integrate \spad{f} - ++ first by using the integration function \spad{int}, and then - ++ by using the pattern match intetgration function \spad{pmint} - ++ on any remaining unintegrable part. - - Impl ==> add - better?: (K, K) -> Boolean - - union(l1, l2) == setUnion(l1, l2) - 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)) - - vark(l, x) == - varselect(reduce("setUnion",[kernels f for f in l],empty()$List(K)), x) - - kmax l == - ans := first l - for k in rest l repeat - if better?(k, ans) then ans := k - ans - --- true if x should be considered before y in the tower - better?(x, y) == - height(y) ^= height(x) => height(y) < height(x) - has?(operator y, ALGOP) or - (is?(y, "exp"::SE) and not is?(x, "exp"::SE) - and not has?(operator x, ALGOP)) - - if R has IntegralDomain then - removeConstantTerm(f, x) == - not freeOf?((den := denom f)::F, x) => f - (u := isPlus(num := numer f)) case "failed" => - freeOf?(num::F, x) => 0 - f - ans:P := 0 - for term in u::List(P) repeat - if not freeOf?(term::F, x) then ans := ans + term - 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, 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, l) == - empty? l => p - q := univariate(p, first l) - cont(unitNormal(leadingCoefficient q).unit * content q, rest l) - - linearLog?(k, f, x) == - is?(k, "log"::SE) and - ((u := retractIfCan(univariate(f,k))@Union(UP,"failed")) case UP) --- and one?(degree(u::UP)) - and (degree(u::UP) = 1) - and not member?(x, variables leadingCoefficient(u::UP)) - - 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, x) == - (u := isExpt(p := ((p exquo cont(p, varselect(variables p, x)))::P))) - case "failed" => [1, p::F] - [u.exponent, u.var::F] - - if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) - and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then - intPatternMatch(f, x, int, pmint) == - ir := int(f, x) - empty?(l := notelem ir) => ir - ans := ratpart ir - nl:List(Record(integrand:F, intvar:F)) := empty() - lg := logpart ir - for rec in l repeat - u := pmint(rec.integrand, retract(rec.intvar)) - if u case ANS then - rc := u::ANS - ans := ans + rc.special - if rc.integrand ^= 0 then - ir0 := intPatternMatch(rc.integrand, x, int, pmint) - ans := ans + ratpart ir0 - lg := concat(logpart ir0, lg) - nl := concat(notelem ir0, nl) - else nl := concat(rec, nl) - mkAnswer(ans, lg, nl) - -@ -\section{package RDEEF ElementaryRischDE} -<>= -)abbrev package RDEEF ElementaryRischDE -++ Risch differential equation, elementary case. -++ Author: Manuel Bronstein -++ Date Created: 1 February 1988 -++ Date Last Updated: 2 November 1995 -++ Keywords: elementary, function, integration. -ElementaryRischDE(R, F): Exports == Implementation where - R : Join(GcdDomain, OrderedSet, CharacteristicZero, - RetractableTo Integer, LinearlyExplicitRingOver Integer) - F : Join(TranscendentalFunctionCategory, AlgebraicallyClosedField, - FunctionSpace R) - - N ==> NonNegativeInteger - Z ==> Integer - SE ==> Symbol - LF ==> List F - K ==> Kernel F - LK ==> List K - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - GP ==> LaurentPolynomial(F, UP) - Data ==> List Record(coeff:Z, argument:P) - RRF ==> Record(mainpart:F,limitedlogs:List NL) - NL ==> Record(coeff:F,logand:F) - U ==> Union(RRF, "failed") - UF ==> Union(F, "failed") - UUP ==> Union(UP, "failed") - UGP ==> Union(GP, "failed") - URF ==> Union(RF, "failed") - UEX ==> Union(Record(ratpart:F, coeff:F), "failed") - PSOL==> Record(ans:F, right:F, sol?:Boolean) - FAIL==> error("Function not supported by Risch d.e.") - ALGOP ==> "%alg" - - Exports ==> with - rischDE: (Z, F, F, SE, (F, LF) -> U, (F, F) -> UEX) -> PSOL - ++ rischDE(n, f, g, x, lim, ext) returns \spad{[y, h, b]} such that - ++ \spad{dy/dx + n df/dx y = h} and \spad{b := h = g}. - ++ The equation \spad{dy/dx + n df/dx y = g} has no solution - ++ if \spad{h \~~= g} (y is a partial solution in that case). - ++ Notes: lim is a limited integration function, and - ++ ext is an extended integration function. - - Implementation ==> add - import IntegrationTools(R, F) - import TranscendentalRischDE(F, UP) - import TranscendentalIntegration(F, UP) - import PureAlgebraicIntegration(R, F, F) - import FunctionSpacePrimitiveElement(R, F) - import ElementaryFunctionStructurePackage(R, F) - 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 f == (numer(f)::GP exquo denom(f)::GP)::GP - - logdiff(twr, bad) == - [u for u in twr | is?(u, "log"::SE) and not member?(u, bad)] - - 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, normal0(n, #1, #2, #3))) case "failed" - => [0, 0, false] - [u::F, g, true] - has?(operator kx, ALGOP) => - rec := primitiveElement(kx::F, k::F) - y := rootOf(rec.prim) - lk:LK := [kx, k] - lv:LF := [(rec.pol1) y, (rec.pol2) y] - rc := rischDE(n, eval(f, lk, lv), eval(g, lk, lv), x, limint, extint) - rc.sol? => [eval(rc.ans, retract(y)@K, rec.primelt), rc.right, true] - [0, 0, false] - FAIL - --- solve y' + n f'y = g for a rational function y - rischDE(n, f, g, x, limitedint, extendedint) == - zero? g => [0, g, true] - zero?(nfp := n * differentiate(f, x)) => - (u := limitedint(g, empty())) case "failed" => [0, 0, false] - [u.mainpart, g, true] - freeOf?(y := g / nfp, x) => [y, g, true] - vl := varselect(union(kernels nfp, kernels g), x) - symbolIfCan(k := kmax vl) case SE => normalise0(n, f, g, x) - is?(k, "log"::SE) or is?(k, "exp"::SE) => - normalise(n, nfp, f, g, x, k, limitedint, extendedint) - has?(operator k, ALGOP) => - rischDEalg(n, nfp, f, g, k, vl, x, limitedint, extendedint) - FAIL - - normal0(n, f, g, x) == - rec := normalise0(n, f, g, x) - rec.sol? => rec.ans - "failed" - --- solve y' + n f' y = g --- when f' and g are rational functions over a constant field - normalise0(n, f, g, x) == - k := kernel(x)@K - if (data1 := search(f, tab)) case "failed" then - tab.f := data := makeData(f, x, k) - else data := data1::Data - f' := nfprime := n * differentiate(f, x) - p:P := 1 - for v in data | (m := n * v.coeff) > 0 repeat - p := p * v.argument ** (m::N) - f' := f' - m * differentiate(v.argument::F, x) / (v.argument::F) - rec := baseRDE(univariate(f', k), univariate(p::F * g, k)) - y := multivariate(rec.ans, k) / p::F - rec.nosol => [y, differentiate(y, x) + nfprime * y, false] - [y, g, true] - --- make f weakly normalized, and solve y' + n f' y = g - normalise(n, nfp, f, g, x, k, limitedint, extendedint) == - if (data1:= search(f, tab)) case "failed" then - tab.f := data := makeData(f, x, k) - else data := data1::Data - p:P := 1 - for v in data | (m := n * v.coeff) > 0 repeat - p := p * v.argument ** (m::N) - f := f - v.coeff * log(v.argument::F) - nfp := nfp - m * differentiate(v.argument::F, x) / (v.argument::F) - newf := univariate(nfp, k) - newg := univariate(p::F * g, k) - twr := union(logdiff(tower f, empty()), logdiff(tower g, empty())) - ans1 := - is?(k, "log"::SE) => - rischDElog(twr, newf, newg, x, k, - differentiate(#1, differentiate(#1, x), - differentiate(k::F, x)::UP), - limitedint, extendedint) - is?(k, "exp"::SE) => - rischDEexp(twr, newf, newg, x, k, - differentiate(#1, differentiate(#1, x), - monomial(differentiate(first argument k, x), 1)), - limitedint, extendedint) - ans1 case "failed" => [0, 0, false] - [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, x, k) == - disasters := empty()$Data - fnum := numer f - fden := denom f - for u in varselect(kernels f, x) | is?(u, "log"::SE) repeat - logand := first argument u - if zero?(degree univariate(fden, u)) and --- one?(degree(num := univariate(fnum, u))) then - (degree(num := univariate(fnum, u)) = 1) then - cf := (leadingCoefficient num) / fden - if (n := retractIfCan(cf)@Union(Z, "failed")) case Z then - if degree(numer logand, k) > 0 then - disasters := concat([n::Z, numer logand], disasters) - if degree(denom logand, k) > 0 then - disasters := concat([-(n::Z), denom logand], disasters) - disasters - - 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(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(twr, aa, bb, cc, x, t, driv, limint, extint) == - zero? cc => 0 - t' := differentiate(t::F, x) - zero? bb => - (u := cc exquo aa) case "failed" => "failed" - primintfldpoly(u::UP, extint(#1, t'), t') - n := degree(cc)::Z - (db := degree(bb)::Z) - if ((da := degree(aa)::Z) = db) and (da > 0) then - lk0 := tower(f0 := - - (leadingCoefficient bb) / (leadingCoefficient aa)) - lk1 := logdiff(twr, lk0) - (if0 := limint(f0, [first argument u for u in lk1])) - case "failed" => error "Risch's theorem violated" - (alph := validExponential(lk0, RRF2F(if0::RRF), x)) case F => - return - (ans := polyDElog(twr, alph::F * aa, - differentiate(alph::F, x) * aa + alph::F * bb, - cc, x, t, driv, limint, extint)) case "failed" => "failed" - alph::F * ans::UP - if (da > db + 1) then n := max(0, degree(cc)::Z - da + 1) - if (da = db + 1) then - i := limint(- (leadingCoefficient bb) / (leadingCoefficient aa), - [first argument t]) - if not(i case "failed") then - r := - null(i.limitedlogs) => 0$F - i.limitedlogs.first.coeff - if (nn := retractIfCan(r)@Union(Z, "failed")) case Z then - n := max(nn::Z, n) - (v := polyRDE(aa, bb, cc, n, driv)) case ans => - v.ans.nosol => "failed" - v.ans.ans - w := v.eq - zero?(w.b) => - degree(w.c) > w.m => "failed" - (u := primintfldpoly(w.c, extint(#1,t'), t')) case "failed" => "failed" - degree(u::UP) > w.m => "failed" - w.alpha * u::UP + w.beta - (u := logdegrad(twr, retract(w.b), w.c, w.m, x, t, limint, extint)) - case "failed" => "failed" - w.alpha * u::UP + w.beta - - gpolDEexp(twr, a, b, c, x, t, driv, limint, extint) == - zero? c => 0 - zero? b => - (u := c exquo (a::GP)) case "failed" => "failed" - expintfldpoly(u::GP, - rischDE(#1, first argument t, #2, x, limint, extint)) - lb := boundAt0(twr, - coefficient(b, 0) / coefficient(a, 0), - nb := order b, nc := order c, x, t, limint) - tm := monomial(1, (m := max(0, max(-nb, lb - nc)))::N)$UP - (v := polyDEexp(twr,a * tm,lb * differentiate(first argument t, x) - * a * tm + retract(b * tm::GP)@UP, - retract(c * monomial(1, m - lb))@UP, - x, t, driv, limint, extint)) case "failed" => "failed" - v::UP::GP * monomial(1, lb) - - polyDEexp(twr, aa, bb, cc, x, t, driv, limint, extint) == - zero? cc => 0 - zero? bb => - (u := cc exquo aa) case "failed" => "failed" - exppolyint(u::UP, rischDE(#1, first argument t, #2, x, limint, extint)) - n := boundInf(twr,-leadingCoefficient(bb) / (leadingCoefficient aa), - degree(aa)::Z, degree(bb)::Z, degree(cc)::Z, x, t, limint) - (v := polyRDE(aa, bb, cc, n, driv)) case ans => - v.ans.nosol => "failed" - v.ans.ans - w := v.eq - zero?(w.b) => - degree(w.c) > w.m => "failed" - (u := exppolyint(w.c, - rischDE(#1, first argument t, #2, x, limint, extint))) - case "failed" => "failed" - w.alpha * u::UP + w.beta - (u := expdegrad(twr, retract(w.b), w.c, w.m, x, t, limint, extint)) - case "failed" => "failed" - w.alpha * u::UP + w.beta - - exppolyint(p, rischdiffeq) == - (u := expintfldpoly(p::GP, rischdiffeq)) case "failed" => "failed" - retractIfCan(u::GP)@Union(UP, "failed") - - boundInf(twr, f0, da, db, dc, x, t, limitedint) == - da < db => dc - db - da > db => max(0, dc - da) - l1 := logdiff(twr, l0 := tower f0) - (if0 := limitedint(f0, [first argument u for u in l1])) - case "failed" => error "Risch's theorem violated" - (alpha := validExponential(concat(t, l0), RRF2F(if0::RRF), x)) - case F => - al := separate(univariate(alpha::F, t))$GP - zero?(al.fracPart) and monomial?(al.polyPart) => - max(0, max(degree(al.polyPart), dc - db)) - dc - db - dc - db - - boundAt0(twr, f0, nb, nc, x, t, limitedint) == - nb ^= 0 => min(0, nc - min(0, nb)) - l1 := logdiff(twr, l0 := tower f0) - (if0 := limitedint(f0, [first argument u for u in l1])) - case "failed" => error "Risch's theorem violated" - (alpha := validExponential(concat(t, l0), RRF2F(if0::RRF), x)) - case F => - al := separate(univariate(alpha::F, t))$GP - zero?(al.fracPart) and monomial?(al.polyPart) => - min(0, min(degree(al.polyPart), nc)) - min(0, nc) - min(0, nc) - --- case a = 1, deg(B) = 0, B <> 0 --- cancellation at infinity is possible - logdegrad(twr, b, c, n, x, t, limitedint, extint) == - t' := differentiate(t::F, x) - lk1 := logdiff(twr, lk0 := tower(f0 := - b)) - (if0 := limitedint(f0, [first argument u for u in lk1])) - case "failed" => error "Risch's theorem violated" - (alpha := validExponential(lk0, RRF2F(if0::RRF), x)) case F => - (u1 := primintfldpoly(inv(alpha::F) * c, extint(#1, t'), t')) - case "failed" => "failed" - degree(u1::UP)::Z > n => "failed" - alpha::F * u1::UP - logdeg(c, - if0.mainpart - - +/[v.coeff * log(v.logand) for v in if0.limitedlogs], - n, x, t', limitedint, extint) - --- case a = 1, degree(b) = 0, and (exp integrate b) is not in F --- this implies no cancellation at infinity - logdeg(c, f, n, x, t', limitedint, extint) == - answr:UP := 0 - repeat - zero? c => return answr - (n < 0) or ((m := degree c)::Z > n) => return "failed" - u := rischDE(1, f, leadingCoefficient c, x, limitedint, extint) - ~u.sol? => return "failed" - zero? m => return(answr + u.ans::UP) - n := m::Z - 1 - c := (reductum c) - monomial(m::Z * t' * u.ans, (m - 1)::N) - answr := answr + monomial(u.ans, m) - --- case a = 1, deg(B) = 0, B <> 0 --- cancellation at infinity is possible - 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])) - case "failed" => error "Risch's theorem violated" - intf0 := - if0.mainpart - - +/[v.coeff * log(v.logand) for v in if0.limitedlogs] - (alpha := validExponential(concat(t, lk0), RRF2F(if0::RRF), x)) - case F => - al := separate(univariate(alpha::F, t))$GP - zero?(al.fracPart) and monomial?(al.polyPart) and - (degree(al.polyPart) >= 0) => - (u1 := expintfldpoly(c::GP * recip(al.polyPart)::GP, - rischDE(#1, first argument t, #2, x, limint, extint))) - case "failed" => "failed" - degree(u1::GP) > n => "failed" - retractIfCan(al.polyPart * u1::GP)@Union(UP, "failed") - expdeg(c, intf0, n, x, first argument t, limint,extint) - expdeg(c, intf0, n, x, first argument t, limint, extint) - --- case a = 1, degree(b) = 0, and (exp integrate b) is not a monomial --- this implies no cancellation at infinity - expdeg(c, f, n, x, eta, limitedint, extint) == - answr:UP := 0 - repeat - zero? c => return answr - (n < 0) or ((m := degree c)::Z > n) => return "failed" - u := rischDE(1, f + m * eta, leadingCoefficient c, x,limitedint,extint) - ~u.sol? => return "failed" - zero? m => return(answr + u.ans::UP) - n := m::Z - 1 - c := reductum c - answr := answr + monomial(u.ans, m) - - RRF2F rrf == - rrf.mainpart + +/[v.coeff*log(v.logand) for v in rrf.limitedlogs] - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- SPAD files for the integration world should be compiled in the --- following order: --- --- intaux rderf intrf curve curvepkg divisor pfo --- intalg intaf efstruc RDEEF intef irexpand integrat - -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rderf.spad.pamphlet b/src/algebra/rderf.spad.pamphlet deleted file mode 100644 index 33dcd1d..0000000 --- a/src/algebra/rderf.spad.pamphlet +++ /dev/null @@ -1,226 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rderf.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package RDETR TranscendentalRischDE} -<>= -)abbrev package RDETR TranscendentalRischDE -++ Risch differential equation, transcendental case. -++ Author: Manuel Bronstein -++ Date Created: Jan 1988 -++ Date Last Updated: 2 November 1995 -TranscendentalRischDE(F, UP): Exports == Implementation where - F : Join(Field, CharacteristicZero, RetractableTo Integer) - UP : UnivariatePolynomialCategory F - - N ==> NonNegativeInteger - Z ==> Integer - RF ==> Fraction UP - REC ==> Record(a:UP, b:UP, c:UP, t:UP) - SPE ==> Record(b:UP, c:UP, m:Z, alpha:UP, beta:UP) - PSOL==> Record(ans:UP, nosol:Boolean) - ANS ==> Union(ans:PSOL, eq:SPE) - PSQ ==> Record(ans:RF, nosol:Boolean) - - Exports ==> with - monomRDE: (RF,RF,UP->UP) -> Union(Record(a:UP,b:RF,c:RF,t:UP), "failed") - ++ monomRDE(f,g,D) returns \spad{[A, B, C, T]} such that - ++ \spad{y' + f y = g} has a solution if and only if \spad{y = Q / T}, - ++ where Q satisfies \spad{A Q' + B Q = C} and has no normal pole. - ++ A and T are polynomials and B and C have no normal poles. - ++ D is the derivation to use. - baseRDE : (RF, RF) -> PSQ - ++ baseRDE(f, g) returns a \spad{[y, b]} such that \spad{y' + fy = g} - ++ if \spad{b = true}, y is a partial solution otherwise (no solution - ++ in that case). - ++ D is the derivation to use. - polyRDE : (UP, UP, UP, Z, UP -> UP) -> ANS - ++ polyRDE(a, B, C, n, D) returns either: - ++ 1. \spad{[Q, b]} such that \spad{degree(Q) <= n} and - ++ \spad{a Q'+ B Q = C} if \spad{b = true}, Q is a partial solution - ++ otherwise. - ++ 2. \spad{[B1, C1, m, \alpha, \beta]} such that any polynomial solution - ++ of degree at most n of \spad{A Q' + BQ = C} must be of the form - ++ \spad{Q = \alpha H + \beta} where \spad{degree(H) <= m} and - ++ H satisfies \spad{H' + B1 H = C1}. - ++ D is the derivation to use. - - Implementation ==> add - 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(aa, bb, cc, d, derivation) == - n:Z - (u := SPDE(aa, bb, cc, d, derivation)) case "failed" => [[0, true]] - zero?(u.c) => [[u.beta, false]] --- baseCase? := one?(dt := derivation monomial(1, 1)) - baseCase? := ((dt := derivation monomial(1, 1)) = 1) - n := degree(dt)::Z - 1 - b0? := zero?(u.b) - (~b0?) and (baseCase? or degree(u.b) > max(0, n)) => - answ := SPDEnocancel1(u.b, u.c, u.m, derivation) - [[u.alpha * answ.ans + u.beta, answ.nosol]] - (n > 0) and (b0? or degree(u.b) < n) => - uansw := SPDEnocancel2(u.b,u.c,u.m,n,leadingCoefficient dt,derivation) - uansw case ans=> [[u.alpha * uansw.ans.ans + u.beta, uansw.ans.nosol]] - [[uansw.eq.b, uansw.eq.c, uansw.eq.m, - u.alpha * uansw.eq.alpha, u.alpha * uansw.eq.beta + u.beta]] - b0? and baseCase? => - degree(u.c) >= u.m => [[0, true]] - [[u.alpha * integrate(u.c) + u.beta, false]] - [u::SPE] - --- cancellation at infinity is possible, A is assumed nonzero --- if u.b = 0 then u.a = 1 already, but no degree check is done --- returns "failed" if a p' + b p = c has no soln of degree at most d, --- 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(aa, bb, cc, d, derivation) == - zero? cc => [0, 0, 0, 0, 0] - d < 0 => "failed" - (u := cc exquo (g := gcd(aa, bb))) case "failed" => "failed" - aa := (aa exquo g)::UP - bb := (bb exquo g)::UP - cc := u::UP - (ra := retractIfCan(aa)@Union(F, "failed")) case F => - a1 := inv(ra::F) - [a1 * bb, a1 * cc, d, 1, 0] - bc := extendedEuclidean(bb, aa, cc)::Record(coef1:UP, coef2:UP) - qr := divide(bc.coef1, aa) - r := qr.remainder -- z = bc.coef2 + b * qr.quotient - (v := SPDE(aa, bb + derivation aa, - bc.coef2 + bb * qr.quotient - derivation r, - d - degree(aa)::Z, derivation)) case "failed" => "failed" - [v.b, v.c, v.m, aa * v.alpha, aa * v.beta + r] - --- solves q' + b q = c with deg(q) <= d --- case (B <> 0) and (D = d/dt or degree(B) > max(0, degree(Dt) - 1)) --- 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(bb, cc, d, derivation) == - q:UP := 0 - db := (degree bb)::Z - lb := leadingCoefficient bb - while cc ^= 0 repeat - d < 0 or (n := (degree cc)::Z - db) < 0 or n > d => return [q, true] - r := monomial((leadingCoefficient cc) / lb, n::N) - cc := cc - bb * r - derivation r - d := n - 1 - q := q + r - [q, false] - --- 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(bb, cc, d, dtm1, lt, derivation) == - q:UP := 0 - while cc ^= 0 repeat - d < 0 or (n := (degree cc)::Z - dtm1) < 0 or n > d => return [[q, true]] - if n > 0 then - r := monomial((leadingCoefficient cc) / (n * lt), n::N) - cc := cc - bb * r - derivation r - d := n - 1 - q := q + r - else -- n = 0 so solution must have degree 0 - db:N := (zero? bb => 0; degree bb); - db ^= degree(cc) => return [[q, true]] - zero? db => return [[bb, cc, 0, 1, q]] - r := leadingCoefficient(cc) / leadingCoefficient(bb) - cc := cc - r * bb - derivation(r::UP) - d := - 1 - q := q + r::UP - [[q, false]] - - 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 - (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed" - [aa, aa * f - (d * derivation tt)::RF, u::UP * e * g, tt] - --- solve y' + f y = g for y in RF --- assumes that f is weakly normalized (no finite cancellation) --- base case: F' = 0 - 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) - v := polyRDE(u.a, bb, cc, n, differentiate).ans - [v.ans / u.t, v.nosol] - --- 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(a, b, dc) == - da := (degree a)::Z - zero? b => max(0, dc - da + 1) - db := (degree b)::Z - da > (db + 1) => max(0, dc - da + 1) - da < (db + 1) => dc - db - (n := retractIfCan(- leadingCoefficient(b) / leadingCoefficient(a) - )@Union(Z, "failed")) case Z => max(n::Z, dc - db) - dc - db - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- SPAD files for the integration world should be compiled in the --- following order: --- --- intaux RDERF intrf rdeef intef irexpand integrat - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rdesys.spad.pamphlet b/src/algebra/rdesys.spad.pamphlet deleted file mode 100644 index b2eabef..0000000 --- a/src/algebra/rdesys.spad.pamphlet +++ /dev/null @@ -1,362 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rdesys.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package RDETRS TranscendentalRischDESystem} -<>= -)abbrev package RDETRS TranscendentalRischDESystem -++ Risch differential equation system, transcendental case. -++ Author: Manuel Bronstein -++ Date Created: 17 August 1992 -++ Date Last Updated: 3 February 1994 -TranscendentalRischDESystem(F, UP): Exports == Implementation where - F : Join(Field, CharacteristicZero, RetractableTo Integer) - UP : UnivariatePolynomialCategory F - - N ==> NonNegativeInteger - Z ==> Integer - RF ==> Fraction UP - V ==> Vector UP - U ==> Union(List UP, "failed") - REC ==> Record(z1:UP, z2:UP, r1:UP, r2:UP) - - Exports ==> with - monomRDEsys: (RF, RF, RF, UP -> UP) -> _ - Union(Record(a:UP, b:RF, h:UP, c1:RF, c2:RF, t:UP),"failed") - ++ monomRDEsys(f,g1,g2,D) returns \spad{[A, B, H, C1, C2, T]} such that - ++ \spad{(y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2)} has a solution - ++ if and only if \spad{y1 = Q1 / T, y2 = Q2 / T}, - ++ where \spad{B,C1,C2,Q1,Q2} have no normal poles and satisfy - ++ A \spad{(Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2)} - ++ D is the derivation to use. - baseRDEsys: (RF, RF, RF) -> Union(List RF, "failed") - ++ baseRDEsys(f, g1, g2) returns fractions \spad{y_1.y_2} such that - ++ \spad{(y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2)} - ++ if \spad{y_1,y_2} exist, "failed" otherwise. - - Implementation ==> add - 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(f, g1, g2, derivation) == - gg := gcd(d := normalDenom(f, derivation), - e := lcm(normalDenom(g1,derivation),normalDenom(g2,derivation))) - tt := (gcd(e, differentiate e) exquo gcd(gg,differentiate gg))::UP - (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed" - [aa, tt * d * f, - d * derivation tt, u::UP * e * g1, u::UP * e * g2, tt] - --- 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(f, g1, g2) == - zero? f => error "baseRDEsys: f must be nonzero" - zero? g1 and zero? g2 => [0, 0] - (u := monomRDEsys(f, g1, g2, differentiate)) case "failed" => "failed" - n := getBound(u.a, bb := retract(u.b), u.h, - cc1 := retract(u.c1), cc2 := retract(u.c2)) - (v := SPDEsys(u.a, bb, u.h, cc1, cc2, n, differentiate, - DSPDEsys(#1, #2::UP, #3::UP, #4, #5, #6, differentiate))) - case "failed" => "failed" - l := v::List(UP) - [first(l) / u.t, second(l) / u.t] - --- solve --- D1 = A Z1 + B R1 - C R2 --- D2 = A Z2 + C R1 + B R2 --- 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(a, b, c, d1, d2) == - (u := diophantineSystem(matrix [[a,0,b,-c], [0,a,c,b]], - vector [d1,d2]).particular) case "failed" => "failed" - v := u::V - qr1 := divide(v 3, a) - qr2 := divide(v 4, a) - [v.1 + b * qr1.quotient - c * qr2.quotient, - v.2 + c * qr1.quotient + b * qr2.quotient, qr1.remainder, qr2.remainder] - --- solve --- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2) --- for polynomials Q1 and Q2 with degree <= n --- A and B are nonzero --- cancellation at infinity is possible - SPDEsys(a, b, h, c1, c2, n, derivation, degradation) == - zero? c1 and zero? c2 => [0, 0] - n < 0 => "failed" - g := gcd(a, gcd(b, h)) - ((u1 := c1 exquo g) case "failed") or - ((u2 := c2 exquo g) case "failed") => "failed" - a := (a exquo g)::UP - b := (b exquo g)::UP - h := (h exquo g)::UP - c1 := u1::UP - c2 := u2::UP - (da := degree a) > 0 => - (u := diophant(a, h, b, c1, c2)) case "failed" => "failed" - rec := u::REC - v := SPDEsys(a, b, h + derivation a, rec.z1 - derivation(rec.r1), - rec.z2 - derivation(rec.r2),n-da::Z,derivation,degradation) - v case "failed" => "failed" - l := v::List(UP) - [a * first(l) + rec.r1, a * second(l) + rec.r2] - ra := retract(a)@F - ((rb := retractIfCan(b)@Union(F, "failed")) case "failed") or - ((rh := retractIfCan(h)@Union(F, "failed")) case "failed") => - DSPDEsys(ra, b, h, c1, c2, n, derivation) - degradation(ra, rb::F, rh::F, c1, c2, n) - --- solve --- a (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2) --- 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(a, b, h, c1, c2, n, derivation) == - bb := degree(b)::Z - hh:Z := - zero? h => 0 - degree(h)::Z - lb := leadingCoefficient b - lh := leadingCoefficient h - bb < hh => - DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,DSPDEhdom(#1,#2,#3,#4,#5,hh)) - bb > hh => - DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,DSPDEbdom(#1,#2,#3,#4,#5,bb)) - det := lb * lb + lh * lh - DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,DSPDEmix(#1,#2,#3,#4,#5,bb,det)) - - DSPDEsys0(a, b, h, c1, c2, lb, lh, n, derivation, getlc) == - ans1 := ans2 := 0::UP - repeat - zero? c1 and zero? c2 => return [ans1, ans2] - n < 0 or (u := getlc(c1,c2,lb,lh,n::N)) case "failed" => return "failed" - lq := u::List(UP) - q1 := first lq - q2 := second lq - c1 := c1 - a * derivation(q1) - h * q1 + b * q2 - c2 := c2 - a * derivation(q2) - b * q1 - h * q2 - n := n - 1 - ans1 := ans1 + q1 - ans2 := ans2 + q2 - - DSPDEmix(c1, c2, lb, lh, n, d, det) == - rh1:F := - zero? c1 => 0 - (d1 := degree(c1)::Z - d) < n => 0 - d1 > n => return "failed" - leadingCoefficient c1 - rh2:F := - zero? c2 => 0 - (d2 := degree(c2)::Z - d) < n => 0 - d2 > n => return "failed" - leadingCoefficient c2 - q1 := (rh1 * lh + rh2 * lb) / det - q2 := (rh2 * lh - rh1 * lb) / det - [monomial(q1, n), monomial(q2, n)] - - - DSPDEhdom(c1, c2, lb, lh, n, d) == - q1:UP := - zero? c1 => 0 - (d1 := degree(c1)::Z - d) < n => 0 - d1 > n => return "failed" - monomial(leadingCoefficient(c1) / lh, n) - q2:UP := - zero? c2 => 0 - (d2 := degree(c2)::Z - d) < n => 0 - d2 > n => return "failed" - monomial(leadingCoefficient(c2) / lh, n) - [q1, q2] - - DSPDEbdom(c1, c2, lb, lh, n, d) == - q1:UP := - zero? c2 => 0 - (d2 := degree(c2)::Z - d) < n => 0 - d2 > n => return "failed" - monomial(leadingCoefficient(c2) / lb, n) - q2:UP := - zero? c1 => 0 - (d1 := degree(c1)::Z - d) < n => 0 - d1 > n => return "failed" - monomial(- leadingCoefficient(c1) / lb, n) - [q1, q2] - --- return a common bound on the degrees of a solution of --- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2), Q1 = y1 T, Q2 = y2 T --- cancellation at infinity is possible --- a and b are nonzero --- base case: F' = 0 - getBound(a, b, h, c1, c2) == - da := (degree a)::Z - dc := - zero? c1 => degree(c2)::Z - zero? c2 => degree(c1)::Z - max(degree c1, degree c2)::Z - hh:Z := - zero? h => 0 - degree(h)::Z - db := max(hh, bb := degree(b)::Z) - da < db + 1 => dc - db - da > db + 1 => max(0, dc - da + 1) - bb >= hh => dc - db - (n := retractIfCan(leadingCoefficient(h) / leadingCoefficient(a) - )@Union(Z, "failed")) case Z => max(n::Z, dc - db) - dc - db - -@ -\section{package RDEEFS ElementaryRischDESystem} -<>= -)abbrev package RDEEFS ElementaryRischDESystem -++ Risch differential equation, elementary case. -++ Author: Manuel Bronstein -++ Date Created: 12 August 1992 -++ Date Last Updated: 17 August 1992 -++ Keywords: elementary, function, integration. -ElementaryRischDESystem(R, F): Exports == Implementation where - R : Join(GcdDomain, OrderedSet, CharacteristicZero, - RetractableTo Integer, LinearlyExplicitRingOver Integer) - F : Join(TranscendentalFunctionCategory, AlgebraicallyClosedField, - FunctionSpace R) - - Z ==> Integer - SE ==> Symbol - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - NL ==> Record(coeff:F,logand:F) - RRF ==> Record(mainpart:F,limitedlogs:List NL) - U ==> Union(RRF, "failed") - ULF ==> Union(List F, "failed") - UEX ==> Union(Record(ratpart:F, coeff:F), "failed") - - Exports ==> with - rischDEsys: (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF - ++ rischDEsys(n, f, g_1, g_2, x,lim,ext) returns \spad{y_1.y_2} such that - ++ \spad{(dy1/dx,dy2/dx) + ((0, - n df/dx),(n df/dx,0)) (y1,y2) = (g1,g2)} - ++ if \spad{y_1,y_2} exist, "failed" otherwise. - ++ lim is a limited integration function, - ++ ext is an extended integration function. - - Implementation ==> add - import IntegrationTools(R, F) - import ElementaryRischDE(R, F) - import TranscendentalRischDESystem(F, UP) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R, P, F) - --- sm1 := sqrt(-1::F) --- ks1 := retract(sm1)@K - --- gcoeffs : P -> ULF --- gets1coeffs: F -> ULF --- cheat : (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF - basecase : (F, F, F, K) -> ULF - --- solve (y1',y2') + ((0, -nfp), (nfp, 0)) (y1,y2) = (g1, g2), base case - basecase(nfp, g1, g2, k) == - (ans := baseRDEsys(univariate(nfp, k), univariate(g1, k), - univariate(g2, k))) case "failed" => "failed" - l := ans::List(RF) - [multivariate(first l, k), multivariate(second l, k)] - --- returns [x,y] s.t. f = x + y %i --- f can be of the form (a + b %i) / (c + d %i) --- gets1coeffs f == --- (lnum := gcoeffs(numer f)) case "failed" => "failed" --- (lden := gcoeffs(denom f)) case "failed" => "failed" --- a := first(lnum::List F) --- b := second(lnum::List F) --- c := first(lden::List F) --- zero?(d := second(lden::List F)) => [a/c, b/c] --- cd := c * c + d * d --- [(a * c + b * d) / cd, (b * c - a * d) / cd] - --- gcoeffs p == --- degree(q := univariate(p, ks1)) > 1 => "failed" --- [coefficient(q, 0)::F, coefficient(q, 1)::F] - --- cheat(n, f, g1, g2, x, limint, extint) == --- (u := rischDE(n, sm1 * f, g1 + sm1 * g2, x, limint, extint)) --- case "failed" => "failed" --- (l := gets1coeffs(u::F)) case "failed" => --- error "rischDEsys: expect linear result in sqrt(-1)" --- l::List F - --- solve (y1',y2') + ((0, -n f'), (n f', 0)) (y1,y2) = (g1, g2) - rischDEsys(n, f, g1, g2, x, limint, extint) == - zero? g1 and zero? g2 => [0, 0] - zero?(nfp := n * differentiate(f, x)) => - ((u1 := limint(g1, empty())) case "failed") or - ((u2 := limint(g1, empty())) case "failed") => "failed" - [u1.mainpart, u2.mainpart] - freeOf?(y1 := g2 / nfp, x) and freeOf?(y2 := - g1 / nfp, x) => [y1, y2] - vl := varselect(union(kernels nfp, union(kernels g1, kernels g2)), x) - symbolIfCan(k := kmax vl) case SE => basecase(nfp, g1, g2, k) --- cheat(n, f, g1, g2, x, limint, extint) - error "rischDEsys: can only handle rational functions for now" - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/real0q.spad.pamphlet b/src/algebra/real0q.spad.pamphlet deleted file mode 100644 index 5a891c9..0000000 --- a/src/algebra/real0q.spad.pamphlet +++ /dev/null @@ -1,129 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra real0q.spad} -\author{Andy Neff, Barry Trager} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package REAL0Q RealZeroPackageQ} -<>= -)abbrev package REAL0Q RealZeroPackageQ -++ Author: Andy Neff, Barry Trager -++ Date Created: -++ Date Last Updated: 7 April 1991 -++ Basic Functions: -++ Related Constructors: UnivariatePolynomial, RealZeroPackageQ -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package provides functions for finding the real zeros -++ of univariate polynomials over the rational numbers to arbitrary user-specified -++ precision. The results are returned as a list of -++ isolating intervals, expressed as records with "left" and "right" rational number components. - -RealZeroPackageQ(Pol): T == C where - RN ==> Fraction Integer - I ==> Integer - SUP ==> SparseUnivariatePolynomial - Pol: UnivariatePolynomialCategory RN - Interval ==> Record(left : RN, right : RN) - isoList ==> List(Interval) - ApproxInfo ==> Record(approx : RN, exFlag : Boolean) - T == with - -- next two functions find isolating intervals - realZeros: (Pol) -> isoList - ++ realZeros(pol) returns a list of isolating intervals for - ++ all the real zeros of the univariate polynomial pol. - realZeros: (Pol, Interval) -> isoList - ++ realZeros(pol, range) returns a list of isolating intervals - ++ for all the real zeros of the univariate polynomial pol which - ++ lie in the interval expressed by the record range. - -- next two functions return intervals smaller then tolerence - realZeros: (Pol, RN) -> isoList - ++ realZeros(pol, eps) returns a list of intervals of length less - ++ than the rational number eps for all the real roots of the - ++ polynomial pol. - realZeros: (Pol, Interval, RN) -> isoList - ++ realZeros(pol, int, eps) returns a list of intervals of length - ++ less than the rational number eps for all the real roots of the - ++ polynomial pol which lie in the interval expressed by the - ++ record int. - refine: (Pol, Interval, RN) -> Interval - ++ refine(pol, int, eps) refines the interval int containing - ++ exactly one root of the univariate polynomial pol to size less - ++ than the rational number eps. - refine: (Pol, Interval, Interval) -> Union(Interval,"failed") - ++ refine(pol, int, range) takes a univariate polynomial pol and - ++ and isolating interval int which must contain exactly one real - ++ root of pol, and returns an isolating interval which - ++ is contained within range, or "failed" if no such isolating interval exists. - C == add - 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(f : Pol) == realZeros(convert2PolInt f) - realZeros(f : Pol, rn : RN) == realZeros(convert2PolInt f, rn) - realZeros(f : Pol, bounds : Interval) == - realZeros(convert2PolInt f, bounds) - realZeros(f : Pol, bounds : Interval, rn : RN) == - realZeros(convert2PolInt f, bounds, rn) - refine(f : Pol, int : Interval, eps : RN) == - refine(convert2PolInt f, int, eps) - refine(f : Pol, int : Interval, bounds : Interval) == - refine(convert2PolInt f, int, bounds) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/realzero.spad.pamphlet b/src/algebra/realzero.spad.pamphlet deleted file mode 100644 index 2737413..0000000 --- a/src/algebra/realzero.spad.pamphlet +++ /dev/null @@ -1,347 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra realzero.spad} -\author{Andy Neff} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package REAL0 RealZeroPackage} -<>= -)abbrev package REAL0 RealZeroPackage -++ Author: Andy Neff -++ Date Created: -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: UnivariatePolynomial, RealZeroPackageQ -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package provides functions for finding the real zeros -++ of univariate polynomials over the integers to arbitrary user-specified -++ precision. The results are returned as a list of -++ isolating intervals which are expressed as records with "left" and "right" rational number -++ components. - -RealZeroPackage(Pol): T == C where - Pol: UnivariatePolynomialCategory Integer - RN ==> Fraction Integer - Interval ==> Record(left : RN, right : RN) - isoList ==> List(Interval) - T == with - -- next two functions find isolating intervals - realZeros: (Pol) -> isoList - ++ realZeros(pol) returns a list of isolating intervals for - ++ all the real zeros of the univariate polynomial pol. - realZeros: (Pol, Interval) -> isoList - ++ realZeros(pol, range) returns a list of isolating intervals - ++ for all the real zeros of the univariate polynomial pol which - ++ lie in the interval expressed by the record range. - -- next two functions return intervals smaller then tolerence - realZeros: (Pol, RN) -> isoList - ++ realZeros(pol, eps) returns a list of intervals of length less - ++ than the rational number eps for all the real roots of the - ++ polynomial pol. - realZeros: (Pol, Interval, RN) -> isoList - ++ realZeros(pol, int, eps) returns a list of intervals of length - ++ less than the rational number eps for all the real roots of the - ++ polynomial pol which lie in the interval expressed by the - ++ record int. - refine: (Pol, Interval, RN) -> Interval - ++ refine(pol, int, eps) refines the interval int containing - ++ exactly one root of the univariate polynomial pol to size less - ++ than the rational number eps. - refine: (Pol, Interval, Interval) -> Union(Interval,"failed") - ++ refine(pol, int, range) takes a univariate polynomial pol and - ++ and isolating interval int containing exactly one real - ++ root of pol; the operation returns an isolating interval which - ++ is contained within range, or "failed" if no such isolating interval exists. - midpoint: Interval -> RN - ++ midpoint(int) returns the midpoint of the interval int. - midpoints: isoList -> List RN - ++ midpoints(isolist) returns the list of midpoints for the list - ++ of intervals isolist. - C == add - --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(int : Interval):Interval == [-int.right,-int.left] - - midpoint(i : Interval):RN == (1/2)*(i.left + i.right) - - midpoints(li : isoList) : List RN == - [midpoint x for x in li] - - makeSqfr(F : Pol):Pol == - sqfr := squareFree F - F := */[s.factor for s in factors(sqfr)] - - realZeros(F : Pol) == - ReZeroSqfr makeSqfr F - - realZeros(F : Pol, rn : RN) == - F := makeSqfr F - [refine(F,int,rn) for int in ReZeroSqfr(F)] - - realZeros(F : Pol, bounds : Interval) == - F := makeSqfr F - [rint::Interval for int in ReZeroSqfr(F) | - (rint:=refine(F,int,bounds)) case Interval] - - realZeros(F : Pol, bounds : Interval, rn : RN) == - F := makeSqfr F - [refine(F,int,rn) for int in realZeros(F,bounds)] - - ReZeroSqfr(F : Pol) == - F = 0 => error "ReZeroSqfr: zero polynomial" - L : isoList := [] - degree(F) = 0 => L - if (r := minimumDegree(F)) > 0 then - L := [[0,0]$Interval] - tempF := F exquo monomial(1, r) - if not (tempF case "failed") then - F := tempF - J:isoList := [negate int for int in reverse(PosZero(minus(F)))] - K : isoList := PosZero(F) - append(append(J, L), K) - - 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(F : Pol) == --returns isoList for roots of F in (0,1) - J : isoList - K : isoList - L : isoList - L := [] - (v := var(transAdd1(invert(F)))) = 0 => [] - v = 1 => L := [[0,1]$Interval] - G : Pol := transMultInv(2, F) - H : Pol := transAdd1(G) - if minimumDegree H > 0 then - -- H has a root at 0 => F has one at 1/2, and G at 1 - L := [[1/2,1/2]$Interval] - Q : Pol := monomial(1, 1) - tempH : Union(Pol, "failed") := H exquo Q - if not (tempH case "failed") then H := tempH - Q := Q + monomial(-1, 0) - tempG : Union(Pol, "failed") := G exquo Q - if not (tempG case "failed") then G := tempG - int : Interval - J := [[(int.left+1)* (1/2),(int.right+1) * (1/2)]$Interval - for int in Zero1(H)] - K := [[int.left * (1/2), int.right * (1/2)]$Interval - for int in Zero1(G)] - append(append(J, L), K) - - rootBound(F : Pol) == --returns power of 2 that is a bound - --for the positive roots of F - if leadingCoefficient(F) < 0 then F := -F - lcoef := leadingCoefficient(F) - F := reductum(F) - i : Integer := 0 - while not (F = 0) repeat - if (an := leadingCoefficient(F)) < 0 then i := i - an - F := reductum(F) - b : Integer := 1 - while (b * lcoef) <= i repeat - b := 2 * b - b - - transMult(c : Integer, F : Pol) == - --computes Pol G such that G(x) = F(c*x) - G : Pol := 0 - while not (F = 0) repeat - n := degree(F) - G := G + monomial((c**n) * leadingCoefficient(F), n) - F := reductum(F) - G - - transMultInv(c : Integer, F : Pol) == - --computes Pol G such that G(x) = (c**n) * F(x/c) - d := degree(F) - cc : Integer := 1 - G : Pol := monomial(leadingCoefficient F,d) - while (F:=reductum(F)) ^= 0 repeat - n := degree(F) - cc := cc*(c**(d-n):NonNegativeInteger) - G := G + monomial(cc * leadingCoefficient(F), n) - d := n - G - --- otransAdd1(F : Pol) == --- --computes Pol G such that G(x) = F(x+1) --- G : Pol := F --- n : Integer := 1 --- while (F := differentiate(F)) ^= 0 repeat --- if not ((tempF := F exquo n) case "failed") then F := tempF --- G := G + F --- n := n + 1 --- G - - transAdd1(F : Pol) == - --computes Pol G such that G(x) = F(x+1) - n := degree F - v := vectorise(F, n+1) - for i in 0..(n-1) repeat - for j in (n-i)..n repeat - qsetelt_!(v,j, qelt(v,j) + qelt(v,(j+1))) - ans : Pol := 0 - for i in 0..n repeat - ans := ans + monomial(qelt(v,(i+1)),i) - ans - - - minus(F : Pol) == - --computes Pol G such that G(x) = F(-x) - G : Pol := 0 - while not (F = 0) repeat - n := degree(F) - coef := leadingCoefficient(F) - odd? n => - G := G + monomial(-coef, n) - F := reductum(F) - G := G + monomial(coef, n) - F := reductum(F) - G - - invert(F : Pol) == - --computes Pol G such that G(x) = (x**n) * F(1/x) - G : Pol := 0 - n := degree(F) - while not (F = 0) repeat - G := G + monomial(leadingCoefficient(F), - (n-degree(F))::NonNegativeInteger) - F := reductum(F) - G - - var(F : Pol) == --number of sign variations in coefs of F - i : Integer := 0 - LastCoef : Boolean - next : Boolean - LastCoef := leadingCoefficient(F) < 0 - while not ((F := reductum(F)) = 0) repeat - next := leadingCoefficient(F) < 0 - if ((not LastCoef) and next) or - ((not next) and LastCoef) then i := i+1 - LastCoef := next - i - - refine(F : Pol, int : Interval, bounds : Interval) == - lseg := min(int.right,bounds.right) - max(int.left,bounds.left) - lseg < 0 => "failed" - lseg = 0 => - pt := - int.left = bounds.right => int.left - int.right - elt(transMultInv(denom(pt),F),numer pt) = 0 => [pt,pt] - "failed" - lseg = int.right - int.left => int - refine(F, refine(F, int, lseg), bounds) - - refine(F : Pol, int : Interval, eps : RN) == - a := int.left - b := int.right - a=b => [a,b]$Interval - an : Integer := numer(a) - ad : Integer := denom(a) - bn : Integer := numer(b) - bd : Integer := denom(b) - xfl : Boolean := false - if (u:=elt(transMultInv(ad, F), an)) = 0 then - F := (F exquo (monomial(ad,1)-monomial(an,0)))::Pol - u:=elt(transMultInv(ad, F), an) - if (v:=elt(transMultInv(bd, F), bn)) = 0 then - F := (F exquo (monomial(bd,1)-monomial(bn,0)))::Pol - v:=elt(transMultInv(bd, F), bn) - u:=elt(transMultInv(ad, F), an) - if u > 0 then (F:=-F;v:=-v) - if v < 0 then - error [int, "is not a valid isolation interval for", F] - if eps <= 0 then error "precision must be positive" - while (b - a) >= eps repeat - mid : RN := (b + a) * (1/2) - midn : Integer := numer(mid) - midd : Integer := denom(mid) - (v := elt(transMultInv(midd, F), midn)) < 0 => - a := mid - an := midn - ad := midd - v > 0 => - b := mid - bn := midn - bd := midd - v = 0 => - a := mid - b := mid - an := midn - ad := midd - xfl := true - [a, b]$Interval - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rec.spad.pamphlet b/src/algebra/rec.spad.pamphlet deleted file mode 100644 index 8cedd33..0000000 --- a/src/algebra/rec.spad.pamphlet +++ /dev/null @@ -1,535 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{rec.spad} -\author{Martin Rubey} -\maketitle -\begin{abstract} - The package defined in this file provide an operator for the - $n$\textsuperscript{th} term of a recurrence and an operator for the - coefficient of $x^n$ in a function specified by a functional equation. -\end{abstract} -\tableofcontents -\section{package RECOP RecurrenceOperator} -<>= -)abbrev package RECOP RecurrenceOperator -++ Author: Martin Rubey -++ Description: -++ This package provides an operator for the n-th term of a recurrence and an -++ operator for the coefficient of x^n in a function specified by a functional -++ equation. -RecurrenceOperator(R, F): Exports == Implementation where - R: Join(OrderedSet, IntegralDomain, ConvertibleTo InputForm) - F: Join(FunctionSpace R, AbelianMonoid, RetractableTo Integer, _ - RetractableTo Symbol, PartialDifferentialRing Symbol, _ - CombinatorialOpsCategory) ---RecurrenceOperator(F): Exports == Implementation where --- F: Join(ExpressionSpace, AbelianMonoid, RetractableTo Integer, --- RetractableTo Symbol, PartialDifferentialRing Symbol) - - Exports == with - - evalRec: (BasicOperator, Symbol, F, F, F, List F) -> F - ++ \spad{evalRec(u, dummy, n, n0, eq, values)} creates an expression that - ++ stands for u(n0), where u(n) is given by the equation eq. However, for - ++ technical reasons the variable n has to be replaced by a dummy - ++ variable dummy in eq. The argument values specifies the initial values - ++ of the recurrence u(0), u(1),... - ++ For the moment we don't allow recursions that contain u inside of - ++ another operator. - - evalADE: (BasicOperator, Symbol, F, F, F, List F) -> F - ++ \spad{evalADE(f, dummy, x, n, eq, values)} creates an expression that - ++ stands for the coefficient of x^n in the Taylor expansion of f(x), - ++ where f(x) is given by the functional equation eq. However, for - ++ technical reasons the variable x has to be replaced by a dummy - ++ variable dummy in eq. The argument values specifies the first few - ++ Taylor coefficients. - - getEq: F -> F - ++ \spad{getEq f} returns the defining equation, if f represents the - ++ coefficient of an ADE or a recurrence. - - getOp: F -> BasicOperator - ++ \spad{getOp f}, if f represents the coefficient of a recurrence or - ++ ADE, returns the operator representing the solution - - --- should be local - numberOfValuesNeeded: (Integer, BasicOperator, Symbol, F) -> Integer - --- should be local - if R has Ring then - getShiftRec: (BasicOperator, Kernel F, Symbol) -> Union(Integer, "failed") - - shiftInfoRec: (BasicOperator, Symbol, F) -> - Record(max: Union(Integer, "failed"), - ord: Union(Integer, "failed"), - ker: Kernel F) - - Implementation == add -<> -@ - -\subsection{Defining new operators} - -We define two new operators, one for recurrences, the other for functional -equations. The operators for recurrences represents the $n$\textsuperscript{th} -term of the corresponding sequence, the other the coefficient of $x^n$ in the -Taylor series expansion. - -<>= - oprecur := operator("rootOfRec"::Symbol)$BasicOperator - - opADE := operator("rootOfADE"::Symbol)$BasicOperator - - setProperty(oprecur, "%dummyVar", 2 pretend None) - setProperty(opADE, "%dummyVar", 2 pretend None) -@ - -Setting these properties implies that the second and third arguments of oprecur -are dummy variables and affects [[tower$ES]]: the second argument will not -appear in [[tower$ES]], if it does not appear in any argument but the first and -second. The third argument will not appear in [[tower$ES]], if it does not appear -in any other argument. ([[%defsum]] is a good example) - -The arguments of the two operators are as follows: - -\begin{enumerate} -\item [[eq]], i.e. the vanishing expression - -<>= - eqAsF: List F -> F - eqAsF l == l.1 -@ - -\item [[dummy]], a dummy variable to make substitutions possible - -<>= - dummy: List F -> Symbol - dummy l == retract(l.2)@Symbol - - dummyAsF: List F -> F - dummyAsF l == l.2 -@ - -\item the variable for display - -<>= - displayVariable: List F -> F - displayVariable l == l.3 -@ - -\item [[operatorName(argument)]] - -<>= - operatorName: List F -> BasicOperator - operatorName l == operator(kernels(l.4).1) - - operatorNameAsF: List F -> F - operatorNameAsF l == l.4 - - operatorArgument: List F -> F - operatorArgument l == argument(kernels(l.4).1).1 -@ - -Concerning [[rootOfADE]], note that although we have [[arg]] as argument of the -operator, it is intended to indicate the coefficient, not the argument of the -power series. - - -\item [[values]] in reversed order. - - \begin{itemize} - \item [[rootOfRec]]: maybe [[values]] should be preceded by the index of the - first given value. Currently, the last value is interpreted as $f(0)$. - - \item [[rootOfADE]]: values are the first few coefficients of the power - series expansion in order. - \end{itemize} - -<>= - initialValues: List F -> List F - initialValues l == rest(l, 4) -@ -\end{enumerate} - -\subsection{Recurrences} - -\subsubsection{Extracting some information from the recurrence} - -We need to find out wether we can determine the next term of the sequence, and -how many initial values are necessary. - -<>= - if R has Ring then - getShiftRec(op: BasicOperator, f: Kernel F, n: Symbol) - : Union(Integer, "failed") == - a := argument f - if every?(freeOf?(#1, n::F), a) then return 0 - - if #a ~= 1 then error "RECOP: operator should have only one argument" - - p := univariate(a.1, retract(n::F)@Kernel(F)) - if denominator p ~= 1 then return "failed" - - num := numer p - - if degree num = 1 and coefficient(num, 1) = 1 - and every?(freeOf?(#1, n::F), coefficients num) - then return retractIfCan(coefficient(num, 0)) - else return "failed" - --- if the recurrence is of the form --- $p(n, f(n+m-o), f(n+m-o+1), \dots, f(n+m)) = 0$ --- in which case shiftInfoRec returns [m, o, f(n+m)]. - - shiftInfoRec(op: BasicOperator, argsym: Symbol, eq: F): - Record(max: Union(Integer, "failed"), - ord: Union(Integer, "failed"), - ker: Kernel F) == - --- ord and ker are valid only if all shifts are Integers --- ker is the kernel of the maximal shift. - maxShift: Integer - minShift: Integer - nextKernel: Kernel F - --- We consider only those kernels that have op as operator. If there is none, --- we raise an error. For the moment we don't allow recursions that contain op --- inside of another operator. - - error? := true - - for f in kernels eq repeat - if is?(f, op) then - shift := getShiftRec(op, f, argsym) - if error? then - error? := false - nextKernel := f - if shift case Integer then - maxShift := shift - minShift := shift - else return ["failed", "failed", nextKernel] - else - if shift case Integer then - if maxShift < shift then - maxShift := shift - nextKernel := f - if minShift > shift then - minShift := shift - else return ["failed", "failed", nextKernel] - - if error? then error "evalRec: equation does not contain operator" - - [maxShift, maxShift - minShift, nextKernel] -@ - -\subsubsection{Evaluating a recurrence} - -<>= - evalRec(op, argsym, argdisp, arg, eq, values) == - if ((n := retractIfCan(arg)@Union(Integer, "failed")) case "failed") - or (n < 0) - then - shiftInfo := shiftInfoRec(op, argsym, eq) - - if (shiftInfo.ord case "failed") or ((shiftInfo.ord)::Integer > 0) - then - kernel(oprecur, - append([eq, argsym::F, argdisp, op(arg)], values)) - else - p := univariate(eq, shiftInfo.ker) - num := numer p - --- If the degree is 1, we can return the function explicitly. - - if degree num = 1 then - eval(-coefficient(num, 0)/coefficient(num, 1), argsym::F, - arg::F-(shiftInfo.max)::Integer::F) - else - kernel(oprecur, - append([eq, argsym::F, argdisp, op(arg)], values)) - else - len: Integer := #values - if n < len - then values.(len-n) - else - shiftInfo := shiftInfoRec(op, argsym, eq) - - if shiftInfo.max case Integer then - p := univariate(eq, shiftInfo.ker) - - num := numer p - - if degree num = 1 then - - next := -coefficient(num, 0)/coefficient(num, 1) - nextval := eval(next, argsym::F, - (len-(shiftInfo.max)::Integer)::F) - newval := eval(nextval, op, - evalRec(op, argsym, argdisp, #1, eq, values)) - evalRec(op, argsym, argdisp, arg, eq, cons(newval, values)) - else - kernel(oprecur, - append([eq, argsym::F, argdisp, op(arg)], values)) - - else - kernel(oprecur, - append([eq, argsym::F, argdisp, op(arg)], values)) - - numberOfValuesNeeded(numberOfValues: Integer, - op: BasicOperator, argsym: Symbol, eq: F): Integer == - order := shiftInfoRec(op, argsym, eq).ord - if order case Integer - then min(numberOfValues, retract(order)@Integer) - else numberOfValues - - - else - evalRec(op, argsym, argdisp, arg, eq, values) == - kernel(oprecur, - append([eq, argsym::F, argdisp, op(arg)], values)) - - numberOfValuesNeeded(numberOfValues: Integer, - op: BasicOperator, argsym: Symbol, eq: F): Integer == - numberOfValues -@ - -\subsubsection{Setting the evaluation property of [[oprecur]]} - -[[irecur]] is just a wrapper that allows us to write a recurrence relation as -an operator. - -<>= - irecur: List F -> F - irecur l == - evalRec(operatorName l, - dummy l, displayVariable l, - operatorArgument l, eqAsF l, initialValues l) - - evaluate(oprecur, irecur)$BasicOperatorFunctions1(F) - -@ - -\subsubsection{Displaying a recurrence relation} - -<>= - ddrec: List F -> OutputForm - ddrec l == - op := operatorName l - values := reverse l - eq := eqAsF l - - numberOfValues := numberOfValuesNeeded(#values-4, op, dummy l, eq) - - vals: List OutputForm - := cons(eval(eq, dummyAsF l, displayVariable l)::OutputForm = _ - 0::OutputForm, - [elt(op::OutputForm, [(i-1)::OutputForm]) = _ - (values.i)::OutputForm - for i in 1..numberOfValues]) - - bracket(hconcat([(operatorNameAsF l)::OutputForm, - ": ", - commaSeparate vals])) - - setProperty(oprecur, "%specialDisp", - ddrec@(List F -> OutputForm) pretend None) - -@ - -\subsection{Functional Equations} - -\subsubsection{Determining the number of initial values for ADE's} - -We use Joris van der Hoeven's instructions for ADE's. Given -$Q=p(f,f',\dots,f^{(r)})$ we first need to differentiate $Q$ with respect to -$f^{(i)}$ for $i\in\{0,1,\dots,r\}$, plug in the given truncated power series -solution and determine the valuation. - -<>= - getValuation(op, argsym, eq, maxorder, values): Integer == - max: Integer := -1; - ker: Kernel F - for i in 0..maxorder repeat - ker := D(op(argsym), argsym, i)::Kernel F - pol := univariate(eq, ker) - dif := D pol - ground numer(dif.D(op(argsym), argsym, i)) -@ - -\subsubsection{Extracting some information from the functional equation} - -[[getOrder]] returns the maximum derivative of [[op]] occurring in [[f]]. - -<>= - getOrder(op: BasicOperator, f: Kernel F): NonNegativeInteger == - res: NonNegativeInteger := 0 - g := f - while is?(g, %diff) repeat - g := kernels(argument(g).1).1 - res := res+1 - - if is?(g, op) then res else 0 - -@ - -\subsubsection{Extracting a coefficient given a functional equation} - -<>= - evalADE(op, argsym, argdisp, arg, eq, values) == - if not freeOf?(eq, retract(argdisp)@Symbol) - then error "RECOP: The argument should not be used in the equation of the_ - ADE" - - if ((n := retractIfCan(arg)@Union(Integer, "failed")) case "failed") - then --- try to determine the necessary number of initial values - keq := kernels eq - order := getOrder(op, keq.1) - for k in rest keq repeat order := max(order, getOrder(op, k)) - - p: Fraction SparseUnivariatePolynomial F - := univariate(eq, kernels(D(op(argsym::F), argsym, order)).1)$F - - if one? degree numer p --- the equation is holonomic - then kernel(opADE, - append([eq, argsym::F, argdisp, op(arg)], - reverse first(reverse values, order))) - else kernel(opADE, - append([eq, argsym::F, argdisp, op(arg)], values)) - else - if n < 0 - then 0 - else - keq := kernels eq - order := getOrder(op, keq.1) --- output(hconcat("The order is ", order::OutputForm))$OutputPackage - for k in rest keq repeat order := max(order, getOrder(op, k)) - - p: Fraction SparseUnivariatePolynomial F - := univariate(eq, kernels(D(op(argsym::F), argsym, order)).1)$F - --- output(hconcat("p: ", p::OutputForm))$OutputPackage - - if degree numer p > 1 - then --- kernel(opADE, --- append([eq, argsym::F, argdisp, op(arg)], values)) - - s := seriesSolve(eq, op, argsym, reverse values) - $ExpressionSolve(R, F, - UnivariateFormalPowerSeries F, - UnivariateFormalPowerSeries - SparseUnivariatePolynomialExpressions F) - - elt(s, n::Integer::NonNegativeInteger) - - else - s := seriesSolve(eq, op, argsym, first(reverse values, order)) - $ExpressionSolve(R, F, - UnivariateFormalPowerSeries F, - UnivariateFormalPowerSeries - SparseUnivariatePolynomialExpressions F) - - elt(s, n::Integer::NonNegativeInteger) - - - iADE: List F -> F --- This is just a wrapper that allows us to write a recurrence relation as an --- operator. - iADE l == - evalADE(operatorName l, - dummy l, displayVariable l, - operatorArgument l, eqAsF l, initialValues l) - - evaluate(opADE, iADE)$BasicOperatorFunctions1(F) - - getEq(f: F): F == - ker := kernels f - if one?(#ker) and _ - (is?(operator(ker.1), "rootOfADE"::Symbol) or _ - is?(operator(ker.1), "rootOfRec"::Symbol)) then - l := argument(ker.1) - eval(eqAsF l, dummyAsF l, displayVariable l) - else - error "getEq: argument should be a single rootOfADE or rootOfRec object" - - getOp(f: F): BasicOperator == - ker := kernels f - if one?(#ker) and _ - (is?(operator(ker.1), "rootOfADE"::Symbol) or _ - is?(operator(ker.1), "rootOfRec"::Symbol)) then - operatorName argument(ker.1) - else - error "getOp: argument should be a single rootOfADE or rootOfRec object" - - -@ -%$ -\subsubsection{Displaying a functional equation} - -<>= - ddADE: List F -> OutputForm - ddADE l == - op := operatorName l - values := reverse l - - vals: List OutputForm - := cons(eval(eqAsF l, dummyAsF l, displayVariable l)::OutputForm = _ - 0::OutputForm, - [eval(D(op(dummyAsF l), dummy l, i), _ - dummyAsF l=0)::OutputForm = _ - (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, ": ", - commaSeparate vals])) - - setProperty(opADE, "%specialDisp", - ddADE@(List F -> OutputForm) pretend None) -@ -%$ - - -\section{License} -<>= ---Copyright (c) 2006-2007, Martin Rubey --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ - -<<*>>= -<> - -<> -@ -\end{document} diff --git a/src/algebra/reclos.spad.pamphlet b/src/algebra/reclos.spad.pamphlet deleted file mode 100644 index 0d7147d..0000000 --- a/src/algebra/reclos.spad.pamphlet +++ /dev/null @@ -1,192 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra reclos.spad} -\author{Renaud Rioboo} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -This file describes the Real Closure 1.0 package which consists of different -packages, categoris and domains : - -- the package RealPolynomialUtilitiesPackage whichs receives a field and a -univariate polynomial domain with coefficients in the field. It computes some -simple functions such as Strum and Sylvester sequences. - -- The category RealRootCharacterizationCategory provides abstarct -functionalities to work with "real roots" of univariate polynomials. These -resemble variables with some functionalities needed to compute important -operations. - -- RealClosedField is a category with provides common operations available over -real closed fiels. These include finding all the roots of univariate -polynomial, taking square roots, ... - - -CAVEATS - -Since real algebraic expressions are stored as depending on "real roots" which -are managed like variables, there is an ordering on these. This ordering is -dynamical in the sense that any new algebraic takes precedence over older -ones. In particular every cretaion function raises a new "real root". This has -the effect that when you type something like sqrt(2) + sqrt(2) you have two -new variables which happen to be equal. To avoid this name the expression such -as in s2 := sqrt(2) ; s2 + s2 - -Also note that computing times depend strongly on the ordering you implicitly -provide. Please provide algebraics in the order which most natural to you. - -LIMITATIONS - -The file reclos.input show some basic use of the package. This packages uses -algorithms which are published in [1] and [2] which are based on field -arithmetics, inparticular for polynomial gcd related algorithms. This can be -quite slow for high degree polynomials and subresultants methods usually work -best. Betas versions of the package try to use these techniques in a better -way and work significantly faster. These are mostly based on unpublished -algorithms and cannot be distributed. Please contact the author if you have a -particular problem to solve or want to use these versions. - -Be aware that approximations behave as post-processing and that all -computations are done excatly. They can thus be quite time consuming when -depending on several "real roots". -\section{package POLUTIL RealPolynomialUtilitiesPackage} -<>= -)abbrev package POLUTIL RealPolynomialUtilitiesPackage -++ Author: Renaud Rioboo -++ Date Created: summer 1992 -++ Basic Functions: provides polynomial utilities -++ Related Constructors: RealClosure, -++ Date Last Updated: July 2004 -++ Also See: -++ AMS Classifications: -++ Keywords: Sturm sequences -++ References: -++ Description: -++ \axiomType{RealPolynomialUtilitiesPackage} provides common functions used -++ by interval coding. -RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where - - TheField : Field - ThePols : UnivariatePolynomialCategory(TheField) - - Z ==> Integer - N ==> NonNegativeInteger - P ==> ThePols - - PUB == with - - sylvesterSequence : (ThePols,ThePols) -> List ThePols - ++ \axiom{sylvesterSequence(p,q)} is the negated remainder sequence - ++ of p and q divided by the last computed term - sturmSequence : ThePols -> List ThePols - ++ \axiom{sturmSequence(p) = sylvesterSequence(p,p')} - if TheField has OrderedRing then - boundOfCauchy : ThePols -> TheField - ++ \axiom{boundOfCauchy(p)} bounds the roots of p - sturmVariationsOf : List TheField -> N - ++ \axiom{sturmVariationsOf(l)} is the number of sign variations - ++ in the list of numbers l, - ++ note that the first term counts as a sign - lazyVariations : (List(TheField), Z, Z) -> N - ++ \axiom{lazyVariations(l,s1,sn)} is the number of sign variations - ++ in the list of non null numbers [s1::l]@sn, - - - PRIV == add - - sturmSequence(p) == - sylvesterSequence(p,differentiate(p)) - - sylvesterSequence(p1,p2) == - res : List(ThePols) := [p1] - while (p2 ^= 0) repeat - res := cons(p2 , res) - (p1 , p2) := (p2 , -(p1 rem p2)) - if degree(p1) > 0 - then - p1 := unitCanonical(p1) - res := [ term quo p1 for term in res ] - reverse! res - - if TheField has OrderedRing - then - - 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(l) == --- res : N := 0 --- lsg := sign(first(l)) --- for term in l repeat --- if ^( (sg := sign(term) ) = 0 ) then --- if (sg ^= lsg) then res := res + 1 --- lsg := sg --- res - - sturmVariationsOf(l) == - null(l) => error "POLUTIL: sturmVariationsOf: empty list !" - l1 := first(l) - -- first 0 counts as a sign - ll : List(TheField) := [] - for term in rest(l) repeat - -- zeros don't count - if not(zero?(term)) then ll := cons(term,ll) - -- if l1 is not zero then ll = reverse(l) - null(ll) => error "POLUTIL: sturmVariationsOf: Bad sequence" - ln := first(ll) - ll := reverse(rest(ll)) - -- if l1 is not zero then first(l) = first(ll) - -- if l1 is zero then first zero should count as a sign - zero?(l1) => 1 + lazyVariations(rest(ll),sign(first(ll)),sign(ln)) - lazyVariations(ll, sign(l1), sign(ln)) - - lazyVariations(l,sl,sh) == - zero?(sl) or zero?(sh) => error "POLUTIL: lazyVariations: zero sign!" - null(l) => - if sl = sh then 0 else 1 - null(rest(l)) => - if zero?(first(l)) - then error "POLUTIL: lazyVariations: zero sign!" - else - if sl = sh - then - if (sl = sign(first(l))) - then 0 - else 2 - -- in this case we save one test - else 1 - s := sign(l.2) - lazyVariations([first(l)],sl,s) + - lazyVariations(rest(rest(l)),s,sh) - -@ -\section{License} -<>= ------------------------------------------------------------------------------ --- This software was written by Renaud Rioboo (Computer Algebra group of --- Laboratoire d'Informatique de Paris 6) and is the property of university --- Paris 6. ------------------------------------------------------------------------------ -@ -<<*>>= -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} R. Rioboo, -{\sl Real Algebraic Closure of an ordered Field : Implementation in Axiom.}, -In proceedings of the ISSAC'92 Conference, Berkeley 1992 pp. 206-215. -\bibitem{2} Z. Ligatsikas, R. Rioboo, M. F. Roy -{\sl Generic computation of the real closure of an ordered field.}, -In Mathematics and Computers in Simulation Volume 42, Issue 4-6, -November 1996. -\end{thebibliography} -\end{document} diff --git a/src/algebra/regset.spad.pamphlet b/src/algebra/regset.spad.pamphlet deleted file mode 100644 index b7aae8f..0000000 --- a/src/algebra/regset.spad.pamphlet +++ /dev/null @@ -1,1067 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra regset.spad} -\author{Marc Moreno Maza} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package QCMPACK QuasiComponentPackage} -<>= -)abbrev package QCMPACK QuasiComponentPackage -++ Author: Marc Moreno Maza -++ marc@nag.co.uk -++ Date Created: 08/30/1998 -++ Date Last Updated: 12/16/1998 -++ Basic Functions: -++ Related Constructors: -++ Also See: `tosedom.spad' -++ AMS Classifications: -++ Keywords: -++ Description: -++ A package for removing redundant quasi-components and redundant -++ branches when decomposing a variety by means of quasi-components -++ of regular triangular sets. \newline -++ References : -++ [1] D. LAZARD "A new method for solving algebraic systems of -++ positive dimension" Discr. App. Math. 33:147-160,1991 -++ [2] M. MORENO MAZA "Calculs de pgcd au-dessus des tours -++ d'extensions simples et resolution des systemes d'equations -++ algebriques" These, Universite P.etM. Curie, Paris, 1997. -++ [3] M. MORENO MAZA "A new algorithm for computing triangular -++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. -++ Version: 3. - -QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where - - R : GcdDomain - E : OrderedAbelianMonoidSup - V : OrderedSet - P : RecursivePolynomialCategory(R,E,V) - TS : RegularTriangularSetCategory(R,E,V,P) - N ==> NonNegativeInteger - Z ==> Integer - B ==> Boolean - S ==> String - LP ==> List P - PtoP ==> P -> P - PS ==> GeneralPolynomialSet(R,E,V,P) - PWT ==> Record(val : P, tower : TS) - BWT ==> Record(val : Boolean, tower : TS) - LpWT ==> Record(val : (List P), tower : TS) - Branch ==> Record(eq: List P, tower: TS, ineq: List P) - UBF ==> Union(Branch,"failed") - Split ==> List TS - Key ==> Record(left:TS, right:TS) - Entry ==> Boolean - H ==> TabulatedComputationPackage(Key, Entry) - polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) - - Exports == with - startTable!: (S,S,S) -> Void - ++ \axiom{startTableGcd!(s1,s2,s3)} - ++ is an internal subroutine, exported only for developement. - stopTable!: () -> Void - ++ \axiom{stopTableGcd!()} - ++ is an internal subroutine, exported only for developement. - supDimElseRittWu?: (TS,TS) -> Boolean - ++ \axiom{supDimElseRittWu(ts,us)} returns true iff \axiom{ts} - ++ has less elements than \axiom{us} otherwise if \axiom{ts} - ++ has higher rank than \axiom{us} w.r.t. Riit and Wu ordering. - algebraicSort: Split -> Split - ++ \axiom{algebraicSort(lts)} sorts \axiom{lts} w.r.t - ++ \axiomOpFrom{supDimElseRittWu?}{QuasiComponentPackage}. - moreAlgebraic?: (TS,TS) -> Boolean - ++ \axiom{moreAlgebraic?(ts,us)} returns false iff \axiom{ts} - ++ and \axiom{us} are both empty, or \axiom{ts} - ++ has less elements than \axiom{us}, or some variable is - ++ algebraic w.r.t. \axiom{us} and is not w.r.t. \axiom{ts}. - subTriSet?: (TS,TS) -> Boolean - ++ \axiom{subTriSet?(ts,us)} returns true iff \axiom{ts} is - ++ a sub-set of \axiom{us}. - subPolSet?: (LP, LP) -> Boolean - ++ \axiom{subPolSet?(lp1,lp2)} returns true iff \axiom{lp1} is - ++ a sub-set of \axiom{lp2}. - internalSubPolSet?: (LP, LP) -> Boolean - ++ \axiom{internalSubPolSet?(lp1,lp2)} returns true iff \axiom{lp1} is - ++ a sub-set of \axiom{lp2} assuming that these lists are sorted - ++ increasingly w.r.t. \axiomOpFrom{infRittWu?}{RecursivePolynomialCategory}. - internalInfRittWu?: (LP, LP) -> Boolean - ++ \axiom{internalInfRittWu?(lp1,lp2)} - ++ is an internal subroutine, exported only for developement. - infRittWu?: (LP, LP) -> Boolean - ++ \axiom{infRittWu?(lp1,lp2)} - ++ is an internal subroutine, exported only for developement. - internalSubQuasiComponent?: (TS,TS) -> Union(Boolean,"failed") - ++ \axiom{internalSubQuasiComponent?(ts,us)} returns a boolean \spad{b} value - ++ if the fact that the regular zero set of \axiom{us} contains that of - ++ \axiom{ts} can be decided (and in that case \axiom{b} gives this - ++ inclusion) otherwise returns \axiom{"failed"}. - subQuasiComponent?: (TS,TS) -> Boolean - ++ \axiom{subQuasiComponent?(ts,us)} returns true iff - ++ \axiomOpFrom{internalSubQuasiComponent?}{QuasiComponentPackage} - ++ returs true. - subQuasiComponent?: (TS,Split) -> Boolean - ++ \axiom{subQuasiComponent?(ts,lus)} returns true iff - ++ \axiom{subQuasiComponent?(ts,us)} holds for one \spad{us} in \spad{lus}. - removeSuperfluousQuasiComponents: Split -> Split - ++ \axiom{removeSuperfluousQuasiComponents(lts)} removes from \axiom{lts} - ++ any \spad{ts} such that \axiom{subQuasiComponent?(ts,us)} holds for - ++ another \spad{us} in \axiom{lts}. - subCase?: (LpWT,LpWT) -> Boolean - ++ \axiom{subCase?(lpwt1,lpwt2)} - ++ is an internal subroutine, exported only for developement. - removeSuperfluousCases: List LpWT -> List LpWT - ++ \axiom{removeSuperfluousCases(llpwt)} - ++ is an internal subroutine, exported only for developement. - prepareDecompose: (LP, List(TS),B,B) -> List Branch - ++ \axiom{prepareDecompose(lp,lts,b1,b2)} - ++ is an internal subroutine, exported only for developement. - branchIfCan: (LP,TS,LP,B,B,B,B,B) -> Union(Branch,"failed") - ++ \axiom{branchIfCan(leq,ts,lineq,b1,b2,b3,b4,b5)} - ++ is an internal subroutine, exported only for developement. - - Implementation == add - - squareFreeFactors(lp: LP): LP == - lsflp: LP := [] - for p in lp repeat - lsfp := squareFreeFactors(p)$polsetpack - lsflp := concat(lsfp,lsflp) - sort(infRittWu?,removeDuplicates lsflp) - - 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 == - if makingStats?()$H then printStats!()$H - clearTable!()$H - - supDimElseRittWu? (ts:TS,us:TS): Boolean == - #ts < #us => true - #ts > #us => false - lp1 :LP := members(ts) - lp2 :LP := members(us) - while (not empty? lp1) and (not infRittWu?(first(lp2),first(lp1))) repeat - lp1 := rest lp1 - lp2 := rest lp2 - not empty? lp1 - - algebraicSort (lts:Split): Split == - lts := removeDuplicates lts - sort(supDimElseRittWu?,lts) - - moreAlgebraic?(ts:TS,us:TS): Boolean == - empty? ts => empty? us - empty? us => true - #ts < #us => false - for p in (members us) repeat - not algebraic?(mvar(p),ts) => return false - true - - subTriSet?(ts:TS,us:TS): Boolean == - empty? ts => true - empty? us => false - mvar(ts) > mvar(us) => false - mvar(ts) < mvar(us) => subTriSet?(ts,rest(us)::TS) - first(ts)::P = first(us)::P => subTriSet?(rest(ts)::TS,rest(us)::TS) - false - - internalSubPolSet?(lp1: LP, lp2: LP): Boolean == - empty? lp1 => true - empty? lp2 => false - associates?(first lp1, first lp2) => - internalSubPolSet?(rest lp1, rest lp2) - infRittWu?(first lp1, first lp2) => false - internalSubPolSet?(lp1, rest lp2) - - subPolSet?(lp1: LP, lp2: LP): Boolean == - lp1 := sort(infRittWu?, lp1) - lp2 := sort(infRittWu?, lp2) - internalSubPolSet?(lp1,lp2) - - infRittWu?(lp1: LP, lp2: LP): Boolean == - lp1 := sort(infRittWu?, lp1) - lp2 := sort(infRittWu?, lp2) - internalInfRittWu?(lp1,lp2) - - internalInfRittWu?(lp1: LP, lp2: LP): Boolean == - empty? lp1 => not empty? lp2 - empty? lp2 => false - infRittWu?(first lp1, first lp2)$P => true - infRittWu?(first lp2, first lp1)$P => false - infRittWu?(rest lp1, rest lp2)$$ - - 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,us:TS): Union(Boolean,"failed") == - -- "failed" is false iff saturate(us) is radical - subTriSet?(us,ts) => true - not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed") - for p in (members us) repeat - mdeg(p) < mdeg(select(ts,mvar(p))::P) => - return("failed"::Union(Boolean,"failed")) - for p in (members us) repeat - not zero? initiallyReduce(p,ts) => - return("failed"::Union(Boolean,"failed")) - lsfp := squareFreeFactors(initials us) - for p in lsfp repeat - not invertible?(p,ts)@B => - return(false::Union(Boolean,"failed")) - true::Union(Boolean,"failed") - - subQuasiComponent?(ts:TS,us:TS): Boolean == - k: Key := [ts, us] - e := extractIfCan(k)$H - e case Entry => e::Entry - ubf: Union(Boolean,"failed") := internalSubQuasiComponent?(ts,us) - b: Boolean := (ubf case Boolean) and (ubf::Boolean) - insert!(k,b)$H - b - - subQuasiComponent?(ts:TS,lus:Split): Boolean == - for us in lus repeat - subQuasiComponent?(ts,us)@B => return true - false - - removeSuperfluousCases (cases:List LpWT) == - #cases < 2 => cases - toSee := sort(supDimElseRittWu?(#1.tower,#2.tower),cases) - lpwt1,lpwt2 : LpWT - toSave,headmaxcases,maxcases,copymaxcases : List LpWT - while not empty? toSee repeat - lpwt1 := first toSee - toSee := rest toSee - toSave := [] - for lpwt2 in toSee repeat - if subCase?(lpwt1,lpwt2) - then - lpwt1 := lpwt2 - else - if not subCase?(lpwt2,lpwt1) - then - toSave := cons(lpwt2,toSave) - if empty? maxcases - then - headmaxcases := [lpwt1] - maxcases := headmaxcases - else - copymaxcases := maxcases - while (not empty? copymaxcases) and _ - (not subCase?(lpwt1,first(copymaxcases))) repeat - copymaxcases := rest copymaxcases - if empty? copymaxcases - then - setrest!(headmaxcases,[lpwt1]) - headmaxcases := rest headmaxcases - toSee := reverse toSave - maxcases - - removeSuperfluousQuasiComponents(lts: Split): Split == - lts := removeDuplicates lts - #lts < 2 => lts - toSee := algebraicSort lts - toSave,headmaxlts,maxlts,copymaxlts : Split - while not empty? toSee repeat - ts := first toSee - toSee := rest toSee - toSave := [] - for us in toSee repeat - if subQuasiComponent?(ts,us)@B - then - ts := us - else - if not subQuasiComponent?(us,ts)@B - then - toSave := cons(us,toSave) - if empty? maxlts - then - headmaxlts := [ts] - maxlts := headmaxlts - else - copymaxlts := maxlts - while (not empty? copymaxlts) and _ - (not subQuasiComponent?(ts,first(copymaxlts))@B) repeat - copymaxlts := rest copymaxlts - if empty? copymaxlts - then - setrest!(headmaxlts,[ts]) - headmaxlts := rest headmaxlts - toSee := reverse toSave - algebraicSort maxlts - - removeAssociates (lp:LP):LP == - removeDuplicates [primitivePart(p) for p in lp] - - 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 - -- if b2 then CLEAN UP lineq - -- if b3 then SEARCH for ZERO in lineq with leq - -- if b4 then SEARCH for ZERO in lineq with ts - -- if b5 then SEARCH for ONE in leq with lineq - if b1 - then - leq := removeAssociates(leq) - leq := remove(zero?,leq) - any?(ground?,leq) => - return("failed"::Union(Branch,"failed")) - if b2 - then - any?(zero?,lineq) => - return("failed"::Union(Branch,"failed")) - lineq := removeRedundantFactors(lineq)$polsetpack - if b3 - then - ps: PS := construct(leq)$PS - for q in lineq repeat - zero? remainder(q,ps).polnum => - return("failed"::Union(Branch,"failed")) - (empty? leq) or (empty? lineq) => ([leq, ts, lineq]$Branch)::UBF - if b4 - then - for q in lineq repeat - zero? initiallyReduce(q,ts) => - return("failed"::Union(Branch,"failed")) - if b5 - then - newleq: LP := [] - for p in leq repeat - for q in lineq repeat - if mvar(p) = mvar(q) - then - g := gcd(p,q) - newp := (p exquo g)::P - ground? newp => - return("failed"::Union(Branch,"failed")) - newleq := cons(newp,newleq) - else - newleq := cons(p,newleq) - leq := newleq - leq := sort(infRittWu?, removeDuplicates leq) - ([leq, ts, lineq]$Branch)::UBF - - 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 - lp := sort(infRittWu?, remove(zero?,removeAssociates(lp))) - any?(ground?,lp) => [] - empty? lts => [] - if b1 then lts := removeSuperfluousQuasiComponents lts - not b2 => - [[lp,ts,squareFreeFactors(initials ts)]$Branch for ts in lts] - toSee: List Branch - lq: LP := [] - toSee := [[lq,ts,squareFreeFactors(initials ts)]$Branch for ts in lts] - empty? lp => toSee - for p in lp repeat - lsfp := squareFreeFactors(p)$polsetpack - branches: List Branch := [] - lq := [] - for f in lsfp repeat - for branch in toSee repeat - leq : LP := branch.eq - ts := branch.tower - lineq : LP := branch.ineq - ubf1: UBF := branchIfCan(leq,ts,lq,false,false,true,true,true)@UBF - ubf1 case "failed" => "leave" - ubf2: UBF := branchIfCan([f],ts,lineq,false,false,true,true,true)@UBF - ubf2 case "failed" => "leave" - leq := sort(infRittWu?,removeDuplicates concat(ubf1.eq,ubf2.eq)) - lineq := sort(infRittWu?,removeDuplicates concat(ubf1.ineq,ubf2.ineq)) - newBranch := branchIfCan(leq,ts,lineq,false,false,false,false,false) - branches:= cons(newBranch::Branch,branches) - lq := cons(f,lq) - toSee := branches - sort(supDimElseRittWu?(#1.tower,#2.tower),toSee) - -@ -\section{package RSETGCD RegularTriangularSetGcdPackage} -<>= -)abbrev package RSETGCD RegularTriangularSetGcdPackage -++ Author: Marc Moreno Maza (marc@nag.co.uk) -++ Date Created: 08/30/1998 -++ Date Last Updated: 12/15/1998 -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Description: -++ An internal package for computing gcds and resultants of univariate -++ polynomials with coefficients in a tower of simple extensions of a field.\newline -++ References : -++ [1] M. MORENO MAZA and R. RIOBOO "Computations of gcd over -++ algebraic towers of simple extensions" In proceedings of AAECC11 -++ Paris, 1995. -++ [2] M. MORENO MAZA "Calculs de pgcd au-dessus des tours -++ d'extensions simples et resolution des systemes d'equations -++ algebriques" These, Universite P.etM. Curie, Paris, 1997. -++ [3] M. MORENO MAZA "A new algorithm for computing triangular -++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. -++ Version: 4. - -RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where - - R : GcdDomain - E : OrderedAbelianMonoidSup - V : OrderedSet - P : RecursivePolynomialCategory(R,E,V) - TS : RegularTriangularSetCategory(R,E,V,P) - N ==> NonNegativeInteger - Z ==> Integer - B ==> Boolean - S ==> String - LP ==> List P - PtoP ==> P -> P - PS ==> GeneralPolynomialSet(R,E,V,P) - PWT ==> Record(val : P, tower : TS) - BWT ==> Record(val : Boolean, tower : TS) - LpWT ==> Record(val : (List P), tower : TS) - Branch ==> Record(eq: List P, tower: TS, ineq: List P) - UBF ==> Union(Branch,"failed") - Split ==> List TS - KeyGcd ==> Record(arg1: P, arg2: P, arg3: TS, arg4: B) - EntryGcd ==> List PWT - HGcd ==> TabulatedComputationPackage(KeyGcd, EntryGcd) - KeyInvSet ==> Record(arg1: P, arg3: TS) - EntryInvSet ==> List TS - HInvSet ==> TabulatedComputationPackage(KeyInvSet, EntryInvSet) - polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) - quasicomppack ==> QuasiComponentPackage(R,E,V,P,TS) - - Exports == with - startTableGcd!: (S,S,S) -> Void - ++ \axiom{startTableGcd!(s1,s2,s3)} - ++ is an internal subroutine, exported only for developement. - stopTableGcd!: () -> Void - ++ \axiom{stopTableGcd!()} - ++ is an internal subroutine, exported only for developement. - startTableInvSet!: (S,S,S) -> Void - ++ \axiom{startTableInvSet!(s1,s2,s3)} - ++ is an internal subroutine, exported only for developement. - stopTableInvSet!: () -> Void - ++ \axiom{stopTableInvSet!()} is an internal subroutine, - ++ exported only for developement. - prepareSubResAlgo: (P,P,TS) -> List LpWT - ++ \axiom{prepareSubResAlgo(p1,p2,ts)} - ++ is an internal subroutine, exported only for developement. - internalLastSubResultant: (P,P,TS,B,B) -> List PWT - ++ \axiom{internalLastSubResultant(p1,p2,ts,inv?,break?)} - ++ is an internal subroutine, exported only for developement. - internalLastSubResultant: (List LpWT,V,B) -> List PWT - ++ \axiom{internalLastSubResultant(lpwt,v,flag)} is an internal - ++ subroutine, exported only for developement. - integralLastSubResultant: (P,P,TS) -> List PWT - ++ \axiom{integralLastSubResultant(p1,p2,ts)} - ++ is an internal subroutine, exported only for developement. - toseLastSubResultant: (P,P,TS) -> List PWT - ++ \axiom{toseLastSubResultant(p1,p2,ts)} has the same specifications as - ++ \axiomOpFrom{lastSubResultant}{RegularTriangularSetCategory}. - toseInvertible?: (P,TS) -> B - ++ \axiom{toseInvertible?(p1,p2,ts)} has the same specifications as - ++ \axiomOpFrom{invertible?}{RegularTriangularSetCategory}. - toseInvertible?: (P,TS) -> List BWT - ++ \axiom{toseInvertible?(p1,p2,ts)} has the same specifications as - ++ \axiomOpFrom{invertible?}{RegularTriangularSetCategory}. - toseInvertibleSet: (P,TS) -> Split - ++ \axiom{toseInvertibleSet(p1,p2,ts)} has the same specifications as - ++ \axiomOpFrom{invertibleSet}{RegularTriangularSetCategory}. - toseSquareFreePart: (P,TS) -> List PWT - ++ \axiom{toseSquareFreePart(p,ts)} has the same specifications as - ++ \axiomOpFrom{squareFreePart}{RegularTriangularSetCategory}. - - Implementation == add - - startTableGcd!(ok: S, ko: S, domainName: S): Void == - initTable!()$HGcd - printInfo!(ok,ko)$HGcd - startStats!(domainName)$HGcd - void() - - stopTableGcd!(): Void == - if makingStats?()$HGcd then printStats!()$HGcd - clearTable!()$HGcd - - startTableInvSet!(ok: S, ko: S, domainName: S): Void == - initTable!()$HInvSet - printInfo!(ok,ko)$HInvSet - startStats!(domainName)$HInvSet - void() - - stopTableInvSet!(): Void == - if makingStats?()$HInvSet then printStats!()$HInvSet - clearTable!()$HInvSet - - toseInvertible?(p:P,ts:TS): Boolean == - q := primitivePart initiallyReduce(p,ts) - zero? q => false - normalized?(q,ts) => true - v := mvar(q) - not algebraic?(v,ts) => - toCheck: List BWT := toseInvertible?(p,ts)@(List BWT) - for bwt in toCheck repeat - bwt.val = false => return false - return true - ts_v := select(ts,v)::P - ts_v_- := collectUnder(ts,v) - lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,true) - for gwt in lgwt repeat - g := gwt.val; - (not ground? g) and (mvar(g) = v) => - return false - true - - toseInvertible?(p:P,ts:TS): List BWT == - q := primitivePart initiallyReduce(p,ts) - zero? q => [[false,ts]$BWT] - normalized?(q,ts) => [[true,ts]$BWT] - v := mvar(q) - not algebraic?(v,ts) => - lbwt: List BWT := [] - toCheck: List BWT := toseInvertible?(init(q),ts)@(List BWT) - for bwt in toCheck repeat - bwt.val => lbwt := cons(bwt,lbwt) - newq := removeZero(q,bwt.tower) - zero? newq => lbwt := cons(bwt,lbwt) - lbwt := concat(toseInvertible?(newq,bwt.tower)@(List BWT), lbwt) - return lbwt - ts_v := select(ts,v)::P - ts_v_- := collectUnder(ts,v) - ts_v_+ := collectUpper(ts,v) - lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,false) - lbwt: List BWT := [] - for gwt in lgwt repeat - g := gwt.val; ts := gwt.tower - (ground? g) or (mvar(g) < v) => - ts := internalAugment(ts_v,ts) - ts := internalAugment(members(ts_v_+),ts) - lbwt := cons([true, ts]$BWT,lbwt) - g := mainPrimitivePart g - ts_g := internalAugment(g,ts) - ts_g := internalAugment(members(ts_v_+),ts_g) - -- USE internalAugment with parameters ?? - lbwt := cons([false, ts_g]$BWT,lbwt) - h := lazyPquo(ts_v,g) - (ground? h) or (mvar(h) < v) => "leave" - h := mainPrimitivePart h - ts_h := internalAugment(h,ts) - ts_h := internalAugment(members(ts_v_+),ts_h) - -- USE internalAugment with parameters ?? - -- CAN BE OPTIMIZED if the input tower is separable - inv := toseInvertible?(q,ts_h)@(List BWT) - lbwt := concat([bwt for bwt in inv | bwt.val],lbwt) - sort(#1.val < #2.val,lbwt) - - toseInvertibleSet(p:P,ts:TS): Split == - k: KeyInvSet := [p,ts] - e := extractIfCan(k)$HInvSet - e case EntryInvSet => e::EntryInvSet - q := primitivePart initiallyReduce(p,ts) - zero? q => [] - normalized?(q,ts) => [ts] - v := mvar(q) - toSave: Split := [] - not algebraic?(v,ts) => - toCheck: List BWT := toseInvertible?(init(q),ts)@(List BWT) - for bwt in toCheck repeat - bwt.val => toSave := cons(bwt.tower,toSave) - newq := removeZero(q,bwt.tower) - zero? newq => "leave" - toSave := concat(toseInvertibleSet(newq,bwt.tower), toSave) - toSave := removeDuplicates toSave - return algebraicSort(toSave)$quasicomppack - ts_v := select(ts,v)::P - ts_v_- := collectUnder(ts,v) - ts_v_+ := collectUpper(ts,v) - lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,false) - for gwt in lgwt repeat - g := gwt.val; ts := gwt.tower - (ground? g) or (mvar(g) < v) => - ts := internalAugment(ts_v,ts) - ts := internalAugment(members(ts_v_+),ts) - toSave := cons(ts,toSave) - g := mainPrimitivePart g - h := lazyPquo(ts_v,g) - h := mainPrimitivePart h - (ground? h) or (mvar(h) < v) => "leave" - ts_h := internalAugment(h,ts) - ts_h := internalAugment(members(ts_v_+),ts_h) - inv := toseInvertibleSet(q,ts_h) - toSave := removeDuplicates concat(inv,toSave) - toSave := algebraicSort(toSave)$quasicomppack - insert!(k,toSave)$HInvSet - toSave - - 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 - -- ASSUME p is mainly primitive --- one? mdeg(p) => [[p,ts]$PWT] - mdeg(p) = 1 => [[p,ts]$PWT] - v := mvar(p)$P - q: P := mainPrimitivePart D(p,v) - lgwt: List PWT := internalLastSubResultant(p,q,ts,true,false) - lpwt : List PWT := [] - sfp : P - for gwt in lgwt repeat - g := gwt.val; us := gwt.tower - (ground? g) or (mvar(g) < v) => - lpwt := cons([p,us],lpwt) - g := mainPrimitivePart g - sfp := lazyPquo(p,g) - sfp := mainPrimitivePart stronglyReduce(sfp,us) - lpwt := cons([sfp,us],lpwt) - lpwt - - toseSquareFreePart_base(p:P, ts: TS): List PWT == [[p,ts]$PWT] - - toseSquareFreePart(p:P, ts: TS): List PWT == toseSquareFreePart_wip(p,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 !!! - toSee: List LpWT := [[[p1,p2],ts]$LpWT] - toSave: List LpWT := [] - v := mvar(p1) - while (not empty? toSee) repeat - lpwt := first toSee; toSee := rest toSee - p1 := lpwt.val.1; p2 := lpwt.val.2 - ts := lpwt.tower - lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT) - for bwt in lbwt repeat - (bwt.val = true) and (degree(p2,v) > 0) => - p3 := prem(p1, -p2) - s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N - toSave := cons([[p2,p3,s],bwt.tower]$LpWT,toSave) - -- p2 := initiallyReduce(p2,bwt.tower) - newp2 := primitivePart initiallyReduce(p2,bwt.tower) - (bwt.val = true) => - -- toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave) - toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave) - -- zero? p2 => - zero? newp2 => - toSave := cons([[p1,0,1],bwt.tower]$LpWT,toSave) - -- toSee := cons([[p1,p2],ts]$LpWT,toSee) - toSee := cons([[p1,newp2],bwt.tower]$LpWT,toSee) - toSave - - 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 - lsr := lastSubResultant(p1, p2) - ground?(lsr) => [[lsr,ts]$PWT] - mvar(lsr) < mvar(p1) => [[lsr,ts]$PWT] - gi1i2 := gcd(init(p1),init(p2)) - ex: Union(P,"failed") := (gi1i2 * lsr) exquo$P init(lsr) - ex case "failed" => [[lsr,ts]$PWT] - [[ex::P,ts]$PWT] - - 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 - -- if b2 BREAK with the first non-trivial gcd - k: KeyGcd := [p1,p2,ts,b2] - e := extractIfCan(k)$HGcd - e case EntryGcd => e::EntryGcd - toSave: List PWT - empty? ts => - toSave := integralLastSubResultant(p1,p2,ts) - insert!(k,toSave)$HGcd - return toSave - toSee: List LpWT - if b1 - then - p3 := prem(p1, -p2) - s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N - toSee := [[[p2,p3,s],ts]$LpWT] - else - toSee := prepareSubResAlgo(p1,p2,ts) - toSave := internalLastSubResultant(toSee,mvar(p1),b2) - insert!(k,toSave)$HGcd - toSave - - internalLastSubResultant(llpwt: List LpWT,v:V,b2:B): List PWT == - toReturn: List PWT := []; toSee: List LpWT; - while (not empty? llpwt) repeat - toSee := llpwt; llpwt := [] - -- CONSIDER FIRST the vanishing current last subresultant - for lpwt in toSee repeat - p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3; ts := lpwt.tower - lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT) - for bwt in lbwt repeat - bwt.val = false => - toReturn := cons([p1,bwt.tower]$PWT, toReturn) - b2 and positive?(degree(p1,v)) => return toReturn - llpwt := cons([[p1,p2,s],bwt.tower]$LpWT, llpwt) - empty? llpwt => "leave" - -- CONSIDER NOW the branches where the computations continue - toSee := llpwt; llpwt := [] - lpwt := first toSee; toSee := rest toSee - p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3 - delta: N := (mdeg(p1) - degree(p2,v))::N - p3: P := LazardQuotient2(p2, leadingCoefficient(p2,v), s, delta) - zero?(degree(p3,v)) => - toReturn := cons([p3,lpwt.tower]$PWT, toReturn) - for lpwt in toSee repeat - toReturn := cons([p3,lpwt.tower]$PWT, toReturn) - (p1, p2) := (p3, next_subResultant2(p1, p2, p3, s)) - s := leadingCoefficient(p1,v) - llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) - for lpwt in toSee repeat - llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) - toReturn - - toseLastSubResultant(p1:P,p2:P,ts:TS): List PWT == - ground? p1 => - error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" - ground? p2 => - error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2" - not (mvar(p2) = mvar(p1)) => - error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2" - algebraic?(mvar(p1),ts) => - error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" - not initiallyReduced?(p1,ts) => - error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1" - not initiallyReduced?(p2,ts) => - error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2" - purelyTranscendental?(p1,ts) and purelyTranscendental?(p2,ts) => - integralLastSubResultant(p1,p2,ts) - if mdeg(p1) < mdeg(p2) then - (p1, p2) := (p2, p1) - if odd?(mdeg(p1)) and odd?(mdeg(p2)) then p2 := - p2 - internalLastSubResultant(p1,p2,ts,false,false) - -@ -\section{package RSDCMPK RegularSetDecompositionPackage} -<>= -)abbrev package RSDCMPK RegularSetDecompositionPackage -++ Author: Marc Moreno Maza -++ Date Created: 09/16/1998 -++ Date Last Updated: 12/16/1998 -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Description: -++ A package providing a new algorithm for solving polynomial systems -++ by means of regular chains. Two ways of solving are proposed: -++ in the sense of Zariski closure (like in Kalkbrener's algorithm) -++ or in the sense of the regular zeros (like in Wu, Wang or Lazard -++ methods). This algorithm is valid for nay type -++ of regular set. It does not care about the way a polynomial is -++ added in an regular set, or how two quasi-components are compared -++ (by an inclusion-test), or how the invertibility test is made in -++ the tower of simple extensions associated with a regular set. -++ These operations are realized respectively by the domain \spad{TS} -++ and the packages \axiomType{QCMPACK}(R,E,V,P,TS) and \axiomType{RSETGCD}(R,E,V,P,TS). -++ The same way it does not care about the way univariate polynomial -++ gcd (with coefficients in the tower of simple extensions associated -++ with a regular set) are computed. The only requirement is that these -++ gcd need to have invertible initials (normalized or not). -++ WARNING. There is no need for a user to call diectly any operation -++ of this package since they can be accessed by the domain \axiom{TS}. -++ Thus, the operations of this package are not documented.\newline -++ References : -++ [1] M. MORENO MAZA "A new algorithm for computing triangular -++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. -++ Version: 5. Same as 4 but Does NOT use any unproved criteria. - -RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where - - R : GcdDomain - E : OrderedAbelianMonoidSup - V : OrderedSet - P : RecursivePolynomialCategory(R,E,V) - TS : RegularTriangularSetCategory(R,E,V,P) - N ==> NonNegativeInteger - Z ==> Integer - B ==> Boolean - LP ==> List P - PS ==> GeneralPolynomialSet(R,E,V,P) - PWT ==> Record(val : P, tower : TS) - BWT ==> Record(val : Boolean, tower : TS) - LpWT ==> Record(val : (List P), tower : TS) - Wip ==> Record(done: Split, todo: List LpWT) - Branch ==> Record(eq: List P, tower: TS, ineq: List P) - UBF ==> Union(Branch,"failed") - Split ==> List TS - iprintpack ==> InternalPrintPackage() - polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) - quasicomppack ==> QuasiComponentPackage(R,E,V,P,TS) - regsetgcdpack ==> RegularTriangularSetGcdPackage(R,E,V,P,TS) - - Exports == with - - KrullNumber: (LP, Split) -> N - numberOfVariables: (LP, Split) -> N - algebraicDecompose: (P,TS,B) -> Record(done: Split, todo: List LpWT) - transcendentalDecompose: (P,TS,N) -> Record(done: Split, todo: List LpWT) - transcendentalDecompose: (P,TS) -> Record(done: Split, todo: List LpWT) - internalDecompose: (P,TS,N,B) -> Record(done: Split, todo: List LpWT) - internalDecompose: (P,TS,N) -> Record(done: Split, todo: List LpWT) - internalDecompose: (P,TS) -> Record(done: Split, todo: List LpWT) - decompose: (LP, Split, B, B) -> Split - decompose: (LP, Split, B, B, B, B, B) -> Split - upDateBranches: (LP,Split,List LpWT,Wip,N) -> List LpWT - convert: Record(val: List P,tower: TS) -> String - printInfo: (List Record(val: List P,tower: TS), N) -> Void - - Implementation == add - - KrullNumber(lp: LP, lts: Split): N == - ln: List N := [#(ts) for ts in lts] - n := #lp + reduce(max,ln) - - 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: P, ts: TS, clos?: B): Record(done: Split, todo: List LpWT) == - ground? p => - error " in algebraicDecompose$REGSET: should never happen !" - v := mvar(p); n := #ts - ts_v_- := collectUnder(ts,v) - ts_v_+ := collectUpper(ts,v) - ts_v := select(ts,v)::P - if mdeg(p) < mdeg(ts_v) - then - lgwt := internalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack - else - lgwt := internalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack - lts: Split := [] - llpwt: List LpWT := [] - for gwt in lgwt repeat - g := gwt.val; us := gwt.tower - zero? g => - error " in algebraicDecompose$REGSET: should never happen !!" - ground? g => "leave" - if mvar(g) = v then lts := concat(augment(members(ts_v_+),augment(g,us)),lts) - h := leadingCoefficient(g,v) - b: Boolean := purelyAlgebraic?(us) - lsfp := squareFreeFactors(h)$polsetpack - lus := augment(members(ts_v_+),augment(ts_v,us)@Split) - for f in lsfp repeat - ground? f => "leave" - b and purelyAlgebraic?(f,us) => "leave" - for vs in lus repeat - llpwt := cons([[f,p],vs]$LpWT, llpwt) - [lts,llpwt] - - transcendentalDecompose(p: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) == - lts: Split - if #ts < bound - then - lts := augment(p,ts) - else - lts := [] - llpwt: List LpWT := [] - [lts,llpwt] - - transcendentalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == - lts: Split:= augment(p,ts) - llpwt: List LpWT := [] - [lts,llpwt] - - 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: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) == - -- ASSUME p not constant - llpwt: List LpWT := [] - lts: Split := [] - -- EITHER mvar(p) is null - if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p))) - then - llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt) - p := (p exquo lmp)::P - ip := squareFreePart init(p); tp := tail p - p := mainPrimitivePart p - -- OR init(p) is null or not - lbwt := invertible?(ip,ts)@(List BWT) - for bwt in lbwt repeat - bwt.val => - if algebraic?(mvar(p),bwt.tower) - then - rsl := algebraicDecompose(p,bwt.tower,true) - else - rsl := transcendentalDecompose(p,bwt.tower,bound) - lts := concat(rsl.done,lts) - llpwt := concat(rsl.todo,llpwt) - -- purelyAlgebraicLeadingMonomial?(ip,bwt.tower) => "leave" -- UNPROVED CRITERIA - purelyAlgebraic?(ip,bwt.tower) and purelyAlgebraic?(bwt.tower) => "leave" -- SAFE - (not ground? ip) => - zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt) - (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt) - riv := removeZero(ip,bwt.tower) - (zero? riv) => - zero? tp => lts := cons(bwt.tower,lts) - (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt) - llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) - [lts,llpwt] - - internalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) == - -- ASSUME p not constant - llpwt: List LpWT := [] - lts: Split := [] - -- EITHER mvar(p) is null - if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p))) - then - llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt) - p := (p exquo lmp)::P - ip := squareFreePart init(p); tp := tail p - p := mainPrimitivePart p - -- OR init(p) is null or not - lbwt := invertible?(ip,ts)@(List BWT) - for bwt in lbwt repeat - bwt.val => - if algebraic?(mvar(p),bwt.tower) - then - rsl := algebraicDecompose(p,bwt.tower,false) - else - rsl := transcendentalDecompose(p,bwt.tower) - lts := concat(rsl.done,lts) - llpwt := concat(rsl.todo,llpwt) - purelyAlgebraic?(ip,bwt.tower) and purelyAlgebraic?(bwt.tower) => "leave" - (not ground? ip) => - zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt) - (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt) - riv := removeZero(ip,bwt.tower) - (zero? riv) => - zero? tp => lts := cons(bwt.tower,lts) - (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt) - llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt) - [lts,llpwt] - - decompose(lp: LP, lts: Split, clos?: B, info?: B): Split == - decompose(lp,lts,false,false,clos?,true,info?) - - convert(lpwt: LpWT): String == - ls: List String := ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ] - concat ls - - printInfo(toSee: List LpWT, n: N): Void == - lpwt := first toSee - s: String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String] - m: N := #(lpwt.val) - toSee := rest toSee - for lpwt in toSee repeat - m := m + #(lpwt.val) - s := concat [s, ",", convert(lpwt)@String] - s := concat [s, " -> |", string(m::Z), "|; {", string(n::Z),"}]"] - iprint(s)$iprintpack - void() - - decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, rem?: B, info?: B): Split == - -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts - -- if sqfr? then SPLIT the system with SQUARE-FREE FACTORIZATION - -- if clos? then SOLVE in the closure sense - -- if rem? then REDUCE the current p by using remainder - -- if info? then PRINT info - empty? lp => lts - branches: List Branch := prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack - empty? branches => [] - toSee: List LpWT := [[br.eq,br.tower]$LpWT for br in branches] - toSave: Split := [] - if clos? then bound := KrullNumber(lp,lts) else bound := numberOfVariables(lp,lts) - while (not empty? toSee) repeat - if info? then printInfo(toSee,#toSave) - lpwt := first toSee; toSee := rest toSee - lp := lpwt.val; ts := lpwt.tower - empty? lp => - toSave := cons(ts, toSave) - p := first lp; lp := rest lp - if rem? and (not ground? p) and (not empty? ts) - then - p := remainder(p,ts).polnum - p := removeZero(p,ts) - zero? p => toSee := cons([lp,ts]$LpWT, toSee) - ground? p => "leave" - rsl := internalDecompose(p,ts,bound,clos?) - toSee := upDateBranches(lp,toSave,toSee,rsl,bound) - removeSuperfluousQuasiComponents(toSave)$quasicomppack - - upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N): List LpWT == - newBranches: List LpWT := wip.todo - newComponents: Split := wip.done - branches1, branches2: List LpWT - branches1 := []; branches2 := [] - for branch in newBranches repeat - us := branch.tower - #us > n => "leave" - newleq := sort(infRittWu?,concat(leq,branch.val)) - --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?) - --any?(ground?,foo) => "leave" - branches1 := cons([newleq,us]$LpWT, branches1) - for us in newComponents repeat - #us > n => "leave" - subQuasiComponent?(us,lts)$quasicomppack => "leave" - --newleq := leq - --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?) - --any?(ground?,foo) => "leave" - branches2 := cons([leq,us]$LpWT, branches2) - empty? branches1 => - empty? branches2 => current - concat(branches2, current) - branches := concat [branches2, branches1, current] - -- branches := concat(branches,current) - removeSuperfluousCases(branches)$quasicomppack - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rep1.spad.pamphlet b/src/algebra/rep1.spad.pamphlet deleted file mode 100644 index b65c767..0000000 --- a/src/algebra/rep1.spad.pamphlet +++ /dev/null @@ -1,380 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rep1.spad} -\author{Holger Gollan, Johannes Grabmeier, Thorsten Werther} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package REP1 RepresentationPackage1} -<>= -)abbrev package REP1 RepresentationPackage1 -++ Authors: Holger Gollan, Johannes Grabmeier, Thorsten Werther -++ Date Created: 12 September 1987 -++ Date Last Updated: 24 May 1991 -++ Basic Operations: antisymmetricTensors,symmetricTensors, -++ tensorProduct, permutationRepresentation -++ Related Constructors: RepresentationPackage1, Permutation -++ Also See: IrrRepSymNatPackage -++ AMS Classifications: -++ Keywords: representation, symmetrization, tensor product -++ References: -++ G. James, A. Kerber: The Representation Theory of the Symmetric -++ Group. Encycl. of Math. and its Appl. Vol 16., Cambr. Univ Press 1981; -++ J. Grabmeier, A. Kerber: The Evaluation of Irreducible -++ Polynomial Representations of the General Linear Groups -++ and of the Unitary Groups over Fields of Characteristic 0, -++ Acta Appl. Math. 8 (1987), 271-291; -++ H. Gollan, J. Grabmeier: Algorithms in Representation Theory and -++ their Realization in the Computer Algebra System Scratchpad, -++ Bayreuther Mathematische Schriften, Heft 33, 1990, 1-23 -++ Description: -++ RepresentationPackage1 provides functions for representation theory -++ for finite groups and algebras. -++ The package creates permutation representations and uses tensor products -++ and its symmetric and antisymmetric components to create new -++ representations of larger degree from given ones. -++ Note: instead of having parameters from \spadtype{Permutation} -++ this package allows list notation of permutations as well: -++ e.g. \spad{[1,4,3,2]} denotes permutes 2 and 4 and fixes 1 and 3. - -RepresentationPackage1(R): public == private where - - R : Ring - OF ==> OutputForm - NNI ==> NonNegativeInteger - PI ==> PositiveInteger - I ==> Integer - L ==> List - M ==> Matrix - P ==> Polynomial - SM ==> SquareMatrix - V ==> Vector - ICF ==> IntegerCombinatoricFunctions Integer - SGCF ==> SymmetricGroupCombinatoricFunctions - PERM ==> Permutation - - public ==> with - - if R has commutative("*") then - antisymmetricTensors : (M R,PI) -> M R - ++ antisymmetricTensors(a,n) applies to the square matrix - ++ {\em a} the irreducible, polynomial representation of the - ++ general linear group {\em GLm}, where m is the number of - ++ rows of {\em a}, which corresponds to the partition - ++ {\em (1,1,...,1,0,0,...,0)} of n. - ++ Error: if n is greater than m. - ++ Note: this corresponds to the symmetrization of the representation - ++ with the sign representation of the symmetric group {\em Sn}. - ++ The carrier spaces of the representation are the antisymmetric - ++ tensors of the n-fold tensor product. - if R has commutative("*") then - antisymmetricTensors : (L M R, PI) -> L M R - ++ antisymmetricTensors(la,n) applies to each - ++ m-by-m square matrix in - ++ the list {\em la} the irreducible, polynomial representation - ++ of the general linear group {\em GLm} - ++ which corresponds - ++ to the partition {\em (1,1,...,1,0,0,...,0)} of n. - ++ Error: if n is greater than m. - ++ Note: this corresponds to the symmetrization of the representation - ++ with the sign representation of the symmetric group {\em Sn}. - ++ The carrier spaces of the representation are the antisymmetric - ++ tensors of the n-fold tensor product. - createGenericMatrix : NNI -> M P R - ++ createGenericMatrix(m) creates a square matrix of dimension k - ++ whose entry at the i-th row and j-th column is the - ++ indeterminate {\em x[i,j]} (double subscripted). - symmetricTensors : (M R, PI) -> M R - ++ symmetricTensors(a,n) applies to the m-by-m - ++ square matrix {\em a} the - ++ irreducible, polynomial representation of the general linear - ++ group {\em GLm} - ++ which corresponds to the partition {\em (n,0,...,0)} of n. - ++ Error: if {\em a} is not a square matrix. - ++ Note: this corresponds to the symmetrization of the representation - ++ with the trivial representation of the symmetric group {\em Sn}. - ++ The carrier spaces of the representation are the symmetric - ++ tensors of the n-fold tensor product. - symmetricTensors : (L M R, PI) -> L M R - ++ symmetricTensors(la,n) applies to each m-by-m square matrix in the - ++ list {\em la} the irreducible, polynomial representation - ++ of the general linear group {\em GLm} - ++ which corresponds - ++ to the partition {\em (n,0,...,0)} of n. - ++ Error: if the matrices in {\em la} are not square matrices. - ++ Note: this corresponds to the symmetrization of the representation - ++ with the trivial representation of the symmetric group {\em Sn}. - ++ The carrier spaces of the representation are the symmetric - ++ tensors of the n-fold tensor product. - tensorProduct : (M R, M R) -> M R - ++ tensorProduct(a,b) calculates the Kronecker product - ++ of the matrices {\em a} and b. - ++ Note: if each matrix corresponds to a group representation - ++ (repr. of generators) of one group, then these matrices - ++ correspond to the tensor product of the two representations. - tensorProduct : (L M R, L M R) -> L M R - ++ tensorProduct([a1,...,ak],[b1,...,bk]) calculates the list of - ++ Kronecker products of the matrices {\em ai} and {\em bi} - ++ for {1 <= i <= k}. - ++ Note: If each list of matrices corresponds to a group representation - ++ (repr. of generators) of one group, then these matrices - ++ correspond to the tensor product of the two representations. - tensorProduct : M R -> M R - ++ tensorProduct(a) calculates the Kronecker product - ++ of the matrix {\em a} with itself. - tensorProduct : L M R -> L M R - ++ tensorProduct([a1,...ak]) calculates the list of - ++ Kronecker products of each matrix {\em ai} with itself - ++ for {1 <= i <= k}. - ++ Note: If the list of matrices corresponds to a group representation - ++ (repr. of generators) of one group, then these matrices correspond - ++ to the tensor product of the representation with itself. - permutationRepresentation : (PERM I, I) -> M I - ++ permutationRepresentation(pi,n) returns the matrix - ++ {\em (deltai,pi(i))} (Kronecker delta) for a permutation - ++ {\em pi} of {\em {1,2,...,n}}. - permutationRepresentation : L I -> M I - ++ permutationRepresentation(pi,n) returns the matrix - ++ {\em (deltai,pi(i))} (Kronecker delta) if the permutation - ++ {\em pi} is in list notation and permutes {\em {1,2,...,n}}. - permutationRepresentation : (L PERM I, I) -> L M I - ++ permutationRepresentation([pi1,...,pik],n) returns the list - ++ of matrices {\em [(deltai,pi1(i)),...,(deltai,pik(i))]} - ++ (Kronecker delta) for the permutations {\em pi1,...,pik} - ++ of {\em {1,2,...,n}}. - permutationRepresentation : L L I -> L M I - ++ permutationRepresentation([pi1,...,pik],n) returns the list - ++ of matrices {\em [(deltai,pi1(i)),...,(deltai,pik(i))]} - ++ if the permutations {\em pi1},...,{\em pik} are in - ++ list notation and are permuting {\em {1,2,...,n}}. - - private ==> add - - -- import of domains and packages - - import OutputForm - - -- 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) == - prod : I := 1 - for i in 1..maxIndex beta repeat - prod := prod * multinomial(beta(i), entries row(C,i))$ICF - prod - - - invContent(alpha) == - n : NNI := (+/alpha)::NNI - f : V I := new(n,0) - i : NNI := 1 - j : I := - 1 - for og in alpha repeat - j := j + 1 - for k in 1..og repeat - f(i) := j - i := i + 1 - f - - - -- exported functions: - - - - if R has commutative("*") then - antisymmetricTensors ( a : M R , k : PI ) == - - n : NNI := nrows a - k = 1 => a - k > n => - error("second parameter for antisymmetricTensors is too large") - m : I := binomial(n,k)$ICF - il : L L I := [subSet(n,k,i)$SGCF for i in 0..m-1] - b : M R := zero(m::NNI, m::NNI) - for i in 1..m repeat - for j in 1..m repeat - c : M R := zero(k,k) - lr: L I := il.i - lt: L I := il.j - for r in 1..k repeat - for t in 1..k repeat - rr : I := lr.r - tt : I := lt.t - --c.r.t := a.(1+rr).(1+tt) - setelt(c,r,t,elt(a, 1+rr, 1+tt)) - setelt(b, i, j, determinant c) - b - - - if R has commutative("*") then - antisymmetricTensors(la: L M R, k: PI) == - [antisymmetricTensors(ma,k) for ma in la] - - - - symmetricTensors (a : M R, n : PI) == - - m : NNI := nrows a - m ^= ncols a => - error("Input to symmetricTensors is no square matrix") - n = 1 => a - - dim : NNI := (binomial(m+n-1,n)$ICF)::NNI - c : M R := new(dim,dim,0) - f : V I := new(n,0) - g : V I := new(n,0) - nullMatrix : M I := new(1,1,0) - colemanMatrix : M I - - for i in 1..dim repeat - -- unrankImproperPartitions1 starts counting from 0 - alpha := unrankImproperPartitions1(n,m,i-1)$SGCF - f := invContent(alpha) - for j in 1..dim repeat - -- unrankImproperPartitions1 starts counting from 0 - beta := unrankImproperPartitions1(n,m,j-1)$SGCF - g := invContent(beta) - colemanMatrix := nextColeman(alpha,beta,nullMatrix)$SGCF - while colemanMatrix ^= nullMatrix repeat - gamma := inverseColeman(alpha,beta,colemanMatrix)$SGCF - help : R := calcCoef(beta,colemanMatrix)::R - for k in 1..n repeat - help := help * a( (1+f k)::NNI, (1+g(gamma k))::NNI ) - c(i,j) := c(i,j) + help - colemanMatrix := nextColeman(alpha,beta,colemanMatrix)$SGCF - -- end of while - -- end of j-loop - -- end of i-loop - - c - - - symmetricTensors(la : L M R, k : PI) == - [symmetricTensors (ma, k) for ma in la] - - - tensorProduct(a: M R, b: M R) == - n : NNI := nrows a - m : NNI := nrows b - nc : NNI := ncols a - mc : NNI := ncols b - c : M R := zero(n * m, nc * mc) - indexr : NNI := 1 -- row index - for i in 1..n repeat - for k in 1..m repeat - indexc : NNI := 1 -- column index - for j in 1..nc repeat - for l in 1..mc repeat - c(indexr,indexc) := a(i,j) * b(k,l) - indexc := indexc + 1 - indexr := indexr + 1 - c - - - tensorProduct (la: L M R, lb: L M R) == - [tensorProduct(la.i, lb.i) for i in 1..maxIndex la] - - - tensorProduct(a : M R) == tensorProduct(a, a) - - tensorProduct(la : L M R) == - tensorProduct(la :: L M R, la :: L M R) - - permutationRepresentation (p : PERM I, n : I) == - -- permutations are assumed to permute {1,2,...,n} - a : M I := zero(n :: NNI, n :: NNI) - for i in 1..n repeat - a(eval(p,i)$(PERM I),i) := 1 - a - - - permutationRepresentation (p : L I) == - -- permutations are assumed to permute {1,2,...,n} - n : I := #p - a : M I := zero(n::NNI, n::NNI) - for i in 1..n repeat - a(p.i,i) := 1 - a - - - permutationRepresentation(listperm : L PERM I, n : I) == - -- permutations are assumed to permute {1,2,...,n} - [permutationRepresentation(perm, n) for perm in listperm] - - permutationRepresentation (listperm : L L I) == - -- permutations are assumed to permute {1,2,...,n} - [permutationRepresentation perm for perm in listperm] - - createGenericMatrix(m) == - res : M P R := new(m,m,0$(P R)) - for i in 1..m repeat - for j in 1..m repeat - iof : OF := coerce(i)$Integer - jof : OF := coerce(j)$Integer - le : L OF := cons(iof,list jof) - sy : Symbol := subscript(x::Symbol, le)$Symbol - res(i,j) := (sy :: P R) - res - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rep2.spad.pamphlet b/src/algebra/rep2.spad.pamphlet deleted file mode 100644 index 64fec1f..0000000 --- a/src/algebra/rep2.spad.pamphlet +++ /dev/null @@ -1,827 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rep2.spad} -\author{Holger Gollan, Johannes Grabmeier} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package REP2 RepresentationPackage2} -<>= -)abbrev package REP2 RepresentationPackage2 -++ Authors: Holger Gollan, Johannes Grabmeier -++ Date Created: 10 September 1987 -++ Date Last Updated: 20 August 1990 -++ Basic Operations: areEquivalent?, isAbsolutelyIrreducible?, -++ split, meatAxe -++ Related Constructors: RepresentationTheoryPackage1 -++ Also See: IrrRepSymNatPackage -++ AMS Classifications: -++ Keywords: meat-axe, modular representation -++ Reference: -++ R. A. Parker: The Computer Calculation of Modular Characters -++ (The Meat-Axe), in M. D. Atkinson (Ed.), Computational Group Theory -++ Academic Press, Inc., London 1984 -++ H. Gollan, J. Grabmeier: Algorithms in Representation Theory and -++ their Realization in the Computer Algebra System Scratchpad, -++ Bayreuther Mathematische Schriften, Heft 33, 1990, 1-23. -++ Description: -++ RepresentationPackage2 provides functions for working with -++ modular representations of finite groups and algebra. -++ The routines in this package are created, using ideas of R. Parker, -++ (the meat-Axe) to get smaller representations from bigger ones, -++ i.e. finding sub- and factormodules, or to show, that such the -++ representations are irreducible. -++ Note: most functions are randomized functions of Las Vegas type -++ i.e. every answer is correct, but with small probability -++ the algorithm fails to get an answer. -RepresentationPackage2(R): public == private where - - R : Ring - OF ==> OutputForm - I ==> Integer - L ==> List - SM ==> SquareMatrix - M ==> Matrix - NNI ==> NonNegativeInteger - V ==> Vector - PI ==> PositiveInteger - B ==> Boolean - RADIX ==> RadixExpansion - - public ==> with - - completeEchelonBasis : V V R -> M R - ++ completeEchelonBasis(lv) completes the basis {\em lv} assumed - ++ to be in echelon form of a subspace of {\em R**n} (n the length - ++ of all the vectors in {\em lv}) with unit vectors to a basis of - ++ {\em R**n}. It is assumed that the argument is not an empty - ++ vector and that it is not the basis of the 0-subspace. - ++ Note: the rows of the result correspond to the vectors of the basis. - createRandomElement : (L M R, M R) -> M R - ++ createRandomElement(aG,x) creates a random element of the group - ++ algebra generated by {\em aG}. - -- randomWord : (L L I, L M) -> M R - --++ You can create your own 'random' matrix with "randomWord(lli, lm)". - --++ Each li in lli determines a product of matrices, the entries in li - --++ determine which matrix from lm is chosen. Finally we sum over all - --++ products. The result "sm" can be used to call split with (e.g.) - --++ second parameter "first nullSpace sm" - if R has EuclideanDomain then -- using rowEchelon - cyclicSubmodule : (L M R, V R) -> V V R - ++ cyclicSubmodule(lm,v) generates a basis as follows. - ++ It is assumed that the size n of the vector equals the number - ++ of rows and columns of the matrices. Then the matrices generate - ++ a subalgebra, say \spad{A}, of the algebra of all square matrices of - ++ dimension n. {\em V R} is an \spad{A}-module in the natural way. - ++ cyclicSubmodule(lm,v) generates the R-Basis of {\em Av} as - ++ described in section 6 of R. A. Parker's "The Meat-Axe". - ++ Note: in contrast to the description in "The Meat-Axe" and to - ++ {\em standardBasisOfCyclicSubmodule} the result is in - ++ echelon form. - standardBasisOfCyclicSubmodule : (L M R, V R) -> M R - ++ standardBasisOfCyclicSubmodule(lm,v) returns a matrix as follows. - ++ It is assumed that the size n of the vector equals the number - ++ of rows and columns of the matrices. Then the matrices generate - ++ a subalgebra, say \spad{A}, - ++ of the algebra of all square matrices of - ++ dimension n. {\em V R} is an \spad{A}-module in the natural way. - ++ standardBasisOfCyclicSubmodule(lm,v) calculates a matrix whose - ++ non-zero column vectors are the R-Basis of {\em Av} achieved - ++ in the way as described in section 6 - ++ of R. A. Parker's "The Meat-Axe". - ++ Note: in contrast to {\em cyclicSubmodule}, the result is not - ++ in echelon form. - if R has Field then -- only because of inverse in SM - areEquivalent? : (L M R, L M R, B, I) -> M R - ++ areEquivalent?(aG0,aG1,randomelements,numberOfTries) tests - ++ whether the two lists of matrices, all assumed of same - ++ square shape, can be simultaneously conjugated by a non-singular - ++ matrix. If these matrices represent the same group generators, - ++ the representations are equivalent. - ++ The algorithm tries - ++ {\em numberOfTries} times to create elements in the - ++ generated algebras in the same fashion. If their ranks differ, - ++ they are not equivalent. If an - ++ isomorphism is assumed, then - ++ the kernel of an element of the first algebra - ++ is mapped to the kernel of the corresponding element in the - ++ second algebra. Now consider the one-dimensional ones. - ++ If they generate the whole space (e.g. irreducibility !) - ++ we use {\em standardBasisOfCyclicSubmodule} to create the - ++ only possible transition matrix. The method checks whether the - ++ matrix conjugates all corresponding matrices from {\em aGi}. - ++ The way to choose the singular matrices is as in {\em meatAxe}. - ++ If the two representations are equivalent, this routine - ++ returns the transformation matrix {\em TM} with - ++ {\em aG0.i * TM = TM * aG1.i} for all i. If the representations - ++ are not equivalent, a small 0-matrix is returned. - ++ Note: the case - ++ with different sets of group generators cannot be handled. - areEquivalent? : (L M R, L M R) -> M R - ++ areEquivalent?(aG0,aG1) calls {\em areEquivalent?(aG0,aG1,true,25)}. - ++ Note: the choice of 25 was rather arbitrary. - areEquivalent? : (L M R, L M R, I) -> M R - ++ areEquivalent?(aG0,aG1,numberOfTries) calls - ++ {\em areEquivalent?(aG0,aG1,true,25)}. - ++ Note: the choice of 25 was rather arbitrary. - isAbsolutelyIrreducible? : (L M R, I) -> B - ++ isAbsolutelyIrreducible?(aG, numberOfTries) uses - ++ Norton's irreducibility test to check for absolute - ++ irreduciblity, assuming if a one-dimensional kernel is found. - ++ As no field extension changes create "new" elements - ++ in a one-dimensional space, the criterium stays true - ++ for every extension. The method looks for one-dimensionals only - ++ by creating random elements (no fingerprints) since - ++ a run of {\em meatAxe} would have proved absolute irreducibility - ++ anyway. - isAbsolutelyIrreducible? : L M R -> B - ++ isAbsolutelyIrreducible?(aG) calls - ++ {\em isAbsolutelyIrreducible?(aG,25)}. - ++ Note: the choice of 25 was rather arbitrary. - split : (L M R, V R) -> L L M R - ++ split(aG, vector) returns a subalgebra \spad{A} of all - ++ square matrix of dimension n as a list of list of matrices, - ++ generated by the list of matrices aG, where n denotes both - ++ the size of vector as well as the dimension of each of the - ++ square matrices. - ++ {\em V R} is an A-module in the natural way. - ++ split(aG, vector) then checks whether the cyclic submodule - ++ generated by {\em vector} is a proper submodule of {\em V R}. - ++ If successful, it returns a two-element list, which contains - ++ first the list of the representations of the submodule, - ++ then the list of the representations of the factor module. - ++ If the vector generates the whole module, a one-element list - ++ of the old representation is given. - ++ Note: a later version this should call the other split. - split: (L M R, V V R) -> L L M R - ++ split(aG,submodule) uses a proper submodule of {\em R**n} - ++ to create the representations of the submodule and of - ++ the factor module. - if (R has Finite) and (R has Field) then - meatAxe : (L M R, B, I, I) -> L L M R - ++ meatAxe(aG,randomElements,numberOfTries, maxTests) returns - ++ a 2-list of representations as follows. - ++ All matrices of argument aG are assumed to be square - ++ and of equal size. - ++ Then \spad{aG} generates a subalgebra, say \spad{A}, of the algebra - ++ of all square matrices of dimension n. {\em V R} is an A-module - ++ in the usual way. - ++ meatAxe(aG,numberOfTries, maxTests) creates at most - ++ {\em numberOfTries} random elements of the algebra, tests - ++ them for singularity. If singular, it tries at most {\em maxTests} - ++ elements of its kernel to generate a proper submodule. - ++ If successful, a 2-list is returned: first, a list - ++ containing first the list of the - ++ representations of the submodule, then a list of the - ++ representations of the factor module. - ++ Otherwise, if we know that all the kernel is already - ++ scanned, Norton's irreducibility test can be used either - ++ to prove irreducibility or to find the splitting. - ++ If {\em randomElements} is {\em false}, the first 6 tries - ++ use Parker's fingerprints. - meatAxe : L M R -> L L M R - ++ meatAxe(aG) calls {\em meatAxe(aG,false,25,7)} returns - ++ a 2-list of representations as follows. - ++ All matrices of argument \spad{aG} are assumed to be square - ++ and of - ++ equal size. Then \spad{aG} generates a subalgebra, - ++ say \spad{A}, of the algebra - ++ of all square matrices of dimension n. {\em V R} is an A-module - ++ in the usual way. - ++ meatAxe(aG) creates at most 25 random elements - ++ of the algebra, tests - ++ them for singularity. If singular, it tries at most 7 - ++ elements of its kernel to generate a proper submodule. - ++ If successful a list which contains first the list of the - ++ representations of the submodule, then a list of the - ++ representations of the factor module is returned. - ++ Otherwise, if we know that all the kernel is already - ++ scanned, Norton's irreducibility test can be used either - ++ to prove irreducibility or to find the splitting. - ++ Notes: the first 6 tries use Parker's fingerprints. - ++ Also, 7 covers the case of three-dimensional kernels over - ++ the field with 2 elements. - meatAxe: (L M R, B) -> L L M R - ++ meatAxe(aG, randomElements) calls {\em meatAxe(aG,false,6,7)}, - ++ only using Parker's fingerprints, if {\em randomElemnts} is false. - ++ If it is true, it calls {\em meatAxe(aG,true,25,7)}, - ++ only using random elements. - ++ Note: the choice of 25 was rather arbitrary. - ++ Also, 7 covers the case of three-dimensional kernels over the field - ++ with 2 elements. - meatAxe : (L M R, PI) -> L L M R - ++ meatAxe(aG, numberOfTries) calls - ++ {\em meatAxe(aG,true,numberOfTries,7)}. - ++ Notes: 7 covers the case of three-dimensional - ++ kernels over the field with 2 elements. - scanOneDimSubspaces: (L V R, I) -> V R - ++ scanOneDimSubspaces(basis,n) gives a canonical representative - ++ of the {\em n}-th one-dimensional subspace of the vector space - ++ generated by the elements of {\em basis}, all from {\em R**n}. - ++ The coefficients of the representative are of shape - ++ {\em (0,...,0,1,*,...,*)}, {\em *} in R. If the size of R - ++ is q, then there are {\em (q**n-1)/(q-1)} of them. - ++ We first reduce n modulo this number, then find the - ++ largest i such that {\em +/[q**i for i in 0..i-1] <= n}. - ++ Subtracting this sum of powers from n results in an - ++ i-digit number to basis q. This fills the positions of the - ++ stars. - -- would prefer to have (V V R,.... but nullSpace results - -- in L V R - - private ==> add - - -- import of domain and packages - import OutputForm - - -- declarations and definitions of local variables and - -- local function - - blockMultiply: (M R, M R, L I, I) -> M R - -- blockMultiply(a,b,li,n) assumes that a has n columns - -- and b has n rows, li is a sublist of the rows of a and - -- a sublist of the columns of b. The result is the - -- multiplication of the (li x n) part of a with the - -- (n x li) part of b. We need this, because just matrix - -- multiplying the parts would require extra storage. - blockMultiply(a, b, li, n) == - matrix([[ +/[a(i,s) * b(s,j) for s in 1..n ] _ - for j in li ] for i in li]) - - fingerPrint: (NNI, M R, M R, M R) -> M R - -- is local, because one should know all the results for smaller i - fingerPrint (i : NNI, a : M R, b : M R, x :M R) == - -- i > 2 only gives the correct result if the value of x from - -- the parameter list equals the result of fingerprint(i-1,...) - (i::PI) = 1 => x := a + b + a*b - (i::PI) = 2 => x := (x + a*b)*b - (i::PI) = 3 => x := a + b*x - (i::PI) = 4 => x := x + b - (i::PI) = 5 => x := x + a*b - (i::PI) = 6 => x := x - a + b*a - error "Sorry, but there are only 6 fingerprints!" - x - - - -- definition of exported functions - - - --randomWord(lli,lm) == - -- -- we assume that all matrices are square of same size - -- numberOfMatrices := #lm - -- +/[*/[lm.(1+i rem numberOfMatrices) for i in li ] for li in lli] - - completeEchelonBasis(basis) == - - dimensionOfSubmodule : NNI := #basis - n : NNI := # basis.1 - indexOfVectorToBeScanned : NNI := 1 - row : NNI := dimensionOfSubmodule - - completedBasis : M R := zero(n, n) - for i in 1..dimensionOfSubmodule repeat - completedBasis := setRow_!(completedBasis, i, basis.i) - if #basis <= n then - newStart : NNI := 1 - for j in 1..n - while indexOfVectorToBeScanned <= dimensionOfSubmodule repeat - if basis.indexOfVectorToBeScanned.j = 0 then - completedBasis(1+row,j) := 1 --put unit vector into basis - row := row + 1 - else - indexOfVectorToBeScanned := indexOfVectorToBeScanned + 1 - newStart : NNI := j + 1 - for j in newStart..n repeat - completedBasis(j,j) := 1 --put unit vector into basis - completedBasis - - - createRandomElement(aG,algElt) == - numberOfGenerators : NNI := #aG - -- randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - algElt := algElt * aG.randomIndex - -- randomIndxElement := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - algElt + aG.randomIndex - - - if R has EuclideanDomain then - cyclicSubmodule (lm : L M R, v : V R) == - basis : M R := rowEchelon matrix list entries v - -- normalizing the vector - -- all these elements lie in the submodule generated by v - furtherElts : L V R := [(lm.i*v)::V R for i in 1..maxIndex lm] - --furtherElts has elements of the generated submodule. It will - --will be checked whether they are in the span of the vectors - --computed so far. Of course we stop if we have got the whole - --space. - while (^null furtherElts) and (nrows basis < #v) repeat - w : V R := first furtherElts - nextVector : M R := matrix list entries w -- normalizing the vector - -- will the rank change if we add this nextVector - -- to the basis so far computed? - addedToBasis : M R := vertConcat(basis, nextVector) - if rank addedToBasis ^= nrows basis then - basis := rowEchelon addedToBasis -- add vector w to basis - updateFurtherElts : L V R := _ - [(lm.i*w)::V R for i in 1..maxIndex lm] - furtherElts := append (rest furtherElts, updateFurtherElts) - else - -- the vector w lies in the span of matrix, no updating - -- of the basis - furtherElts := rest furtherElts - vector [row(basis, i) for i in 1..maxRowIndex basis] - - - standardBasisOfCyclicSubmodule (lm : L M R, v : V R) == - dim : NNI := #v - standardBasis : L L R := list(entries v) - basis : M R := rowEchelon matrix list entries v - -- normalizing the vector - -- all these elements lie in the submodule generated by v - furtherElts : L V R := [(lm.i*v)::V R for i in 1..maxIndex lm] - --furtherElts has elements of the generated submodule. It will - --will be checked whether they are in the span of the vectors - --computed so far. Of course we stop if we have got the whole - --space. - while (^null furtherElts) and (nrows basis < #v) repeat - w : V R := first furtherElts - nextVector : M R := matrix list entries w -- normalizing the vector - -- will the rank change if we add this nextVector - -- to the basis so far computed? - addedToBasis : M R := vertConcat(basis, nextVector) - if rank addedToBasis ^= nrows basis then - standardBasis := cons(entries w, standardBasis) - basis := rowEchelon addedToBasis -- add vector w to basis - updateFurtherElts : L V R := _ - [lm.i*w for i in 1..maxIndex lm] - furtherElts := append (rest furtherElts, updateFurtherElts) - else - -- the vector w lies in the span of matrix, therefore - -- no updating of matrix - furtherElts := rest furtherElts - transpose matrix standardBasis - - - if R has Field then -- only because of inverse in Matrix - - -- as conditional local functions, *internal have to be here - - splitInternal: (L M R, V R, B) -> L L M R - splitInternal(algebraGenerators : L M R, vector: V R,doSplitting? : B) == - - n : I := # vector -- R-rank of representation module = - -- degree of representation - submodule : V V R := cyclicSubmodule (algebraGenerators,vector) - rankOfSubmodule : I := # submodule -- R-Rank of submodule - submoduleRepresentation : L M R := nil() - factormoduleRepresentation : L M R := nil() - if n ^= rankOfSubmodule then - messagePrint " A proper cyclic submodule is found." - if doSplitting? then -- no else !! - submoduleIndices : L I := [i for i in 1..rankOfSubmodule] - factormoduleIndices : L I := [i for i in (1+rankOfSubmodule)..n] - transitionMatrix : M R := _ - transpose completeEchelonBasis submodule - messagePrint " Transition matrix computed" - inverseTransitionMatrix : M R := _ - autoCoerce(inverse transitionMatrix)$Union(M R,"failed") - messagePrint " The inverse of the transition matrix computed" - messagePrint " Now transform the matrices" - for i in 1..maxIndex algebraGenerators repeat - helpMatrix : M R := inverseTransitionMatrix * algebraGenerators.i - -- in order to not create extra space and regarding the fact - -- that we only want the two blocks in the main diagonal we - -- multiply with the aid of the local function blockMultiply - submoduleRepresentation := cons( blockMultiply( _ - helpMatrix,transitionMatrix,submoduleIndices,n), _ - submoduleRepresentation) - factormoduleRepresentation := cons( blockMultiply( _ - helpMatrix,transitionMatrix,factormoduleIndices,n), _ - factormoduleRepresentation) - [reverse submoduleRepresentation, reverse _ - factormoduleRepresentation] - else -- represesentation is irreducible - messagePrint " The generated cyclic submodule was not proper" - [algebraGenerators] - - - - irreducibilityTestInternal: (L M R, M R, B) -> L L M R - irreducibilityTestInternal(algebraGenerators,_ - singularMatrix,split?) == - algebraGeneratorsTranspose : L M R := [transpose _ - algebraGenerators.j for j in 1..maxIndex algebraGenerators] - xt : M R := transpose singularMatrix - messagePrint " We know that all the cyclic submodules generated by all" - messagePrint " non-trivial element of the singular matrix under view are" - messagePrint " not proper, hence Norton's irreducibility test can be done:" - -- actually we only would need one (!) non-trivial element from - -- the kernel of xt, such an element must exist as the transpose - -- of a singular matrix is of course singular. Question: Can - -- we get it more easily from the kernel of x = singularMatrix? - kernel : L V R := nullSpace xt - result : L L M R := _ - splitInternal(algebraGeneratorsTranspose,first kernel,split?) - if null rest result then -- this means first kernel generates - -- the whole module - if 1 = #kernel then - messagePrint " Representation is absolutely irreducible" - else - messagePrint " Representation is irreducible, but we don't know " - messagePrint " whether it is absolutely irreducible" - else - if split? then - messagePrint " Representation is not irreducible and it will be split:" - -- these are the dual representations, so calculate the - -- dual to get the desired result, i.e. "transpose inverse" - -- improvements?? - for i in 1..maxIndex result repeat - for j in 1..maxIndex (result.i) repeat - mat : M R := result.i.j - result.i.j := _ - transpose autoCoerce(inverse mat)$Union(M R,"failed") - else - messagePrint " Representation is not irreducible, use meatAxe to split" - -- if "split?" then dual representation interchange factor - -- and submodules, hence reverse - reverse result - - - - -- exported functions for FiniteField-s. - - - areEquivalent? (aG0, aG1) == - areEquivalent? (aG0, aG1, true, 25) - - - areEquivalent? (aG0, aG1, numberOfTries) == - areEquivalent? (aG0, aG1, true, numberOfTries) - - - areEquivalent? (aG0, aG1, randomelements, numberOfTries) == - result : B := false - transitionM : M R := zero(1, 1) - numberOfGenerators : NNI := #aG0 - -- need a start value for creating random matrices: - -- if we switch to randomelements later, we take the last - -- fingerprint. - if randomelements then -- random should not be from I - --randomIndex : I := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x0 : M R := aG0.randomIndex - x1 : M R := aG1.randomIndex - n : NNI := #row(x0,1) -- degree of representation - foundResult : B := false - for i in 1..numberOfTries until foundResult repeat - -- try to create a non-singular element of the algebra - -- generated by "aG". If only two generators, - -- i < 7 and not "randomelements" use Parker's fingerprints - -- i >= 7 create random elements recursively: - -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly - -- chosen elements form "aG". - if i = 7 then randomelements := true - if randomelements then - --randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x0 := x0 * aG0.randomIndex - x1 := x1 * aG1.randomIndex - --randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x0 := x0 + aG0.randomIndex - x1 := x1 + aG1.randomIndex - else - x0 := fingerPrint (i, aG0.0, aG0.1 ,x0) - x1 := fingerPrint (i, aG1.0, aG1.1 ,x1) - -- test singularity of x0 and x1 - rk0 : NNI := rank x0 - rk1 : NNI := rank x1 - rk0 ^= rk1 => - messagePrint "Dimensions of kernels differ" - foundResult := true - result := false - -- can assume dimensions are equal - rk0 ^= n - 1 => - -- not of any use here if kernel not one-dimensional - if randomelements then - messagePrint "Random element in generated algebra does" - messagePrint " not have a one-dimensional kernel" - else - messagePrint "Fingerprint element in generated algebra does" - messagePrint " not have a one-dimensional kernel" - -- can assume dimensions are equal and equal to n-1 - if randomelements then - messagePrint "Random element in generated algebra has" - messagePrint " one-dimensional kernel" - else - messagePrint "Fingerprint element in generated algebra has" - messagePrint " one-dimensional kernel" - kernel0 : L V R := nullSpace x0 - kernel1 : L V R := nullSpace x1 - baseChange0 : M R := standardBasisOfCyclicSubmodule(_ - aG0,kernel0.1) - baseChange1 : M R := standardBasisOfCyclicSubmodule(_ - aG1,kernel1.1) - (ncols baseChange0) ^= (ncols baseChange1) => - messagePrint " Dimensions of generated cyclic submodules differ" - foundResult := true - result := false - -- can assume that dimensions of cyclic submodules are equal - (ncols baseChange0) = n => -- full dimension - transitionM := baseChange0 * _ - autoCoerce(inverse baseChange1)$Union(M R,"failed") - foundResult := true - result := true - for j in 1..numberOfGenerators while result repeat - if (aG0.j*transitionM) ^= (transitionM*aG1.j) then - result := false - transitionM := zero(1 ,1) - messagePrint " There is no isomorphism, as the only possible one" - messagePrint " fails to do the necessary base change" - -- can assume that dimensions of cyclic submodules are not "n" - messagePrint " Generated cyclic submodules have equal, but not full" - messagePrint " dimension, hence we can not draw any conclusion" - -- here ends the for-loop - if not foundResult then - messagePrint " " - messagePrint "Can neither prove equivalence nor inequivalence." - messagePrint " Try again." - else - if result then - messagePrint " " - messagePrint "Representations are equivalent." - else - messagePrint " " - messagePrint "Representations are not equivalent." - transitionM - - - isAbsolutelyIrreducible?(aG) == isAbsolutelyIrreducible?(aG,25) - - - isAbsolutelyIrreducible?(aG, numberOfTries) == - result : B := false - numberOfGenerators : NNI := #aG - -- need a start value for creating random matrices: - -- randomIndex : I := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x : M R := aG.randomIndex - n : NNI := #row(x,1) -- degree of representation - foundResult : B := false - for i in 1..numberOfTries until foundResult repeat - -- try to create a non-singular element of the algebra - -- generated by "aG", dimension of its kernel being 1. - -- create random elements recursively: - -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly - -- chosen elements form "aG". - -- randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x := x * aG.randomIndex - --randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x := x + aG.randomIndex - -- test whether rank of x is n-1 - rk : NNI := rank x - if rk = n - 1 then - foundResult := true - messagePrint "Random element in generated algebra has" - messagePrint " one-dimensional kernel" - kernel : L V R := nullSpace x - if n=#cyclicSubmodule(aG, first kernel) then - result := (irreducibilityTestInternal(aG,x,false)).1 ^= nil()$(L M R) - -- result := not null? first irreducibilityTestInternal(aG,x,false) -- this down't compile !! - else -- we found a proper submodule - result := false - --split(aG,kernel.1) -- to get the splitting - else -- not of any use here if kernel not one-dimensional - messagePrint "Random element in generated algebra does" - messagePrint " not have a one-dimensional kernel" - -- here ends the for-loop - if not foundResult then - messagePrint "We have not found a one-dimensional kernel so far," - messagePrint " as we do a random search you could try again" - --else - -- if not result then - -- messagePrint "Representation is not irreducible." - -- else - -- messagePrint "Representation is irreducible." - result - - - - split(algebraGenerators: L M R, vector: V R) == - splitInternal(algebraGenerators, vector, true) - - - split(algebraGenerators : L M R, submodule: V V R) == --not zero submodule - n : NNI := #submodule.1 -- R-rank of representation module = - -- degree of representation - rankOfSubmodule : I := (#submodule) :: I --R-Rank of submodule - submoduleRepresentation : L M R := nil() - factormoduleRepresentation : L M R := nil() - submoduleIndices : L I := [i for i in 1..rankOfSubmodule] - factormoduleIndices : L I := [i for i in (1+rankOfSubmodule)..(n::I)] - transitionMatrix : M R := _ - transpose completeEchelonBasis submodule - messagePrint " Transition matrix computed" - inverseTransitionMatrix : M R := - autoCoerce(inverse transitionMatrix)$Union(M R,"failed") - messagePrint " The inverse of the transition matrix computed" - messagePrint " Now transform the matrices" - for i in 1..maxIndex algebraGenerators repeat - helpMatrix : M R := inverseTransitionMatrix * algebraGenerators.i - -- in order to not create extra space and regarding the fact - -- that we only want the two blocks in the main diagonal we - -- multiply with the aid of the local function blockMultiply - submoduleRepresentation := cons( blockMultiply( _ - helpMatrix,transitionMatrix,submoduleIndices,n), _ - submoduleRepresentation) - factormoduleRepresentation := cons( blockMultiply( _ - helpMatrix,transitionMatrix,factormoduleIndices,n), _ - factormoduleRepresentation) - 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". - - - -- we are scanning through the vectorspaces - if (R has Finite) and (R has Field) then - - meatAxe(algebraGenerators, randomelements, numberOfTries, _ - maxTests) == - numberOfGenerators : NNI := #algebraGenerators - result : L L M R := nil()$(L L M R) - q : PI := size()$R:PI - -- need a start value for creating random matrices: - -- if we switch to randomelements later, we take the last - -- fingerprint. - if randomelements then -- random should not be from I - --randomIndex : I := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x : M R := algebraGenerators.randomIndex - foundResult : B := false - for i in 1..numberOfTries until foundResult repeat - -- try to create a non-singular element of the algebra - -- generated by "algebraGenerators". If only two generators, - -- i < 7 and not "randomelements" use Parker's fingerprints - -- i >= 7 create random elements recursively: - -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly - -- chosen elements form "algebraGenerators". - if i = 7 then randomelements := true - if randomelements then - --randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x := x * algebraGenerators.randomIndex - --randomIndex := randnum numberOfGenerators - randomIndex := 1+(random()$Integer rem numberOfGenerators) - x := x + algebraGenerators.randomIndex - else - x := fingerPrint (i, algebraGenerators.1,_ - algebraGenerators.2 , x) - -- test singularity of x - n : NNI := #row(x, 1) -- degree of representation - if (rank x) ^= n then -- x singular - if randomelements then - messagePrint "Random element in generated algebra is singular" - else - messagePrint "Fingerprint element in generated algebra is singular" - kernel : L V R := nullSpace x - -- the first number is the maximal number of one dimensional - -- subspaces of the kernel, the second is a user given - -- constant - numberOfOneDimSubspacesInKernel : I := (q**(#kernel)-1)quo(q-1) - numberOfTests : I := _ - min(numberOfOneDimSubspacesInKernel, maxTests) - for j in 1..numberOfTests repeat - --we create an element in the kernel, there is a good - --probability for it to generate a proper submodule, the - --called "split" does the further work: - result := _ - split(algebraGenerators,scanOneDimSubspaces(kernel,j)) - -- we had "not null rest result" directly in the following - -- if .. then, but the statment there foundResult := true - -- didn't work properly - foundResult := not null rest result - if foundResult then - leave -- inner for-loop - -- finish here with result - else -- no proper submodule - -- we were not successfull, i.e gen. submodule was - -- not proper, if the whole kernel is already scanned, - -- Norton's irreducibility test is used now. - if (j+1)>numberOfOneDimSubspacesInKernel then - -- we know that all the cyclic submodules generated - -- by all non-trivial elements of the kernel are proper. - foundResult := true - result : L L M R := irreducibilityTestInternal (_ - algebraGenerators,x,true) - leave -- inner for-loop - -- here ends the inner for-loop - else -- x non-singular - if randomelements then - messagePrint "Random element in generated algebra is non-singular" - else - messagePrint "Fingerprint element in generated algebra is non-singular" - -- here ends the outer for-loop - if not foundResult then - result : L L M R := [nil()$(L M R), nil()$(L M R)] - messagePrint " " - messagePrint "Sorry, no result, try meatAxe(...,true)" - messagePrint " or consider using an extension field." - result - - - meatAxe (algebraGenerators) == - meatAxe(algebraGenerators, false, 25, 7) - - - meatAxe (algebraGenerators, randomElements?) == - randomElements? => meatAxe (algebraGenerators, true, 25, 7) - meatAxe(algebraGenerators, false, 6, 7) - - - meatAxe (algebraGenerators:L M R, numberOfTries:PI) == - meatAxe (algebraGenerators, true, numberOfTries, 7) - - - - scanOneDimSubspaces(basis,n) == - -- "dimension" of subspace generated by "basis" - dim : NNI := #basis - -- "dimension of the whole space: - nn : NNI := #(basis.1) - q : NNI := size()$R - -- number of all one-dimensional subspaces: - nred : I := n rem ((q**dim -1) quo (q-1)) - pos : I := nred - i : I := 0 - for i in 0..dim-1 while nred >= 0 repeat - pos := nred - nred := nred - (q**i) - i := if i = 0 then 0 else i-1 - coefficients : V R := new(dim,0$R) - coefficients.(dim-i) := 1$R - iR : L I := wholeRagits(pos::RADIX q) - for j in 1..(maxIndex iR) repeat - coefficients.(dim-((#iR)::I) +j) := index((iR.j+(q::I))::PI)$R - result : V R := new(nn,0) - for i in 1..maxIndex coefficients repeat - newAdd : V R := coefficients.i * basis.i - for j in 1..nn repeat - result.j := result.j + newAdd.j - result - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/retract.spad.pamphlet b/src/algebra/retract.spad.pamphlet deleted file mode 100644 index 4b36a2b..0000000 --- a/src/algebra/retract.spad.pamphlet +++ /dev/null @@ -1,108 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra retract.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INTRET IntegerRetractions} -<>= -"INTRET" -> "PACKAGE" -"IntegerRetractions(a:RetractableTo(Integer))" -> "Package" -@ -<>= -)abbrev package INTRET IntegerRetractions -++ Author: Manuel Bronstein -++ Description: Provides integer testing and retraction functions. -++ Date Created: March 1990 -++ Date Last Updated: 9 April 1991 -IntegerRetractions(S:RetractableTo(Integer)): with - integer : S -> Integer - ++ integer(x) returns x as an integer; - ++ error if x is not an integer; - integer? : S -> Boolean - ++ integer?(x) is true if x is an integer, false otherwise; - integerIfCan: S -> Union(Integer, "failed") - ++ integerIfCan(x) returns x as an integer, - ++ "failed" if x is not an integer; - == add - integer s == retract s - integer? s == retractIfCan(s) case Integer - integerIfCan s == retractIfCan s - -@ -\section{package RATRET RationalRetractions} -<>= -"RATRET" -> "PACKAGE" -"RationalRetractions(a:RetractableTo(Fraction Integer))" -> "Package" -@ -<>= -)abbrev package RATRET RationalRetractions -++ Author: Manuel Bronstein -++ Description: rational number testing and retraction functions. -++ Date Created: March 1990 -++ Date Last Updated: 9 April 1991 -RationalRetractions(S:RetractableTo(Fraction Integer)): with - rational : S -> Fraction Integer - ++ rational(x) returns x as a rational number; - ++ error if x is not a rational number; - rational? : S -> Boolean - ++ rational?(x) returns true if x is a rational number, - ++ false otherwise; - rationalIfCan: S -> Union(Fraction Integer, "failed") - ++ rationalIfCan(x) returns x as a rational number, - ++ "failed" if x is not a rational number; - == add - rational s == retract s - rational? s == retractIfCan(s) case Fraction(Integer) - rationalIfCan s == retractIfCan s - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rf.spad.pamphlet b/src/algebra/rf.spad.pamphlet deleted file mode 100644 index 26220e4..0000000 --- a/src/algebra/rf.spad.pamphlet +++ /dev/null @@ -1,263 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rf.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package POLYCATQ PolynomialCategoryQuotientFunctions} -<>= -)abbrev package POLYCATQ PolynomialCategoryQuotientFunctions -++ Manipulations on polynomial quotients -++ Author: Manuel Bronstein -++ Date Created: March 1988 -++ Date Last Updated: 9 July 1990 -++ Description: -++ This package transforms multivariate polynomials or fractions into -++ univariate polynomials or fractions, and back. -++ Keywords: polynomial, fraction, transformation -PolynomialCategoryQuotientFunctions(E, V, R, P, F): - Exports == Implementation where - E: OrderedAbelianMonoidSup - V: OrderedSet - R: Ring - P: PolynomialCategory(R, E, V) - F: Field with - coerce: P -> % - numer : % -> P - denom : % -> P - - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - - Exports ==> with - variables : F -> List V - ++ variables(f) returns the list of variables appearing - ++ in the numerator or the denominator of f. - mainVariable: F -> Union(V, "failed") - ++ mainVariable(f) returns the highest variable appearing - ++ in the numerator or the denominator of f, "failed" if - ++ f has no variables. - univariate : (F, V) -> RF - ++ univariate(f, v) returns f viewed as a univariate - ++ rational function in v. - multivariate: (RF, V) -> F - ++ multivariate(f, v) applies both the numerator and - ++ denominator of f to v. - univariate : (F, V, UP) -> UP - ++ univariate(f, x, p) returns f viewed as a univariate - ++ polynomial in x, using the side-condition \spad{p(x) = 0}. - isPlus : F -> Union(List F, "failed") - ++ isPlus(p) returns [m1,...,mn] if \spad{p = m1 + ... + mn} and - ++ \spad{n > 1}, "failed" otherwise. - isTimes : F -> Union(List F, "failed") - ++ isTimes(p) returns \spad{[a1,...,an]} if - ++ \spad{p = a1 ... an} and \spad{n > 1}, - ++ "failed" otherwise. - isExpt : F -> Union(Record(var:V, exponent:Integer), "failed") - ++ isExpt(p) returns \spad{[x, n]} if \spad{p = x**n} and \spad{n <> 0}, - ++ "failed" otherwise. - isPower : F -> Union(Record(val:F, exponent:Integer), "failed") - ++ isPower(p) returns \spad{[x, n]} if \spad{p = x**n} and \spad{n <> 0}, - ++ "failed" otherwise. - - Implementation ==> add - P2UP: (P, V) -> UP - - univariate(f, x) == P2UP(numer f, x) / P2UP(denom f, x) - - 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(f, x) == - v := x::P::F - ((numer f) v) / ((denom f) v) - - mymerge:(List V,List V) ->List V - mymerge(l:List V,m:List V):List V== - empty? l => m - empty? m => l - first l = first m => cons(first l,mymerge(rest l,rest m)) - first l > first m => cons(first l,mymerge(rest l,m)) - cons(first m,mymerge(l,rest m)) - - variables f == - mymerge(variables numer f, variables denom f) - - isPower f == - (den := denom f) ^= 1 => - numer f ^= 1 => "failed" - (ur := isExpt den) case "failed" => [den::F, -1] - r := ur::Record(var:V, exponent:NonNegativeInteger) - [r.var::P::F, - (r.exponent::Integer)] - (ur := isExpt numer f) case "failed" => "failed" - r := ur::Record(var:V, exponent:NonNegativeInteger) - [r.var::P::F, r.exponent::Integer] - - isExpt f == - (ur := isExpt numer f) case "failed" => --- one? numer f => - (numer f) = 1 => - (ur := isExpt denom f) case "failed" => "failed" - r := ur::Record(var:V, exponent:NonNegativeInteger) - [r.var, - (r.exponent::Integer)] - "failed" - r := ur::Record(var:V, exponent:NonNegativeInteger) --- one? denom f => [r.var, r.exponent::Integer] - (denom f) = 1 => [r.var, r.exponent::Integer] - "failed" - - isTimes f == - t := isTimes(num := numer f) - l:Union(List F, "failed") := - t case "failed" => "failed" - [x::F for x in t] --- one?(den := denom f) => l - ((den := denom f) = 1) => l --- one? num => "failed" - num = 1 => "failed" - d := inv(den::F) - l case "failed" => [num::F, d] - concat_!(l::List(F), d) - - isPlus f == - denom f ^= 1 => "failed" - (s := isPlus numer f) case "failed" => "failed" - [x::F for x in s] - - mainVariable f == - a := mainVariable numer f - (b := mainVariable denom f) case "failed" => a - a case "failed" => b - max(a::V, b::V) - - P2UP(p, x) == - map(#1::F, - univariate(p, x))$SparseUnivariatePolynomialFunctions2(P, F) - -@ -\section{package RF RationalFunction} -<>= -)abbrev package RF RationalFunction -++ Top-level manipulations of rational functions -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 18 April 1991 -++ Description: -++ Utilities that provide the same top-level manipulations on -++ fractions than on polynomials. -++ Keywords: polynomial, fraction --- Do not make into a domain! -RationalFunction(R:IntegralDomain): Exports == Implementation where - V ==> Symbol - P ==> Polynomial R - Q ==> Fraction P - QF ==> PolynomialCategoryQuotientFunctions(IndexedExponents Symbol, - Symbol, R, P, Q) - - Exports ==> with - variables : Q -> List V - ++ variables(f) returns the list of variables appearing - ++ in the numerator or the denominator of f. - mainVariable: Q -> Union(V, "failed") - ++ mainVariable(f) returns the highest variable appearing - ++ in the numerator or the denominator of f, "failed" if - ++ f has no variables. - univariate : (Q, V) -> Fraction SparseUnivariatePolynomial Q - ++ univariate(f, v) returns f viewed as a univariate - ++ rational function in v. - multivariate: (Fraction SparseUnivariatePolynomial Q, V) -> Q - ++ multivariate(f, v) applies both the numerator and - ++ denominator of f to v. - eval : (Q, V, Q) -> Q - ++ eval(f, v, g) returns f with v replaced by g. - eval : (Q, List V, List Q) -> Q - ++ eval(f, [v1,...,vn], [g1,...,gn]) returns f with - ++ each vi replaced by gi in parallel, i.e. vi's appearing - ++ inside the gi's are not replaced. - eval : (Q, Equation Q) -> Q - ++ eval(f, v = g) returns f with v replaced by g. - ++ Error: if v is not a symbol. - eval : (Q, List Equation Q) -> Q - ++ eval(f, [v1 = g1,...,vn = gn]) returns f with - ++ each vi replaced by gi in parallel, i.e. vi's appearing - ++ inside the gi's are not replaced. - ++ Error: if any vi is not a symbol. - coerce : R -> Q - ++ coerce(r) returns r viewed as a rational function over R. - - Implementation ==> add - foo : (List V, List Q, V) -> Q - peval: (P, List V, List Q) -> Q - - coerce(r:R):Q == r::P::Q - variables f == variables(f)$QF - mainVariable f == mainVariable(f)$QF - univariate(f, x) == univariate(f, x)$QF - multivariate(f, x) == multivariate(f, x)$QF - eval(x:Q, s:V, y:Q) == eval(x, [s], [y]) - eval(x:Q, eq:Equation Q) == eval(x, [eq]) - foo(ls, lv, x) == match(ls, lv, x, x::Q)$ListToMap(V, Q) - - 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(x:Q, ls:List V, lv:List Q) == - peval(numer x, ls, lv) / peval(denom x, ls, lv) - - peval(p, ls, lv) == - map(foo(ls, lv, #1), #1::Q, - p)$PolynomialCategoryLifting(IndexedExponents V,V,R,P,Q) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/riccati.spad.pamphlet b/src/algebra/riccati.spad.pamphlet deleted file mode 100644 index 3048509..0000000 --- a/src/algebra/riccati.spad.pamphlet +++ /dev/null @@ -1,600 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra riccati.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package ODEPRRIC PrimitiveRatRicDE} -<>= -)abbrev package ODEPRRIC PrimitiveRatRicDE -++ Author: Manuel Bronstein -++ Date Created: 22 October 1991 -++ Date Last Updated: 2 February 1993 -++ Description: In-field solution of Riccati equations, primitive case. -PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where - F : Join(Field, CharacteristicZero, RetractableTo Fraction Integer) - UP : UnivariatePolynomialCategory F - L : LinearOrdinaryDifferentialOperatorCategory UP - LQ : LinearOrdinaryDifferentialOperatorCategory Fraction UP - - N ==> NonNegativeInteger - Z ==> Integer - RF ==> Fraction UP - UP2 ==> SparseUnivariatePolynomial UP - REC ==> Record(deg:N, eq:UP) - REC2 ==> Record(deg:N, eq:UP2) - POL ==> Record(poly:UP, eq:L) - FRC ==> Record(frac:RF, eq:L) - CNT ==> Record(constant:F, eq:L) - IJ ==> Record(ij: List Z, deg:N) - - Exports ==> with - denomRicDE: L -> UP - ++ denomRicDE(op) returns a polynomial \spad{d} such that any rational - ++ solution of the associated Riccati equation of \spad{op y = 0} is - ++ of the form \spad{p/d + q'/q + r} for some polynomials p and q - ++ and a reduced r. Also, \spad{deg(p) < deg(d)} and {gcd(d,q) = 1}. - leadingCoefficientRicDE: L -> List REC - ++ leadingCoefficientRicDE(op) returns - ++ \spad{[[m1, p1], [m2, p2], ... , [mk, pk]]} such that the polynomial - ++ part of any rational solution of the associated Riccati equation of - ++ \spad{op y = 0} must have degree mj for some j, and its leading - ++ coefficient is then a zero of pj. In addition,\spad{m1>m2> ... >mk}. - constantCoefficientRicDE: (L, UP -> List F) -> List CNT - ++ constantCoefficientRicDE(op, ric) returns - ++ \spad{[[a1, L1], [a2, L2], ... , [ak, Lk]]} such that any rational - ++ solution with no polynomial part of the associated Riccati equation of - ++ \spad{op y = 0} must be one of the ai's in which case the equation for - ++ \spad{z = y e^{-int ai}} is \spad{Li z = 0}. - ++ \spad{ric} is a Riccati equation solver over \spad{F}, whose input - ++ is the associated linear equation. - polyRicDE: (L, UP -> List F) -> List POL - ++ polyRicDE(op, zeros) returns - ++ \spad{[[p1, L1], [p2, L2], ... , [pk, Lk]]} such that the polynomial - ++ part of any rational solution of the associated Riccati equation of - ++ \spad{op y=0} must be one of the pi's (up to the constant coefficient), - ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z =0}. - ++ \spad{zeros} is a zero finder in \spad{UP}. - singRicDE: (L, (UP, UP2) -> List UP, UP -> Factored UP) -> List FRC - ++ singRicDE(op, zeros, ezfactor) returns - ++ \spad{[[f1, L1], [f2, L2], ... , [fk, Lk]]} such that the singular - ++ part of any rational solution of the associated Riccati equation of - ++ \spad{op y=0} must be one of the fi's (up to the constant coefficient), - ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z=0}. - ++ \spad{zeros(C(x),H(x,y))} returns all the \spad{P_i(x)}'s such that - ++ \spad{H(x,P_i(x)) = 0 modulo C(x)}. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - changeVar: (L, UP) -> L - ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}. - changeVar: (L, RF) -> L - ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}. - - Implementation ==> add - 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, order(#1, c)::Z) - infLambda l == innerlb(l, -(degree(#1)::Z)) - infmax(rec, l) == innermax(rec, l, degree(#1)::Z) - dmax(rec, c, l) == innermax(rec, l, - order(#1, c)::Z) - 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] - 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] - polyRicDE(l, zeros) == concat([0, l], polysol(l, 0, false, zeros)) - --- refine([p1,...,pn], foo) refines the list of factors using foo - 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(c, op, b, finite?, zeros) == - ans:List(FRC) := empty() - finite? and zero? b => ans - lc := leadingDenomRicDE(c, op) - if finite? then lc := select_!(#1.deg <= b, lc) - for rec in lc repeat - for r in zeros(c, rec.eq) | r ^= 0 repeat - rcn := r /$RF (c ** rec.deg) - neweq := changeVar(op, rcn) - sols := padicsol(c, neweq, (rec.deg-1)::N, true, zeros) - ans := - empty? sols => concat([rcn, neweq], ans) - concat_!([[rcn + sol.frac, sol.eq] for sol in sols], ans) - ans - - leadingDenomRicDE(c, l) == - ind:List(Z) -- to cure the compiler... (won't compile without) - lb := lambda(c, l) - done:List(N) := empty() - ans:List(REC2) := empty() - for rec in lb | (not member?(rec.deg, done)) and - not(empty?(ind := dmax(rec, c, l))) repeat - ans := concat([rec.deg, getPol(rec, c, l, ind)], ans) - done := concat(rec.deg, done) - sort_!(#1.deg > #2.deg, ans) - - getPol(rec, c, l, ind) == --- one?(rec.deg) => getPol1(ind, c, l) - (rec.deg = 1) => getPol1(ind, c, l) - +/[monomial(tau0(c, coefficient(l, i::N)), i::N)$UP2 for i in ind] - - getPol1(ind, c, l) == - cp := diff c - +/[tau0(c, coefficient(l, i::N)) * poly1(c, cp, i) for i in ind] - - 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(op, m) == - ans:UP := 0 - while op ^= 0 repeat - if degree(p := leadingCoefficient op) = m then - ans := ans + monomial(leadingCoefficient p, degree op) - op := reductum op - ans - - 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(rec, l, nu) == - n := degree l - i := first(rec.ij) - m := i * (d := rec.deg) + nu coefficient(l, i::N) - ans:List(Z) := empty() - for j in 0..n | (f := coefficient(l, j)) ^= 0 repeat - if ((k := (j * d + nu f)) > m) then return empty() - else if (k = m) then ans := concat(j, ans) - ans - - leadingCoefficientRicDE l == - ind:List(Z) -- to cure the compiler... (won't compile without) - lb := infLambda l - done:List(N) := empty() - ans:List(REC) := empty() - for rec in lb | (not member?(rec.deg, done)) and - not(empty?(ind := infmax(rec, l))) repeat - ans := concat([rec.deg, getPoly(rec, l, ind)], ans) - done := concat(rec.deg, done) - sort_!(#1.deg > #2.deg, ans) - - factoredDenomRicDE l == - bd := factors balancedFactorisation(leadingCoefficient l, coefficients l) - [dd.factor for dd in bd] - - changeVar(l:L, a:UP) == - dpa := diff + a::L -- the operator (D + a) - dpan:L := 1 -- will accumulate the powers of (D + a) - op:L := 0 - for i in 0..degree l repeat - op := op + coefficient(l, i) * dpan - dpan := dpa * dpan - primitivePart op - - changeVar(l:L, a:RF) == - dpa := diffq + a::LQ -- the operator (D + a) - dpan:LQ := 1 -- will accumulate the powers of (D + a) - op:LQ := 0 - for i in 0..degree l repeat - op := op + coefficient(l, i)::RF * dpan - dpan := dpa * dpan - splitDenominator(op, empty()).eq - - 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, nu) == - lb:List(IJ) := empty() - n := degree l - for i in 0..n | (li := coefficient(l, i)) ^= 0repeat - for j in i+1..n | (lj := coefficient(l, j)) ^= 0 repeat - u := (nu li - nu lj) exquo (i-j) - if (u case Z) and ((b := u::Z) > 0) then - lb := concat([[i, j], b::N], lb) - lb - - 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, zeros, lc) == - ans:List(FRC) := empty() - empty? lc => ans - empty?(sols := padicsol(first lc, l, 0, false, zeros)) => - fracsol(l, zeros, rest lc) - for rec in sols repeat - neweq := changeVar(l, rec.frac) - sols := fracsol(neweq, zeros, rest lc) - ans := - empty? sols => concat(rec, ans) - concat_!([[rec.frac + sol.frac, sol.eq] for sol in sols], ans) - ans - --- returns [] if the solutions of l have no polynomial component - polysol(l, b, finite?, zeros) == - ans:List(POL) := empty() - finite? and zero? b => ans - lc := leadingCoefficientRicDE l - if finite? then lc := select_!(#1.deg <= b, lc) - for rec in lc repeat - for a in zeros(rec.eq) | a ^= 0 repeat - atn:UP := monomial(a, rec.deg) - neweq := changeVar(l, atn) - sols := polysol(neweq, (rec.deg - 1)::N, true, zeros) - ans := - empty? sols => concat([atn, neweq], ans) - concat_!([[atn + sol.poly, sol.eq] for sol in sols], ans) - ans - -@ -\section{package ODERTRIC RationalRicDE} -<>= -)abbrev package ODERTRIC RationalRicDE -++ Author: Manuel Bronstein -++ Date Created: 22 October 1991 -++ Date Last Updated: 11 April 1994 -++ Description: In-field solution of Riccati equations, rational case. -RationalRicDE(F, UP): Exports == Implementation where - F : Join(Field, CharacteristicZero, RetractableTo Integer, - RetractableTo Fraction Integer) - UP : UnivariatePolynomialCategory F - - N ==> NonNegativeInteger - Z ==> Integer - SY ==> Symbol - P ==> Polynomial F - RF ==> Fraction P - EQ ==> Equation RF - QF ==> Fraction UP - UP2 ==> SparseUnivariatePolynomial UP - SUP ==> SparseUnivariatePolynomial P - REC ==> Record(poly:SUP, vars:List SY) - SOL ==> Record(var:List SY, val:List F) - POL ==> Record(poly:UP, eq:L) - FRC ==> Record(frac:QF, eq:L) - CNT ==> Record(constant:F, eq:L) - UTS ==> UnivariateTaylorSeries(F, dummy, 0) - UPS ==> SparseUnivariatePolynomial UTS - L ==> LinearOrdinaryDifferentialOperator2(UP, QF) - LQ ==> LinearOrdinaryDifferentialOperator1 QF - - Exports ==> with - ricDsolve: (LQ, UP -> List F) -> List QF - ++ ricDsolve(op, zeros) returns the rational solutions of the associated - ++ Riccati equation of \spad{op y = 0}. - ++ \spad{zeros} is a zero finder in \spad{UP}. - ricDsolve: (LQ, UP -> List F, UP -> Factored UP) -> List QF - ++ ricDsolve(op, zeros, ezfactor) returns the rational - ++ solutions of the associated Riccati equation of \spad{op y = 0}. - ++ \spad{zeros} is a zero finder in \spad{UP}. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - ricDsolve: (L, UP -> List F) -> List QF - ++ ricDsolve(op, zeros) returns the rational solutions of the associated - ++ Riccati equation of \spad{op y = 0}. - ++ \spad{zeros} is a zero finder in \spad{UP}. - ricDsolve: (L, UP -> List F, UP -> Factored UP) -> List QF - ++ ricDsolve(op, zeros, ezfactor) returns the rational - ++ solutions of the associated Riccati equation of \spad{op y = 0}. - ++ \spad{zeros} is a zero finder in \spad{UP}. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - singRicDE: (L, UP -> Factored UP) -> List FRC - ++ singRicDE(op, ezfactor) returns \spad{[[f1,L1], [f2,L2],..., [fk,Lk]]} - ++ such that the singular ++ part of any rational solution of the - ++ associated Riccati equation of \spad{op y = 0} must be one of the fi's - ++ (up to the constant coefficient), in which case the equation for - ++ \spad{z = y e^{-int ai}} is \spad{Li z = 0}. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - polyRicDE: (L, UP -> List F) -> List POL - ++ polyRicDE(op, zeros) returns \spad{[[p1, L1], [p2, L2], ... , [pk,Lk]]} - ++ such that the polynomial part of any rational solution of the - ++ associated Riccati equation of \spad{op y = 0} must be one of the pi's - ++ (up to the constant coefficient), in which case the equation for - ++ \spad{z = y e^{-int p}} is \spad{Li z = 0}. - ++ \spad{zeros} is a zero finder in \spad{UP}. - if F has AlgebraicallyClosedField then - ricDsolve: LQ -> List QF - ++ ricDsolve(op) returns the rational solutions of the associated - ++ Riccati equation of \spad{op y = 0}. - ricDsolve: (LQ, UP -> Factored UP) -> List QF - ++ ricDsolve(op, ezfactor) returns the rational solutions of the - ++ associated Riccati equation of \spad{op y = 0}. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - ricDsolve: L -> List QF - ++ ricDsolve(op) returns the rational solutions of the associated - ++ Riccati equation of \spad{op y = 0}. - ricDsolve: (L, UP -> Factored UP) -> List QF - ++ ricDsolve(op, ezfactor) returns the rational solutions of the - ++ associated Riccati equation of \spad{op y = 0}. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - - Implementation ==> add - import RatODETools(P, SUP) - import RationalLODE(F, UP) - import NonLinearSolvePackage F - 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]]}. - - dummy := new()$SY - - UP2SUP p == map(#1::P,p)$UnivariatePolynomialCategoryFunctions2(F,UP,P,SUP) - 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) - 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(p, ls, lv) == - map(ground eval(#1, ls, lv), - p)$UnivariatePolynomialCategoryFunctions2(P, SUP, F, UP) - - FifCan f == - ((n := retractIfCan(numer f))@Union(F, "failed") case F) and - ((d := retractIfCan(denom f))@Union(F, "failed") case F) => - (n::F) / (d::F) - "failed" - --- returns [0, []] if n < 0 - genericPolynomial(s, n) == - ans:SUP := 0 - l:List(SY) := empty() - for i in 0..n repeat - ans := ans + monomial((sy := new s)::P, i::N) - l := concat(sy, l) - [ans, reverse_! l] - - ratsln l == - ls:List(SY) := empty() - lv:List(F) := empty() - for eq in l repeat - ((u := FifCan rhs eq) case "failed") or - ((v := retractIfCan(lhs eq)@Union(SY, "failed")) case "failed") - => return "failed" - lv := concat(u::F, lv) - ls := concat(v::SY, ls) - [ls, lv] - - ratsol l == - ans:List(SOL) := empty() - for sol in l repeat - if ((u := ratsln sol) case SOL) then ans := concat(u::SOL, ans) - ans - --- returns [] if the solutions of l have no polynomial component - polyRicDE(l, zeros) == - ans:List(POL) := [[0, l]] - empty?(lc := leadingCoefficientRicDE l) => ans - rec := first lc -- one with highest degree - for a in zeros(rec.eq) | a ^= 0 repeat - if (p := newtonSolution(l, a, rec.deg, zeros)) ^= 0 then - ans := concat([p, changeVar(l, p)], ans) - ans - --- reverseUP(a_0 + a_1 x + ... + an x^n) = a_n + ... + a_0 x^n - reverseUP p == - ans:UTS := 0 - n := degree(p)::Z - while p ^= 0 repeat - ans := ans + monomial(leadingCoefficient p, (n - degree p)::N) - p := reductum p - ans - --- reverseUTS(a_0 + a_1 x + ..., n) = a_n + ... + a_0 x^n - reverseUTS(s, n) == - +/[monomial(coefficient(s, i), (n - i)::N)$UP for i in 0..n] - --- returns a potential polynomial solution p with leading coefficient a*?**n - newtonSolution(l, a, n, zeros) == - i:N - m:Z := 0 - aeq:UPS := 0 - op := l - while op ^= 0 repeat - mu := degree(op) * n + degree leadingCoefficient op - op := reductum op - if mu > m then m := mu - while l ^= 0 repeat - c := leadingCoefficient l - d := degree l - s:UTS := monomial(1, (m - d * n - degree c)::N)$UTS * reverseUP c - aeq := aeq + monomial(s, d) - l := reductum l - (u := newtonSolve(aeq, a, n)) case UTS => reverseUTS(u::UTS, n) - -- newton lifting failed, so revert to traditional method - atn := monomial(a, n)$UP - neq := changeVar(l, atn) - sols := [sol.poly for sol in polyRicDE(neq, zeros) | degree(sol.poly) < n] - empty? sols => atn - atn + first sols - --- solves the algebraic equation eq for y, returns a solution of degree n with --- initial term a --- 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(eq, a, n) == - deq := differentiate eq - sol := a::UTS - for i in 1..n repeat - (xquo := eq(sol) exquo deq(sol)) case "failed" => return "failed" - sol := truncate(sol - xquo::UTS, i) - sol - --- 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(l:L, zeros:UP -> List F, ezfactor:UP -> Factored UP) == - n := degree l - ans:List(QF) := empty() - for rec in singRicDE(l, ezfactor) repeat - ans := removeDuplicates_! concat_!(ans, - [rec.frac + f for f in nonSingSolve(n, rec.eq, zeros)]) - #ans = n => return ans - ans - --- 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, zeros) == - ans:List(QF) := empty() - for rec in polyRicDE(l, zeros) repeat - ans := removeDuplicates_! concat_!(ans, nopoly(n,rec.poly,rec.eq,zeros)) - #ans = n => return ans - ans - - 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, p, l, zeros) == - ans:List(QF) := empty() - for rec in constantCoefficientRicDE(l, constantRic(#1, zeros)) repeat - ans := removeDuplicates_! concat_!(ans, - [(rec.constant::UP + p)::QF + f for f in logDerOnly(rec.eq)]) - #ans = n => return ans - ans - --- returns [p1,...,pn] s.t. h(x,pi(x)) = 0 mod c(x) - solveModulo(c, h) == - rec := genericPolynomial(dummy, degree(c)::Z - 1) - unk:SUP := 0 - while not zero? h repeat - unk := unk + UP2SUP(leadingCoefficient h) * (rec.poly ** degree h) - h := reductum h - sol := ratsol solve(coefficients(monicDivide(unk,UP2SUP c).remainder), - rec.vars) - [mapeval(rec.poly, s.var, s.val) for s in sol] - - if F has AlgebraicallyClosedField then - zro1: UP -> List F - zro : (UP, UP -> Factored UP) -> List F - - ricDsolve(l:L) == ricDsolve(l, squareFree) - ricDsolve(l:LQ) == ricDsolve(l, squareFree) - - ricDsolve(l:L, ezfactor:UP -> Factored UP) == - ricDsolve(l, zro(#1, ezfactor), ezfactor) - - ricDsolve(l:LQ, ezfactor:UP -> Factored UP) == - ricDsolve(l, zro(#1, ezfactor), ezfactor) - - zro(p, ezfactor) == - concat [zro1(r.factor) for r in factors ezfactor p] - - zro1 p == - [zeroOf(map(#1, p)$UnivariatePolynomialCategoryFunctions2(F, UP, - F, SparseUnivariatePolynomial F))] - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- Compile order for the differential equation solver: --- oderf.spad odealg.spad nlode.spad nlinsol.spad riccati.spad odeef.spad - -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rinterp.spad.pamphlet b/src/algebra/rinterp.spad.pamphlet deleted file mode 100644 index 41fa6c5..0000000 --- a/src/algebra/rinterp.spad.pamphlet +++ /dev/null @@ -1,150 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rinterp.spad} -\author{Martin Rubey} -\maketitle -\begin{abstract} -Rational Interpolation -\end{abstract} -\eject -\section{Introduction} -This file contains a crude na\"ive implementation of rational interpolation, -where the coefficients of the rational function are in any given field. - -\section{Questions and Outlook} -\begin{itemize} -\item Maybe this file should be joined with pinterp.spad, where polynomial - Lagrange interpolation is implemented. I have a second version that parallels - the structure of pinterp.spad closely. -\item There are probably better ways to implement rational interpolation. Maybe - {http://www.cs.ucsb.edu/~omer/personal/abstracts/rational.html} contains - something useful, but I don't know. -\item Comments welcome! -\end{itemize} - -\section{RationalInterpolation} - -<>= -)abbrev package RINTERP RationalInterpolation -++ Description: -++ This package exports rational interpolation algorithms -RationalInterpolation(xx,F): Exports == Implementation where - xx: Symbol - F: Field -@ - -<>= - Exports == with - interpolate: (List F, List F, NonNegativeInteger, - NonNegativeInteger) -> Fraction Polynomial F -@ - -The implementation sets up a system of linear equations and solves it. -<>= - Implementation == add - interpolate(xlist, ylist, m, k) == -@ - -First we check whether we have the right number of points and values. Clearly -the number of points and the number of values must be identical. Note that we -want to determine the numerator and denominator polynomials only up to a -factor. Thus, we want to determine $m+k+1$ coefficients, where $m$ is the degree -of the polynomial in the numerator and $k$ is the degree of the polynomial in -the denominator. - -In fact, we could also leave -- for example -- $k$ unspecified and determine it -as $k=[[#xlist]]-m-1$: I don't know whether this would be better. -<>= - #xlist ^= #ylist => - error "Different number of points and values." - #xlist ^= m+k+1 => - error "wrong number of points" -@ - -The next step is to set up the matrix. Suppose that our numerator polynomial is -$p(x)=a_0+a_1x+\dots+a_mx^m$ and that our denominator polynomial is -$q(x)=b_0+b_1x+\dots+b_mx^m$. Then we have the following equations, writing $n$ -for $m+k+1$: -\noindent -$$ -\begin{array}{rl} - p(x_1)-y_1q(x_1)&=a_0+a_1x_1+\dots +a_mx_1^m-y_1(b_0+b_1x_1+\dots +b_kx_1^k)=0\\ - p(x_2)-y_2q(x_2)&=a_0+a_1x_2+\dots +a_mx_2^m-y_2(b_0+b_1x_2+\dots +b_kx_2^k)=0\\ - &\;\;\vdots\\ - p(x_n)-y_nq(x_n)&=a_0+a_1x_n+\dots +a_mx_n^m-y_n(b_0+b_1x_n+\dots +b_kx_n^k)=0 -\end{array} -$$ -This can be written as -$$ -\left[ -\begin{array}{cccccccc} -1&x_1&\dots&x_1^m&-y_1&-y_1x_1&\dots&-y_1x_1^k\\ -1&x_2&\dots&x_2^m&-y_2&-y_2x_2&\dots&-y_2x_2^k\\ -&&&\vdots&&&&\\ -1&x_n&\dots&x_n^m&-y_n&-y_nx_n&\dots&-y_nx_2^k -\end{array} -\right] -\left[ -\begin{array}{c} -a_0\\a_1\\\vdots\\a_m\\b_0\\b_1\\\vdots\\b_k -\end{array} -\right] -=\mathbf 0 -$$ -We generate this matrix columnwise: -<>= - tempvec: List F := [1 for i in 1..(m+k+1)] - - collist: List List F := cons(tempvec, - [(tempvec := [tempvec.i * xlist.i _ - for i in 1..(m+k+1)]) _ - for j in 1..max(m,k)]) - - collist := append([collist.j for j in 1..(m+1)], _ - [[- collist.j.i * ylist.i for i in 1..(m+k+1)] _ - for j in 1..(k+1)]) -@ -Now we can solve the system: -<>= - res: List Vector F := nullSpace((transpose matrix collist) _ - ::Matrix F) -@ - -Note that it may happen that the system has several solutions. In this case, -some of the data points may not be interpolated correctly. However, the -solution is often still useful, thus we do not signal an error. - -<>= - if #res~=1 then output("Warning: unattainable points!" _ - ::OutputForm)$OutputPackage -@ - -In this situation, all the solutions will be equivalent, thus we can always -simply take the first one: - -<>= - reslist: List List Polynomial F := _ - [[(res.1).(i+1)*(xx::Polynomial F)**i for i in 0..m], _ - [(res.1).(i+m+2)*(xx::Polynomial F)**i for i in 0..k]] -@ -Finally, we generate the rational function: -<>= - reduce((_+),reslist.1)/reduce((_+),reslist.2) -@ -\section{Rational Interpolation Code} -<>= -<> -<> -<> -@ -<<*>>= -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/rule.spad.pamphlet b/src/algebra/rule.spad.pamphlet deleted file mode 100644 index daadf27..0000000 --- a/src/algebra/rule.spad.pamphlet +++ /dev/null @@ -1,174 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra rule.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package APPRULE ApplyRules} -<>= -)abbrev package APPRULE ApplyRules -++ Applications of rules to expressions -++ Author: Manuel Bronstein -++ Date Created: 20 Mar 1990 -++ Date Last Updated: 5 Jul 1990 -++ Description: -++ This package apply rewrite rules to expressions, calling -++ the pattern matcher. -++ Keywords: pattern, matching, rule. -ApplyRules(Base, R, F): Exports == Implementation where - Base : SetCategory - R : Join(Ring, PatternMatchable Base, OrderedSet, - ConvertibleTo Pattern Base) - F : Join(FunctionSpace R, PatternMatchable Base, - ConvertibleTo Pattern Base) - - P ==> Pattern Base - PR ==> PatternMatchResult(Base, F) - RR ==> RewriteRule(Base, R, F) - K ==> Kernel F - - Exports ==> with - applyRules : (List RR, F) -> F - ++ applyRules([r1,...,rn], expr) applies the rules - ++ r1,...,rn to f an unlimited number of times, i.e. until - ++ none of r1,...,rn is applicable to the expression. - applyRules : (List RR, F, PositiveInteger) -> F - ++ applyRules([r1,...,rn], expr, n) applies the rules - ++ r1,...,rn to f a most n times. - localUnquote: (F, List Symbol) -> F - ++ localUnquote(f,ls) is a local function. - - Implementation ==> add - 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 l == - ncr := empty()$List(RR) - lk := empty()$List(K) - lv := empty()$List(F) - for r in l repeat - if (u := retractIfCan(r)@Union(Equation F, "failed")) - case "failed" then ncr := concat(r, ncr) - else - lk := concat(retract(lhs(u::Equation F))@K, lk) - lv := concat(rhs(u::Equation F), lv) - [lk, lv, ncr] - - applyRules(l, s) == - rec := splitRules l - repeat - (new:= localApply(rec.lker,rec.lval,rec.rl,s,1)) = s => return s - s := new - - applyRules(l, s, n) == - rec := splitRules l - localApply(rec.lker, rec.lval, rec.rl, s, n) - - localApply(lk, lv, lrule, subject, n) == - for i in 1..n repeat - for k in lk for v in lv repeat - subject := eval(subject, k, v) - subject := app(lrule, subject) - subject - - rewrite(f, res, l) == - lk := empty()$List(K) - lv := empty()$List(F) - for rec in destruct res repeat - lk := concat(kernel(rec.key), lk) - lv := concat(rec.entry, lv) - localUnquote(eval(f, lk, lv), l) - - if R has ConvertibleTo InputForm then - localUnquote(f, l) == - empty? l => f - eval(f, l) - else - localUnquote(f, l) == f - - isitwithpred(subject, pat, vars, bad) == - failed?(u := patternMatch(subject, pat, new()$PR)) => u - satisfy?(u, pat)::Boolean => u - member?(u, bad) => failed() - for v in vars repeat addBadValue(v, getMatch(v, u)::F) - isitwithpred(subject, pat, vars, concat(u, bad)) - - 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(lrule, subject) == - for r in lrule repeat - not failed?(u := isit(subject, pattern r)) => - return rewrite(rhs r, u, quotedOperators r) - (k := retractIfCan(subject)@Union(K, "failed")) case K => - operator(k::K) applist(lrule, argument(k::K)) - (l := isPlus subject) case List(F) => +/applist(lrule,l::List(F)) - (l := isTimes subject) case List(F) => */applist(lrule,l::List(F)) - (e := isPower subject) case Record(val:F, exponent:Integer) => - ee := e::Record(val:F, exponent:Integer) - f := app(lrule, ee.val) - positive?(ee.exponent) => f ** (ee.exponent)::NonNegativeInteger - recip(f)::F ** (- ee.exponent)::NonNegativeInteger - subject - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 85a69c9..5f4f1d3 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -931,5 +931,7 @@ bookvol10.4 add packages
bookvol10.4 add packages
20090208.01.tpd.patch bookvol10.4 add packages
+20090208.02.tpd.patch +bookvol10.4 add packages