diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 4eaccf3..aae6652 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -6027,6 +6027,64 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter B} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain BPADIC BalancedPAdicInteger} +\pagehead{BalancedPAdicInteger}{BPADIC} +\pagepic{ps/v103balancedpadicinteger.ps}{BPADIC}{1.00} +See also:\\ +\refto{InnerPAdicInteger}{IPADIC} +\refto{PAdicInteger}{PADIC} +\refto{PAdicRationalConstructor}{PADICRC} +\refto{PAdicRational}{PADICRAT} +\refto{BalancedPAdicRational}{BPADICRT} +<>= +)abbrev domain BPADIC BalancedPAdicInteger +++ Author: Clifton J. Williamson +++ Date Created: 15 May 1990 +++ Date Last Updated: 15 May 1990 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: p-adic, complementation +++ Examples: +++ References: +++ Description: +++ Stream-based implementation of Zp: p-adic numbers are represented as +++ sum(i = 0.., a[i] * p^i), where the a[i] lie in -(p - 1)/2,...,(p - 1)/2. +BalancedPAdicInteger(p:Integer) == InnerPAdicInteger(p,false$Boolean) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain BPADICRT BalancedPAdicRational} +\pagehead{BalancedPAdicRational}{BPADICRT} +\pagepic{ps/v103balancedpadicrational.ps}{BPADICRT}{1.00} +See also:\\ +\refto{InnerPAdicInteger}{IPADIC} +\refto{PAdicInteger}{PADIC} +\refto{BalancedPAdicInteger}{BPADIC} +\refto{PAdicRationalConstructor}{PADICRC} +\refto{PAdicRational}{PADICRAT} +<>= +)abbrev domain BPADICRT BalancedPAdicRational +++ Author: Clifton J. Williamson +++ Date Created: 15 May 1990 +++ Date Last Updated: 15 May 1990 +++ Keywords: p-adic, complementation +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: p-adic, completion +++ Examples: +++ References: +++ Description: +++ Stream-based implementation of Qp: numbers are represented as +++ sum(i = k.., a[i] * p^i), where the a[i] lie in -(p - 1)/2,...,(p - 1)/2. +BalancedPAdicRational(p:Integer) == + PAdicRationalConstructor(p,BalancedPAdicInteger p) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain BFUNCT BasicFunctions} \pagehead{BasicFunctions}{BFUNCT} \pagepic{ps/v103basicfunctions.ps}{BFUNCT}{1.00} @@ -26302,6 +26360,83 @@ FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FM FreeModule} +\pagehead{FreeModule}{FM} +\pagepic{ps/v103freemodule.ps}{FM}{1.00} +See also:\\ +\refto{PolynomialRing}{PR} +\refto{SparseUnivariatePolynomial}{SUP} +\refto{UnivariatePolynomial}{UP} +<>= +)abbrev domain FM FreeModule +++ Author: Dave Barton, James Davenport, Barry Trager +++ Date Created: +++ Date Last Updated: +++ Basic Functions: BiModule(R,R) +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A bi-module is a free module +++ over a ring with generators indexed by an ordered set. +++ Each element can be expressed as a finite linear combination of +++ generators. Only non-zero terms are stored. + +FreeModule(R:Ring,S:OrderedSet): + Join(BiModule(R,R),IndexedDirectProductCategory(R,S)) with + if R has CommutativeRing then Module(R) + == IndexedDirectProductAbelianGroup(R,S) add + --representations + Term:= Record(k:S,c:R) + Rep:= List Term + --declarations + x,y: % + r: R + n: Integer + f: R -> R + s: S + --define + if R has EntireRing then + r * x == + zero? r => 0 +-- one? r => x + (r = 1) => x + --map(r*#1,x) + [[u.k,r*u.c] for u in x ] + else + r * x == + zero? r => 0 +-- one? r => x + (r = 1) => x + --map(r*#1,x) + [[u.k,a] for u in x | (a:=r*u.c) ^= 0$R] + if R has EntireRing then + x * r == + zero? r => 0 +-- one? r => x + (r = 1) => x + --map(r*#1,x) + [[u.k,u.c*r] for u in x ] + else + x * r == + zero? r => 0 +-- one? r => x + (r = 1) => x + --map(r*#1,x) + [[u.k,a] for u in x | (a:=u.c*r) ^= 0$R] + + coerce(x) : OutputForm == + null x => (0$R) :: OutputForm + le : List OutputForm := nil + for rec in reverse x repeat + rec.c = 1 => le := cons(rec.k :: OutputForm, le) + le := cons(rec.c :: OutputForm * rec.k :: OutputForm, le) + reduce("+",le) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain FMONOID FreeMonoid} \pagehead{FreeMonoid}{FMONOID} \pagepic{ps/v103freemonoid.ps}{FMONOID}{1.00} @@ -28117,6 +28252,90 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain GPOLSET GeneralPolynomialSet} +\pagehead{GeneralPolynomialSet}{GPOLSET} +\pagepic{ps/v103generalpolynomialset.ps}{GPOLSET}{1.00} +<>= +)abbrev domain GPOLSET GeneralPolynomialSet +++ Author: Marc Moreno Maza +++ Date Created: 04/26/1994 +++ Date Last Updated: 12/15/1998 +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: polynomial, multivariate, ordered variables set +++ References: +++ Description: A domain for polynomial sets. +++ Version: 1 + +GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where + + R:Ring + VarSet:OrderedSet + E:OrderedAbelianMonoidSup + P:RecursivePolynomialCategory(R,E,VarSet) + LP ==> List P + PtoP ==> P -> P + + Exports == PolynomialSetCategory(R,E,VarSet,P) with + + convert : LP -> $ + ++ \axiom{convert(lp)} returns the polynomial set whose members + ++ are the polynomials of \axiom{lp}. + + finiteAggregate + shallowlyMutable + + Implementation == add + + Rep := List P + + construct lp == + (removeDuplicates(lp)$List(P))::$ + + copy ps == + construct(copy(members(ps)$$)$LP)$$ + + empty() == + [] + + parts ps == + ps pretend LP + + map (f : PtoP, ps : $) : $ == + construct(map(f,members(ps))$LP)$$ + + map! (f : PtoP, ps : $) : $ == + construct(map!(f,members(ps))$LP)$$ + + member? (p,ps) == + member?(p,members(ps))$LP + + ps1 = ps2 == + {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)} + + coerce(ps:$) : OutputForm == + lp : List(P) := sort(infRittWu?,members(ps))$(List P) + brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm + + mvar ps == + empty? ps => error"Error from GPOLSET in mvar : #1 is empty" + lv : List VarSet := variables(ps) + empty? lv => error"Error from GPOLSET in mvar : every polynomial in #1 is constant" + reduce(max,lv)$(List VarSet) + + retractIfCan(lp) == + (construct(lp))::Union($,"failed") + + coerce(ps:$) : (List P) == + ps pretend (List P) + + convert(lp:LP) : $ == + construct lp + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain GSERIES GeneralUnivariatePowerSeries} \pagehead{GeneralUnivariatePowerSeries}{GSERIES} \pagepic{ps/v103generalunivariatepowerseries.ps}{GSERIES}{1.00} @@ -30470,6 +30689,454 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain IPADIC InnerPAdicInteger} +\pagehead{InnerPAdicInteger}{IPADIC} +\pagepic{ps/v103innerpadicinteger.ps}{IPADIC}{1.00} +See also:\\ +\refto{PAdicInteger}{PADIC} +\refto{BalancedPAdicInteger}{BPADIC} +\refto{PAdicRationalConstructor}{PADICRC} +\refto{PAdicRational}{PADICRAT} +\refto{BalancedPAdicRational}{BPADICRT} +<>= +)abbrev domain IPADIC InnerPAdicInteger +++ Author: Clifton J. Williamson +++ Date Created: 20 August 1989 +++ Date Last Updated: 15 May 1990 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Keywords: p-adic, completion +++ Examples: +++ References: +++ Description: +++ This domain implements Zp, the p-adic completion of the integers. +++ This is an internal domain. +InnerPAdicInteger(p,unBalanced?): Exports == Implementation where + p : Integer + unBalanced? : Boolean + I ==> Integer + NNI ==> NonNegativeInteger + OUT ==> OutputForm + L ==> List + ST ==> Stream + SUP ==> SparseUnivariatePolynomial + + Exports ==> PAdicIntegerCategory p + + Implementation ==> add + + PEXPR := p :: OUT + + Rep := ST I + + characteristic() == 0 + euclideanSize(x) == order(x) + + stream(x:%):ST I == x pretend ST(I) + padic(x:ST I):% == x pretend % + digits x == stream x + + extend(x,n) == extend(x,n + 1)$Rep + complete x == complete(x)$Rep + +-- notBalanced?:() -> Boolean +-- notBalanced?() == unBalanced? + + modP:I -> I + modP n == + unBalanced? or (p = 2) => positiveRemainder(n,p) + symmetricRemainder(n,p) + + modPInfo:I -> Record(digit:I,carry:I) + modPInfo n == + dv := divide(n,p) + r0 := dv.remainder; q := dv.quotient + if (r := modP r0) ^= r0 then q := q + ((r0 - r) quo p) + [r,q] + + invModP: I -> I + invModP n == invmod(n,p) + + modulus() == p + moduloP x == (empty? x => 0; frst x) + quotientByP x == (empty? x => x; rst x) + + approximate(x,n) == + n <= 0 or empty? x => 0 + frst x + p * approximate(rst x,n - 1) + + x = y == + st : ST I := stream(x - y) + n : I := _$streamCount$Lisp + for i in 0..n repeat + empty? st => return true + frst st ^= 0 => return false + st := rst st + empty? st + + order x == + st := stream x + for i in 0..1000 repeat + empty? st => return 0 + frst st ^= 0 => return i + st := rst st + error "order: series has more than 1000 leading zero coefs" + + 0 == padic concat(0$I,empty()) + 1 == padic concat(1$I,empty()) + + intToPAdic: I -> ST I + intToPAdic n == delay + n = 0 => empty() + modp := modPInfo n + concat(modp.digit,intToPAdic modp.carry) + + intPlusPAdic: (I,ST I) -> ST I + intPlusPAdic(n,x) == delay + empty? x => intToPAdic n + modp := modPInfo(n + frst x) + concat(modp.digit,intPlusPAdic(modp.carry,rst x)) + + intMinusPAdic: (I,ST I) -> ST I + intMinusPAdic(n,x) == delay + empty? x => intToPAdic n + modp := modPInfo(n - frst x) + concat(modp.digit,intMinusPAdic(modp.carry,rst x)) + + plusAux: (I,ST I,ST I) -> ST I + plusAux(n,x,y) == delay + empty? x and empty? y => intToPAdic n + empty? x => intPlusPAdic(n,y) + empty? y => intPlusPAdic(n,x) + modp := modPInfo(n + frst x + frst y) + concat(modp.digit,plusAux(modp.carry,rst x,rst y)) + + minusAux: (I,ST I,ST I) -> ST I + minusAux(n,x,y) == delay + empty? x and empty? y => intToPAdic n + empty? x => intMinusPAdic(n,y) + empty? y => intPlusPAdic(n,x) + modp := modPInfo(n + frst x - frst y) + concat(modp.digit,minusAux(modp.carry,rst x,rst y)) + + x + y == padic plusAux(0,stream x,stream y) + x - y == padic minusAux(0,stream x,stream y) + - y == padic intMinusPAdic(0,stream y) + coerce(n:I) == padic intToPAdic n + + intMult:(I,ST I) -> ST I + intMult(n,x) == delay + empty? x => empty() + modp := modPInfo(n * frst x) + concat(modp.digit,intPlusPAdic(modp.carry,intMult(n,rst x))) + + (n:I) * (x:%) == + padic intMult(n,stream x) + + timesAux:(ST I,ST I) -> ST I + timesAux(x,y) == delay + empty? x or empty? y => empty() + modp := modPInfo(frst x * frst y) + car := modp.digit + cdr : ST I --!! + cdr := plusAux(modp.carry,intMult(frst x,rst y),timesAux(rst x,y)) + concat(car,cdr) + + (x:%) * (y:%) == padic timesAux(stream x,stream y) + + quotientAux:(ST I,ST I) -> ST I + quotientAux(x,y) == delay + empty? x => error "quotientAux: first argument" + empty? y => empty() + modP frst x = 0 => + modP frst y = 0 => quotientAux(rst x,rst y) + error "quotient: quotient not integral" + z0 := modP(invModP frst x * frst y) + yy : ST I --!! + yy := rest minusAux(0,y,intMult(z0,x)) + concat(z0,quotientAux(x,yy)) + + recip x == + empty? x or modP frst x = 0 => "failed" + padic quotientAux(stream x,concat(1,empty())) + + iExquo: (%,%,I) -> Union(%,"failed") + iExquo(xx,yy,n) == + n > 1000 => + error "exquo: quotient by series with many leading zero coefs" + empty? yy => "failed" + empty? xx => 0 + zero? frst yy => + zero? frst xx => iExquo(rst xx,rst yy,n + 1) + "failed" + (rec := recip yy) case "failed" => "failed" + xx * (rec :: %) + + x exquo y == iExquo(stream x,stream y,0) + + divide(x,y) == + (z:=x exquo y) case "failed" => [0,x] + [z, 0] + + iSqrt: (I,I,I,%) -> % + iSqrt(pn,an,bn,bSt) == delay + bn1 := (empty? bSt => bn; bn + pn * frst(bSt)) + c := (bn1 - an*an) quo pn + aa := modP(c * invmod(2*an,p)) + nSt := (empty? bSt => bSt; rst bSt) + concat(aa,iSqrt(pn*p,an + pn*aa,bn1,nSt)) + + sqrt(b,a) == + p = 2 => + error "sqrt: no square roots in Z2 yet" + not zero? modP(a*a - (bb := moduloP b)) => + error "sqrt: not a square root (mod p)" + b := (empty? b => b; rst b) + a := modP a + concat(a,iSqrt(p,a,bb,b)) + + iRoot: (SUP I,I,I,I) -> ST I + iRoot(f,alpha,invFpx0,pPow) == delay + num := -((f(alpha) exquo pPow) :: I) + digit := modP(num * invFpx0) + concat(digit,iRoot(f,alpha + digit * pPow,invFpx0,p * pPow)) + + root(f,x0) == + x0 := modP x0 + not zero? modP f(x0) => + error "root: not a root (mod p)" + fpx0 := modP (differentiate f)(x0) + zero? fpx0 => + error "root: approximate root must be a simple root (mod p)" + invFpx0 := modP invModP fpx0 + padic concat(x0,iRoot(f,x0,invFpx0,p)) + + termOutput:(I,I) -> OUT + termOutput(k,c) == + k = 0 => c :: OUT + mon := (k = 1 => PEXPR; PEXPR ** (k :: OUT)) + c = 1 => mon + c = -1 => -mon + (c :: OUT) * mon + + showAll?:() -> Boolean + -- check a global Lisp variable + showAll?() == true + + coerce(x:%):OUT == + empty?(st := stream x) => 0 :: OUT + n : NNI ; count : NNI := _$streamCount$Lisp + l : L OUT := empty() + for n in 0..count while not empty? st repeat + if frst(st) ^= 0 then + l := concat(termOutput(n :: I,frst st),l) + st := rst st + if showAll?() then + for n in (count + 1).. while explicitEntries? st and _ + not eq?(st,rst st) repeat + if frst(st) ^= 0 then + l := concat(termOutput(n pretend I,frst st),l) + st := rst st + l := + explicitlyEmpty? st => l + eq?(st,rst st) and frst st = 0 => l + concat(prefix("O" :: OUT,[PEXPR ** (n :: OUT)]),l) + empty? l => 0 :: OUT + reduce("+",reverse_! l) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain IPF InnerPrimeField} +\pagehead{InnerPrimeField}{IPF} +\pagepic{ps/v103innerprimefield.ps}{IPF}{1.00} +See also:\\ +\refto{PrimeField}{PF} +<>= +)abbrev domain IPF InnerPrimeField +-- Argument MUST be a prime. +-- This domain does not check, PrimeField does. +++ Authors: N.N., J.Grabmeier, A.Scheerhorn +++ Date Created: ?, November 1990, 26.03.1991 +++ Date Last Updated: 12 April 1991 +++ Basic Operations: +++ Related Constructors: PrimeField +++ Also See: +++ AMS Classifications: +++ Keywords: prime characteristic, prime field, finite field +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ AXIOM Technical Report Series, to appear. +++ Description: +++ InnerPrimeField(p) implements the field with p elements. +++ Note: argument p MUST be a prime (this domain does not check). +++ See \spadtype{PrimeField} for a domain that does check. + + +InnerPrimeField(p:PositiveInteger): Exports == Implementation where + + I ==> Integer + NNI ==> NonNegativeInteger + PI ==> PositiveInteger + TBL ==> Table(PI,NNI) + R ==> Record(key:PI,entry:NNI) + SUP ==> SparseUnivariatePolynomial + OUT ==> OutputForm + + Exports ==> Join(FiniteFieldCategory,FiniteAlgebraicExtensionField($),_ + ConvertibleTo(Integer)) + + Implementation ==> IntegerMod p add + + initializeElt:() -> Void + initializeLog:() -> Void + +-- global variables ==================================================== + + primitiveElt:PI:=1 + -- for the lookup the primitive Element computed by createPrimitiveElement() + + sizeCG :=(p-1) pretend NonNegativeInteger + -- the size of the cyclic group + + facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer)) + -- the factorization of the cyclic group size + + initlog?:Boolean:=true + -- gets false after initialization of the logarithm table + + initelt?:Boolean:=true + -- gets false after initialization of the primitive Element + + + discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) + -- tables indexed by the factors of the size q of the cyclic group + -- discLogTable.factor is a table of with keys + -- primitiveElement() ** (i * (q quo factor)) and entries i for + -- i in 0..n-1, n computed in initialize() in order to use + -- the minimal size limit 'limit' optimal. + +-- functions =========================================================== + + generator() == 1 + + -- This uses x**(p-1)=1 (mod p), so x**(q(p-1)+r) = x**r (mod p) + x:$ ** n:Integer == + zero?(n) => 1 + zero?(x) => 0 + r := positiveRemainder(n,p-1)::NNI + ((x pretend IntegerMod p) **$IntegerMod(p) r) pretend $ + + if p <= convert(max()$SingleInteger)@Integer then + q := p::SingleInteger + + recip x == + zero?(y := convert(x)@Integer :: SingleInteger) => "failed" + invmod(y, q)::Integer::$ + else + recip x == + zero?(y := convert(x)@Integer) => "failed" + invmod(y, p)::$ + + convert(x:$) == x pretend I + + normalElement() == 1 + + createNormalElement() == 1 + + characteristic() == p + + factorsOfCyclicGroupSize() == + p=2 => facOfGroupSize -- this fixes an infinite loop of functions + -- calls, problem was that factors factor(1) + -- is the empty list + if empty? facOfGroupSize then initializeElt() + facOfGroupSize + + representationType() == "prime" + + tableForDiscreteLogarithm(fac) == + if initlog? then initializeLog() + tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) + tbl case "failed" => + error "tableForDiscreteLogarithm: argument must be prime divisor_ + of the order of the multiplicative group" + tbl pretend TBL + + primitiveElement() == + if initelt? then initializeElt() + index(primitiveElt) + + initializeElt() == + facOfGroupSize:=factors(factor(sizeCG)$I)$(Factored I) + -- get a primitive element + primitiveElt:=lookup(createPrimitiveElement()) + -- set initialization flag + initelt? := false + void$Void + + initializeLog() == + if initelt? then initializeElt() + -- set up tables for discrete logarithm + limit:Integer:=30 + -- the minimum size for the discrete logarithm table + for f in facOfGroupSize repeat + fac:=f.factor + base:$:=primitiveElement() ** (sizeCG quo fac) + l:Integer:=length(fac)$Integer + n:Integer:=0 + if odd?(l)$Integer then n:=shift(fac,-(l quo 2)) + else n:=shift(1,(l quo 2)) + if n < limit then + d:=(fac-1) quo limit + 1 + n:=(fac-1) quo d + 1 + tbl:TBL:=table()$TBL + a:$:=1 + for i in (0::NNI)..(n-1)::NNI repeat + insert_!([lookup(a),i::NNI]$R,tbl)$TBL + a:=a*base + insert_!([fac::PI,copy(tbl)$TBL]_ + $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL) + -- tell user about initialization + -- print("discrete logarithm table initialized"::OUT) + -- set initialization flag + initlog? := false + void$Void + + degree(x):PI == 1::PositiveInteger + extensionDegree():PI == 1::PositiveInteger + +-- sizeOfGroundField() == p::NonNegativeInteger + + inGroundField?(x) == true + + coordinates(x) == new(1,x)$(Vector $) + + represents(v) == v.1 + + retract(x) == x + + retractIfCan(x) == x + + basis() == new(1,1::$)$(Vector $) + basis(n:PI) == + n = 1 => basis() + error("basis: argument must divide extension degree") + + definingPolynomial() == + monomial(1,1)$(SUP $) - monomial(1,0)$(SUP $) + + + minimalPolynomial(x) == + monomial(1,1)$(SUP $) - monomial(x,0)$(SUP $) + + charthRoot x == x + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain INFORM InputForm} \pagehead{InputForm}{INFORM} \pagepic{ps/v103inputform.ps}{INFORM}{1.00} @@ -43443,6 +44110,256 @@ OutputForm(): SetCategory with %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter P} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PADIC PAdicInteger} +\pagehead{PAdicInteger}{PADIC} +\pagepic{ps/v103padicinteger.ps}{PADIC}{1.00} +See also:\\ +\refto{InnerPAdicInteger}{IPADIC} +\refto{BalancedPAdicInteger}{BPADIC} +\refto{PAdicRationalConstructor}{PADICRC} +\refto{PAdicRational}{PADICRAT} +\refto{BalancedPAdicRational}{BPADICRT} +<>= +)abbrev domain PADIC PAdicInteger +++ Author: Clifton J. Williamson +++ Date Created: 20 August 1989 +++ Date Last Updated: 15 May 1990 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Keywords: p-adic, completion +++ Examples: +++ References: +++ Description: +++ Stream-based implementation of Zp: p-adic numbers are represented as +++ sum(i = 0.., a[i] * p^i), where the a[i] lie in 0,1,...,(p - 1). +PAdicInteger(p:Integer) == InnerPAdicInteger(p,true$Boolean) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PADICRAT PAdicRational} +\pagehead{PAdicRational}{PADICRAT} +\pagepic{ps/v103padicrational.ps}{PADICRAT}{1.00} +See also:\\ +\refto{InnerPAdicInteger}{IPADIC} +\refto{PAdicInteger}{PADIC} +\refto{BalancedPAdicInteger}{BPADIC} +\refto{PAdicRationalConstructor}{PADICRC} +\refto{BalancedPAdicRational}{BPADICRT} +<>= +)abbrev domain PADICRAT PAdicRational +++ Author: Clifton J. Williamson +++ Date Created: 15 May 1990 +++ Date Last Updated: 15 May 1990 +++ Keywords: p-adic, complementation +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: p-adic, completion +++ Examples: +++ References: +++ Description: +++ Stream-based implementation of Qp: numbers are represented as +++ sum(i = k.., a[i] * p^i) where the a[i] lie in 0,1,...,(p - 1). +PAdicRational(p:Integer) == PAdicRationalConstructor(p,PAdicInteger p) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PADICRC PAdicRationalConstructor} +\pagehead{PAdicRationalConstructor}{PADICRC} +\pagepic{ps/v103padicrationalconstructor.ps}{PADICRC}{1.00} +See also:\\ +\refto{InnerPAdicInteger}{IPADIC} +\refto{PAdicInteger}{PADIC} +\refto{BalancedPAdicInteger}{BPADIC} +\refto{PAdicRational}{PADICRAT} +\refto{BalancedPAdicRational}{BPADICRT} +<>= +)abbrev domain PADICRC PAdicRationalConstructor +++ Author: Clifton J. Williamson +++ Date Created: 10 May 1990 +++ Date Last Updated: 10 May 1990 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Keywords: p-adic, completion +++ Examples: +++ References: +++ Description: This is the category of stream-based representations of Qp. +PAdicRationalConstructor(p,PADIC): Exports == Implementation where + p : Integer + PADIC : PAdicIntegerCategory p + CF ==> ContinuedFraction + I ==> Integer + NNI ==> NonNegativeInteger + OUT ==> OutputForm + L ==> List + RN ==> Fraction Integer + ST ==> Stream + + Exports ==> QuotientFieldCategory(PADIC) with + approximate: (%,I) -> RN + ++ \spad{approximate(x,n)} returns a rational number y such that + ++ \spad{y = x (mod p^n)}. + continuedFraction: % -> CF RN + ++ \spad{continuedFraction(x)} converts the p-adic rational number x + ++ to a continued fraction. + removeZeroes: % -> % + ++ \spad{removeZeroes(x)} removes leading zeroes from the + ++ representation of the p-adic rational \spad{x}. + ++ A p-adic rational is represented by (1) an exponent and + ++ (2) a p-adic integer which may have leading zero digits. + ++ When the p-adic integer has a leading zero digit, a 'leading zero' + ++ is removed from the p-adic rational as follows: + ++ the number is rewritten by increasing the exponent by 1 and + ++ dividing the p-adic integer by p. + ++ Note: \spad{removeZeroes(f)} removes all leading zeroes from f. + removeZeroes: (I,%) -> % + ++ \spad{removeZeroes(n,x)} removes up to n leading zeroes from + ++ the p-adic rational \spad{x}. + + Implementation ==> add + + PEXPR := p :: OUT + +--% representation + + Rep := Record(expon:I,pint:PADIC) + + getExpon: % -> I + getZp : % -> PADIC + makeQp : (I,PADIC) -> % + + getExpon x == x.expon + getZp x == x.pint + makeQp(r,int) == [r,int] + +--% creation + + 0 == makeQp(0,0) + 1 == makeQp(0,1) + + coerce(x:I) == x :: PADIC :: % + coerce(r:RN) == (numer(r) :: %)/(denom(r) :: %) + coerce(x:PADIC) == makeQp(0,x) + +--% normalizations + + removeZeroes x == + empty? digits(xx := getZp x) => 0 + zero? moduloP xx => + removeZeroes makeQp(getExpon x + 1,quotientByP xx) + x + + removeZeroes(n,x) == + n <= 0 => x + empty? digits(xx := getZp x) => 0 + zero? moduloP xx => + removeZeroes(n - 1,makeQp(getExpon x + 1,quotientByP xx)) + x + +--% arithmetic + + x = y == + EQ(x,y)$Lisp => true + n := getExpon(x) - getExpon(y) + n >= 0 => + (p**(n :: NNI) * getZp(x)) = getZp(y) + (p**((- n) :: NNI) * getZp(y)) = getZp(x) + + x + y == + n := getExpon(x) - getExpon(y) + n >= 0 => + makeQp(getExpon y,getZp(y) + p**(n :: NNI) * getZp(x)) + makeQp(getExpon x,getZp(x) + p**((-n) :: NNI) * getZp(y)) + + -x == makeQp(getExpon x,-getZp(x)) + + x - y == + n := getExpon(x) - getExpon(y) + n >= 0 => + makeQp(getExpon y,p**(n :: NNI) * getZp(x) - getZp(y)) + makeQp(getExpon x,getZp(x) - p**((-n) :: NNI) * getZp(y)) + + n:I * x:% == makeQp(getExpon x,n * getZp x) + x:% * y:% == makeQp(getExpon x + getExpon y,getZp x * getZp y) + + x:% ** n:I == + zero? n => 1 + positive? n => expt(x,n :: PositiveInteger)$RepeatedSquaring(%) + inv expt(x,(-n) :: PositiveInteger)$RepeatedSquaring(%) + + recip x == + x := removeZeroes(1000,x) + zero? moduloP(xx := getZp x) => "failed" + (inv := recip xx) case "failed" => "failed" + makeQp(- getExpon x,inv :: PADIC) + + inv x == + (inv := recip x) case "failed" => error "inv: no inverse" + inv :: % + + x:% / y:% == x * inv y + x:PADIC / y:PADIC == (x :: %) / (y :: %) + x:PADIC * y:% == makeQp(getExpon y,x * getZp y) + + approximate(x,n) == + k := getExpon x + (p :: RN) ** k * approximate(getZp x,n - k) + + cfStream: % -> Stream RN + cfStream x == delay +-- zero? x => empty() + invx := inv x; x0 := approximate(invx,1) + concat(x0,cfStream(invx - (x0 :: %))) + + continuedFraction x == + x0 := approximate(x,1) + reducedContinuedFraction(x0,cfStream(x - (x0 :: %))) + + termOutput:(I,I) -> OUT + termOutput(k,c) == + k = 0 => c :: OUT + mon := (k = 1 => PEXPR; PEXPR ** (k :: OUT)) + c = 1 => mon + c = -1 => -mon + (c :: OUT) * mon + + showAll?:() -> Boolean + -- check a global Lisp variable + showAll?() == true + + coerce(x:%):OUT == + x := removeZeroes(_$streamCount$Lisp,x) + m := getExpon x; zp := getZp x + uu := digits zp + l : L OUT := empty() + empty? uu => 0 :: OUT + n : NNI ; count : NNI := _$streamCount$Lisp + for n in 0..count while not empty? uu repeat + if frst(uu) ^= 0 then + l := concat(termOutput((n :: I) + m,frst(uu)),l) + uu := rst uu + if showAll?() then + for n in (count + 1).. while explicitEntries? uu and _ + not eq?(uu,rst uu) repeat + if frst(uu) ^= 0 then + l := concat(termOutput((n::I) + m,frst(uu)),l) + uu := rst uu + l := + explicitlyEmpty? uu => l + eq?(uu,rst uu) and frst uu = 0 => l + concat(prefix("O" :: OUT,[PEXPR ** ((n :: I) + m) :: OUT]),l) + empty? l => 0 :: OUT + reduce("+",reverse_! l) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain PALETTE Palette} <>= "PALETTE" -> "SETCAT" @@ -43507,6 +44424,2740 @@ Palette(): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PARPCURV ParametricPlaneCurve} +\pagehead{ParametricPlaneCurve}{PARPCURV} +\pagepic{ps/v103parametricplanecurve.ps}{PARPCURV}{1.00} +See also:\\ +\refto{ParametricSpaceCurve}{PARSCURV} +\refto{ParametricSurface}{PARSURF} +<>= +)abbrev domain PARPCURV ParametricPlaneCurve +++ Author: Clifton J. Williamson +++ Date Created: 24 May 1990 +++ Date Last Updated: 24 May 1990 +++ Basic Operations: curve, coordinate +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: parametric curve, graphics +++ References: +++ Description: ParametricPlaneCurve is used for plotting parametric plane +++ curves in the affine plane. + +ParametricPlaneCurve(ComponentFunction): Exports == Implementation where + ComponentFunction : Type + NNI ==> NonNegativeInteger + + Exports ==> with + curve: (ComponentFunction,ComponentFunction) -> % + ++ curve(c1,c2) creates a plane curve from 2 component functions \spad{c1} + ++ and \spad{c2}. + coordinate: (%,NNI) -> ComponentFunction + ++ coordinate(c,i) returns a coordinate function for c using 1-based + ++ indexing according to i. This indicates what the function for the + ++ coordinate component i of the plane curve is. + + Implementation ==> add + + Rep := Record(xCoord:ComponentFunction,yCoord:ComponentFunction) + + curve(x,y) == [x,y] + coordinate(c,n) == + n = 1 => c.xCoord + n = 2 => c.yCoord + error "coordinate: index out of bounds" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PARSCURV ParametricSpaceCurve} +\pagehead{ParametricSpaceCurve}{PARSCURV} +\pagepic{ps/v103parametricspacecurve.ps}{PARSCURV}{1.00} +See also:\\ +\refto{ParametricPlaneCurve}{PARPCURV} +\refto{ParametricSurface}{PARSURF} +<>= +)abbrev domain PARSCURV ParametricSpaceCurve +++ Author: Clifton J. Williamson +++ Date Created: 24 May 1990 +++ Date Last Updated: 24 May 1990 +++ Basic Operations: curve, coordinate +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: parametric curve, graphics +++ References: +++ Description: ParametricSpaceCurve is used for plotting parametric space +++ curves in affine 3-space. + +ParametricSpaceCurve(ComponentFunction): Exports == Implementation where + ComponentFunction : Type + NNI ==> NonNegativeInteger + + Exports ==> with + curve: (ComponentFunction,ComponentFunction,ComponentFunction) -> % + ++ curve(c1,c2,c3) creates a space curve from 3 component functions + ++ \spad{c1}, \spad{c2}, and \spad{c3}. + coordinate: (%,NNI) -> ComponentFunction + ++ coordinate(c,i) returns a coordinate function of c using 1-based + ++ indexing according to i. This indicates what the function for the + ++ coordinate component, i, of the space curve is. + + Implementation ==> add + + Rep := Record(xCoord:ComponentFunction,_ + yCoord:ComponentFunction,_ + zCoord:ComponentFunction) + + curve(x,y,z) == [x,y,z] + coordinate(c,n) == + n = 1 => c.xCoord + n = 2 => c.yCoord + n = 3 => c.zCoord + error "coordinate: index out of bounds" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PARSURF ParametricSurface} +\pagehead{ParametricSurface}{PARSURF} +\pagepic{ps/v103parametricsurface.ps}{PARSURF}{1.00} +See also:\\ +\refto{ParametricPlaneCurve}{PARPCURV} +\refto{ParametricSpaceCurve}{PARSCURV} +<>= +)abbrev domain PARSURF ParametricSurface +++ Author: Clifton J. Williamson +++ Date Created: 24 May 1990 +++ Date Last Updated: 24 May 1990 +++ Basic Operations: surface, coordinate +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: parametric surface, graphics +++ References: +++ Description: ParametricSurface is used for plotting parametric surfaces in +++ affine 3-space. + +ParametricSurface(ComponentFunction): Exports == Implementation where + ComponentFunction : Type + NNI ==> NonNegativeInteger + + Exports ==> with + surface: (ComponentFunction,ComponentFunction,ComponentFunction) -> % + ++ surface(c1,c2,c3) creates a surface from 3 parametric component + ++ functions \spad{c1}, \spad{c2}, and \spad{c3}. + coordinate: (%,NNI) -> ComponentFunction + ++ coordinate(s,i) returns a coordinate function of s using 1-based + ++ indexing according to i. This indicates what the function for the + ++ coordinate component, i, of the surface is. + + Implementation ==> add + + Rep := Record(xCoord:ComponentFunction,_ + yCoord:ComponentFunction,_ + zCoord:ComponentFunction) + + surface(x,y,z) == [x,y,z] + coordinate(c,n) == + n = 1 => c.xCoord + n = 2 => c.yCoord + n = 3 => c.zCoord + error "coordinate: index out of bounds" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PFR PartialFraction} +<>= +-- pfr.spad.pamphlet PartialFraction.input +)spool PartialFraction.output +)set message test on +)set message auto off +)clear all +--S 1 of 10 +partialFraction(1,factorial 10) +--R +--R +--R 159 23 12 1 +--R (1) --- - -- - -- + - +--R 8 4 2 7 +--R 2 3 5 +--R Type: PartialFraction Integer +--E 1 + +--S 2 of 10 +f := padicFraction(%) +--R +--R +--R 1 1 1 1 1 1 2 1 2 2 2 1 +--R (2) - + -- + -- + -- + -- + -- - -- - -- - -- - - - -- + - +--R 2 4 5 6 7 8 2 3 4 5 2 7 +--R 2 2 2 2 2 3 3 3 5 +--R Type: PartialFraction Integer +--E 2 + +--S 3 of 10 +compactFraction(f) +--R +--R +--R 159 23 12 1 +--R (3) --- - -- - -- + - +--R 8 4 2 7 +--R 2 3 5 +--R Type: PartialFraction Integer +--E 3 + +--S 4 of 10 +numberOfFractionalTerms(f) +--R +--R +--R (4) 12 +--R Type: PositiveInteger +--E 4 + +--S 5 of 10 +nthFractionalTerm(f,3) +--R +--R +--R 1 +--R (5) -- +--R 5 +--R 2 +--R Type: PartialFraction Integer +--E 5 + +--S 6 of 10 +partialFraction(1,- 13 + 14 * %i) +--R +--R +--R 1 4 +--R (6) - ------- + ------- +--R 1 + 2%i 3 + 8%i +--R Type: PartialFraction Complex Integer +--E 6 + +--S 7 of 10 +% :: Fraction Complex Integer +--R +--R +--R %i +--R (7) - --------- +--R 14 + 13%i +--R Type: Fraction Complex Integer +--E 7 + +--S 8 of 10 +u : FR UP(x, FRAC INT) := reduce(*,[primeFactor(x+i,i) for i in 1..4]) +--R +--R +--R 2 3 4 +--R (8) (x + 1)(x + 2) (x + 3) (x + 4) +--R Type: Factored UnivariatePolynomial(x,Fraction Integer) +--E 8 + +--S 9 of 10 +partialFraction(1,u) +--R +--R +--R (9) +--R 1 1 7 17 2 139 607 3 10115 2 391 44179 +--R --- - x + -- - -- x - 12x - --- --- x + ----- x + --- x + ----- +--R 648 4 16 8 8 324 432 4 324 +--R ----- + -------- + ------------------- + --------------------------------- +--R x + 1 2 3 4 +--R (x + 2) (x + 3) (x + 4) +--R Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) +--E 9 + +--S 10 of 10 +padicFraction % +--R +--R +--R (10) +--R 1 1 1 17 3 1 607 403 +--R --- - -- -- - - --- --- +--R 648 4 16 8 4 2 324 432 +--R ----- + ----- - -------- - ----- + -------- - -------- + ----- + -------- +--R x + 1 x + 2 2 x + 3 2 3 x + 4 2 +--R (x + 2) (x + 3) (x + 3) (x + 4) +--R + +--R 13 1 +--R -- -- +--R 36 12 +--R -------- + -------- +--R 3 4 +--R (x + 4) (x + 4) +--R Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) +--E 10 +)spool +)lisp (bye) +@ +<>= +==================================================================== +PartialFraction examples +==================================================================== + +A partial fraction is a decomposition of a quotient into a sum of +quotients where the denominators of the summands are powers of +primes. Most people first encounter partial fractions when they are +learning integral calculus. For a technical discussion of partial +fractions, see, for example, Lang's Algebra. For example, the rational +number 1/6 is decomposed into 1/2-1/3. You can compute partial +fractions of quotients of objects from domains belonging to the +category EuclideanDomain. For example, Integer, Complex Integer, and +UnivariatePolynomial(x, Fraction Integer) all belong to EuclideanDomain. +In the examples following, we demonstrate how to decompose quotients of +each of these kinds of object into partial fractions. + +It is necessary that we know how to factor the denominator when we +want to compute a partial fraction. Although the interpreter can +often do this automatically, it may be necessary for you to include a +call to factor. In these examples, it is not necessary to factor the +denominators explicitly. + +The main operation for computing partial fractions is called partialFraction +and we use this to compute a decomposition of 1/10!. The first argument to +partialFraction is the numerator of the quotient and the second argument is +the factored denominator. + + partialFraction(1,factorial 10) + 159 23 12 1 + --- - -- - -- + - + 8 4 2 7 + 2 3 5 + Type: PartialFraction Integer + +Since the denominators are powers of primes, it may be possible to +expand the numerators further with respect to those primes. Use the +operation padicFraction to do this. + + f := padicFraction(%) + 1 1 1 1 1 1 2 1 2 2 2 1 + - + -- + -- + -- + -- + -- - -- - -- - -- - - - -- + - + 2 4 5 6 7 8 2 3 4 5 2 7 + 2 2 2 2 2 3 3 3 5 + Type: PartialFraction Integer + +The operation compactFraction returns an expanded fraction into the usual +form. The compacted version is used internally for computational efficiency. + + compactFraction(f) + 159 23 12 1 + --- - -- - -- + - + 8 4 2 7 + 2 3 5 + Type: PartialFraction Integer + +You can add, subtract, multiply and divide partial fractions. In addition, +you can extract the parts of the decomposition. numberOfFractionalTerms +computes the number of terms in the fractional part. This does not include +the whole part of the fraction, which you get by calling wholePart. In +this example, the whole part is just 0. + + numberOfFractionalTerms(f) + 12 + Type: PositiveInteger + +The operation nthFractionalTerm returns the individual terms in the +decomposition. Notice that the object returned is a partial fraction +itself. firstNumer and firstDenom extract the numerator and denominator +of the first term of the fraction. + + nthFractionalTerm(f,3) + 1 + -- + 5 + 2 + Type: PartialFraction Integer + +Given two gaussian integers, you can decompose their quotient into a +partial fraction. + + partialFraction(1,- 13 + 14 * %i) + 1 4 + - ------- + ------- + 1 + 2%i 3 + 8%i + Type: PartialFraction Complex Integer + +To convert back to a quotient, simply use a conversion. + + % :: Fraction Complex Integer + %i + - --------- + 14 + 13%i + Type: Fraction Complex Integer + +To conclude this section, we compute the decomposition of + + 1 + ------------------------------- + 2 3 4 + (x + 1)(x + 2) (x + 3) (x + 4) + + +The polynomials in this object have type +UnivariatePolynomial(x, Fraction Integer). + +We use the primeFactor operation to create the denominator in factored +form directly. + + u : FR UP(x, FRAC INT) := reduce(*,[primeFactor(x+i,i) for i in 1..4]) + 2 3 4 + (x + 1)(x + 2) (x + 3) (x + 4) + Type: Factored UnivariatePolynomial(x,Fraction Integer) + +These are the compact and expanded partial fractions for the quotient. + + partialFraction(1,u) + 1 1 7 17 2 139 607 3 10115 2 391 44179 + --- - x + -- - -- x - 12x - --- --- x + ----- x + --- x + ----- + 648 4 16 8 8 324 432 4 324 + ----- + -------- + ------------------- + --------------------------------- + x + 1 2 3 4 + (x + 2) (x + 3) (x + 4) + Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) + + padicFraction % + 1 1 1 17 3 1 607 403 + --- - -- -- - - --- --- + 648 4 16 8 4 2 324 432 + ----- + ----- - -------- - ----- + -------- - -------- + ----- + -------- + x + 1 x + 2 2 x + 3 2 3 x + 4 2 + (x + 2) (x + 3) (x + 3) (x + 4) + + + 13 1 + -- -- + 36 12 + -------- + -------- + 3 4 + (x + 4) (x + 4) + Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) + +See Also: +o )help Factored +o )help Complex +o )help FullPartialFractionExpansionXmpPage +o )show PartialFraction +o $AXIOM/doc/src/algebra/pfr.spad.dvi + +@ +\pagehead{PartialFraction}{PFR} +\pagepic{ps/v103partialfraction.ps}{PFR}{1.00} +<>= +)abbrev domain PFR PartialFraction +++ Author: Robert S. Sutor +++ Date Created: 1986 +++ Change History: +++ 05/20/91 BMT Converted to the new library +++ Basic Operations: (Field), (Algebra), +++ coerce, compactFraction, firstDenom, firstNumer, +++ nthFractionalTerm, numberOfFractionalTerms, padicallyExpand, +++ padicFraction, partialFraction, wholePart +++ Related Constructors: +++ Also See: ContinuedFraction +++ AMS Classifications: +++ Keywords: partial fraction, factorization, euclidean domain +++ References: +++ Description: +++ The domain \spadtype{PartialFraction} implements partial fractions +++ over a euclidean domain \spad{R}. This requirement on the +++ argument domain allows us to normalize the fractions. Of +++ particular interest are the 2 forms for these fractions. The +++ ``compact'' form has only one fractional term per prime in the +++ denominator, while the ``p-adic'' form expands each numerator +++ p-adically via the prime p in the denominator. For computational +++ efficiency, the compact form is used, though the p-adic form may +++ be gotten by calling the function \spadfunFrom{padicFraction}{PartialFraction}. For a +++ general euclidean domain, it is not known how to factor the +++ denominator. Thus the function \spadfunFrom{partialFraction}{PartialFraction} takes as its +++ second argument an element of \spadtype{Factored(R)}. + +PartialFraction(R: EuclideanDomain): Cat == Capsule where + FRR ==> Factored R + SUPR ==> SparseUnivariatePolynomial R + + Cat == Join(Field, Algebra R) with + coerce: % -> Fraction R + ++ coerce(p) sums up the components of the partial fraction and + ++ returns a single fraction. + + coerce: Fraction FRR -> % + ++ coerce(f) takes a fraction with numerator and denominator in + ++ factored form and creates a partial fraction. It is + ++ necessary for the parts to be factored because it is not + ++ known in general how to factor elements of \spad{R} and + ++ this is needed to decompose into partial fractions. + + compactFraction: % -> % + ++ compactFraction(p) normalizes the partial fraction \spad{p} + ++ to the compact representation. In this form, the partial + ++ fraction has only one fractional term per prime in the + ++ denominator. + + firstDenom: % -> FRR + ++ firstDenom(p) extracts the denominator of the first fractional + ++ term. This returns 1 if there is no fractional part (use + ++ \spadfunFrom{wholePart}{PartialFraction} to get the whole part). + + firstNumer: % -> R + ++ firstNumer(p) extracts the numerator of the first fractional + ++ term. This returns 0 if there is no fractional part (use + ++ \spadfunFrom{wholePart}{PartialFraction} to get the whole part). + + nthFractionalTerm: (%,Integer) -> % + ++ nthFractionalTerm(p,n) extracts the nth fractional term from + ++ the partial fraction \spad{p}. This returns 0 if the index + ++ \spad{n} is out of range. + + numberOfFractionalTerms: % -> Integer + ++ numberOfFractionalTerms(p) computes the number of fractional + ++ terms in \spad{p}. This returns 0 if there is no fractional + ++ part. + + padicallyExpand: (R,R) -> SUPR + ++ padicallyExpand(p,x) is a utility function that expands + ++ the second argument \spad{x} ``p-adically'' in + ++ the first. + + padicFraction: % -> % + ++ padicFraction(q) expands the fraction p-adically in the primes + ++ \spad{p} in the denominator of \spad{q}. For example, + ++ \spad{padicFraction(3/(2**2)) = 1/2 + 1/(2**2)}. + ++ Use \spadfunFrom{compactFraction}{PartialFraction} to return to compact form. + + partialFraction: (R, FRR) -> % + ++ partialFraction(numer,denom) is the main function for + ++ constructing partial fractions. The second argument is the + ++ denominator and should be factored. + + wholePart: % -> R + ++ wholePart(p) extracts the whole part of the partial fraction + ++ \spad{p}. + + Capsule == add + + -- some constructor assignments and macros + + Ex ==> OutputForm + fTerm ==> Record(num: R, den: FRR) -- den should have + -- unit = 1 and only + -- 1 factor + LfTerm ==> List Record(num: R, den: FRR) + QR ==> Record(quotient: R, remainder: R) + + Rep := Record(whole:R, fract: LfTerm) + + -- private function signatures + + copypf: % -> % + LessThan: (fTerm, fTerm) -> Boolean + multiplyFracTerms: (fTerm, fTerm) -> % + normalizeFracTerm: fTerm -> % + partialFractionNormalized: (R, FRR) -> % + + -- declarations + + a,b: % + n: Integer + r: R + + -- private function definitions + + copypf(a: %): % == [a.whole,copy a.fract]$% + + LessThan(s: fTerm, t: fTerm) == + -- have to wait until FR has < operation + if (GGREATERP(s.den,t.den)$Lisp : Boolean) then false + else true + + multiplyFracTerms(s : fTerm, t : fTerm) == + nthFactor(s.den,1) = nthFactor(t.den,1) => + normalizeFracTerm([s.num * t.num, s.den * t.den]$fTerm) : Rep + i : Union(Record(coef1: R, coef2: R),"failed") + coefs : Record(coef1: R, coef2: R) + i := extendedEuclidean(expand t.den, expand s.den,s.num * t.num) + i case "failed" => error "PartialFraction: not in ideal" + coefs := (i :: Record(coef1: R, coef2: R)) + c : % := copypf 0$% + d : % + if coefs.coef2 ^= 0$R then + c := normalizeFracTerm ([coefs.coef2, t.den]$fTerm) + if coefs.coef1 ^= 0$R then + d := normalizeFracTerm ([coefs.coef1, s.den]$fTerm) + c.whole := c.whole + d.whole + not (null d.fract) => c.fract := append(d.fract,c.fract) + c + + normalizeFracTerm(s : fTerm) == + -- makes sure num is "less than" den, whole may be non-zero + qr : QR := divide(s.num, (expand s.den)) + qr.remainder = 0$R => [qr.quotient, nil()$LfTerm] + -- now verify num and den are coprime + f : R := nthFactor(s.den,1) + nexpon : Integer := nthExponent(s.den,1) + expon : Integer := 0 + q : QR := divide(qr.remainder, f) + while (q.remainder = 0$R) and (expon < nexpon) repeat + expon := expon + 1 + qr.remainder := q.quotient + q := divide(qr.remainder,f) + expon = 0 => [qr.quotient,[[qr.remainder, s.den]$fTerm]$LfTerm] + expon = nexpon => (qr.quotient + qr.remainder) :: % + [qr.quotient,[[qr.remainder, nilFactor(f,nexpon-expon)]$fTerm]$LfTerm] + + partialFractionNormalized(nm: R, dn : FRR) == + -- assume unit dn = 1 + nm = 0$R => 0$% + dn = 1$FRR => nm :: % + qr : QR := divide(nm, expand dn) + c : % := [0$R,[[qr.remainder, + nilFactor(nthFactor(dn,1), nthExponent(dn,1))]$fTerm]$LfTerm] + d : % + for i in 2..numberOfFactors(dn) repeat + d := + [0$R,[[1$R,nilFactor(nthFactor(dn,i), nthExponent(dn,i))]$fTerm]$LfTerm] + c := c * d + (qr.quotient :: %) + c + + -- public function definitions + + padicFraction(a : %) == + b: % := compactFraction a + null b.fract => b + l : LfTerm := nil + s : fTerm + f : R + e,d: Integer + for s in b.fract repeat + e := nthExponent(s.den,1) + e = 1 => l := cons(s,l) + f := nthFactor(s.den,1) + d := degree(sp := padicallyExpand(f,s.num)) + while (sp ^= 0$SUPR) repeat + l := cons([leadingCoefficient sp,nilFactor(f,e-d)]$fTerm, l) + d := degree(sp := reductum sp) + [b.whole, sort(LessThan,l)]$% + + compactFraction(a : %) == + -- only one power for each distinct denom will remain + 2 > # a.fract => a + af : LfTerm := reverse a.fract + bf : LfTerm := nil + bw : R := a.whole + b : % + s : fTerm := [(first af).num,(first af).den]$fTerm + f : R := nthFactor(s.den,1) + e : Integer := nthExponent(s.den,1) + t : fTerm + for t in rest af repeat + f = nthFactor(t.den,1) => + s.num := s.num + (t.num * + (f **$R ((e - nthExponent(t.den,1)) : NonNegativeInteger))) + b := normalizeFracTerm s + bw := bw + b.whole + if not (null b.fract) then bf := cons(first b.fract,bf) + s := [t.num, t.den]$fTerm + f := nthFactor(s.den,1) + e := nthExponent(s.den,1) + b := normalizeFracTerm s + [bw + b.whole,append(b.fract,bf)]$% + + 0 == [0$R, nil()$LfTerm] + 1 == [1$R, nil()$LfTerm] + characteristic() == characteristic()$R + + coerce(r): % == [r, nil()$LfTerm] + coerce(n): % == [(n :: R), nil()$LfTerm] + coerce(a): Fraction R == + q : Fraction R := (a.whole :: Fraction R) + s : fTerm + for s in a.fract repeat + q := q + (s.num / (expand s.den)) + q + coerce(q: Fraction FRR): % == + u : R := (recip unit denom q):: R + r1 : R := u * expand numer q + partialFractionNormalized(r1, u * denom q) + + a exquo b == + b = 0$% => "failed" + b = 1$% => a + br : Fraction R := inv (b :: Fraction R) + a * partialFraction(numer br,(denom br) :: FRR) + recip a == (1$% exquo a) + + firstDenom a == -- denominator of 1st fractional term + null a.fract => 1$FRR + (first a.fract).den + firstNumer a == -- numerator of 1st fractional term + null a.fract => 0$R + (first a.fract).num + numberOfFractionalTerms a == # a.fract + nthFractionalTerm(a,n) == + l : LfTerm := a.fract + (n < 1) or (n > # l) => 0$% + [0$R,[l.n]$LfTerm]$% + wholePart a == a.whole + + partialFraction(nm: R, dn : FRR) == + nm = 0$R => 0$% + -- move inv unit of den to numerator + u : R := unit dn + u := (recip u) :: R + partialFractionNormalized(u * nm,u * dn) + + padicallyExpand(p : R, r : R) == + -- expands r as a sum of powers of p, with coefficients + -- r = HornerEval(padicallyExpand(p,r),p) + qr : QR := divide(r, p) + qr.quotient = 0$R => qr.remainder :: SUPR + (qr.remainder :: SUPR) + monomial(1$R,1$NonNegativeInteger)$SUPR * + padicallyExpand(p,qr.quotient) + + a = b == + a.whole ^= b.whole => false -- must verify this + (null a.fract) => + null b.fract => a.whole = b.whole + false + null b.fract => false + -- oh, no! following is temporary + (a :: Fraction R) = (b :: Fraction R) + + - a == + s: fTerm + l: LfTerm := nil + for s in reverse a.fract repeat l := cons([- s.num,s.den]$fTerm,l) + [- a.whole,l] + + r * a == + r = 0$R => 0$% + r = 1$R => a + b : % := (r * a.whole) :: % + c : % + s : fTerm + for s in reverse a.fract repeat + c := normalizeFracTerm [r * s.num, s.den]$fTerm + b.whole := b.whole + c.whole + not (null c.fract) => b.fract := append(c.fract, b.fract) + b + + n * a == (n :: R) * a + + a + b == + compactFraction + [a.whole + b.whole, + sort(LessThan,append(a.fract,copy b.fract))]$% + + a * b == + null a.fract => a.whole * b + null b.fract => b.whole * a + af : % := [0$R, a.fract]$% -- a - a.whole + c: % := (a.whole * b) + (b.whole * af) + s,t : fTerm + for s in a.fract repeat + for t in b.fract repeat + c := c + multiplyFracTerms(s,t) + c + + coerce(a): Ex == + null a.fract => a.whole :: Ex + s : fTerm + l : List Ex + if a.whole = 0 then l := nil else l := [a.whole :: Ex] + for s in a.fract repeat + s.den = 1$FRR => l := cons(s.num :: Ex, l) + l := cons(s.num :: Ex / s.den :: Ex, l) + # l = 1 => first l + reduce("+", reverse l) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PRTITION Partition} +\pagehead{Partition}{PRTITION} +\pagepic{ps/v103partition.ps}{PRTITION}{1.00} +See also:\\ +\refto{SymmetricPolynomial}{SYMPOLY} +<>= +)abbrev domain PRTITION Partition +++ Domain for partitions of positive integers +++ Author: William H. Burge +++ Date Created: 29 October 1987 +++ Date Last Updated: 23 Sept 1991 +++ Keywords: +++ Examples: +++ References: +Partition: Exports == Implementation where + ++ Partition is an OrderedCancellationAbelianMonoid which is used + ++ as the basis for symmetric polynomial representation of the + ++ sums of powers in SymmetricPolynomial. Thus, \spad{(5 2 2 1)} will + ++ represent \spad{s5 * s2**2 * s1}. + L ==> List + I ==> Integer + OUT ==> OutputForm + NNI ==> NonNegativeInteger + UN ==> Union(%,"failed") + + Exports ==> Join(OrderedCancellationAbelianMonoid, + ConvertibleTo List Integer) with + partition: L I -> % + ++ partition(li) converts a list of integers li to a partition + powers: L I -> L L I + ++ powers(li) returns a list of 2-element lists. For each 2-element + ++ list, the first element is an entry of li and the second + ++ element is the multiplicity with which the first element + ++ occurs in li. There is a 2-element list for each value + ++ occurring in l. + pdct: % -> I + ++ \spad{pdct(a1**n1 a2**n2 ...)} returns + ++ \spad{n1! * a1**n1 * n2! * a2**n2 * ...}. + ++ This function is used in the package \spadtype{CycleIndicators}. + conjugate: % -> % + ++ conjugate(p) returns the conjugate partition of a partition p + coerce:% -> List Integer + ++ coerce(p) coerces a partition into a list of integers + + Implementation ==> add + + import PartitionsAndPermutations + + Rep := List Integer + 0 == nil() + + coerce (s:%) == s pretend List Integer + convert x == copy(x pretend L I) + + partition list == sort(#2 < #1,list) + + x < y == + empty? x => not empty? y + empty? y => false + first x = first y => rest x < rest y + first x < first y + + x = y == + EQUAL(x,y)$Lisp +-- empty? x => empty? y +-- empty? y => false +-- first x = first y => rest x = rest y +-- false + + x + y == + empty? x => y + empty? y => x + first x > first y => concat(first x,rest(x) + y) + concat(first y,x + rest(y)) + n:NNI * x:% == (zero? n => 0; x + (subtractIfCan(n,1) :: NNI) * x) + + dp: (I,%) -> % + dp(i,x) == + empty? x => 0 + first x = i => rest x + concat(first x,dp(i,rest x)) + + remv: (I,%) -> UN + remv(i,x) == (member?(i,x) => dp(i,x); "failed") + + subtractIfCan(x, y) == + empty? x => + empty? y => 0 + "failed" + empty? y => x + (aa := remv(first y,x)) case "failed" => "failed" + subtractIfCan((aa :: %), rest y) + + li1 : L I --!! 'bite' won't compile without this + bite: (I,L I) -> L I + bite(i,li) == + empty? li => concat(0,nil()) + first li = i => + li1 := bite(i,rest li) + concat(first(li1) + 1,rest li1) + concat(0,li) + + li : L I --!! 'powers' won't compile without this + powers l == + empty? l => nil() + li := bite(first l,rest l) + concat([first l,first(li) + 1],powers(rest li)) + + conjugate x == conjugate(x pretend Rep)$PartitionsAndPermutations + + mkterm: (I,I) -> OUT + mkterm(i1,i2) == + i2 = 1 => (i1 :: OUT) ** (" " :: OUT) + (i1 :: OUT) ** (i2 :: OUT) + + mkexp1: L L I -> L OUT + mkexp1 lli == + empty? lli => nil() + li := first lli + empty?(rest lli) and second(li) = 1 => + concat(first(li) :: OUT,nil()) + concat(mkterm(first li,second li),mkexp1(rest lli)) + + coerce(x:%):OUT == + empty? (x pretend Rep) => coerce(x pretend Rep)$Rep + paren(reduce("*",mkexp1(powers(x pretend Rep)))) + + pdct x == + */[factorial(second a) * (first(a) ** (second(a) pretend NNI)) + for a in powers(x pretend Rep)] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PATTERN Pattern} +<>= +"RETRACT" -> "CATEGORY" +"RetractableTo(a:Type)" -> "Category" +"RetractableTo(SetCategory)" -> "RetractableTo(a:Type)" +"RetractableTo(Symbol)" -> "RetractableTo(a:Type)" +@ +\pagehead{Pattern}{PATTERN} +\pagepic{ps/v103pattern.ps}{PATTERN}{1.00} +<>= +)abbrev domain PATTERN Pattern +++ Patterns for use by the pattern matcher +++ Author: Manuel Bronstein +++ Date Created: 10 Nov 1988 +++ Date Last Updated: 20 June 1991 +++ Description: Patterns for use by the pattern matcher. +++ Keywords: pattern, matching. +-- Not exposed. +-- Patterns are optimized for quick answers to structural questions. +Pattern(R:SetCategory): Exports == Implementation where + B ==> Boolean + SI ==> SingleInteger + Z ==> Integer + SY ==> Symbol + O ==> OutputForm + BOP ==> BasicOperator + QOT ==> Record(num:%, den:%) + REC ==> Record(val:%, exponent:NonNegativeInteger) + RSY ==> Record(tag:SI, val: SY, pred:List Any, bad:List Any) + KER ==> Record(tag:SI, op:BOP, arg:List %) + PAT ==> Union(ret:R, ker: KER, exp:REC, qot: QOT, sym:RSY) + +-- the following MUST be the name of the formal exponentiation operator + POWER ==> "%power"::Symbol + +-- the 4 SYM_ constants must be disting powers of 2 (bitwise arithmetic) + SYM_GENERIC ==> 1::SI + SYM_MULTIPLE ==> 2::SI + SYM_OPTIONAL ==> 4::SI + + PAT_PLUS ==> 1::SI + PAT_TIMES ==> 2::SI + PAT_LIST ==> 3::SI + PAT_ZERO ==> 4::SI + PAT_ONE ==> 5::SI + PAT_EXPT ==> 6::SI + + Exports ==> Join(SetCategory, RetractableTo R, RetractableTo SY) with + 0 : constant -> % ++ 0 + 1 : constant -> % ++ 1 + isPlus : % -> Union(List %, "failed") + ++ isPlus(p) returns \spad{[a1,...,an]} if \spad{n > 1} + ++ and \spad{p = a1 + ... + an}, + ++ and "failed" otherwise. + isTimes : % -> Union(List %, "failed") + ++ isTimes(p) returns \spad{[a1,...,an]} if \spad{n > 1} and + ++ \spad{p = a1 * ... * an}, and + ++ "failed" otherwise. + isOp : (%, BOP) -> Union(List %, "failed") + ++ isOp(p, op) returns \spad{[a1,...,an]} if \spad{p = op(a1,...,an)}, and + ++ "failed" otherwise. + isOp : % -> Union(Record(op:BOP, arg:List %), "failed") + ++ isOp(p) returns \spad{[op, [a1,...,an]]} if + ++ \spad{p = op(a1,...,an)}, and + ++ "failed" otherwise; + isExpt : % -> Union(REC, "failed") + ++ isExpt(p) returns \spad{[q, n]} if \spad{n > 0} and \spad{p = q ** n}, + ++ and "failed" otherwise. + isQuotient : % -> Union(QOT, "failed") + ++ isQuotient(p) returns \spad{[a, b]} if \spad{p = a / b}, and + ++ "failed" otherwise. + isList : % -> Union(List %, "failed") + ++ isList(p) returns \spad{[a1,...,an]} if \spad{p = [a1,...,an]}, + ++ "failed" otherwise; + isPower : % -> Union(Record(val:%, exponent:%), "failed") + ++ isPower(p) returns \spad{[a, b]} if \spad{p = a ** b}, and + ++ "failed" otherwise. + elt : (BOP, List %) -> % + ++ \spad{elt(op, [a1,...,an])} returns \spad{op(a1,...,an)}. + "+" : (%, %) -> % + ++ \spad{a + b} returns the pattern \spad{a + b}. + "*" : (%, %) -> % + ++ \spad{a * b} returns the pattern \spad{a * b}. + "**" : (%, NonNegativeInteger) -> % + ++ \spad{a ** n} returns the pattern \spad{a ** n}. + "**" : (%, %) -> % + ++ \spad{a ** b} returns the pattern \spad{a ** b}. + "/" : (%, %) -> % + ++ \spad{a / b} returns the pattern \spad{a / b}. + depth : % -> NonNegativeInteger + ++ depth(p) returns the nesting level of p. + convert : List % -> % + ++ \spad{convert([a1,...,an])} returns the pattern \spad{[a1,...,an]}. + copy : % -> % + ++ copy(p) returns a recursive copy of p. + inR? : % -> B + ++ inR?(p) tests if p is an atom (i.e. an element of R). + quoted? : % -> B + ++ quoted?(p) tests if p is of the form 's for a symbol s. + symbol? : % -> B + ++ symbol?(p) tests if p is a symbol. + constant? : % -> B + ++ constant?(p) tests if p contains no matching variables. + generic? : % -> B + ++ generic?(p) tests if p is a single matching variable. + multiple? : % -> B + ++ multiple?(p) tests if p is a single matching variable + ++ allowing list matching or multiple term matching in a + ++ sum or product. + optional? : % -> B + ++ optional?(p) tests if p is a single matching variable + ++ which can match an identity. + hasPredicate?: % -> B + ++ hasPredicate?(p) tests if p has predicates attached to it. + predicates : % -> List Any + ++ predicates(p) returns \spad{[p1,...,pn]} such that the predicate + ++ attached to p is p1 and ... and pn. + setPredicates: (%, List Any) -> % + ++ \spad{setPredicates(p, [p1,...,pn])} attaches the predicate + ++ p1 and ... and pn to p. + withPredicates:(%, List Any) -> % + ++ \spad{withPredicates(p, [p1,...,pn])} makes a copy of p and attaches + ++ the predicate p1 and ... and pn to the copy, which is + ++ returned. + patternVariable: (SY, B, B, B) -> % + ++ patternVariable(x, c?, o?, m?) creates a pattern variable x, + ++ which is constant if \spad{c? = true}, optional if \spad{o? = true}, + ++ and multiple if \spad{m? = true}. + setTopPredicate: (%, List SY, Any) -> % + ++ \spad{setTopPredicate(x, [a1,...,an], f)} returns x with + ++ the top-level predicate set to \spad{f(a1,...,an)}. + topPredicate: % -> Record(var:List SY, pred:Any) + ++ topPredicate(x) returns \spad{[[a1,...,an], f]} where the top-level + ++ predicate of x is \spad{f(a1,...,an)}. + ++ Note: n is 0 if x has no top-level + ++ predicate. + hasTopPredicate?: % -> B + ++ hasTopPredicate?(p) tests if p has a top-level predicate. + resetBadValues: % -> % + ++ resetBadValues(p) initializes the list of "bad values" for p + ++ to \spad{[]}. + ++ Note: p is not allowed to match any of its "bad values". + addBadValue: (%, Any) -> % + ++ addBadValue(p, v) adds v to the list of "bad values" for p. + ++ Note: p is not allowed to match any of its "bad values". + getBadValues: % -> List Any + ++ getBadValues(p) returns the list of "bad values" for p. + ++ Note: p is not allowed to match any of its "bad values". + variables: % -> List % + ++ variables(p) returns the list of matching variables + ++ appearing in p. + optpair: List % -> Union(List %, "failed") + ++ optpair(l) returns l has the form \spad{[a, b]} and + ++ a is optional, and + ++ "failed" otherwise; + + Implementation ==> add + Rep := Record(cons?: B, pat:PAT, lev: NonNegativeInteger, + topvar: List SY, toppred: Any) + + dummy:BOP := operator(new()$Symbol) + nopred := coerce(0$Integer)$AnyFunctions1(Integer) + + mkPat : (B, PAT, NonNegativeInteger) -> % + mkrsy : (SY, B, B, B) -> RSY + SYM2O : RSY -> O + PAT2O : PAT -> O + patcopy : PAT -> PAT + bitSet? : (SI , SI) -> B + pateq? : (PAT, PAT) -> B + LPAT2O : ((O, O) -> O, List %) -> O + taggedElt : (SI, List %) -> % + isTaggedOp: (%, SI) -> Union(List %, "failed") + incmax : List % -> NonNegativeInteger + + coerce(r:R):% == mkPat(true, [r], 0) + mkPat(c, p, l) == [c, p, l, empty(), nopred] + hasTopPredicate? x == not empty?(x.topvar) + topPredicate x == [x.topvar, x.toppred] + setTopPredicate(x, l, f) == (x.topvar := l; x.toppred := f; x) + constant? p == p.cons? + depth p == p.lev + inR? p == p.pat case ret + symbol? p == p.pat case sym + isPlus p == isTaggedOp(p, PAT_PLUS) + isTimes p == isTaggedOp(p, PAT_TIMES) + isList p == isTaggedOp(p, PAT_LIST) + isExpt p == (p.pat case exp => p.pat.exp; "failed") + isQuotient p == (p.pat case qot => p.pat.qot; "failed") + hasPredicate? p == not empty? predicates p + quoted? p == symbol? p and zero?(p.pat.sym.tag) + generic? p == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC) + multiple? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE) + optional? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL) + bitSet?(a, b) == And(a, b) ^= 0 + coerce(p:%):O == PAT2O(p.pat) + p1:% ** p2:% == taggedElt(PAT_EXPT, [p1, p2]) + LPAT2O(f, l) == reduce(f, [x::O for x in l])$List(O) + retract(p:%):R == (inR? p => p.pat.ret; error "Not retractable") + convert(l:List %):% == taggedElt(PAT_LIST, l) + retractIfCan(p:%):Union(R,"failed") ==(inR? p => p.pat.ret;"failed") + withPredicates(p, l) == setPredicates(copy p, l) + coerce(sy:SY):% == patternVariable(sy, false, false, false) + copy p == [constant? p, patcopy(p.pat), p.lev, p.topvar, p.toppred] + + -- returns [a, b] if #l = 2 and optional? a, "failed" otherwise + optpair l == + empty? rest rest l => + b := first rest l + optional?(a := first l) => l + optional? b => reverse l + "failed" + "failed" + + incmax l == + 1 + reduce("max", [p.lev for p in l], 0)$List(NonNegativeInteger) + + p1 = p2 == + (p1.cons? = p2.cons?) and (p1.lev = p2.lev) and + (p1.topvar = p2.topvar) and + ((EQ(p1.toppred, p2.toppred)$Lisp) pretend B) and + pateq?(p1.pat, p2.pat) + + isPower p == + (u := isTaggedOp(p, PAT_EXPT)) case "failed" => "failed" + [first(u::List(%)), second(u::List(%))] + + taggedElt(n, l) == + mkPat(every?(constant?, l), [[n, dummy, l]$KER], incmax l) + + elt(o, l) == + is?(o, POWER) and #l = 2 => first(l) ** last(l) + mkPat(every?(constant?, l), [[0, o, l]$KER], incmax l) + + isOp p == + (p.pat case ker) and zero?(p.pat.ker.tag) => + [p.pat.ker.op, p.pat.ker.arg] + "failed" + + isTaggedOp(p,t) == + (p.pat case ker) and (p.pat.ker.tag = t) => p.pat.ker.arg + "failed" + + if R has Monoid then + 1 == 1::R::% + else + 1 == taggedElt(PAT_ONE, empty()) + + if R has AbelianMonoid then + 0 == 0::R::% + else + 0 == taggedElt(PAT_ZERO, empty()) + + p:% ** n:NonNegativeInteger == + p = 0 and n > 0 => 0 + p = 1 or zero? n => 1 +-- one? n => p + (n = 1) => p + mkPat(constant? p, [[p, n]$REC], 1 + (p.lev)) + + p1 / p2 == + p2 = 1 => p1 + mkPat(constant? p1 and constant? p2, [[p1, p2]$QOT], + 1 + max(p1.lev, p2.lev)) + + p1 + p2 == + p1 = 0 => p2 + p2 = 0 => p1 + (u1 := isPlus p1) case List(%) => + (u2 := isPlus p2) case List(%) => + taggedElt(PAT_PLUS, concat(u1::List %, u2::List %)) + taggedElt(PAT_PLUS, concat(u1::List %, p2)) + (u2 := isPlus p2) case List(%) => + taggedElt(PAT_PLUS, concat(p1, u2::List %)) + taggedElt(PAT_PLUS, [p1, p2]) + + p1 * p2 == + p1 = 0 or p2 = 0 => 0 + p1 = 1 => p2 + p2 = 1 => p1 + (u1 := isTimes p1) case List(%) => + (u2 := isTimes p2) case List(%) => + taggedElt(PAT_TIMES, concat(u1::List %, u2::List %)) + taggedElt(PAT_TIMES, concat(u1::List %, p2)) + (u2 := isTimes p2) case List(%) => + taggedElt(PAT_TIMES, concat(p1, u2::List %)) + taggedElt(PAT_TIMES, [p1, p2]) + + isOp(p, o) == + (p.pat case ker) and zero?(p.pat.ker.tag) and (p.pat.ker.op =o) => + p.pat.ker.arg + "failed" + + predicates p == + symbol? p => p.pat.sym.pred + empty() + + setPredicates(p, l) == + generic? p => (p.pat.sym.pred := l; p) + error "Can only attach predicates to generic symbol" + + resetBadValues p == + generic? p => (p.pat.sym.bad := empty()$List(Any); p) + error "Can only attach bad values to generic symbol" + + addBadValue(p, a) == + generic? p => + if not member?(a, p.pat.sym.bad) then + p.pat.sym.bad := concat(a, p.pat.sym.bad) + p + error "Can only attach bad values to generic symbol" + + getBadValues p == + generic? p => p.pat.sym.bad + error "Not a generic symbol" + + SYM2O p == + sy := (p.val)::O + empty?(p.pred) => sy + paren infix(" | "::O, sy, + reduce("and",[sub("f"::O, i::O) for i in 1..#(p.pred)])$List(O)) + + variables p == + constant? p => empty() + generic? p => [p] + q := p.pat + q case ret => empty() + q case exp => variables(q.exp.val) + q case qot => concat_!(variables(q.qot.num), variables(q.qot.den)) + q case ker => concat [variables r for r in q.ker.arg] + empty() + + PAT2O p == + p case ret => (p.ret)::O + p case sym => SYM2O(p.sym) + p case exp => (p.exp.val)::O ** (p.exp.exponent)::O + p case qot => (p.qot.num)::O / (p.qot.den)::O + p.ker.tag = PAT_PLUS => LPAT2O("+", p.ker.arg) + p.ker.tag = PAT_TIMES => LPAT2O("*", p.ker.arg) + p.ker.tag = PAT_LIST => (p.ker.arg)::O + p.ker.tag = PAT_ZERO => 0::Integer::O + p.ker.tag = PAT_ONE => 1::Integer::O + l := [x::O for x in p.ker.arg]$List(O) + (u:=display(p.ker.op)) case "failed" =>prefix(name(p.ker.op)::O,l) + (u::(List O -> O)) l + + patcopy p == + p case ret => [p.ret] + p case sym => + [[p.sym.tag, p.sym.val, copy(p.sym.pred), copy(p.sym.bad)]$RSY] + p case ker=>[[p.ker.tag,p.ker.op,[copy x for x in p.ker.arg]]$KER] + p case qot => [[copy(p.qot.num), copy(p.qot.den)]$QOT] + [[copy(p.exp.val), p.exp.exponent]$REC] + + pateq?(p1, p2) == + p1 case ret => (p2 case ret) and (p1.ret = p2.ret) + p1 case qot => + (p2 case qot) and (p1.qot.num = p2.qot.num) + and (p1.qot.den = p2.qot.den) + p1 case sym => + (p2 case sym) and (p1.sym.val = p2.sym.val) + and {p1.sym.pred} =$Set(Any) {p2.sym.pred} + and {p1.sym.bad} =$Set(Any) {p2.sym.bad} + p1 case ker => + (p2 case ker) and (p1.ker.tag = p2.ker.tag) + and (p1.ker.op = p2.ker.op) and (p1.ker.arg = p2.ker.arg) + (p2 case exp) and (p1.exp.exponent = p2.exp.exponent) + and (p1.exp.val = p2.exp.val) + + retractIfCan(p:%):Union(SY, "failed") == + symbol? p => p.pat.sym.val + "failed" + + mkrsy(t, c?, o?, m?) == + c? => [0, t, empty(), empty()] + mlt := (m? => SYM_MULTIPLE; 0) + opt := (o? => SYM_OPTIONAL; 0) + [Or(Or(SYM_GENERIC, mlt), opt), t, empty(), empty()] + + patternVariable(sy, c?, o?, m?) == + rsy := mkrsy(sy, c?, o?, m?) + mkPat(zero?(rsy.tag), [rsy], 0) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PATLRES PatternMatchListResult} +<>= +"PATLRES" -> "SETCAT" +"PatternMatchListResult(a:SETCAT,b:SETCAT,c:LSAGG(SETCAT))" + -> "SetCategory()" +@ +\pagehead{PatternMatchListResult}{PATLRES} +\pagepic{ps/v103patternmatchlistresult.ps}{PATLRES}{1.00} +See also:\\ +\refto{PatternMatchResult}{PATRES} +<>= +)abbrev domain PATLRES PatternMatchListResult +++ Result returned by the pattern matcher when using lists +++ Author: Manuel Bronstein +++ Date Created: 4 Dec 1989 +++ Date Last Updated: 4 Dec 1989 +++ Description: +++ A PatternMatchListResult is an object internally returned by the +++ pattern matcher when matching on lists. +++ It is either a failed match, or a pair of PatternMatchResult, +++ one for atoms (elements of the list), and one for lists. +++ Keywords: pattern, matching, list. +-- not exported +PatternMatchListResult(R:SetCategory, S:SetCategory, L:ListAggregate S): + SetCategory with + failed? : % -> Boolean + ++ failed?(r) tests if r is a failed match. + failed : () -> % + ++ failed() returns a failed match. + new : () -> % + ++ new() returns a new empty match result. + makeResult: (PatternMatchResult(R,S), PatternMatchResult(R,L)) -> % + ++ makeResult(r1,r2) makes the combined result [r1,r2]. + atoms : % -> PatternMatchResult(R, S) + ++ atoms(r) returns the list of matches that match atoms + ++ (elements of the lists). + lists : % -> PatternMatchResult(R, L) + ++ lists(r) returns the list of matches that match lists. + == add + Rep := Record(a:PatternMatchResult(R, S), l:PatternMatchResult(R, L)) + + new() == [new(), new()] + atoms r == r.a + lists r == r.l + failed() == [failed(), failed()] + failed? r == failed?(atoms r) + x = y == (atoms x = atoms y) and (lists x = lists y) + + makeResult(r1, r2) == + failed? r1 or failed? r2 => failed() + [r1, r2] + + coerce(r:%):OutputForm == + failed? r => atoms(r)::OutputForm + RecordPrint(r, Rep)$Lisp + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PATRES PatternMatchResult} +<>= +"PATRES" -> "SETCAT" +"PatternMatchResult(a:SetCategory, b:SetCategory)" -> "SetCategory()" +@ +\pagehead{PatternMatchResult}{PATRES} +\pagepic{ps/v103patternmatchresult.ps}{PATRES}{1.00} +See also:\\ +\refto{PatternMatchListResult}{PATLRES} +<>= +)abbrev domain PATRES PatternMatchResult +++ Result returned by the pattern matcher +++ Author: Manuel Bronstein +++ Date Created: 28 Nov 1989 +++ Date Last Updated: 5 Jul 1990 +++ Description: +++ A PatternMatchResult is an object internally returned by the +++ pattern matcher; It is either a failed match, or a list of +++ matches of the form (var, expr) meaning that the variable var +++ matches the expression expr. +++ Keywords: pattern, matching. +-- not exported +PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with + failed? : % -> Boolean + ++ failed?(r) tests if r is a failed match. + failed : () -> % + ++ failed() returns a failed match. + new : () -> % + ++ new() returns a new empty match result. + union : (%, %) -> % + ++ union(a, b) makes the set-union of two match results. + getMatch : (Pattern R, %) -> Union(S, "failed") + ++ getMatch(var, r) returns the expression that var matches + ++ in the result r, and "failed" if var is not matched in r. + addMatch : (Pattern R, S, %) -> % + ++ addMatch(var, expr, r) adds the match (var, expr) in r, + ++ provided that expr satisfies the predicates attached to var, + ++ and that var is not matched to another expression already. + insertMatch : (Pattern R, S, %) -> % + ++ insertMatch(var, expr, r) adds the match (var, expr) in r, + ++ without checking predicates or previous matches for var. + addMatchRestricted: (Pattern R, S, %, S) -> % + ++ addMatchRestricted(var, expr, r, val) adds the match + ++ (var, expr) in r, + ++ provided that expr satisfies the predicates attached to var, + ++ that var is not matched to another expression already, + ++ and that either var is an optional pattern variable or that + ++ expr is not equal to val (usually an identity). + destruct : % -> List Record(key:Symbol, entry:S) + ++ destruct(r) returns the list of matches (var, expr) in r. + ++ Error: if r is a failed match. + construct : List Record(key:Symbol, entry:S) -> % + ++ construct([v1,e1],...,[vn,en]) returns the match result + ++ containing the matches (v1,e1),...,(vn,en). + satisfy? : (%, Pattern R) -> Union(Boolean, "failed") + ++ satisfy?(r, p) returns true if the matches satisfy the + ++ top-level predicate of p, false if they don't, and "failed" + ++ if not enough variables of p are matched in r to decide. + + == add + LR ==> AssociationList(Symbol, S) + + import PatternFunctions1(R, S) + + Rep := Union(LR, "failed") + + new() == empty() + failed() == "failed" + failed? x == x case "failed" + insertMatch(p, x, l) == concat([retract p, x], l::LR) + construct l == construct(l)$LR + destruct l == entries(l::LR)$LR + +-- returns "failed" if not all the variables of the pred. are matched + satisfy?(r, p) == + failed? r => false + lr := r::LR + lv := [if (u := search(v, lr)) case "failed" then return "failed" + else u::S for v in topPredicate(p).var]$List(S) + satisfy?(lv, p) + + union(x, y) == + failed? x or failed? y => failed() + removeDuplicates concat(x::LR, y::LR) + + x = y == + failed? x => failed? y + failed? y => false + x::LR =$LR y::LR + + coerce(x:%):OutputForm == + failed? x => "Does not match"::OutputForm + destruct(x)::OutputForm + + addMatchRestricted(p, x, l, ident) == + (not optional? p) and (x = ident) => failed() + addMatch(p, x, l) + + addMatch(p, x, l) == + failed?(l) or not(satisfy?(x, p)) => failed() + al := l::LR + sy := retract(p)@Symbol + (r := search(sy, al)) case "failed" => insertMatch(p, x, l) + r::S = x => l + failed() + + getMatch(p, l) == + failed? l => "failed" + search(retract(p)@Symbol, l::LR) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PERM Permutation} +\pagehead{Permutation}{PERM} +\pagepic{ps/v103permutation.ps}{PERM}{1.00} +<>= +)abbrev domain PERM Permutation +++ Authors: Johannes Grabmeier, Holger Gollan, Martin Rubey +++ Date Created: 19 May 1989 +++ Date Last Updated: 2 June 2006 +++ Basic Operations: _*, degree, movedPoints, cyclePartition, order, +++ numberOfCycles, sign, even?, odd? +++ Related Constructors: PermutationGroup, PermutationGroupExamples +++ Also See: RepresentationTheoryPackage1 +++ AMS Classifications: +++ Keywords: +++ Reference: G. James/A. Kerber: The Representation Theory of the Symmetric +++ Group. Encycl. of Math. and its Appl., Vol. 16., Cambridge +++ Description: Permutation(S) implements the group of all bijections +++ on a set S, which move only a finite number of points. +++ A permutation is considered as a map from S into S. In particular +++ multiplication is defined as composition of maps: +++ {\em pi1 * pi2 = pi1 o pi2}. +++ The internal representation of permuatations are two lists +++ of equal length representing preimages and images. + +Permutation(S:SetCategory): public == private where + + B ==> Boolean + PI ==> PositiveInteger + I ==> Integer + L ==> List + NNI ==> NonNegativeInteger + V ==> Vector + PT ==> Partition + OUTFORM ==> OutputForm + RECCYPE ==> Record(cycl: L L S, permut: %) + RECPRIM ==> Record(preimage: L S, image : L S) + + public ==> PermutationCategory S with + + listRepresentation: % -> RECPRIM + ++ listRepresentation(p) produces a representation {\em rep} of + ++ the permutation p as a list of preimages and images, i.e + ++ p maps {\em (rep.preimage).k} to {\em (rep.image).k} for all + ++ indices k. Elements of \spad{S} not in {\em (rep.preimage).k} + ++ are fixed points, and these are the only fixed points of the + ++ permutation. + coercePreimagesImages : List List S -> % + ++ coercePreimagesImages(lls) coerces the representation {\em lls} + ++ of a permutation as a list of preimages and images to a permutation. + ++ We assume that both preimage and image do not contain repetitions. + coerce : List List S -> % + ++ coerce(lls) coerces a list of cycles {\em lls} to a + ++ permutation, each cycle being a list with no + ++ repetitions, is coerced to the permutation, which maps + ++ {\em ls.i} to {\em ls.i+1}, indices modulo the length of the list, + ++ then these permutations are mutiplied. + ++ Error: if repetitions occur in one cycle. + coerce : List S -> % + ++ coerce(ls) coerces a cycle {\em ls}, i.e. a list with not + ++ repetitions to a permutation, which maps {\em ls.i} to + ++ {\em ls.i+1}, indices modulo the length of the list. + ++ Error: if repetitions occur. + coerceListOfPairs : List List S -> % + ++ coerceListOfPairs(lls) coerces a list of pairs {\em lls} to a + ++ permutation. + ++ Error: if not consistent, i.e. the set of the first elements + ++ coincides with the set of second elements. + --coerce : % -> OUTFORM + ++ coerce(p) generates output of the permutation p with domain + ++ OutputForm. + degree : % -> NonNegativeInteger + ++ degree(p) retuns the number of points moved by the + ++ permutation p. + movedPoints : % -> Set S + ++ movedPoints(p) returns the set of points moved by the permutation p. + cyclePartition : % -> Partition + ++ cyclePartition(p) returns the cycle structure of a permutation + ++ p including cycles of length 1 only if S is finite. + order : % -> NonNegativeInteger + ++ order(p) returns the order of a permutation p as a group element. + numberOfCycles : % -> NonNegativeInteger + ++ numberOfCycles(p) returns the number of non-trivial cycles of + ++ the permutation p. + sign : % -> Integer + ++ sign(p) returns the signum of the permutation p, +1 or -1. + even? : % -> Boolean + ++ even?(p) returns true if and only if p is an even permutation, + ++ i.e. {\em sign(p)} is 1. + odd? : % -> Boolean + ++ odd?(p) returns true if and only if p is an odd permutation + ++ i.e. {\em sign(p)} is {\em -1}. + sort : L % -> L % + ++ sort(lp) sorts a list of permutations {\em lp} according to + ++ cycle structure first according to length of cycles, + ++ second, if S has \spadtype{Finite} or S has + ++ \spadtype{OrderedSet} according to lexicographical order of + ++ entries in cycles of equal length. + if S has Finite then + fixedPoints : % -> Set S + ++ fixedPoints(p) returns the points fixed by the permutation p. + if S has IntegerNumberSystem or S has Finite then + coerceImages : L S -> % + ++ coerceImages(ls) coerces the list {\em ls} to a permutation + ++ whose image is given by {\em ls} and the preimage is fixed + ++ to be {\em [1,...,n]}. + ++ Note: {coerceImages(ls)=coercePreimagesImages([1,...,n],ls)}. + ++ We assume that both preimage and image do not contain repetitions. + + private ==> add + + -- representation of the object: + + Rep := V L S +@ + +We represent a permutation as two lists of equal length representing preimages +and images of moved points. I.e., fixed points do not occur in either of these +lists. This enables us to compute the set of fixed points and the set of moved +points easily. + +Note that this was not respected in versions before [[patch--50]] of this +domain. + +<>= +-- perm.spad.pamphlet Permutation.input +)spool Permutation.output +)set message test on +)set message auto off +)clear all +--S 1 of 8 +p := coercePreimagesImages([[1,2,3],[1,2,3]]) +--R +--R +--R (1) 1 +--R Type: Permutation PositiveInteger +--E 1 + +--S 2 of 8 +movedPoints p -- should return {} +--R +--R +--R (2) {} +--R Type: Set PositiveInteger +--E 2 + +--S 3 of 8 +even? p -- should return true +--R +--R +--R (3) true +--R Type: Boolean +--E 3 + +--S 4 of 8 +p := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4 +--R +--R +--R (4) (1 0 3) +--R Type: Permutation IntegerMod 4 +--E 4 + +--S 5 of 8 +fixedPoints p -- should return {2} +--R +--R +--R (5) {2} +--R Type: Set IntegerMod 4 +--E 5 + +--S 6 of 8 +q := coercePreimagesImages([[0,1,2,3],[1,0]])$PERM ZMOD 4 +--R +--R +--R (6) (1 0) +--R Type: Permutation IntegerMod 4 +--E 6 + +--S 7 of 8 +fixedPoints(p*q) -- should return {2,0} +--R +--R +--R (7) {2,0} +--R Type: Set IntegerMod 4 +--E 7 + +--S 8 of 8 +even?(p*q) -- should return false +--R +--R +--R (8) false +--R Type: Boolean +--E 8 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Permutation Examples +==================================================================== + + p := coercePreimagesImages([[1,2,3],[1,2,3]]) + 1 + Type: Permutation PositiveInteger + + movedPoints p + {} + Type: Set PositiveInteger + + even? p + true + Type: Boolean + + p := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4 + (1 0 3) + Type: Permutation IntegerMod 4 + + fixedPoints p + {2} + Type: Set IntegerMod 4 + + q := coercePreimagesImages([[0,1,2,3],[1,0]])$PERM ZMOD 4 + (1 0) + Type: Permutation IntegerMod 4 + + fixedPoints(p*q) + {2,0} + Type: Set IntegerMod 4 + even?(p*q) + false + Type: Boolean + +See Also: +o )show Permutation +o $AXIOM/doc/src/algebra/perm.spad.dvi + +@ +<>= + -- import of domains and packages + + import OutputForm + import Vector List S + + -- variables + + p,q : % + exp : I + + -- local functions first, signatures: + + smaller? : (S,S) -> B + rotateCycle: L S -> L S + coerceCycle: L L S -> % + smallerCycle?: (L S, L S) -> B + shorterCycle?:(L S, L S) -> B + permord:(RECCYPE,RECCYPE) -> B + coerceToCycle:(%,B) -> L L S + duplicates?: L S -> B + + smaller?(a:S, b:S): B == + S has OrderedSet => a <$S b + S has Finite => lookup a < lookup b + false + + rotateCycle(cyc: L S): L S == + -- smallest element is put in first place + -- doesn't change cycle if underlying set + -- is not ordered or not finite. + min:S := first cyc + minpos:I := 1 -- 1 = minIndex cyc + for i in 2..maxIndex cyc repeat + if smaller?(cyc.i,min) then + min := cyc.i + minpos := i +-- one? minpos => cyc + (minpos = 1) => cyc + concat(last(cyc,((#cyc-minpos+1)::NNI)),first(cyc,(minpos-1)::NNI)) + + coerceCycle(lls : L L S): % == + perm : % := 1 + for lists in reverse lls repeat + perm := cycle lists * perm + perm + + smallerCycle?(cyca: L S, cycb: L S): B == + #cyca ^= #cycb => + #cyca < #cycb + for i in cyca for j in cycb repeat + i ^= j => return smaller?(i, j) + false + + shorterCycle?(cyca: L S, cycb: L S): B == + #cyca < #cycb + + permord(pa: RECCYPE, pb : RECCYPE): B == + for i in pa.cycl for j in pb.cycl repeat + i ^= j => return smallerCycle?(i, j) + #pa.cycl < #pb.cycl + + coerceToCycle(p: %, doSorting?: B): L L S == + preim := p.1 + im := p.2 + cycles := nil()$(L L S) + while not null preim repeat + -- start next cycle + firstEltInCycle: S := first preim + nextCycle : L S := list firstEltInCycle + preim := rest preim + nextEltInCycle := first im + im := rest im + while nextEltInCycle ^= firstEltInCycle repeat + nextCycle := cons(nextEltInCycle, nextCycle) + i := position(nextEltInCycle, preim) + preim := delete(preim,i) + nextEltInCycle := im.i + im := delete(im,i) + nextCycle := reverse nextCycle + -- check on 1-cycles, we don't list these + if not null rest nextCycle then + if doSorting? and (S has OrderedSet or S has Finite) then + -- put smallest element in cycle first: + nextCycle := rotateCycle nextCycle + cycles := cons(nextCycle, cycles) + not doSorting? => cycles + -- sort cycles + S has OrderedSet or S has Finite => + sort(smallerCycle?,cycles)$(L L S) + sort(shorterCycle?,cycles)$(L L S) + + duplicates? (ls : L S ): B == + x := copy ls + while not null x repeat + member? (first x ,rest x) => return true + x := rest x + false + + -- now the exported functions + + listRepresentation p == + s : RECPRIM := [p.1,p.2] + + coercePreimagesImages preImageAndImage == + preImage: List S := [] + image: List S := [] + for i in preImageAndImage.1 + for pi in preImageAndImage.2 repeat + if i ~= pi then + preImage := cons(i, preImage) + image := cons(pi, image) + + [preImage, image] +@ + +This operation transforms a pair of preimages and images into an element of the +domain. Since we assume that fixed points do not occur in the representation, +we have to sort them out here. + +Note that before [[patch--50]] this read +\begin{verbatim} + coercePreimagesImages preImageAndImage == + p : % := [preImageAndImage.1,preImageAndImage.2] +\end{verbatim} +causing bugs when computing [[movedPoints]], [[fixedPoints]], [[even?]], +[[odd?]], etc., as reported in Issue~\#295. + +The other coercion facilities check for fixed points. It also seems that [[*]] +removes fixed points from its result. + +<>= + + movedPoints p == construct p.1 + + degree p == #movedPoints p + + p = q == + #(preimp := p.1) ^= #(preimq := q.1) => false + for i in 1..maxIndex preimp repeat + pos := position(preimp.i, preimq) + pos = 0 => return false + (p.2).i ^= (q.2).pos => return false + true + + orbit(p ,el) == + -- start with a 1-element list: + out : Set S := brace list el + el2 := eval(p, el) + while el2 ^= el repeat + -- be carefull: insert adds one element + -- as side effect to out + insert_!(el2, out) + el2 := eval(p, el2) + out + + cyclePartition p == + partition([#c for c in coerceToCycle(p, false)])$Partition + + order p == + ord: I := lcm removeDuplicates convert cyclePartition p + ord::NNI + + sign(p) == + even? p => 1 + - 1 + + + even?(p) == even?(#(p.1) - numberOfCycles p) + -- see the book of James and Kerber on symmetric groups + -- for this formula. + + odd?(p) == odd?(#(p.1) - numberOfCycles p) + + pa < pb == + pacyc:= coerceToCycle(pa,true) + pbcyc:= coerceToCycle(pb,true) + for i in pacyc for j in pbcyc repeat + i ^= j => return smallerCycle? ( i, j ) + maxIndex pacyc < maxIndex pbcyc + + coerce(lls : L L S): % == coerceCycle lls + + coerce(ls : L S): % == cycle ls + + sort(inList : L %): L % == + not (S has OrderedSet or S has Finite) => inList + ownList: L RECCYPE := nil()$(L RECCYPE) + for sigma in inList repeat + ownList := + cons([coerceToCycle(sigma,true),sigma]::RECCYPE, ownList) + ownList := sort(permord, ownList)$(L RECCYPE) + outList := nil()$(L %) + for rec in ownList repeat + outList := cons(rec.permut, outList) + reverse outList + + coerce (p: %): OUTFORM == + cycles: L L S := coerceToCycle(p,true) + outfmL : L OUTFORM := nil() + for cycle in cycles repeat + outcycL: L OUTFORM := nil() + for elt in cycle repeat + outcycL := cons(elt :: OUTFORM, outcycL) + outfmL := cons(paren blankSeparate reverse outcycL, outfmL) + -- The identity element will be output as 1: + null outfmL => outputForm(1@Integer) + -- represent a single cycle in the form (a b c d) + -- and not in the form ((a b c d)): + null rest outfmL => first outfmL + hconcat reverse outfmL + + cycles(vs ) == coerceCycle vs + + cycle(ls) == + #ls < 2 => 1 + duplicates? ls => error "cycle: the input contains duplicates" + [ls, append(rest ls, list first ls)] + + coerceListOfPairs(loP) == + preim := nil()$(L S) + im := nil()$(L S) + for pair in loP repeat + if first pair ^= second pair then + preim := cons(first pair, preim) + im := cons(second pair, im) + duplicates?(preim) or duplicates?(im) or brace(preim)$(Set S) _ + ^= brace(im)$(Set S) => + error "coerceListOfPairs: the input cannot be interpreted as a permutation" + [preim, im] + + q * p == + -- use vectors for efficiency?? + preimOfp : V S := construct p.1 + imOfp : V S := construct p.2 + preimOfq := q.1 + imOfq := q.2 + preimOfqp := nil()$(L S) + imOfqp := nil()$(L S) + -- 1 = minIndex preimOfp + for i in 1..(maxIndex preimOfp) repeat + -- find index of image of p.i in q if it exists + j := position(imOfp.i, preimOfq) + if j = 0 then + -- it does not exist + preimOfqp := cons(preimOfp.i, preimOfqp) + imOfqp := cons(imOfp.i, imOfqp) + else + -- it exists + el := imOfq.j + -- if the composition fixes the element, we don't + -- have to do anything + if el ^= preimOfp.i then + preimOfqp := cons(preimOfp.i, preimOfqp) + imOfqp := cons(el, imOfqp) + -- we drop the parts of q which have to do with p + preimOfq := delete(preimOfq, j) + imOfq := delete(imOfq, j) + [append(preimOfqp, preimOfq), append(imOfqp, imOfq)] + + 1 == new(2,empty())$Rep + + inv p == [p.2, p.1] + + eval(p, el) == + pos := position(el, p.1) + pos = 0 => el + (p.2).pos + + elt(p, el) == eval(p, el) + + numberOfCycles p == #coerceToCycle(p, false) + + + if S has IntegerNumberSystem then + + coerceImages (image) == + preImage : L S := [i::S for i in 1..maxIndex image] + coercePreimagesImages [preImage,image] +@ + +Up to [[patch--50]] we did not check for duplicates. + +<>= + if S has Finite then + + coerceImages (image) == + preImage : L S := [index(i::PI)::S for i in 1..maxIndex image] + coercePreimagesImages [preImage,image] +@ + +Up to [[patch--50]] we did not check for duplicates. + +<>= + fixedPoints ( p ) == complement movedPoints p + + cyclePartition p == + pt := partition([#c for c in coerceToCycle(p, false)])$Partition + pt +$PT conjugate(partition([#fixedPoints(p)])$PT)$PT + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PERMGRP PermutationGroup} +\pagehead{PermutationGroup}{PERMGRP} +\pagepic{ps/v103permutationgroup.ps}{PERMGRP}{1.00} +<>= +)abbrev domain PERMGRP PermutationGroup +++ Authors: G. Schneider, H. Gollan, J. Grabmeier +++ Date Created: 13 February 1987 +++ Date Last Updated: 24 May 1991 +++ Basic Operations: +++ Related Constructors: PermutationGroupExamples, Permutation +++ Also See: RepresentationTheoryPackage1 +++ AMS Classifications: +++ Keywords: permutation, permutation group, group operation, word problem +++ References: +++ C. Sims: Determining the conjugacy classes of a permutation group, +++ in Computers in Algebra and Number Theory, SIAM-AMS Proc., Vol. 4, +++ Amer. Math. Soc., Providence, R. I., 1971, pp. 191-195 +++ Description: +++ PermutationGroup implements permutation groups acting +++ on a set S, i.e. all subgroups of the symmetric group of S, +++ represented as a list of permutations (generators). Note that +++ therefore the objects are not members of the \Language category +++ \spadtype{Group}. +++ Using the idea of base and strong generators by Sims, +++ basic routines and algorithms +++ are implemented so that the word problem for +++ permutation groups can be solved. +--++ Note: we plan to implement lattice operations on the subgroup +--++ lattice in a later release + +PermutationGroup(S:SetCategory): public == private where + + L ==> List + PERM ==> Permutation + FSET ==> Set + I ==> Integer + NNI ==> NonNegativeInteger + V ==> Vector + B ==> Boolean + OUT ==> OutputForm + SYM ==> Symbol + REC ==> Record ( orb : L NNI , svc : V I ) + REC2 ==> Record(order:NNI,sgset:L V NNI,_ + gpbase:L NNI,orbs:L REC,mp:L S,wd:L L NNI) + REC3 ==> Record(elt:V NNI,lst:L NNI) + REC4 ==> Record(bool:B,lst:L NNI) + + public ==> SetCategory with + + coerce : % -> L PERM S + ++ coerce(gp) returns the generators of the group {\em gp}. + generators : % -> L PERM S + ++ generators(gp) returns the generators of the group {\em gp}. + elt : (%,NNI) -> PERM S + ++ elt(gp,i) returns the i-th generator of the group {\em gp}. + random : (%,I) -> PERM S + ++ random(gp,i) returns a random product of maximal i generators + ++ of the group {\em gp}. + random : % -> PERM S + ++ random(gp) returns a random product of maximal 20 generators + ++ of the group {\em gp}. + ++ Note: {\em random(gp)=random(gp,20)}. + order : % -> NNI + ++ order(gp) returns the order of the group {\em gp}. + degree : % -> NNI + ++ degree(gp) returns the number of points moved by all permutations + ++ of the group {\em gp}. + base : % -> L S + ++ base(gp) returns a base for the group {\em gp}. + strongGenerators : % -> L PERM S + ++ strongGenerators(gp) returns strong generators for + ++ the group {\em gp}. + wordsForStrongGenerators : % -> L L NNI + ++ wordsForStrongGenerators(gp) returns the words for the strong + ++ generators of the group {\em gp} in the original generators of + ++ {\em gp}, represented by their indices in the list, given by + ++ {\em generators}. + coerce : L PERM S -> % + ++ coerce(ls) coerces a list of permutations {\em ls} to the group + ++ generated by this list. + permutationGroup : L PERM S -> % + ++ permutationGroup(ls) coerces a list of permutations {\em ls} to + ++ the group generated by this list. + orbit : (%,S) -> FSET S + ++ orbit(gp,el) returns the orbit of the element {\em el} under the + ++ group {\em gp}, i.e. the set of all points gained by applying + ++ each group element to {\em el}. + orbits : % -> FSET FSET S + ++ orbits(gp) returns the orbits of the group {\em gp}, i.e. + ++ it partitions the (finite) of all moved points. + orbit : (%,FSET S)-> FSET FSET S + ++ orbit(gp,els) returns the orbit of the unordered + ++ set {\em els} under the group {\em gp}. + orbit : (%,L S) -> FSET L S + ++ orbit(gp,ls) returns the orbit of the ordered + ++ list {\em ls} under the group {\em gp}. + ++ Note: return type is L L S temporarily because FSET L S has an error. + -- (GILT DAS NOCH?) + member? : (PERM S, %)-> B + ++ member?(pp,gp) answers the question, whether the + ++ permutation {\em pp} is in the group {\em gp} or not. + wordInStrongGenerators : (PERM S, %)-> L NNI + ++ wordInStrongGenerators(p,gp) returns the word for the + ++ permutation p in the strong generators of the group {\em gp}, + ++ represented by the indices of the list, given by {\em strongGenerators}. + wordInGenerators : (PERM S, %)-> L NNI + ++ wordInGenerators(p,gp) returns the word for the permutation p + ++ in the original generators of the group {\em gp}, + ++ represented by the indices of the list, given by {\em generators}. + movedPoints : % -> FSET S + ++ movedPoints(gp) returns the points moved by the group {\em gp}. + "<" : (%,%) -> B + ++ gp1 < gp2 returns true if and only if {\em gp1} + ++ is a proper subgroup of {\em gp2}. + "<=" : (%,%) -> B + ++ gp1 <= gp2 returns true if and only if {\em gp1} + ++ is a subgroup of {\em gp2}. + ++ Note: because of a bug in the parser you have to call this + ++ function explicitly by {\em gp1 <=$(PERMGRP S) gp2}. + -- (GILT DAS NOCH?) + initializeGroupForWordProblem : % -> Void + ++ initializeGroupForWordProblem(gp) initializes the group {\em gp} + ++ for the word problem. + ++ Notes: it calls the other function of this name with parameters + ++ 0 and 1: {\em initializeGroupForWordProblem(gp,0,1)}. + ++ Notes: (1) be careful: invoking this routine will destroy the + ++ possibly information about your group (but will recompute it again) + ++ (2) users need not call this function normally for the soultion of + ++ the word problem. + initializeGroupForWordProblem :(%,I,I) -> Void + ++ initializeGroupForWordProblem(gp,m,n) initializes the group + ++ {\em gp} for the word problem. + ++ Notes: (1) with a small integer you get shorter words, but the + ++ routine takes longer than the standard routine for longer words. + ++ (2) be careful: invoking this routine will destroy the possibly stored + ++ information about your group (but will recompute it again). + ++ (3) users need not call this function normally for the soultion of + ++ the word problem. + + private ==> add + + -- representation of the object: + + Rep := Record ( gens : L PERM S , information : REC2 ) + + -- import of domains and packages + + import Permutation S + import OutputForm + import Symbol + import Void + + --first the local variables + + sgs : L V NNI := [] + baseOfGroup : L NNI := [] + sizeOfGroup : NNI := 1 + degree : NNI := 0 + gporb : L REC := [] + out : L L V NNI := [] + outword : L L L NNI := [] + wordlist : L L NNI := [] + basePoint : NNI := 0 + newBasePoint : B := true + supp : L S := [] + ord : NNI := 1 + wordProblem : B := true + + --local functions first, signatures: + + shortenWord:(L NNI, %)->L NNI + times:(V NNI, V NNI)->V NNI + strip:(V NNI,REC,L V NNI,L L NNI)->REC3 + orbitInternal:(%,L S )->L L S + inv: V NNI->V NNI + ranelt:(L V NNI,L L NNI, I)->REC3 + testIdentity:V NNI->B + pointList: %->L S + orbitWithSvc:(L V NNI ,NNI )->REC + cosetRep:(NNI ,REC ,L V NNI )->REC3 + bsgs1:(L V NNI,NNI,L L NNI,I,%,I)->NNI + computeOrbits: I->L NNI + reduceGenerators: I->Void + bsgs:(%, I, I)->NNI + initialize: %->FSET PERM S + knownGroup?: %->Void + subgroup:(%, %)->B + memberInternal:(PERM S, %, B)->REC4 + + --local functions first, implementations: + + shortenWord ( lw : L NNI , gp : % ) : L NNI == + -- tries to shorten a word in the generators by removing identities + gpgens : L PERM S := coerce gp + orderList : L NNI := [ order gen for gen in gpgens ] + newlw : L NNI := copy lw + for i in 1.. maxIndex orderList repeat + if orderList.i = 1 then + while member?(i,newlw) repeat + -- removing the trivial element + pos := position(i,newlw) + newlw := delete(newlw,pos) + flag : B := true + while flag repeat + actualLength : NNI := (maxIndex newlw) pretend NNI + pointer := actualLength + test := newlw.pointer + anzahl : NNI := 1 + flag := false + while pointer > 1 repeat + pointer := ( pointer - 1 )::NNI + if newlw.pointer ^= test then + -- don't get a trivial element, try next + test := newlw.pointer + anzahl := 1 + else + anzahl := anzahl + 1 + if anzahl = orderList.test then + -- we have an identity, so remove it + for i in (pointer+anzahl)..actualLength repeat + newlw.(i-anzahl) := newlw.i + newlw := first(newlw, (actualLength - anzahl) :: NNI) + flag := true + pointer := 1 + newlw + + times ( p : V NNI , q : V NNI ) : V NNI == + -- internal multiplication of permutations + [ qelt(p,qelt(q,i)) for i in 1..degree ] + + strip(element:V NNI,orbit:REC,group:L V NNI,words:L L NNI) : REC3 == + -- strip an element into the stabilizer + actelt := element + schreierVector := orbit.svc + point := orbit.orb.1 + outlist := nil()$(L NNI) + entryLessZero : B := false + while ^entryLessZero repeat + entry := schreierVector.(actelt.point) + entryLessZero := (entry < 0) + if ^entryLessZero then + actelt := times(group.entry, actelt) + if wordProblem then outlist := append ( words.(entry::NNI) , outlist ) + [ actelt , reverse outlist ] + + orbitInternal ( gp : % , startList : L S ) : L L S == + orbitList : L L S := [ startList ] + pos : I := 1 + while not zero? pos repeat + gpset : L PERM S := gp.gens + for gen in gpset repeat + newList := nil()$(L S) + workList := orbitList.pos + for j in #workList..1 by -1 repeat + newList := cons ( eval ( gen , workList.j ) , newList ) + if ^member?( newList , orbitList ) then + orbitList := cons ( newList , orbitList ) + pos := pos + 1 + pos := pos - 1 + reverse orbitList + + inv ( p : V NNI ) : V NNI == + -- internal inverse of a permutation + q : V NNI := new(degree,0)$(V NNI) + for i in 1..degree repeat q.(qelt(p,i)) := i + q + + ranelt ( group : L V NNI , word : L L NNI , maxLoops : I ) : REC3 == + -- generate a "random" element + numberOfGenerators := # group + randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) + randomElement : V NNI := group.randomInteger + words := nil()$(L NNI) + if wordProblem then words := word.(randomInteger::NNI) + if maxLoops > 0 then + numberOfLoops : I := 1 + (random()$Integer rem maxLoops) + else + numberOfLoops : I := maxLoops + while numberOfLoops > 0 repeat + randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) + randomElement := times ( group.randomInteger , randomElement ) + if wordProblem then words := append ( word.(randomInteger::NNI) , words) + numberOfLoops := numberOfLoops - 1 + [ randomElement , words ] + + testIdentity ( p : V NNI ) : B == + -- internal test for identity + for i in 1..degree repeat qelt(p,i) ^= i => return false + true + + pointList(group : %) : L S == + support : FSET S := brace() -- empty set !! + for perm in group.gens repeat + support := union(support, movedPoints perm) + parts support + + orbitWithSvc ( group : L V NNI , point : NNI ) : REC == + -- compute orbit with Schreier vector, "-2" means not in the orbit, + -- "-1" means starting point, the PI correspond to generators + newGroup := nil()$(L V NNI) + for el in group repeat + newGroup := cons ( inv el , newGroup ) + newGroup := reverse newGroup + orbit : L NNI := [ point ] + schreierVector : V I := new ( degree , -2 ) + schreierVector.point := -1 + position : I := 1 + while not zero? position repeat + for i in 1..#newGroup repeat + newPoint := orbit.position + newPoint := newGroup.i.newPoint + if ^ member? ( newPoint , orbit ) then + orbit := cons ( newPoint , orbit ) + position := position + 1 + schreierVector.newPoint := i + position := position - 1 + [ reverse orbit , schreierVector ] + + cosetRep ( point : NNI , o : REC , group : L V NNI ) : REC3 == + ppt := point + xelt : V NNI := [ n for n in 1..degree ] + word := nil()$(L NNI) + oorb := o.orb + osvc := o.svc + while degree > 0 repeat + p := osvc.ppt + p < 0 => return [ xelt , word ] + x := group.p + xelt := times ( x , xelt ) + if wordProblem then word := append ( wordlist.p , word ) + ppt := x.ppt + + bsgs1 (group:L V NNI,number1:NNI,words:L L NNI,maxLoops:I,gp:%,diff:I)_ + : NNI == + -- try to get a good approximation for the strong generators and base + for i in number1..degree repeat + ort := orbitWithSvc ( group , i ) + k := ort.orb + k1 := # k + if k1 ^= 1 then leave + gpsgs := nil()$(L V NNI) + words2 := nil()$(L L NNI) + gplength : NNI := #group + for jj in 1..gplength repeat if (group.jj).i ^= i then leave + for k in 1..gplength repeat + el2 := group.k + if el2.i ^= i then + gpsgs := cons ( el2 , gpsgs ) + if wordProblem then words2 := cons ( words.k , words2 ) + else + gpsgs := cons ( times ( group.jj , el2 ) , gpsgs ) + if wordProblem _ + then words2 := cons ( append ( words.jj , words.k ) , words2 ) + group2 := nil()$(L V NNI) + words3 := nil()$(L L NNI) + j : I := 15 + while j > 0 repeat + -- find generators for the stabilizer + ran := ranelt ( group , words , maxLoops ) + str := strip ( ran.elt , ort , group , words ) + el2 := str.elt + if ^ testIdentity el2 then + if ^ member?(el2,group2) then + group2 := cons ( el2 , group2 ) + if wordProblem then + help : L NNI := append ( reverse str.lst , ran.lst ) + help := shortenWord ( help , gp ) + words3 := cons ( help , words3 ) + j := j - 2 + j := j - 1 + -- this is for word length control + if wordProblem then maxLoops := maxLoops - diff + if ( null group2 ) or ( maxLoops < 0 ) then + sizeOfGroup := k1 + baseOfGroup := [ i ] + out := [ gpsgs ] + outword := [ words2 ] + return sizeOfGroup + k2 := bsgs1 ( group2 , i + 1 , words3 , maxLoops , gp , diff ) + sizeOfGroup := k1 * k2 + out := append ( out , [ gpsgs ] ) + outword := append ( outword , [ words2 ] ) + baseOfGroup := cons ( i , baseOfGroup ) + sizeOfGroup + + computeOrbits ( kkk : I ) : L NNI == + -- compute the orbits for the stabilizers + sgs := nil() + orbitLength := nil()$(L NNI) + gporb := nil() + for i in 1..#baseOfGroup repeat + sgs := append ( sgs , out.i ) + pt := #baseOfGroup - i + 1 + obs := orbitWithSvc ( sgs , baseOfGroup.pt ) + orbitLength := cons ( #obs.orb , orbitLength ) + gporb := cons ( obs , gporb ) + gporb := reverse gporb + reverse orbitLength + + reduceGenerators ( kkk : I ) : Void == + -- try to reduce number of strong generators + orbitLength := computeOrbits ( kkk ) + sgs := nil() + wordlist := nil() + for i in 1..(kkk-1) repeat + sgs := append ( sgs , out.i ) + if wordProblem then wordlist := append ( wordlist , outword.i ) + removedGenerator := false + baseLength : NNI := #baseOfGroup + for nnn in kkk..(baseLength-1) repeat + sgs := append ( sgs , out.nnn ) + if wordProblem then wordlist := append ( wordlist , outword.nnn ) + pt := baseLength - nnn + 1 + obs := orbitWithSvc ( sgs , baseOfGroup.pt ) + i := 1 + while not ( i > # out.nnn ) repeat + pos := position ( out.nnn.i , sgs ) + sgs2 := delete(sgs, pos) + obs2 := orbitWithSvc ( sgs2 , baseOfGroup.pt ) + if # obs2.orb = orbitLength.nnn then + test := true + for j in (nnn+1)..(baseLength-1) repeat + pt2 := baseLength - j + 1 + sgs2 := append ( sgs2 , out.j ) + obs2 := orbitWithSvc ( sgs2 , baseOfGroup.pt2 ) + if # obs2.orb ^= orbitLength.j then + test := false + leave + if test then + removedGenerator := true + sgs := delete (sgs, pos) + if wordProblem then wordlist := delete(wordlist, pos) + out.nnn := delete (out.nnn, i) + if wordProblem then _ + outword.nnn := delete(outword.nnn, i ) + else + i := i + 1 + else + i := i + 1 + if removedGenerator then orbitLength := computeOrbits ( kkk ) + void() + + + bsgs ( group : % ,maxLoops : I , diff : I ) : NNI == + -- the MOST IMPORTANT part of the package + supp := pointList group + degree := # supp + if degree = 0 then + sizeOfGroup := 1 + sgs := [ [ 0 ] ] + baseOfGroup := nil() + gporb := nil() + return sizeOfGroup + newGroup := nil()$(L V NNI) + gp : L PERM S := group.gens + words := nil()$(L L NNI) + for ggg in 1..#gp repeat + q := new(degree,0)$(V NNI) + for i in 1..degree repeat + newEl := eval ( gp.ggg , supp.i ) + pos2 := position ( newEl , supp ) + q.i := pos2 pretend NNI + newGroup := cons ( q , newGroup ) + if wordProblem then words := cons(list ggg, words) + if maxLoops < 1 then + -- try to get the (approximate) base length + if zero? (# ((group.information).gpbase)) then + wordProblem := false + k := bsgs1 ( newGroup , 1 , words , 20 , group , 0 ) + wordProblem := true + maxLoops := (# baseOfGroup) - 1 + else + maxLoops := (# ((group.information).gpbase)) - 1 + k := bsgs1 ( newGroup , 1 , words , maxLoops , group , diff ) + kkk : I := 1 + newGroup := reverse newGroup + noAnswer : B := true + while noAnswer repeat + reduceGenerators kkk +-- *** Here is former "bsgs2" *** -- + -- test whether we have a base and a strong generating set + sgs := nil() + wordlist := nil() + for i in 1..(kkk-1) repeat + sgs := append ( sgs , out.i ) + if wordProblem then wordlist := append ( wordlist , outword.i ) + noresult : B := true + for i in kkk..#baseOfGroup while noresult repeat + sgs := append ( sgs , out.i ) + if wordProblem then wordlist := append ( wordlist , outword.i ) + gporbi := gporb.i + for pt in gporbi.orb while noresult repeat + ppp := cosetRep ( pt , gporbi , sgs ) + y1 := inv ppp.elt + word3 := ppp.lst + for jjj in 1..#sgs while noresult repeat + word := nil()$(L NNI) + z := times ( sgs.jjj , y1 ) + if wordProblem then word := append ( wordlist.jjj , word ) + ppp := cosetRep ( (sgs.jjj).pt , gporbi , sgs ) + z := times ( ppp.elt , z ) + if wordProblem then word := append ( ppp.lst , word ) + newBasePoint := false + for j in (i-1)..1 by -1 while noresult repeat + s := gporb.j.svc + p := gporb.j.orb.1 + while ( degree > 0 ) and noresult repeat + entry := s.(z.p) + if entry < 0 then + if entry = -1 then leave + basePoint := j::NNI + noresult := false + else + ee := sgs.entry + z := times ( ee , z ) + if wordProblem then word := append ( wordlist.entry , word ) + if noresult then + basePoint := 1 + newBasePoint := true + noresult := testIdentity z + noAnswer := not (testIdentity z) + if noAnswer then + -- we have missed something + word2 := nil()$(L NNI) + if wordProblem then + for wd in word3 repeat + ttt := newGroup.wd + while not (testIdentity ttt) repeat + word2 := cons ( wd , word2 ) + ttt := times ( ttt , newGroup.wd ) + word := append ( word , word2 ) + word := shortenWord ( word , group ) + if newBasePoint then + for i in 1..degree repeat + if z.i ^= i then + baseOfGroup := append ( baseOfGroup , [ i ] ) + leave + out := cons (list z, out ) + if wordProblem then outword := cons (list word , outword ) + else + out.basePoint := cons ( z , out.basePoint ) + if wordProblem then outword.basePoint := cons(word ,outword.basePoint ) + kkk := basePoint + sizeOfGroup := 1 + for j in 1..#baseOfGroup repeat + sizeOfGroup := sizeOfGroup * # gporb.j.orb + sizeOfGroup + + + initialize ( group : % ) : FSET PERM S == + group2 := brace()$(FSET PERM S) + gp : L PERM S := group.gens + for gen in gp repeat + if degree gen > 0 then insert_!(gen, group2) + group2 + + knownGroup? (gp : %) : Void == + -- do we know the group already? + result := gp.information + if result.order = 0 then + wordProblem := false + ord := bsgs ( gp , 20 , 0 ) + result := [ ord , sgs , baseOfGroup , gporb , supp , [] ] + gp.information := result + else + ord := result.order + sgs := result.sgset + baseOfGroup := result.gpbase + gporb := result.orbs + supp := result.mp + wordlist := result.wd + void + + subgroup ( gp1 : % , gp2 : % ) : B == + gpset1 := initialize gp1 + gpset2 := initialize gp2 + empty? difference (gpset1, gpset2) => true + for el in parts gpset1 repeat + not member? (el, gp2) => return false + true + + memberInternal ( p : PERM S , gp : % , flag : B ) : REC4 == + -- internal membership testing + supp := pointList gp + outlist := nil()$(L NNI) + mP : L S := parts movedPoints p + for x in mP repeat + not member? (x, supp) => return [ false , nil()$(L NNI) ] + if flag then + member? ( p , gp.gens ) => return [ true , nil()$(L NNI) ] + knownGroup? gp + else + result := gp.information + if #(result.wd) = 0 then + initializeGroupForWordProblem gp + else + ord := result.order + sgs := result.sgset + baseOfGroup := result.gpbase + gporb := result.orbs + supp := result.mp + wordlist := result.wd + degree := # supp + pp := new(degree,0)$(V NNI) + for i in 1..degree repeat + el := eval ( p , supp.i ) + pos := position ( el , supp ) + pp.i := pos::NNI + words := nil()$(L L NNI) + if wordProblem then + for i in 1..#sgs repeat + lw : L NNI := [ (#sgs - i + 1)::NNI ] + words := cons ( lw , words ) + for i in #baseOfGroup..1 by -1 repeat + str := strip ( pp , gporb.i , sgs , words ) + pp := str.elt + if wordProblem then outlist := append ( outlist , str.lst ) + [ testIdentity pp , reverse outlist ] + + --now the exported functions + + coerce ( gp : % ) : L PERM S == gp.gens + generators ( gp : % ) : L PERM S == gp.gens + + strongGenerators ( group ) == + knownGroup? group + degree := # supp + strongGens := nil()$(L PERM S) + for i in sgs repeat + pairs := nil()$(L L S) + for j in 1..degree repeat + pairs := cons ( [ supp.j , supp.(i.j) ] , pairs ) + strongGens := cons ( coerceListOfPairs pairs , strongGens ) + reverse strongGens + + elt ( gp , i ) == (gp.gens).i + + movedPoints ( gp ) == brace pointList gp + + random ( group , maximalNumberOfFactors ) == + maximalNumberOfFactors < 1 => 1$(PERM S) + gp : L PERM S := group.gens + numberOfGenerators := # gp + randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) + randomElement := gp.randomInteger + numberOfLoops : I := 1 + (random()$Integer rem maximalNumberOfFactors) + while numberOfLoops > 0 repeat + randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) + randomElement := gp.randomInteger * randomElement + numberOfLoops := numberOfLoops - 1 + randomElement + + random ( group ) == random ( group , 20 ) + + order ( group ) == + knownGroup? group + ord + + degree ( group ) == # pointList group + + base ( group ) == + knownGroup? group + groupBase := nil()$(L S) + for i in baseOfGroup repeat + groupBase := cons ( supp.i , groupBase ) + reverse groupBase + + wordsForStrongGenerators ( group ) == + knownGroup? group + wordlist + + coerce ( gp : L PERM S ) : % == + result : REC2 := [ 0 , [] , [] , [] , [] , [] ] + group := [ gp , result ] + + permutationGroup ( gp : L PERM S ) : % == + result : REC2 := [ 0 , [] , [] , [] , [] , [] ] + group := [ gp , result ] + + coerce(group: %) : OUT == + outList := nil()$(L OUT) + gp : L PERM S := group.gens + for i in (maxIndex gp)..1 by -1 repeat + outList := cons(coerce gp.i, outList) + postfix(outputForm(">":SYM),postfix(commaSeparate outList,outputForm("<":SYM))) + + orbit ( gp : % , el : S ) : FSET S == + elList : L S := [ el ] + outList := orbitInternal ( gp , elList ) + outSet := brace()$(FSET S) + for i in 1..#outList repeat + insert_! ( outList.i.1 , outSet ) + outSet + + orbits ( gp ) == + spp := movedPoints gp + orbits := nil()$(L FSET S) + while cardinality spp > 0 repeat + el := extract_! spp + orbitSet := orbit ( gp , el ) + orbits := cons ( orbitSet , orbits ) + spp := difference ( spp , orbitSet ) + brace orbits + + member? (p, gp) == + wordProblem := false + mi := memberInternal ( p , gp , true ) + mi.bool + + wordInStrongGenerators (p, gp ) == + mi := memberInternal ( inv p , gp , false ) + not mi.bool => error "p is not an element of gp" + mi.lst + + wordInGenerators (p, gp) == + lll : L NNI := wordInStrongGenerators (p, gp) + outlist := nil()$(L NNI) + for wd in lll repeat + outlist := append ( outlist , wordlist.wd ) + shortenWord ( outlist , gp ) + + gp1 < gp2 == + not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false + not subgroup ( gp1 , gp2 ) => false + order gp1 = order gp2 => false + true + + gp1 <= gp2 == + not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false + subgroup ( gp1 , gp2 ) + + gp1 = gp2 == + movedPoints gp1 ^= movedPoints gp2 => false + if #(gp1.gens) <= #(gp2.gens) then + not subgroup ( gp1 , gp2 ) => return false + else + not subgroup ( gp2 , gp1 ) => return false + order gp1 = order gp2 => true + false + + orbit ( gp : % , startSet : FSET S ) : FSET FSET S == + startList : L S := parts startSet + outList := orbitInternal ( gp , startList ) + outSet := brace()$(FSET FSET S) + for i in 1..#outList repeat + newSet : FSET S := brace outList.i + insert_! ( newSet , outSet ) + outSet + + orbit ( gp : % , startList : L S ) : FSET L S == + brace orbitInternal(gp, startList) + + initializeGroupForWordProblem ( gp , maxLoops , diff ) == + wordProblem := true + ord := bsgs ( gp , maxLoops , diff ) + gp.information := [ ord , sgs , baseOfGroup , gporb , supp , wordlist ] + void + + initializeGroupForWordProblem ( gp ) == initializeGroupForWordProblem ( gp , 0 , 1 ) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain HACKPI Pi} \pagehead{Pi}{HACKPI} \pagepic{ps/v103pi.ps}{HACKPI}{1.00} @@ -44829,6 +48480,1158 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PLOT Plot} +<>= +-- plot.spad.pamphlet Plot.input +)spool Plot.output +)set message test on +)set message auto off +)clear all +--S 1 of 2 +fp:=(t:DFLOAT):DFLOAT +-> sin(t) +--R +--R (1) theMap(Closure) +--R Type: (DoubleFloat -> DoubleFloat) +--E 1 + +--S 2 of 2 +plot(fp,-1.0..1.0)$PLOT +--R +--R +--R (2) PLOT(x = (- 1.)..1. y = (- 0.8414709848078965)..0.8414709848078965) +--R [- 1.,- 0.8414709848078965] +--R [- 0.95833333333333337,- 0.81823456433427133] +--R [- 0.91666666666666674,- 0.79357780324894212] +--R [- 0.87500000000000011,- 0.76754350223602708] +--R [- 0.83333333333333348,- 0.74017685319603721] +--R [- 0.79166666666666685,- 0.7115253607990657] +--R [- 0.75000000000000022,- 0.68163876002333434] +--R [- 0.70833333333333359,- 0.65056892982223602] +--R [- 0.66666666666666696,- 0.61836980306973721] +--R [- 0.62500000000000033,- 0.58509727294046243] +--R [- 0.5833333333333337,- 0.55080909588697013] +--R [- 0.54166666666666707,- 0.51556479138264011] +--R [- 0.50000000000000044,- 0.47942553860420339] +--R [- 0.45833333333333376,- 0.44245407023325911] +--R [- 0.41666666666666707,- 0.40471456356112506] +--R [- 0.37500000000000039,- 0.3662725290860479] +--R [- 0.3333333333333337,- 0.3271946967961526] +--R [- 0.29166666666666702,- 0.28754890033552849] +--R [- 0.25000000000000033,- 0.24740395925452324] +--R [- 0.20833333333333368,- 0.20682955954864138] +--R [- 0.16666666666666702,- 0.16589613269341538] +--R [- 0.12500000000000036,- 0.12467473338522805] +--R [- 8.3333333333333703E-2,- 8.3236916200310623E-2] +--R [- 4.1666666666667039E-2,- 4.1654611386019461E-2] +--R [- 3.7470027081099033E-16,- 3.7470027081099033E-16] +--R [4.166666666666629E-2,4.1654611386018711E-2] +--R [8.3333333333332954E-2,8.3236916200309874E-2] +--R [0.12499999999999961,0.1246747333852273] +--R [0.16666666666666627,0.16589613269341463] +--R [0.20833333333333293,0.20682955954864066] +--R [0.24999999999999958,0.24740395925452252] +--R [0.29166666666666624,0.28754890033552777] +--R [0.33333333333333293,0.32719469679615187] +--R [0.37499999999999961,0.36627252908604718] +--R [0.4166666666666663,0.4047145635611244] +--R [0.45833333333333298,0.44245407023325839] +--R [0.49999999999999967,0.47942553860420273] +--R [0.5416666666666663,0.51556479138263944] +--R [0.58333333333333293,0.55080909588696947] +--R [0.62499999999999956,0.58509727294046177] +--R [0.66666666666666619,0.61836980306973666] +--R [0.70833333333333282,0.65056892982223535] +--R [0.74999999999999944,0.68163876002333379] +--R [0.79166666666666607,0.71152536079906514] +--R [0.8333333333333327,0.74017685319603665] +--R [0.87499999999999933,0.76754350223602663] +--R [0.91666666666666596,0.79357780324894167] +--R [0.95833333333333259,0.81823456433427078] +--R [1.,0.8414709848078965] +--R Type: Plot +--E 2 +)spool +)lisp (bye) +@ +<>= +========================================================================= +Plot examples +========================================================================= + +The Plot (PLOT) domain supports plotting of functions defined over a +real number system. Plot is limited to 2 dimensional plots. + +The function plot: (F -> F,R) -> % plots the function f(x) on the +interval a..b. So we need to define a function that maps from +DoubleFloat to DoubleFloat: + + fp:=(t:DFLOAT):DFLOAT +-> sin(t) + +and then feed it to the plot function with a Segment DoubleFloat + + plot(fp,-1.0..1.0)$PLOT + +See Also: +o )show Plot +o $AXIOM/doc/src/algebra/plot.spad.dvi + +@ +\pagehead{Plot}{PLOT} +\pagepic{ps/v103plot.ps}{PLOT}{1.00} +<>= +)abbrev domain PLOT Plot +++ Author: Michael Monagan (revised by Clifton J. Williamson) +++ Date Created: Jan 1988 +++ Date Last Updated: 30 Nov 1990 by Jonathan Steinbach +++ Basic Operations: plot, pointPlot, plotPolar, parametric?, zoom, refine, +++ tRange, minPoints, setMinPoints, maxPoints, screenResolution, adaptive?, +++ setAdaptive, numFunEvals, debug +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: plot, function, parametric +++ References: +++ Description: The Plot domain supports plotting of functions defined over a +++ real number system. A real number system is a model for the real +++ numbers and as such may be an approximation. For example +++ floating point numbers and infinite continued fractions. +++ The facilities at this point are limited to 2-dimensional plots +++ or either a single function or a parametric function. +Plot(): Exports == Implementation where + B ==> Boolean + F ==> DoubleFloat + I ==> Integer + L ==> List + N ==> NonNegativeInteger + OUT ==> OutputForm + P ==> Point F + RN ==> Fraction Integer + S ==> String + SEG ==> Segment + R ==> Segment F + C ==> Record(source: F -> P,ranges: L R,knots: L F,points: L P) + + Exports ==> PlottablePlaneCurveCategory with + +--% function plots + + plot: (F -> F,R) -> % + ++ plot(f,a..b) plots the function \spad{f(x)} + ++ on the interval \spad{[a,b]}. + ++ + ++X fp:=(t:DFLOAT):DFLOAT +-> sin(t) + ++X plot(fp,-1.0..1.0)$PLOT + + plot: (F -> F,R,R) -> % + ++ plot(f,a..b,c..d) plots the function \spad{f(x)} on the interval + ++ \spad{[a,b]}; y-range of \spad{[c,d]} is noted in Plot object. + +--% multiple function plots + + plot: (L(F -> F),R) -> % + ++ plot([f1,...,fm],a..b) plots the functions \spad{y = f1(x)},..., + ++ \spad{y = fm(x)} on the interval \spad{a..b}. + plot: (L(F -> F),R,R) -> % + ++ plot([f1,...,fm],a..b,c..d) plots the functions \spad{y = f1(x)},..., + ++ \spad{y = fm(x)} on the interval \spad{a..b}; y-range of \spad{[c,d]} is + ++ noted in Plot object. + +--% parametric plots + + plot: (F -> F,F -> F,R) -> % + ++ plot(f,g,a..b) plots the parametric curve \spad{x = f(t)}, \spad{y = g(t)} + ++ as t ranges over the interval \spad{[a,b]}. + plot: (F -> F,F -> F,R,R,R) -> % + ++ plot(f,g,a..b,c..d,e..f) plots the parametric curve \spad{x = f(t)}, + ++ \spad{y = g(t)} as t ranges over the interval \spad{[a,b]}; x-range + ++ of \spad{[c,d]} and y-range of \spad{[e,f]} are noted in Plot object. + +--% parametric plots + + pointPlot: (F -> P,R) -> % + ++ pointPlot(t +-> (f(t),g(t)),a..b) plots the parametric curve + ++ \spad{x = f(t)}, \spad{y = g(t)} as t ranges over the interval \spad{[a,b]}. + pointPlot: (F -> P,R,R,R) -> % + ++ pointPlot(t +-> (f(t),g(t)),a..b,c..d,e..f) plots the parametric + ++ curve \spad{x = f(t)}, \spad{y = g(t)} as t ranges over the interval \spad{[a,b]}; + ++ x-range of \spad{[c,d]} and y-range of \spad{[e,f]} are noted in Plot object. + +--% polar plots + + plotPolar: (F -> F,R) -> % + ++ plotPolar(f,a..b) plots the polar curve \spad{r = f(theta)} as + ++ theta ranges over the interval \spad{[a,b]}; this is the same as + ++ the parametric curve \spad{x = f(t) * cos(t)}, \spad{y = f(t) * sin(t)}. + + plotPolar: (F -> F) -> % + ++ plotPolar(f) plots the polar curve \spad{r = f(theta)} as theta + ++ ranges over the interval \spad{[0,2*%pi]}; this is the same as + ++ the parametric curve \spad{x = f(t) * cos(t)}, \spad{y = f(t) * sin(t)}. + + plot: (%,R) -> % -- change the range + ++ plot(x,r) \undocumented + parametric?: % -> B + ++ parametric? determines whether it is a parametric plot? + + zoom: (%,R) -> % + ++ zoom(x,r) \undocumented + zoom: (%,R,R) -> % + ++ zoom(x,r,s) \undocumented + refine: (%,R) -> % + ++ refine(x,r) \undocumented + refine: % -> % + ++ refine(p) performs a refinement on the plot p + + tRange: % -> R + ++ tRange(p) returns the range of the parameter in a parametric plot p + + minPoints: () -> I + ++ minPoints() returns the minimum number of points in a plot + setMinPoints: I -> I + ++ setMinPoints(i) sets the minimum number of points in a plot to i + maxPoints: () -> I + ++ maxPoints() returns the maximum number of points in a plot + setMaxPoints: I -> I + ++ setMaxPoints(i) sets the maximum number of points in a plot to i + screenResolution: () -> I + ++ screenResolution() returns the screen resolution + setScreenResolution: I -> I + ++ setScreenResolution(i) sets the screen resolution to i + adaptive?: () -> B + ++ adaptive?() determines whether plotting be done adaptively + setAdaptive: B -> B + ++ setAdaptive(true) turns adaptive plotting on + ++ \spad{setAdaptive(false)} turns adaptive plotting off + numFunEvals: () -> I + ++ numFunEvals() returns the number of points computed + debug: B -> B + ++ debug(true) turns debug mode on + ++ \spad{debug(false)} turns debug mode off + + Implementation ==> add + import PointPackage(DoubleFloat) + +--% local functions + + checkRange : R -> R + -- checks that left-hand endpoint is less than right-hand endpoint + intersect : (R,R) -> R + -- intersection of two intervals + union : (R,R) -> R + -- union of two intervals + join : (L C,I) -> R + parametricRange: % -> R + select : (L P,P -> F,(F,F) -> F) -> F + rangeRefine : (C,R) -> C + adaptivePlot : (C,R,R,R,I) -> C + basicPlot : (F -> P,R) -> C + basicRefine : (C,R) -> C + pt : (F,F) -> P + Fnan? : F -> Boolean + Pnan? : P -> Boolean + +--% representation + + Rep := Record( parametric: B, _ + display: L R, _ + bounds: L R, _ + axisLabels: L S, _ + functions: L C ) + +--% global constants + + ADAPTIVE: B := true + MINPOINTS: I := 49 + MAXPOINTS: I := 1000 + NUMFUNEVALS: I := 0 + SCREENRES: I := 500 + ANGLEBOUND: F := cos inv (4::F) + DEBUG: B := false + + Fnan?(x) == x ~= x + Pnan?(x) == any?(Fnan?,x) + +--% graphics output + + listBranches plot == + outList : L L P := nil() + for curve in plot.functions repeat + -- curve is C + newl:L P:=nil() + for p in curve.points repeat + if not Pnan? p then newl:=cons(p,newl) + else if not empty? newl then + outList := concat(newl:=reverse! newl,outList) + newl:=nil() + if not empty? newl then outList := concat(newl:=reverse! newl,outList) +-- print(outList::OutputForm) + outList + + checkRange r == (lo r > hi r => error "ranges cannot be negative"; r) + intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t)) + union(s,t) == min(lo s,lo t) .. max(hi s,hi t) + join(l,i) == + rr := first l + u : R := + i = 0 => first(rr.ranges) + i = 1 => second(rr.ranges) + third(rr.ranges) + for r in rest l repeat + i = 0 => u := union(u,first(r.ranges)) + i = 1 => u := union(u,second(r.ranges)) + u := union(u,third(r.ranges)) + u + parametricRange r == first(r.bounds) + + minPoints() == MINPOINTS + setMinPoints n == + if n < 3 then error "three points minimum required" + if MAXPOINTS < n then MAXPOINTS := n + MINPOINTS := n + maxPoints() == MAXPOINTS + setMaxPoints n == + if n < 3 then error "three points minimum required" + if MINPOINTS > n then MINPOINTS := n + MAXPOINTS := n + screenResolution() == SCREENRES + setScreenResolution n == + if n < 2 then error "buy a new terminal" + SCREENRES := n + adaptive?() == ADAPTIVE + setAdaptive b == ADAPTIVE := b + parametric? p == p.parametric + + numFunEvals() == NUMFUNEVALS + debug b == DEBUG := b + + xRange plot == second plot.bounds + yRange plot == third plot.bounds + tRange plot == first plot.bounds + + select(l,f,g) == + m := f first l + if Fnan? m then m := 0 + for p in rest l repeat + n := m + m := g(m, f p) + if Fnan? m then m := n + m + + rangeRefine(curve,nRange) == + checkRange nRange; l := lo nRange; h := hi nRange + t := curve.knots; p := curve.points; f := curve.source + while not null t and first t < l repeat + (t := rest t; p := rest p) + c: L F := nil(); q: L P := nil() + while not null t and (first t) <= h repeat + c := concat(first t,c); q := concat(first p,q) + t := rest t; p := rest p + if null c then return basicPlot(f,nRange) + if first c < h then + c := concat(h,c) + q := concat(f h,q) + NUMFUNEVALS := NUMFUNEVALS + 1 + t := c := reverse_! c; p := q := reverse_! q + s := (h-l)/(minPoints()::F-1) + if (first t) ^= l then + t := c := concat(l,c) + p := q := concat(f l,p) + NUMFUNEVALS := NUMFUNEVALS + 1 + while not null rest t repeat + n := wholePart((second(t) - first(t))/s) + d := (second(t) - first(t))/((n+1)::F) + for i in 1..n repeat + t.rest := concat(first(t) + d,rest t) + p.rest := concat(f second t,rest p) + NUMFUNEVALS := NUMFUNEVALS + 1 + t := rest t; p := rest p + t := rest t + p := rest p + xRange := select(q,xCoord,min) .. select(q,xCoord,max) + yRange := select(q,yCoord,min) .. select(q,yCoord,max) + [ f, [nRange,xRange,yRange], c, q] + + adaptivePlot(curve,tRange,xRange,yRange,pixelfraction) == + xDiff := hi xRange - lo xRange + yDiff := hi yRange - lo yRange + xDiff = 0 or yDiff = 0 => curve + l := lo tRange; h := hi tRange + (tDiff := h-l) = 0 => curve +-- if (EQL(yDiff, _$NaNvalue$Lisp)$Lisp) then yDiff := 1::F + t := curve.knots + #t < 3 => curve + p := curve.points; f := curve.source + minLength:F := 4::F/500::F + maxLength:F := 1::F/6::F + tLimit := tDiff/(pixelfraction*500)::F + while not null t and first t < l repeat (t := rest t; p := rest p) + #t < 3 => curve + headert := t; headerp := p + + -- jitter the input points +-- while not null rest rest t repeat +-- t0 := second(t); t1 := third(t) +-- jitter := (random()$I) :: F +-- jitter := sin (jitter) +-- val := t0 + jitter * (t1-t0)/10::F +-- t.2 := val; p.2 := f val +-- t := rest t; p := rest p +-- t := headert; p := headerp + + st := t; sp := p + todot : L L F := nil() + todop : L L P := nil() + while not null rest rest st repeat + todot := concat_!(todot, st) + todop := concat_!(todop, sp) + st := rest st; sp := rest sp + st := headert; sp := headerp + todo1 := todot; todo2 := todop + n : I := 0 + while not null todo1 repeat + st := first(todo1) + t0 := first(st); t1 := second(st); t2 := third(st) + if t2 > h then leave + t2 - t0 < tLimit => + todo1 := rest todo1 + todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + sp := first(todo2) + x0 := xCoord first(sp); y0 := yCoord first(sp) + x1 := xCoord second(sp); y1 := yCoord second(sp) + x2 := xCoord third(sp); y2 := yCoord third(sp) + a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff + a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff + s1 := sqrt(a1**2+b1**2); s2 := sqrt(a2**2+b2**2) + dp := a1*a2+b1*b2 + + s1 < maxLength and s2 < maxLength and _ + (s1 = 0::F or s2 = 0::F or + s1 < minLength and s2 < minLength or _ + dp/s1/s2 > ANGLEBOUND) => + todo1 := rest todo1 + todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + if n > MAXPOINTS then leave else n := n + 1 + st := rest t + if not null rest rest st then + tm := (t0+t1)/2::F + tj := tm + t.rest := concat(tj,rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := rest todo1; todo2 := rest todo2 + + tm := (t1+t2)/2::F + tj := tm + t.rest := concat(tj, rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + todo1 := rest todo1 + todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + else + tm := (t0+t1)/2::F + tj := tm + t.rest := concat(tj,rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + + tm := (t1+t2)/2::F + tj := tm + t.rest := concat(tj, rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + todo1 := rest todo1 + todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + n > 0 => + NUMFUNEVALS := NUMFUNEVALS + n + t := curve.knots; p := curve.points + xRange := select(p,xCoord,min) .. select(p,xCoord,max) + yRange := select(p,yCoord,min) .. select(p,yCoord,max) + [ curve.source, [tRange,xRange,yRange], t, p ] + curve + + basicPlot(f,tRange) == + checkRange tRange + l := lo tRange + h := hi tRange + t : L F := list l + p : L P := list f l + s := (h-l)/(minPoints()-1)::F + for i in 2..minPoints()-1 repeat + l := l+s + t := concat(l,t) + p := concat(f l,p) + t := reverse_! concat(h,t) + p := reverse_! concat(f h,p) +-- print(p::OutputForm) + xRange : R := select(p,xCoord,min) .. select(p,xCoord,max) + yRange : R := select(p,yCoord,min) .. select(p,yCoord,max) + [ f, [tRange,xRange,yRange], t, p ] + + zoom(p,xRange) == + [p.parametric, [xRange,third(p.display)], p.bounds, _ + p.axisLabels, p.functions] + zoom(p,xRange,yRange) == + [p.parametric, [xRange,yRange], p.bounds, _ + p.axisLabels, p.functions] + + basicRefine(curve,nRange) == + tRange:R := first curve.ranges + -- curve := copy$C curve -- Yet another compiler bug + curve: C := [curve.source,curve.ranges,curve.knots,curve.points] + t := curve.knots := copy curve.knots + p := curve.points := copy curve.points + l := lo nRange; h := hi nRange + f := curve.source + while not null rest t and first t < h repeat + second(t) < l => (t := rest t; p := rest p) + -- insert new point between t.0 and t.1 + tm : F := (first(t) + second(t))/2::F +-- if DEBUG then output$O (tm::E) + pm := f tm + NUMFUNEVALS := NUMFUNEVALS + 1 + t.rest := concat(tm,rest t); t := rest rest t + p.rest := concat(pm,rest p); p := rest rest p + t := curve.knots; p := curve.points + xRange := select(p,xCoord,min) .. select(p,xCoord,max) + yRange := select(p,yCoord,min) .. select(p,yCoord,max) + [ curve.source, [tRange,xRange,yRange], t, p ] + + refine p == refine(p,parametricRange p) + refine(p,nRange) == + NUMFUNEVALS := 0 + tRange := parametricRange p + nRange := intersect(tRange,nRange) + curves: L C := [basicRefine(c,nRange) for c in p.functions] + xRange := join(curves,1); yRange := join(curves,2) + if adaptive? then + tlimit := if parametric? p then 8 else 1 + curves := [adaptivePlot(c,nRange,xRange,yRange, _ + tlimit) for c in curves] + xRange := join(curves,1); yRange := join(curves,2) +-- print(NUMFUNEVALS::OUT) + [p.parametric, p.display, [tRange,xRange,yRange], _ + p.axisLabels, curves ] + + plot(p:%,tRange:R) == + -- re plot p on a new range making use of the points already + -- computed if possible + NUMFUNEVALS := 0 + curves: L C := [rangeRefine(c,tRange) for c in p.functions] + xRange := join(curves,1); yRange := join(curves,2) + if adaptive? then + tlimit := if parametric? p then 8 else 1 + curves := [adaptivePlot(c,tRange,xRange,yRange,tlimit) for c in curves] + xRange := join(curves,1); yRange := join(curves,2) +-- print(NUMFUNEVALS::OUT) + [ p.parametric, [xRange,yRange], [tRange,xRange,yRange], + p.axisLabels, curves ] + + pt(xx,yy) == point(l : L F := [xx,yy]) + + myTrap: (F-> F, F) -> F + myTrap(ff:F-> F, f:F):F == + s := trapNumericErrors(ff(f))$Lisp :: Union(F, "failed") + s case "failed" => _$NaNvalue$Lisp + r:F:=s::F + r > max()$F or r < min()$F => _$NaNvalue$Lisp + r + + plot(f:F -> F,xRange:R) == + p := basicPlot(pt(#1,myTrap(f,#1)),xRange) + r := p.ranges + NUMFUNEVALS := minPoints() + if adaptive? then + p := adaptivePlot(p,first r,second r,third r,1) + r := p.ranges + [ false, rest r, r, nil(), [ p ] ] + + plot(f:F -> F,xRange:R,yRange:R) == + p := plot(f,xRange) + p.display := [xRange,checkRange yRange] + p + + plot(f:F -> F,g:F -> F,tRange:R) == + p := basicPlot(pt(myTrap(f,#1),myTrap(g,#1)),tRange) + r := p.ranges + NUMFUNEVALS := minPoints() + if adaptive? then + p := adaptivePlot(p,first r,second r,third r,8) + r := p.ranges + [ true, rest r, r, nil(), [ p ] ] + + plot(f:F -> F,g:F -> F,tRange:R,xRange:R,yRange:R) == + p := plot(f,g,tRange) + p.display := [checkRange xRange,checkRange yRange] + p + + pointPlot(f:F -> P,tRange:R) == + p := basicPlot(f,tRange) + r := p.ranges + NUMFUNEVALS := minPoints() + if adaptive? then + p := adaptivePlot(p,first r,second r,third r,8) + r := p.ranges + [ true, rest r, r, nil(), [ p ] ] + + pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R) == + p := pointPlot(f,tRange) + p.display := [checkRange xRange,checkRange yRange] + p + + plot(l:L(F -> F),xRange:R) == + if null l then error "empty list of functions" + t: L C := [ basicPlot(pt(#1,myTrap(f,#1)),xRange) for f in l ] + yRange := join(t,2) + NUMFUNEVALS := # l * minPoints() + if adaptive? then + t := [adaptivePlot(p,xRange,xRange,yRange,1) _ + for f in l for p in t] + yRange := join(t,2) +-- print(NUMFUNEVALS::OUT) + [false, [xRange,yRange], [xRange,xRange,yRange], nil(), t ] + + plot(l:L(F -> F),xRange:R,yRange:R) == + p := plot(l,xRange) + p.display := [xRange,checkRange yRange] + p + + plotPolar(f,thetaRange) == + plot(f(#1) * cos(#1),f(#1) * sin(#1),thetaRange) + + plotPolar f == plotPolar(f,segment(0,2*pi())) + +--% terminal output + + coerce r == + spaces: OUT := coerce " " + xSymbol := "x = " :: OUT + ySymbol := "y = " :: OUT + tSymbol := "t = " :: OUT + plotSymbol := "PLOT" :: OUT + tRange := (parametricRange r) :: OUT + f : L OUT := nil() + for curve in r.functions repeat + xRange := second(curve.ranges) :: OUT + yRange := third(curve.ranges) :: OUT + l : L OUT := [xSymbol,xRange,spaces,ySymbol,yRange] + if parametric? r then + l := concat_!([tSymbol,tRange,spaces],l) + h : OUT := hconcat l + l := [p::OUT for p in curve.points] + f := concat(vconcat concat(h,l),f) + prefix("PLOT" :: OUT, reverse_! f) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PLOT3D Plot3D} +\pagehead{Plot3D}{PLOT3D} +\pagepic{ps/v103plot3d.ps}{PLOT3D}{1.00} +<>= +)abbrev domain PLOT3D Plot3D +++ Author: Clifton J. Williamson based on code by Michael Monagan +++ Date Created: Jan 1989 +++ Date Last Updated: 22 November 1990 (Jon Steinbach) +++ Basic Operations: pointPlot, plot, zoom, refine, tRange, tValues, +++ minPoints3D, setMinPoints3D, maxPoints3D, setMaxPoints3D, +++ screenResolution3D, setScreenResolution3D, adaptive3D?, setAdaptive3D, +++ numFunEvals3D, debug3D +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: plot, parametric +++ References: +++ Description: Plot3D supports parametric plots defined over a real +++ number system. A real number system is a model for the real +++ numbers and as such may be an approximation. For example, +++ floating point numbers and infinite continued fractions are +++ real number systems. The facilities at this point are limited +++ to 3-dimensional parametric plots. +Plot3D(): Exports == Implementation where + B ==> Boolean + F ==> DoubleFloat + I ==> Integer + L ==> List + N ==> NonNegativeInteger + OUT ==> OutputForm + P ==> Point F + S ==> String + R ==> Segment F + O ==> OutputPackage + C ==> Record(source: F -> P,ranges: L R, knots: L F, points: L P) + + Exports ==> PlottableSpaceCurveCategory with + + pointPlot: (F -> P,R) -> % + ++ pointPlot(f,g,h,a..b) plots {/emx = f(t), y = g(t), z = h(t)} as + ++ t ranges over {/em[a,b]}. + pointPlot: (F -> P,R,R,R,R) -> % + ++ pointPlot(f,x,y,z,w) \undocumented + plot: (F -> F,F -> F,F -> F,F -> F,R) -> % + ++ plot(f,g,h,a..b) plots {/emx = f(t), y = g(t), z = h(t)} as + ++ t ranges over {/em[a,b]}. + plot: (F -> F,F -> F,F -> F,F -> F,R,R,R,R) -> % + ++ plot(f1,f2,f3,f4,x,y,z,w) \undocumented + + plot: (%,R) -> % -- change the range + ++ plot(x,r) \undocumented + zoom: (%,R,R,R) -> % + ++ zoom(x,r,s,t) \undocumented + refine: (%,R) -> % + ++ refine(x,r) \undocumented + refine: % -> % + ++ refine(x) \undocumented + + tRange: % -> R + ++ tRange(p) returns the range of the parameter in a parametric plot p. + tValues: % -> L L F + ++ tValues(p) returns a list of lists of the values of the parameter for + ++ which a point is computed, one list for each curve in the plot p. + + minPoints3D: () -> I + ++ minPoints3D() returns the minimum number of points in a plot. + setMinPoints3D: I -> I + ++ setMinPoints3D(i) sets the minimum number of points in a plot to i. + maxPoints3D: () -> I + ++ maxPoints3D() returns the maximum number of points in a plot. + setMaxPoints3D: I -> I + ++ setMaxPoints3D(i) sets the maximum number of points in a plot to i. + screenResolution3D: () -> I + ++ screenResolution3D() returns the screen resolution for a 3d graph. + setScreenResolution3D: I -> I + ++ setScreenResolution3D(i) sets the screen resolution for a 3d graph to i. + adaptive3D?: () -> B + ++ adaptive3D?() determines whether plotting be done adaptively. + setAdaptive3D: B -> B + ++ setAdaptive3D(true) turns adaptive plotting on; + ++ setAdaptive3D(false) turns adaptive plotting off. + numFunEvals3D: () -> I + ++ numFunEvals3D() returns the number of points computed. + debug3D: B -> B + ++ debug3D(true) turns debug mode on; + ++ debug3D(false) turns debug mode off. + + Implementation ==> add + import PointPackage(F) + +--% local functions + + fourth : L R -> R + checkRange : R -> R + -- checks that left-hand endpoint is less than right-hand endpoint + intersect : (R,R) -> R + -- intersection of two intervals + union : (R,R) -> R + -- union of two intervals + join : (L C,I) -> R + parametricRange: % -> R +-- setColor : (P,F) -> F + select : (L P,P -> F,(F,F) -> F) -> F +-- normalizeColor : (P,F,F) -> F + rangeRefine : (C,R) -> C + adaptivePlot : (C,R,R,R,R,I,I) -> C + basicPlot : (F -> P,R) -> C + basicRefine : (C,R) -> C + point : (F,F,F,F) -> P + +--% representation + + Rep := Record( display: L R, _ + bounds: L R, _ + screenres: I, _ + axisLabels: L S, _ + functions: L C ) + +--% global constants + + ADAPTIVE : B := true + MINPOINTS : I := 49 + MAXPOINTS : I := 1000 + NUMFUNEVALS : I := 0 + SCREENRES : I := 500 + ANGLEBOUND : F := cos inv (4::F) + DEBUG : B := false + + point(xx,yy,zz,col) == point(l : L F := [xx,yy,zz,col]) + + fourth list == first rest rest rest list + + checkRange r == (lo r > hi r => error "ranges cannot be negative"; r) + intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t)) + union(s:R,t:R) == min(lo s,lo t) .. max(hi s,hi t) + join(l,i) == + rr := first l + u : R := + i = 0 => first(rr.ranges) + i = 1 => second(rr.ranges) + i = 2 => third(rr.ranges) + fourth(rr.ranges) + for r in rest l repeat + i = 0 => union(u,first(r.ranges)) + i = 1 => union(u,second(r.ranges)) + i = 2 => union(u,third(r.ranges)) + union(u,fourth(r.ranges)) + u + parametricRange r == first(r.bounds) + + minPoints3D() == MINPOINTS + setMinPoints3D n == + if n < 3 then error "three points minimum required" + if MAXPOINTS < n then MAXPOINTS := n + MINPOINTS := n + maxPoints3D() == MAXPOINTS + setMaxPoints3D n == + if n < 3 then error "three points minimum required" + if MINPOINTS > n then MINPOINTS := n + MAXPOINTS := n + screenResolution3D() == SCREENRES + setScreenResolution3D n == + if n < 2 then error "buy a new terminal" + SCREENRES := n + adaptive3D?() == ADAPTIVE + setAdaptive3D b == ADAPTIVE := b + + numFunEvals3D() == NUMFUNEVALS + debug3D b == DEBUG := b + +-- setColor(p,c) == p.colNum := c + + xRange plot == second plot.bounds + yRange plot == third plot.bounds + zRange plot == fourth plot.bounds + tRange plot == first plot.bounds + + tValues plot == + outList : L L F := nil() + for curve in plot.functions repeat + outList := concat(curve.knots,outList) + outList + + select(l,f,g) == + m := f first l + if (EQL(m, _$NaNvalue$Lisp)$Lisp) then m := 0 +-- for p in rest l repeat m := g(m,fp) + for p in rest l repeat + fp : F := f p + if (EQL(fp, _$NaNvalue$Lisp)$Lisp) then fp := 0 + m := g(m,fp) + m + +-- normalizeColor(p,lo,diff) == +-- p.colNum := (p.colNum - lo)/diff + + rangeRefine(curve,nRange) == + checkRange nRange; l := lo nRange; h := hi nRange + t := curve.knots; p := curve.points; f := curve.source + while not null t and first t < l repeat + (t := rest t; p := rest p) + c : L F := nil(); q : L P := nil() + while not null t and first t <= h repeat + c := concat(first t,c); q := concat(first p,q) + t := rest t; p := rest p + if null c then return basicPlot(f,nRange) + if first c < h then + c := concat(h,c); q := concat(f h,q) + NUMFUNEVALS := NUMFUNEVALS + 1 + t := c := reverse_! c; p := q := reverse_! q + s := (h-l)/(MINPOINTS::F-1) + if (first t) ^= l then + t := c := concat(l,c); p := q := concat(f l,p) + NUMFUNEVALS := NUMFUNEVALS + 1 + while not null rest t repeat + n := wholePart((second(t) - first(t))/s) + d := (second(t) - first(t))/((n+1)::F) + for i in 1..n repeat + t.rest := concat(first(t) + d,rest t); t1 := second t + p.rest := concat(f t1,rest p) + NUMFUNEVALS := NUMFUNEVALS + 1 + t := rest t; p := rest p + t := rest t + p := rest p + xRange := select(q,xCoord,min) .. select(q,xCoord,max) + yRange := select(q,yCoord,min) .. select(q,yCoord,max) + zRange := select(q,zCoord,min) .. select(q,zCoord,max) +-- colorLo := select(q,color,min); colorHi := select(q,color,max) +-- (diff := colorHi - colorLo) = 0 => +-- error "all points are the same color" +-- map(normalizeColor(#1,colorLo,diff),q)$ListPackage1(P) + [f,[nRange,xRange,yRange,zRange],c,q] + + + adaptivePlot(curve,tRg,xRg,yRg,zRg,pixelfraction,resolution) == + xDiff := hi xRg - lo xRg + yDiff := hi yRg - lo yRg + zDiff := hi zRg - lo zRg +-- xDiff = 0 or yDiff = 0 or zDiff = 0 => curve--!! delete this? + if xDiff = 0::F then xDiff := 1::F + if yDiff = 0::F then yDiff := 1::F + if zDiff = 0::F then zDiff := 1::F + l := lo tRg; h := hi tRg + (tDiff := h-l) = 0 => curve + t := curve.knots + #t < 3 => curve + p := curve.points; f := curve.source + minLength:F := 4::F/resolution::F + maxLength := 1/4::F + tLimit := tDiff/(pixelfraction*resolution)::F + while not null t and first t < l repeat (t := rest t; p := rest p) + #t < 3 => curve + headert := t; headerp := p + st := t; sp := p + todot : L L F := nil() + todop : L L P := nil() + while not null rest rest st repeat + todot := concat_!(todot, st) + todop := concat_!(todop, sp) + st := rest st; sp := rest sp + st := headert; sp := headerp + todo1 := todot; todo2 := todop + n : I := 0 + + while not null todo1 repeat + st := first(todo1) + t0 := first(st); t1 := second(st); t2 := third(st) + if t2 > h then leave + t2 - t0 < tLimit => + todo1 := rest todo1 + todo2 := rest todo2; + if not null todo1 then (t := first(todo1); p := first(todo2)) + sp := first(todo2) + x0 := xCoord first(sp); y0 := yCoord first(sp); z0 := zCoord first(sp) + x1 := xCoord second(sp); y1 := yCoord second(sp); z1 := zCoord second(sp) + x2 := xCoord third(sp); y2 := yCoord third(sp); z2 := zCoord third(sp) + a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff; c1 := (z1-z0)/zDiff + a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff; c2 := (z2-z1)/zDiff + s1 := sqrt(a1**2+b1**2+c1**2); s2 := sqrt(a2**2+b2**2+c2**2) + dp := a1*a2+b1*b2+c1*c2 + s1 < maxLength and s2 < maxLength and _ + (s1 = 0 or s2 = 0 or + s1 < minLength and s2 < minLength or _ + dp/s1/s2 > ANGLEBOUND) => + todo1 := rest todo1 + todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + if n = MAXPOINTS then leave else n := n + 1 + --if DEBUG then + --r : L F := [minLength,maxLength,s1,s2,dp/s1/s2,ANGLEBOUND] + --output(r::E)$O + st := rest t + if not null rest rest st then + tm := (t0+t1)/2::F + tj := tm + t.rest := concat(tj,rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := rest todo1; todo2 := rest todo2 + + tm := (t1+t2)/2::F + tj := tm + t.rest := concat(tj, rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + todo1 := rest todo1; todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + else + tm := (t0+t1)/2::F + tj := tm + t.rest := concat(tj,rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + t := rest t; p := rest p + + tm := (t1+t2)/2::F + tj := tm + t.rest := concat(tj, rest t) + p.rest := concat(f tj, rest p) + todo1 := concat_!(todo1, t) + todo2 := concat_!(todo2, p) + todo1 := rest todo1; todo2 := rest todo2 + if not null todo1 then (t := first(todo1); p := first(todo2)) + if n > 0 then + NUMFUNEVALS := NUMFUNEVALS + n + t := curve.knots; p := curve.points + xRg := select(p,xCoord,min) .. select(p,xCoord,max) + yRg := select(p,yCoord,min) .. select(p,yCoord,max) + zRg := select(p,zCoord,min) .. select(p,zCoord,max) + [curve.source,[tRg,xRg,yRg,zRg],t,p] + else curve + + basicPlot(f,tRange) == + checkRange tRange; l := lo tRange; h := hi tRange + t : L F := list l; p : L P := list f l + s := (h-l)/(MINPOINTS-1)::F + for i in 2..MINPOINTS-1 repeat + l := l+s; t := concat(l,t) + p := concat(f l,p) + t := reverse_! concat(h,t) + p := reverse_! concat(f h,p) + xRange : R := select(p,xCoord,min) .. select(p,xCoord,max) + yRange : R := select(p,yCoord,min) .. select(p,yCoord,max) + zRange : R := select(p,zCoord,min) .. select(p,zCoord,max) + [f,[tRange,xRange,yRange,zRange],t,p] + + zoom(p,xRange,yRange,zRange) == + [[xRange,yRange,zRange],p.bounds, + p.screenres,p.axisLabels,p.functions] + + basicRefine(curve,nRange) == + tRange:R := first curve.ranges + -- curve := copy$C curve -- Yet another @#$%^&* compiler bug + curve: C := [curve.source,curve.ranges,curve.knots,curve.points] + t := curve.knots := copy curve.knots + p := curve.points := copy curve.points + l := lo nRange; h := hi nRange + f := curve.source + while not null rest t and first(t) < h repeat + second(t) < l => (t := rest t; p := rest p) + -- insert new point between t.0 and t.1 + tm:F := (first(t) + second(t))/2::F + -- if DEBUG then output$O (tm::E) + pm := f tm + NUMFUNEVALS := NUMFUNEVALS + 1 + t.rest := concat(tm,rest t); t := rest rest t + p.rest := concat(pm,rest p); p := rest rest p + t := curve.knots; p := curve.points + xRange := select(p,xCoord,min) .. select(p,xCoord,max) + yRange := select(p,yCoord,min) .. select(p,yCoord,max) + zRange := select(p,zCoord,min) .. select(p,zCoord,max) + [curve.source,[tRange,xRange,yRange,zRange],t,p] + + refine p == refine(p,parametricRange p) + refine(p,nRange) == + NUMFUNEVALS := 0 + tRange := parametricRange p + nRange := intersect(tRange,nRange) + curves: L C := [basicRefine(c,nRange) for c in p.functions] + xRange := join(curves,1); yRange := join(curves,2) + zRange := join(curves,3) + scrres := p.screenres + if adaptive3D? then + tlimit := 8 + curves := [adaptivePlot(c,nRange,xRange,yRange,zRange, _ + tlimit,scrres := 2*scrres) for c in curves] + xRange := join(curves,1); yRange := join(curves,2) + zRange := join(curves,3) + [p.display,[tRange,xRange,yRange,zRange], _ + scrres,p.axisLabels,curves] + + plot(p:%,tRange:R) == + -- re plot p on a new range making use of the points already + -- computed if possible + NUMFUNEVALS := 0 + curves: L C := [rangeRefine(c,tRange) for c in p.functions] + xRange := join(curves,1); yRange := join(curves,2) + zRange := join(curves,3) + if adaptive3D? then + tlimit := 8 + curves := [adaptivePlot(c,tRange,xRange,yRange,zRange,tlimit, _ + p.screenres) for c in curves] + xRange := join(curves,1); yRange := join(curves,2) + zRange := join(curves,3) +-- print(NUMFUNEVALS::OUT) + [[xRange,yRange,zRange],[tRange,xRange,yRange,zRange], + p.screenres,p.axisLabels,curves] + + pointPlot(f:F -> P,tRange:R) == + p := basicPlot(f,tRange) + r := p.ranges + NUMFUNEVALS := MINPOINTS + if adaptive3D? then + p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES) +-- print(NUMFUNEVALS::OUT) +-- print(p::OUT) + [ rest r, r, SCREENRES, nil(), [ p ] ] + + pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R,zRange:R) == + p := pointPlot(f,tRange) + p.display:= [checkRange xRange,checkRange yRange,checkRange zRange] + p + + myTrap: (F-> F, F) -> F + myTrap(ff:F-> F, f:F):F == + s := trapNumericErrors(ff(f))$Lisp :: Union(F, "failed") + if (s) case "failed" then + r:F := _$NaNvalue$Lisp + else + r:F := s + r + + plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,tRange:R) == + p := basicPlot(point(myTrap(f1,#1),myTrap(f2,#1),myTrap(f3,#1),col(#1)),tRange) + r := p.ranges + NUMFUNEVALS := MINPOINTS + if adaptive3D? then + p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES) +-- print(NUMFUNEVALS::OUT) + [ rest r, r, SCREENRES, nil(), [ p ] ] + + plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,_ + tRange:R,xRange:R,yRange:R,zRange:R) == + p := plot(f1,f2,f3,col,tRange) + p.display:= [checkRange xRange,checkRange yRange,checkRange zRange] + p + +--% terminal output + + coerce r == + spaces := " " :: OUT + xSymbol := "x = " :: OUT; ySymbol := "y = " :: OUT + zSymbol := "z = " :: OUT; tSymbol := "t = " :: OUT + tRange := (parametricRange r) :: OUT + f : L OUT := nil() + for curve in r.functions repeat + xRange := coerce curve.ranges.1 + yRange := coerce curve.ranges.2 + zRange := coerce curve.ranges.3 + l : L OUT := [xSymbol,xRange,spaces,ySymbol,yRange,_ + spaces,zSymbol,zRange] + l := concat_!([tSymbol,tRange,spaces],l) + h : OUT := hconcat l + l := [p::OUT for p in curve.points] + f := concat(vconcat concat(h,l),f) + prefix("PLOT" :: OUT,reverse_! f) + +----% graphics output + + listBranches plot == + outList : L L P := nil() + for curve in plot.functions repeat + outList := concat(curve.points,outList) + outList + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain POINT Point} \pagehead{Point}{POINT} \pagepic{ps/v103point.ps}{POINT}{1.00} @@ -46128,6 +50931,320 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PR PolynomialRing} +\pagehead{PolynomialRing}{PR} +\pagepic{ps/v103polynomialring.ps}{PR}{1.00} +See also:\\ +\refto{FreeModule}{FM} +\refto{SparseUnivariatePolynomial}{SUP} +\refto{UnivariatePolynomial}{UP} +<>= +)abbrev domain PR PolynomialRing +++ Author: Dave Barton, James Davenport, Barry Trager +++ Date Created: +++ Date Last Updated: 14.08.2000. Improved exponentiation [MMM/TTT] +++ Basic Functions: Ring, degree, coefficient, monomial, reductum +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain represents generalized polynomials with coefficients +++ (from a not necessarily commutative ring), and terms +++ indexed by their exponents (from an arbitrary ordered abelian monoid). +++ This type is used, for example, +++ by the \spadtype{DistributedMultivariatePolynomial} domain where +++ the exponent domain is a direct product of non negative integers. + +PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C + where + T == FiniteAbelianMonoidRing(R,E) with + --assertions + if R has IntegralDomain and E has CancellationAbelianMonoid then + fmecg: (%,E,R,%) -> % + ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 + if R has canonicalUnitNormal then canonicalUnitNormal + ++ canonicalUnitNormal guarantees that the function + ++ unitCanonical returns the same representative for all + ++ associates of any particular element. + + C == FreeModule(R,E) add + --representations + Term:= Record(k:E,c:R) + Rep:= List Term + + + --declarations + x,y,p,p1,p2: % + n: Integer + nn: NonNegativeInteger + np: PositiveInteger + e: E + r: R + --local operations + 1 == [[0$E,1$R]] + characteristic == characteristic$R + numberOfMonomials x == (# x)$Rep + degree p == if null p then 0 else p.first.k + minimumDegree p == if null p then 0 else (last p).k + leadingCoefficient p == if null p then 0$R else p.first.c + leadingMonomial p == if null p then 0 else [p.first] + reductum p == if null p then p else p.rest + retractIfCan(p:%):Union(R,"failed") == + null p => 0$R + not null p.rest => "failed" + zero?(p.first.k) => p.first.c + "failed" + coefficient(p,e) == + for tm in p repeat + tm.k=e => return tm.c + tm.k < e => return 0$R + 0$R + recip(p) == + null p => "failed" + p.first.k > 0$E => "failed" + (u:=recip(p.first.c)) case "failed" => "failed" + (u::R)::% + + coerce(r) == if zero? r then 0$% else [[0$E,r]] + coerce(n) == (n::R)::% + + ground?(p): Boolean == empty? p or (empty? rest p and zero? degree p) + + qsetrest!: (Rep, Rep) -> Rep + qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp + + times!: (R, %) -> % + times: (R, E, %) -> % + + entireRing? := R has EntireRing + + times!(r: R, x: %): % == + res, endcell, newend, xx: Rep + if entireRing? then + for tx in x repeat tx.c := r*tx.c + else + xx := x + res := empty() + while not empty? xx repeat + tx := first xx + tx.c := r * tx.c + if zero? tx.c then + xx := rest xx + else + newend := xx + xx := rest xx + if empty? res then + res := newend + endcell := res + else + qsetrest!(endcell, newend) + endcell := newend + res; + + --- term * polynomial + termTimes: (R, E, Term) -> Term + termTimes(r: R, e: E, tx:Term): Term == [e+tx.k, r*tx.c] + times(tco: R, tex: E, rx: %): % == + if entireRing? then + map(termTimes(tco, tex, #1), rx::Rep) + else + [[tex + tx.k, r] for tx in rx::Rep | not zero? (r := tco * tx.c)] + + + + -- local addm! + addm!: (Rep, R, E, Rep) -> Rep + -- p1 + coef*x^E * p2 + -- `spare' (commented out) is for storage efficiency (not so good for + -- performance though. + addm!(p1:Rep, coef:R, exp: E, p2:Rep): Rep == + --local res, newend, last: Rep + res, newcell, endcell: Rep + spare: List Rep + res := empty() + endcell := empty() + --spare := empty() + while not empty? p1 and not empty? p2 repeat + tx := first p1 + ty := first p2 + exy := exp + ty.k + newcell := empty(); + if tx.k = exy then + newcoef := tx.c + coef * ty.c + if not zero? newcoef then + tx.c := newcoef + newcell := p1 + --else + -- spare := cons(p1, spare) + p1 := rest p1 + p2 := rest p2 + else if tx.k > exy then + newcell := p1 + p1 := rest p1 + else + newcoef := coef * ty.c + if not entireRing? and zero? newcoef then + newcell := empty() + --else if empty? spare then + -- ttt := [exy, newcoef] + -- newcell := cons(ttt, empty()) + --else + -- newcell := first spare + -- spare := rest spare + -- ttt := first newcell + -- ttt.k := exy + -- ttt.c := newcoef + else + ttt := [exy, newcoef] + newcell := cons(ttt, empty()) + p2 := rest p2 + if not empty? newcell then + if empty? res then + res := newcell + endcell := res + else + qsetrest!(endcell, newcell) + endcell := newcell + if not empty? p1 then -- then end is const * p1 + newcell := p1 + else -- then end is (coef, exp) * p2 + newcell := times(coef, exp, p2) + empty? res => newcell + qsetrest!(endcell, newcell) + res + pomopo! (p1, r, e, p2) == addm!(p1, r, e, p2) + p1 * p2 == + xx := p1::Rep + empty? xx => p1 + yy := p2::Rep + empty? yy => p2 + zero? first(xx).k => first(xx).c * p2 + zero? first(yy).k => p1 * first(yy).c + --if #xx > #yy then + -- (xx, yy) := (yy, xx) + -- (p1, p2) := (p2, p1) + xx := reverse xx + res : Rep := empty() + for tx in xx repeat res:=addm!(res,tx.c,tx.k,yy) + res + +-- if R has EntireRing then +-- p1 * p2 == +-- null p1 => 0 +-- null p2 => 0 +-- zero?(p1.first.k) => p1.first.c * p2 +-- one? p2 => p1 +-- +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2] +-- for t1 in reverse(p1)] +-- -- This 'reverse' is an efficiency improvement: +-- -- reduces both time and space [Abbott/Bradford/Davenport] +-- else +-- p1 * p2 == +-- null p1 => 0 +-- null p2 => 0 +-- zero?(p1.first.k) => p1.first.c * p2 +-- one? p2 => p1 +-- +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0] +-- for t1 in reverse(p1)] +-- -- This 'reverse' is an efficiency improvement: +-- -- reduces both time and space [Abbott/Bradford/Davenport] + if R has CommutativeRing then + p ** np == p ** (np pretend NonNegativeInteger) + p ^ np == p ** (np pretend NonNegativeInteger) + p ^ nn == p ** nn + + + p ** nn == + null p => 0 + zero? nn => 1 +-- one? nn => p + (nn = 1) => p + empty? p.rest => + zero?(cc:=p.first.c ** nn) => 0 + [[nn * p.first.k, cc]] + binomThmExpt([p.first], p.rest, nn) + + if R has Field then + unitNormal(p) == + null p or (lcf:R:=p.first.c) = 1 => [1,p,1] + a := inv lcf + [lcf::%, [[p.first.k,1],:(a * p.rest)], a::%] + unitCanonical(p) == + null p or (lcf:R:=p.first.c) = 1 => p + a := inv lcf + [[p.first.k,1],:(a * p.rest)] + else if R has IntegralDomain then + unitNormal(p) == + null p or p.first.c = 1 => [1,p,1] + (u,cf,a):=unitNormal(p.first.c) + [u::%, [[p.first.k,cf],:(a * p.rest)], a::%] + unitCanonical(p) == + null p or p.first.c = 1 => p + (u,cf,a):=unitNormal(p.first.c) + [[p.first.k,cf],:(a * p.rest)] + if R has IntegralDomain then + associates?(p1,p2) == + null p1 => null p2 + null p2 => false + p1.first.k = p2.first.k and + associates?(p1.first.c,p2.first.c) and + ((p2.first.c exquo p1.first.c)::R * p1.rest = p2.rest) + p exquo r == + [(if (a:= tm.c exquo r) case "failed" + then return "failed" else [tm.k,a]) + for tm in p] :: Union(%,"failed") + if E has CancellationAbelianMonoid then + fmecg(p1:%,e:E,r:R,p2:%):% == -- p1 - r * X**e * p2 + rout:%:= [] + r:= - r + for tm in p2 repeat + e2:= e + tm.k + c2:= r * tm.c + c2 = 0 => "next term" + while not null p1 and p1.first.k > e2 repeat + (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? + null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] + if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] + p1:=p1.rest + NRECONC(rout,p1)$Lisp + if R has approximate then + p1 exquo p2 == + null p2 => error "Division by 0" + p2 = 1 => p1 + p1=p2 => 1 + --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" + rout:= []@List(Term) + while not null p1 repeat + (a:= p1.first.c exquo p2.first.c) + a case "failed" => return "failed" + ee:= subtractIfCan(p1.first.k, p2.first.k) + ee case "failed" => return "failed" + p1:= fmecg(p1.rest, ee, a, p2.rest) + rout:= [[ee,a], :rout] + null p1 => reverse(rout)::% -- nreverse? + "failed" + else -- R not approximate + p1 exquo p2 == + null p2 => error "Division by 0" + p2 = 1 => p1 + --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" + rout:= []@List(Term) + while not null p1 repeat + (a:= p1.first.c exquo p2.first.c) + a case "failed" => return "failed" + ee:= subtractIfCan(p1.first.k, p2.first.k) + ee case "failed" => return "failed" + p1:= fmecg(p1.rest, ee, a, p2.rest) + rout:= [[ee,a], :rout] + null p1 => reverse(rout)::% -- nreverse? + "failed" + if R has Field then + x/r == inv(r)*x + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain PI PositiveInteger} \pagehead{PositiveInteger}{PI} \pagepic{ps/v103positiveinteger.ps}{PI}{1.00} @@ -46157,6 +51274,39 @@ PositiveInteger: Join(AbelianSemiGroup,OrderedSet,Monoid) with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PF PrimeField} +\pagehead{PrimeField}{PF} +\pagepic{ps/v103primefield.ps}{PF}{1.00} +See also:\\ +\refto{InnerPrimeField}{IPF} +<>= +)abbrev domain PF PrimeField +++ Authors: N.N., +++ Date Created: November 1990, 26.03.1991 +++ Date Last Updated: 31 March 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: prime characteristic, prime field, finite field +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ Description: +++ PrimeField(p) implements the field with p elements if p is a +++ prime number. +++ Error: if p is not prime. +++ Note: this domain does not check that argument is a prime. +--++ with new compiler, want to put the error check before the add +PrimeField(p:PositiveInteger): Exp == Impl where + Exp ==> Join(FiniteFieldCategory,FiniteAlgebraicExtensionField($),_ + ConvertibleTo(Integer)) + Impl ==> InnerPrimeField(p) add + if not prime?(p)$IntegerPrimesPackage(Integer) then + error "Argument to prime field must be a prime" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain PRIMARR PrimitiveArray} <>= "PRIMARR" -> "A1AGG" @@ -46195,6 +51345,106 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PRODUCT Product} +\pagehead{Product}{PRODUCT} +\pagepic{ps/v103product.ps}{PRODUCT}{1.00} +<>= +)abbrev domain PRODUCT Product +++ Description: +++ This domain implements cartesian product +Product (A:SetCategory,B:SetCategory) : C == T + where + C == SetCategory with + if A has Finite and B has Finite then Finite + if A has Monoid and B has Monoid then Monoid + if A has AbelianMonoid and B has AbelianMonoid then AbelianMonoid + if A has CancellationAbelianMonoid and + B has CancellationAbelianMonoid then CancellationAbelianMonoid + if A has Group and B has Group then Group + if A has AbelianGroup and B has AbelianGroup then AbelianGroup + if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup + then OrderedAbelianMonoidSup + if A has OrderedSet and B has OrderedSet then OrderedSet + + makeprod : (A,B) -> % + ++ makeprod(a,b) \undocumented + selectfirst : % -> A + ++ selectfirst(x) \undocumented + selectsecond : % -> B + ++ selectsecond(x) \undocumented + + T == add + + --representations + Rep := Record(acomp:A,bcomp:B) + + --declarations + x,y: % + i: NonNegativeInteger + p: NonNegativeInteger + a: A + b: B + d: Integer + + --define + coerce(x):OutputForm == paren [(x.acomp)::OutputForm, + (x.bcomp)::OutputForm] + x=y == + x.acomp = y.acomp => x.bcomp = y.bcomp + false + makeprod(a:A,b:B) :% == [a,b] + + selectfirst(x:%) : A == x.acomp + + selectsecond (x:%) : B == x.bcomp + + if A has Monoid and B has Monoid then + 1 == [1$A,1$B] + x * y == [x.acomp * y.acomp,x.bcomp * y.bcomp] + x ** p == [x.acomp ** p ,x.bcomp ** p] + + if A has Finite and B has Finite then + size == size$A () * size$B () + + if A has Group and B has Group then + inv(x) == [inv(x.acomp),inv(x.bcomp)] + + if A has AbelianMonoid and B has AbelianMonoid then + 0 == [0$A,0$B] + + x + y == [x.acomp + y.acomp,x.bcomp + y.bcomp] + + c:NonNegativeInteger * x == [c * x.acomp,c*x.bcomp] + + if A has CancellationAbelianMonoid and + B has CancellationAbelianMonoid then + subtractIfCan(x, y) : Union(%,"failed") == + (na:= subtractIfCan(x.acomp, y.acomp)) case "failed" => "failed" + (nb:= subtractIfCan(x.bcomp, y.bcomp)) case "failed" => "failed" + [na::A,nb::B] + + if A has AbelianGroup and B has AbelianGroup then + - x == [- x.acomp,-x.bcomp] + (x - y):% == [x.acomp - y.acomp,x.bcomp - y.bcomp] + d * x == [d * x.acomp,d * x.bcomp] + + if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup then + sup(x,y) == [sup(x.acomp,y.acomp),sup(x.bcomp,y.bcomp)] + + if A has OrderedSet and B has OrderedSet then + x < y == + xa:= x.acomp ; ya:= y.acomp + xa < ya => true + xb:= x.bcomp ; yb:= y.bcomp + xa = ya => (xb < yb) + false + +-- coerce(x:%):Symbol == +-- PrintableForm() +-- formList([x.acomp::Expression,x.bcomp::Expression])$PrintableForm + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter Q} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain QFORM QuadraticForm} @@ -48093,6 +53343,363 @@ SingletonAsOrderedSet(): OrderedSet with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SUP SparseUnivariatePolynomial} +\pagehead{SparseUnivariatePolynomial}{SUP} +\pagepic{ps/v103sparseunivariatepolynomial.ps}{SUP}{1.00} +See also:\\ +\refto{FreeModule}{FM} +\refto{PolynomialRing}{PR} +\refto{UnivariatePolynomial}{UP} +<>= +)abbrev domain SUP SparseUnivariatePolynomial +++ Author: Dave Barton, Barry Trager +++ Date Created: +++ Date Last Updated: +++ Basic Functions: Ring, monomial, coefficient, reductum, differentiate, +++ elt, map, resultant, discriminant +++ Related Constructors: UnivariatePolynomial, Polynomial +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain represents univariate polynomials over arbitrary +++ (not necessarily commutative) coefficient rings. The variable is +++ unspecified so that the variable displays as \spad{?} on output. +++ If it is necessary to specify the variable name, use type \spadtype{UnivariatePolynomial}. +++ The representation is sparse +++ in the sense that only non-zero terms are represented. +++ Note: if the coefficient ring is a field, this domain forms a euclidean domain. + +SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with + outputForm : (%,OutputForm) -> OutputForm + ++ outputForm(p,var) converts the SparseUnivariatePolynomial p to + ++ an output form (see \spadtype{OutputForm}) printed as a polynomial in the + ++ output form variable. + fmecg: (%,NonNegativeInteger,R,%) -> % + ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 + == PolynomialRing(R,NonNegativeInteger) + add + --representations + Term := Record(k:NonNegativeInteger,c:R) + Rep := List Term + p:% + n:NonNegativeInteger + np: PositiveInteger + FP ==> SparseUnivariatePolynomial % + pp,qq: FP + lpp:List FP + + -- for karatsuba + kBound: NonNegativeInteger := 63 + upmp := UnivariatePolynomialMultiplicationPackage(R,%) + + + if R has FieldOfPrimeCharacteristic then + p ** np == p ** (np pretend NonNegativeInteger) + p ^ np == p ** (np pretend NonNegativeInteger) + p ^ n == p ** n + p ** n == + null p => 0 + zero? n => 1 +-- one? n => p + (n = 1) => p + empty? p.rest => + zero?(cc:=p.first.c ** n) => 0 + [[n * p.first.k, cc]] + -- not worth doing special trick if characteristic is too small + if characteristic()$R < 3 then return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%) + y:%:=1 + -- break up exponent in qn * characteristic + rn + -- exponentiating by the characteristic is fast + rec := divide(n, characteristic()$R) + qn:= rec.quotient + rn:= rec.remainder + repeat + if rn = 1 then y := y * p + if rn > 1 then y:= y * binomThmExpt([p.first], p.rest, rn) + zero? qn => return y + -- raise to the characteristic power + p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term for t in p] + rec := divide(qn, characteristic()$R) + qn:= rec.quotient + rn:= rec.remainder + y + + + + zero?(p): Boolean == empty?(p) +-- one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) + one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) + ground?(p): Boolean == empty? p or (empty? rest p and zero? first(p).k) + multiplyExponents(p,n) == [ [u.k*n,u.c] for u in p] + divideExponents(p,n) == + null p => p + m:= (p.first.k :: Integer exquo n::Integer) + m case "failed" => "failed" + u:= divideExponents(p.rest,n) + u case "failed" => "failed" + [[m::Integer::NonNegativeInteger,p.first.c],:u] + karatsubaDivide(p, n) == + zero? n => [p, 0] + lowp: Rep := p + highp: Rep := [] + repeat + if empty? lowp then break + t := first lowp + if t.k < n then break + lowp := rest lowp + highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp) + [ reverse highp, lowp] + shiftRight(p, n) == + [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p] + shiftLeft(p, n) == + [[t.k + n,t.c]$Term for t in p] + pomopo!(p1,r,e,p2) == + rout:%:= [] + for tm in p2 repeat + e2:= e + tm.k + c2:= r * tm.c + c2 = 0 => "next term" + while not null p1 and p1.first.k > e2 repeat + (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? + null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] + if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] + p1:=p1.rest + NRECONC(rout,p1)$Lisp + +-- implementation using karatsuba algorithm conditionally +-- +-- p1 * p2 == +-- xx := p1::Rep +-- empty? xx => p1 +-- yy := p2::Rep +-- empty? yy => p2 +-- zero? first(xx).k => first(xx).c * p2 +-- zero? first(yy).k => p1 * first(yy).c +-- (first(xx).k > kBound) and (first(yy).k > kBound) and (#xx > kBound) and (#yy > kBound) => +-- karatsubaOnce(p1,p2)$upmp +-- xx := reverse xx +-- res : Rep := empty() +-- for tx in xx repeat res:= rep pomopo!( res,tx.c,tx.k,p2) +-- res + + + univariate(p:%) == p pretend SparseUnivariatePolynomial(R) + multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) == + sup pretend % + univariate(p:%,v:SingletonAsOrderedSet) == + zero? p => 0 + monomial(leadingCoefficient(p)::%,degree p) + + univariate(reductum p,v) + multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) == + zero? supp => 0 + lc:=leadingCoefficient supp + degree lc > 0 => error "bad form polynomial" + monomial(leadingCoefficient lc,degree supp) + + multivariate(reductum supp,v) + if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then + RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R + squareFreePolynomial pp == + squareFree(pp)$UnivariatePolynomialSquareFree(%,FP) + factorPolynomial pp == + (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) + pretend Factored SparseUnivariatePolynomial % + factorSquareFreePolynomial pp == + (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) + pretend Factored SparseUnivariatePolynomial % + gcdPolynomial(pp,qq) == gcd(pp,qq)$FP + factor p == factor(p)$DistinctDegreeFactorize(R,%) + solveLinearPolynomialEquation(lpp,pp) == + solveLinearPolynomialEquation(lpp, pp)$FiniteFieldSolveLinearPolynomialEquation(R,%,FP) + else if R has PolynomialFactorizationExplicit then + import PolynomialFactorizationByRecursionUnivariate(R,%) + solveLinearPolynomialEquation(lpp,pp)== + solveLinearPolynomialEquationByRecursion(lpp,pp) + factorPolynomial(pp) == + factorByRecursion(pp) + factorSquareFreePolynomial(pp) == + factorSquareFreeByRecursion(pp) + + if R has IntegralDomain then + if R has approximate then + p1 exquo p2 == + null p2 => error "Division by 0" + p2 = 1 => p1 + p1=p2 => 1 + --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" + rout:= []@List(Term) + while not null p1 repeat + (a:= p1.first.c exquo p2.first.c) + a case "failed" => return "failed" + ee:= subtractIfCan(p1.first.k, p2.first.k) + ee case "failed" => return "failed" + p1:= fmecg(p1.rest, ee, a, p2.rest) + rout:= [[ee,a], :rout] + null p1 => reverse(rout)::% -- nreverse? + "failed" + else -- R not approximate + p1 exquo p2 == + null p2 => error "Division by 0" + p2 = 1 => p1 + --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" + rout:= []@List(Term) + while not null p1 repeat + (a:= p1.first.c exquo p2.first.c) + a case "failed" => return "failed" + ee:= subtractIfCan(p1.first.k, p2.first.k) + ee case "failed" => return "failed" + p1:= fmecg(p1.rest, ee, a, p2.rest) + rout:= [[ee,a], :rout] + null p1 => reverse(rout)::% -- nreverse? + "failed" + fmecg(p1,e,r,p2) == -- p1 - r * X**e * p2 + rout:%:= [] + r:= - r + for tm in p2 repeat + e2:= e + tm.k + c2:= r * tm.c + c2 = 0 => "next term" + while not null p1 and p1.first.k > e2 repeat + (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? + null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] + if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] + p1:=p1.rest + NRECONC(rout,p1)$Lisp + pseudoRemainder(p1,p2) == + null p2 => error "PseudoDivision by Zero" + null p1 => 0 + co:=p2.first.c; + e:=p2.first.k; + p2:=p2.rest; + e1:=max(p1.first.k:Integer-e+1,0):NonNegativeInteger + while not null p1 repeat + if (u:=subtractIfCan(p1.first.k,e)) case "failed" then leave + p1:=fmecg(co * p1.rest, u, p1.first.c, p2) + e1:= (e1 - 1):NonNegativeInteger + e1 = 0 => p1 + co ** e1 * p1 + toutput(t1:Term,v:OutputForm):OutputForm == + t1.k = 0 => t1.c :: OutputForm + if t1.k = 1 + then mon:= v + else mon := v ** t1.k::OutputForm + t1.c = 1 => mon + t1.c = -1 and + ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon + t1.c::OutputForm * mon + outputForm(p:%,v:OutputForm) == + l: List(OutputForm) + l:=[toutput(t,v) for t in p] + null l => (0$Integer)::OutputForm -- else FreeModule 0 problems + reduce("+",l) + + coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm) + elt(p:%,val:R) == + null p => 0$R + co:=p.first.c + n:=p.first.k + for tm in p.rest repeat + co:= co * val ** (n - (n:=tm.k)):NonNegativeInteger + tm.c + n = 0 => co + co * val ** n + elt(p:%,val:%) == + null p => 0$% + coef:% := p.first.c :: % + n:=p.first.k + for tm in p.rest repeat + coef:= coef * val ** (n-(n:=tm.k)):NonNegativeInteger+(tm.c::%) + n = 0 => coef + coef * val ** n + + monicDivide(p1:%,p2:%) == + null p2 => error "monicDivide: division by 0" + leadingCoefficient p2 ^= 1 => error "Divisor Not Monic" + p2 = 1 => [p1,0] + null p1 => [0,0] + degree p1 < (n:=degree p2) => [0,p1] + rout:Rep := [] + p2 := p2.rest + while not null p1 repeat + (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave + rout:=[[u, p1.first.c], :rout] + p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) + [reverse_!(rout),p1] + + if R has IntegralDomain then + discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%) +-- discriminant(p) == +-- null p or zero?(p.first.k) => error "cannot take discriminant of constants" +-- dp:=differentiate p +-- corr:= p.first.c ** ((degree p - 1 - degree dp)::NonNegativeInteger) +-- (-1)**((p.first.k*(p.first.k-1)) quo 2):NonNegativeInteger +-- * (corr * resultant(p,dp) exquo p.first.c)::R + + subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%) +-- subResultantGcd(p1,p2) == --args # 0, non-coef, prim, ans not prim +-- --see algorithm 1 (p. 4) of Brown's latest (unpublished) paper +-- if p1.first.k < p2.first.k then (p1,p2):=(p2,p1) +-- p:=pseudoRemainder(p1,p2) +-- co:=1$R; +-- e:= (p1.first.k - p2.first.k):NonNegativeInteger +-- while not null p and p.first.k ^= 0 repeat +-- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) +-- null p or p.first.k = 0 => "enuf" +-- co:=(p1.first.c ** e exquo co ** max(0, (e-1))::NonNegativeInteger)::R +-- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e +-- p:=[[tm.k,((tm.c exquo p1.first.c)::R exquo c1)::R] for tm in p] +-- if null p then p2 else 1$% + + resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%) +-- resultant(p1,p2) == --SubResultant PRS Algorithm +-- null p1 or null p2 => 0$R +-- 0 = degree(p1) => ((first p1).c)**degree(p2) +-- 0 = degree(p2) => ((first p2).c)**degree(p1) +-- if p1.first.k < p2.first.k then +-- (if odd?(p1.first.k) then p1:=-p1; (p1,p2):=(p2,p1)) +-- p:=pseudoRemainder(p1,p2) +-- co:=1$R; e:=(p1.first.k-p2.first.k):NonNegativeInteger +-- while not null p repeat +-- if not odd?(e) then p:=-p +-- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) +-- co:=(p1.first.c ** e exquo co ** max(e:Integer-1,0):NonNegativeInteger)::R +-- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e +-- p:=(p exquo ((leadingCoefficient p1) * c1))::% +-- degree p2 > 0 => 0$R +-- (p2.first.c**e exquo co**((e-1)::NonNegativeInteger))::R + if R has GcdDomain then + content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p] + --make CONTENT more efficient? + + primitivePart(p) == + null p => p + ct :=content(p) + unitCanonical((p exquo ct)::%) + -- exquo present since % is now an IntegralDomain + + gcd(p1,p2) == + gcdPolynomial(p1 pretend SparseUnivariatePolynomial R, + p2 pretend SparseUnivariatePolynomial R) pretend % + + if R has Field then + divide( p1, p2) == + zero? p2 => error "Division by 0" +-- one? p2 => [p1,0] + (p2 = 1) => [p1,0] + ct:=inv(p2.first.c) + n:=p2.first.k + p2:=p2.rest + rout:=empty()$List(Term) + while p1 ^= 0 repeat + (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave + rout:=[[u, ct * p1.first.c], :rout] + p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) + [reverse_!(rout),p1] + + p / co == inv(co) * p + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ORESUP SparseUnivariateSkewPolynomial} \pagehead{SparseUnivariateSkewPolynomial}{ORESUP} \pagepic{ps/v103sparseunivariateskewpolynomial.ps}{ORESUP}{1.00} @@ -50669,6 +56276,46 @@ SymbolTable() : exports == implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SYMPOLY SymmetricPolynomial} +\pagehead{SymmetricPolynomial}{SYMPOLY} +\pagepic{ps/v103symmetricpolynomial.ps}{SYMPOLY}{1.00} +See also:\\ +\refto{Partition}{PRTITION} +<>= +)abbrev domain SYMPOLY SymmetricPolynomial +++ Description: +++ This domain implements symmetric polynomial +SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add + Term:= Record(k:Partition,c:R) + Rep:= List Term + +-- override PR implementation because coeff. arithmetic too expensive (??) + + if R has EntireRing then + (p1:%) * (p2:%) == + null p1 => 0 + null p2 => 0 + zero?(p1.first.k) => p1.first.c * p2 +-- one? p2 => p1 + (p2 = 1) => p1 + +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2] + for t1 in reverse(p1)] + -- This 'reverse' is an efficiency improvement: + -- reduces both time and space [Abbott/Bradford/Davenport] + else + (p1:%) * (p2:%) == + null p1 => 0 + null p2 => 0 + zero?(p1.first.k) => p1.first.c * p2 +-- one? p2 => p1 + (p2 = 1) => p1 + +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0] + for t1 in reverse(p1)] + -- This 'reverse' is an efficiency improvement: + -- reduces both time and space [Abbott/Bradford/Davenport] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter T} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain TS TaylorSeries} @@ -52515,6 +58162,1190 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain UP UnivariatePolynomial} +<>= +-- poly.spad.pamphlet UnivariatePolynomial.input +)spool UnivariatePolynomial.output +)set message test on +)set message auto off +)clear all +--S 1 of 35 +(p,q) : UP(x,INT) +--R +--R Type: Void +--E 1 + +--S 2 of 35 +p := (3*x-1)**2 * (2*x + 8) +--R +--R +--R 3 2 +--R (2) 18x + 60x - 46x + 8 +--R Type: UnivariatePolynomial(x,Integer) +--E 2 + +--S 3 of 35 +q := (1 - 6*x + 9*x**2)**2 +--R +--R +--R 4 3 2 +--R (3) 81x - 108x + 54x - 12x + 1 +--R Type: UnivariatePolynomial(x,Integer) +--E 3 + +--S 4 of 35 +p**2 + p*q +--R +--R +--R 7 6 5 4 3 2 +--R (4) 1458x + 3240x - 7074x + 10584x - 9282x + 4120x - 878x + 72 +--R Type: UnivariatePolynomial(x,Integer) +--E 4 + +--S 5 of 35 +leadingCoefficient p +--R +--R +--R (5) 18 +--R Type: PositiveInteger +--E 5 + +--S 6 of 35 +degree p +--R +--R +--R (6) 3 +--R Type: PositiveInteger +--E 6 + +--S 7 of 35 +reductum p +--R +--R +--R 2 +--R (7) 60x - 46x + 8 +--R Type: UnivariatePolynomial(x,Integer) +--E 7 + +--S 8 of 35 +gcd(p,q) +--R +--R +--R 2 +--R (8) 9x - 6x + 1 +--R Type: UnivariatePolynomial(x,Integer) +--E 8 + +--S 9 of 35 +lcm(p,q) +--R +--R +--R 5 4 3 2 +--R (9) 162x + 432x - 756x + 408x - 94x + 8 +--R Type: UnivariatePolynomial(x,Integer) +--E 9 + +--S 10 of 35 +resultant(p,q) +--R +--R +--R (10) 0 +--R Type: NonNegativeInteger +--E 10 + +--S 11 of 35 +D p +--R +--R +--R 2 +--R (11) 54x + 120x - 46 +--R Type: UnivariatePolynomial(x,Integer) +--E 11 + +--S 12 of 35 +p(2) +--R +--R +--R (12) 300 +--R Type: PositiveInteger +--E 12 + +--S 13 of 35 +p(q) +--R +--R +--R (13) +--R 12 11 10 9 8 +--R 9565938x - 38263752x + 70150212x - 77944680x + 58852170x +--R + +--R 7 6 5 4 3 2 +--R - 32227632x + 13349448x - 4280688x + 1058184x - 192672x + 23328x +--R + +--R - 1536x + 40 +--R Type: UnivariatePolynomial(x,Integer) +--E 13 + +--S 14 of 35 +q(p) +--R +--R +--R (14) +--R 12 11 10 9 8 +--R 8503056x + 113374080x + 479950272x + 404997408x - 1369516896x +--R + +--R 7 6 5 4 3 +--R - 626146848x + 2939858712x - 2780728704x + 1364312160x - 396838872x +--R + +--R 2 +--R 69205896x - 6716184x + 279841 +--R Type: UnivariatePolynomial(x,Integer) +--E 14 + +--S 15 of 35 +l := coefficients p +--R +--R +--R (15) [18,60,- 46,8] +--R Type: List Integer +--E 15 + +--S 16 of 35 +reduce(gcd,l) +--R +--R +--R (16) 2 +--R Type: PositiveInteger +--E 16 + +--S 17 of 35 +content p +--R +--R +--R (17) 2 +--R Type: PositiveInteger +--E 17 + +--S 18 of 35 +ux := (x**4+2*x+3)::UP(x,INT) +--R +--R +--R 4 +--R (18) x + 2x + 3 +--R Type: UnivariatePolynomial(x,Integer) +--E 18 + +--S 19 of 35 +vectorise(ux,5) +--R +--R +--R (19) [3,2,0,0,1] +--R Type: Vector Integer +--E 19 + +--S 20 of 35 +squareTerms(p) == reduce(+,[t**2 for t in monomials p]) +--R +--R Type: Void +--E 20 + +--S 21 of 35 +p +--R +--R +--R 3 2 +--R (21) 18x + 60x - 46x + 8 +--R Type: UnivariatePolynomial(x,Integer) +--E 21 + +--S 22 of 35 +squareTerms p +--R +--R Compiling function squareTerms with type UnivariatePolynomial(x, +--R Integer) -> UnivariatePolynomial(x,Integer) +--R +--R 6 4 2 +--R (22) 324x + 3600x + 2116x + 64 +--R Type: UnivariatePolynomial(x,Integer) +--E 22 + +--S 23 of 35 +(r,s) : UP(a1,FRAC INT) +--R +--R Type: Void +--E 23 + +--S 24 of 35 +r := a1**2 - 2/3 +--R +--R +--R 2 2 +--R (24) a1 - - +--R 3 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 24 + +--S 25 of 35 +s := a1 + 4 +--R +--R +--R (25) a1 + 4 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 25 + +--S 26 of 35 +r quo s +--R +--R +--R (26) a1 - 4 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 26 + +--S 27 of 35 +r rem s +--R +--R +--R 46 +--R (27) -- +--R 3 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 27 + +--S 28 of 35 +d := divide(r, s) +--R +--R +--R 46 +--R (28) [quotient= a1 - 4,remainder= --] +--R 3 +--RType: Record(quotient: UnivariatePolynomial(a1,Fraction Integer),remainder: UnivariatePolynomial(a1,Fraction Integer)) +--E 28 + +--S 29 of 35 +r - (d.quotient * s + d.remainder) +--R +--R +--R (29) 0 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 29 + +--S 30 of 35 +integrate r +--R +--R +--R 1 3 2 +--R (30) - a1 - - a1 +--R 3 3 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 30 + +--S 31 of 35 +integrate s +--R +--R +--R 1 2 +--R (31) - a1 + 4a1 +--R 2 +--R Type: UnivariatePolynomial(a1,Fraction Integer) +--E 31 + +--S 32 of 35 +t : UP(a1,FRAC POLY INT) +--R +--R Type: Void +--E 32 + +--S 33 of 35 +t := a1**2 - a1/b2 + (b1**2-b1)/(b2+3) +--R +--R +--R 2 +--R 2 1 b1 - b1 +--R (33) a1 - -- a1 + -------- +--R b2 b2 + 3 +--R Type: UnivariatePolynomial(a1,Fraction Polynomial Integer) +--E 33 + +--S 34 of 35 +u : FRAC POLY INT := t +--R +--R +--R 2 2 2 2 +--R a1 b2 + (b1 - b1 + 3a1 - a1)b2 - 3a1 +--R (34) --------------------------------------- +--R 2 +--R b2 + 3b2 +--R Type: Fraction Polynomial Integer +--E 34 + +--S 35 of 35 +u :: UP(b1,?) +--R +--R +--R 2 +--R 1 2 1 a1 b2 - a1 +--R (35) ------ b1 - ------ b1 + ---------- +--R b2 + 3 b2 + 3 b2 +--R Type: UnivariatePolynomial(b1,Fraction Polynomial Integer) +--E 35 +)spool +)lisp (bye) +@ +<>= +==================================================================== +UnivariatePolynomial examples +==================================================================== + +The domain constructor UnivariatePolynomial (abbreviated UP) creates +domains of univariate polynomials in a specified variable. For +example, the domain UP(a1,POLY FRAC INT) provides polynomials in the +single variable a1 whose coefficients are general polynomials with +rational number coefficients. + +Restriction: Axiom does not allow you to create types where +UnivariatePolynomial is contained in the coefficient type of +Polynomial. Therefore, UP(x,POLY INT) is legal but POLY UP(x,INT) +is not. + +UP(x,INT) is the domain of polynomials in the single variable x with +integer coefficients. + + (p,q) : UP(x,INT) + Type: Void + + p := (3*x-1)**2 * (2*x + 8) + 3 2 + 18x + 60x - 46x + 8 + Type: UnivariatePolynomial(x,Integer) + + q := (1 - 6*x + 9*x**2)**2 + 4 3 2 + 81x - 108x + 54x - 12x + 1 + Type: UnivariatePolynomial(x,Integer) + +The usual arithmetic operations are available for univariate polynomials. + + p**2 + p*q + 7 6 5 4 3 2 + 1458x + 3240x - 7074x + 10584x - 9282x + 4120x - 878x + 72 + Type: UnivariatePolynomial(x,Integer) + +The operation leadingCoefficient extracts the coefficient of the term +of highest degree. + + leadingCoefficient p + 18 + Type: PositiveInteger + +The operation degree returns the degree of the polynomial. Since the +polynomial has only one variable, the variable is not supplied to +operations like degree. + + degree p + 3 + Type: PositiveInteger + +The reductum of the polynomial, the polynomial obtained by subtracting +the term of highest order, is returned by reductum. + + reductum p + 2 + 60x - 46x + 8 + Type: UnivariatePolynomial(x,Integer) + +The operation gcd computes the greatest common divisor of two polynomials. + + gcd(p,q) + 2 + 9x - 6x + 1 + Type: UnivariatePolynomial(x,Integer) + +The operation lcm computes the least common multiple. + + lcm(p,q) + 5 4 3 2 + 162x + 432x - 756x + 408x - 94x + 8 + Type: UnivariatePolynomial(x,Integer) + +The operation resultant computes the resultant of two univariate +polynomials. In the case of p and q, the resultant is 0 because they +share a common root. + + resultant(p,q) + 0 + Type: NonNegativeInteger + +To compute the derivative of a univariate polynomial with respect to its +variable, use the function D. + + D p + 2 + 54x + 120x - 46 + Type: UnivariatePolynomial(x,Integer) + +Univariate polynomials can also be used as if they were functions. To +evaluate a univariate polynomial at some point, apply the polynomial +to the point. + + p(2) + 300 + Type: PositiveInteger + +The same syntax is used for composing two univariate polynomials, i.e. +substituting one polynomial for the variable in another. This substitutes +q for the variable in p. + + p(q) + 12 11 10 9 8 + 9565938x - 38263752x + 70150212x - 77944680x + 58852170x + + + 7 6 5 4 3 2 + - 32227632x + 13349448x - 4280688x + 1058184x - 192672x + 23328x + + + - 1536x + 40 + Type: UnivariatePolynomial(x,Integer) + +This substitutes p for the variable in q. + + q(p) + 12 11 10 9 8 + 8503056x + 113374080x + 479950272x + 404997408x - 1369516896x + + + 7 6 5 4 3 + - 626146848x + 2939858712x - 2780728704x + 1364312160x - 396838872x + + + 2 + 69205896x - 6716184x + 279841 + Type: UnivariatePolynomial(x,Integer) + +To obtain a list of coefficients of the polynomial, use coefficients. + + l := coefficients p + [18,60,- 46,8] + Type: List Integer + +From this you can use gcd and reduce to compute the content of the polynomial. + + reduce(gcd,l) + 2 + Type: PositiveInteger + +Alternatively (and more easily), you can just call content. + + content p + 2 + Type: PositiveInteger + +Note that the operation coefficients omits the zero coefficients from +the list. Sometimes it is useful to convert a univariate polynomial +to a vector whose i-th position contains the degree i-1 coefficient of +the polynomial. + + ux := (x**4+2*x+3)::UP(x,INT) + 4 + x + 2x + 3 + Type: UnivariatePolynomial(x,Integer) + +To get a complete vector of coefficients, use the operation vectorise, +which takes a univariate polynomial and an integer denoting the length +of the desired vector. + + vectorise(ux,5) + [3,2,0,0,1] + Type: Vector Integer + +It is common to want to do something to every term of a polynomial, +creating a new polynomial in the process. + +This is a function for iterating across the terms of a polynomial, +squaring each term. + + squareTerms(p) == reduce(+,[t**2 for t in monomials p]) + Type: Void + +Recall what p looked like. + + p + 3 2 + 18x + 60x - 46x + 8 + Type: UnivariatePolynomial(x,Integer) + +We can demonstrate squareTerms on p. + + squareTerms p + 6 4 2 + 324x + 3600x + 2116x + 64 + Type: UnivariatePolynomial(x,Integer) + +When the coefficients of the univariate polynomial belong to a field, +it is possible to compute quotients and remainders. For example, when +the coefficients are rational numbers, as opposed to integers. The +important property of a field is that non-zero elements can be divided +and produce another element. The quotient of the integers 2 and 3 is +not another integer. + + (r,s) : UP(a1,FRAC INT) + Type: Void + + r := a1**2 - 2/3 + 2 2 + a1 - - + 3 + Type: UnivariatePolynomial(a1,Fraction Integer) + + s := a1 + 4 + a1 + 4 + Type: UnivariatePolynomial(a1,Fraction Integer) + +When the coefficients are rational numbers or rational expressions, +the operation quo computes the quotient of two polynomials. + + r quo s + a1 - 4 + Type: UnivariatePolynomial(a1,Fraction Integer) + +The operation rem computes the remainder. + + r rem s + 46 + -- + 3 + Type: UnivariatePolynomial(a1,Fraction Integer) + +The operation divide can be used to return a record of both components. + + d := divide(r, s) + 46 + [quotient= a1 - 4,remainder= --] + 3 + Type: Record(quotient: UnivariatePolynomial(a1,Fraction Integer), + remainder: UnivariatePolynomial(a1,Fraction Integer)) + +Now we check the arithmetic! + + r - (d.quotient * s + d.remainder) + 0 + Type: UnivariatePolynomial(a1,Fraction Integer) + +It is also possible to integrate univariate polynomials when the +coefficients belong to a field. + + integrate r + 1 3 2 + - a1 - - a1 + 3 3 + Type: UnivariatePolynomial(a1,Fraction Integer) + + integrate s + 1 2 + - a1 + 4a1 + 2 + Type: UnivariatePolynomial(a1,Fraction Integer) + +One application of univariate polynomials is to see expressions in terms +of a specific variable. + +We start with a polynomial in a1 whose coefficients are quotients of +polynomials in b1 and b2. + + t : UP(a1,FRAC POLY INT) + Type: Void + +Since in this case we are not talking about using multivariate +polynomials in only two variables, we use Polynomial. We also use +Fraction because we want fractions. + + t := a1**2 - a1/b2 + (b1**2-b1)/(b2+3) + 2 + 2 1 b1 - b1 + a1 - -- a1 + -------- + b2 b2 + 3 + Type: UnivariatePolynomial(a1,Fraction Polynomial Integer) + +We push all the variables into a single quotient of polynomials. + + u : FRAC POLY INT := t + 2 2 2 2 + a1 b2 + (b1 - b1 + 3a1 - a1)b2 - 3a1 + --------------------------------------- + 2 + b2 + 3b2 + Type: Fraction Polynomial Integer + +Alternatively, we can view this as a polynomial in the variable This +is a mode-directed conversion: you indicate as much of the structure +as you care about and let Axiom decide on the full type and how to do +the transformation. + + u :: UP(b1,?) + 2 + 1 2 1 a1 b2 - a1 + ------ b1 - ------ b1 + ---------- + b2 + 3 b2 + 3 b2 + Type: UnivariatePolynomial(b1,Fraction Polynomial Integer) + +See Also: +o )help MultivariatePolynomial +o )help DistributedMultivariatePolynomial +o )show UnivariatePolynomial +o $AXIOM/doc/src/algebra/poly.spad.dvi + +@ +\pagehead{UnivariatePolynomial}{UP} +\pagepic{ps/v103univariatepolynomial.ps}{UP}{1.00} +See also:\\ +\refto{FreeModule}{FM} +\refto{PolynomialRing}{PR} +\refto{SparseUnivariatePolynomial}{SUP} +<>= +)abbrev domain UP UnivariatePolynomial +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: Ring, monomial, coefficient, reductum, differentiate, +++ elt, map, resultant, discriminant +++ Related Constructors: SparseUnivariatePolynomial, MultivariatePolynomial +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain represents univariate polynomials in some symbol +++ over arbitrary (not necessarily commutative) coefficient rings. +++ The representation is sparse +++ in the sense that only non-zero terms are represented. +++ Note: if the coefficient ring is a field, then this domain forms a euclidean domain. + +UnivariatePolynomial(x:Symbol, R:Ring): + UnivariatePolynomialCategory(R) with + coerce: Variable(x) -> % + ++ coerce(x) converts the variable x to a univariate polynomial. + fmecg: (%,NonNegativeInteger,R,%) -> % + ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 + == SparseUnivariatePolynomial(R) add + Rep:=SparseUnivariatePolynomial(R) + coerce(p:%):OutputForm == outputForm(p, outputForm x) + coerce(v:Variable(x)):% == monomial(1, 1) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain UPXS UnivariatePuiseuxSeries} +\pagehead{UnivariatePuiseuxSeries}{UPXS} +\pagepic{ps/v103univariatepuiseuxseries.ps}{UPXS}{1.00} +See also:\\ +\refto{UnivariatePuiseuxSeriesConstructor}{UPXSCONS} +<>= +)abbrev domain UPXS UnivariatePuiseuxSeries +++ Author: Clifton J. Williamson +++ Date Created: 28 January 1990 +++ Date Last Updated: 21 September 1993 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: series, Puiseux +++ Examples: +++ References: +++ Description: Dense Puiseux series in one variable +++ \spadtype{UnivariatePuiseuxSeries} is a domain representing Puiseux +++ series in one variable with coefficients in an arbitrary ring. The +++ parameters of the type specify the coefficient ring, the power series +++ variable, and the center of the power series expansion. For example, +++ \spad{UnivariatePuiseuxSeries(Integer,x,3)} represents Puiseux series in +++ \spad{(x - 3)} with \spadtype{Integer} coefficients. +UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where + Coef : Ring + var : Symbol + cen : Coef + I ==> Integer + L ==> List + NNI ==> NonNegativeInteger + OUT ==> OutputForm + RN ==> Fraction Integer + ST ==> Stream Coef + UTS ==> UnivariateTaylorSeries(Coef,var,cen) + ULS ==> UnivariateLaurentSeries(Coef,var,cen) + + Exports ==> Join(UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS),_ + RetractableTo UTS) with + coerce: Variable(var) -> % + ++ coerce(var) converts the series variable \spad{var} into a + ++ Puiseux series. + differentiate: (%,Variable(var)) -> % + ++ \spad{differentiate(f(x),x)} returns the derivative of + ++ \spad{f(x)} with respect to \spad{x}. + if Coef has Algebra Fraction Integer then + integrate: (%,Variable(var)) -> % + ++ \spad{integrate(f(x))} returns an anti-derivative of the power + ++ series \spad{f(x)} with constant coefficient 0. + ++ We may integrate a series when we can divide coefficients + ++ by integers. + + Implementation ==> UnivariatePuiseuxSeriesConstructor(Coef,ULS) add + + Rep := Record(expon:RN,lSeries:ULS) + + getExpon: % -> RN + getExpon pxs == pxs.expon + + variable upxs == var + center upxs == cen + + coerce(uts:UTS) == uts :: ULS :: % + + retractIfCan(upxs:%):Union(UTS,"failed") == + (ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" => + "failed" + retractIfCan(ulsIfCan :: ULS) + + --retract(upxs:%):UTS == + --(ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" => + --error "retractIfCan: series has fractional exponents" + --utsIfCan := retractIfCan(ulsIfCan :: ULS)@Union(UTS,"failed") + --utsIfCan case "failed" => + --error "retractIfCan: series has negative exponents" + --utsIfCan :: UTS + + coerce(v:Variable(var)) == + zero? cen => monomial(1,1) + monomial(1,1) + monomial(cen,0) + + if Coef has "*": (Fraction Integer, Coef) -> Coef then + differentiate(upxs:%,v:Variable(var)) == differentiate upxs + + if Coef has Algebra Fraction Integer then + integrate(upxs:%,v:Variable(var)) == integrate upxs + + if Coef has coerce: Symbol -> Coef then + if Coef has "**": (Coef,RN) -> Coef then + + roundDown: RN -> I + roundDown rn == + -- returns the largest integer <= rn + (den := denom rn) = 1 => numer rn + n := (num := numer rn) quo den + positive?(num) => n + n - 1 + + stToCoef: (ST,Coef,NNI,NNI) -> Coef + stToCoef(st,term,n,n0) == + (n > n0) or (empty? st) => 0 + frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0) + + approximateLaurent: (ULS,Coef,I) -> Coef + approximateLaurent(x,term,n) == + (m := n - (e := degree x)) < 0 => 0 + app := stToCoef(coefficients taylorRep x,term,0,m :: NNI) + zero? e => app + app * term ** (e :: RN) + + approximate(x,r) == + e := rationalPower(x) + term := ((variable(x) :: Coef) - center(x)) ** e + approximateLaurent(laurentRep x,term,roundDown(r / e)) + + termOutput:(RN,Coef,OUT) -> OUT + termOutput(k,c,vv) == + -- creates a term c * vv ** k + k = 0 => c :: OUT + mon := + k = 1 => vv + vv ** (k :: OUT) + c = 1 => mon + c = -1 => -mon + (c :: OUT) * mon + + showAll?:() -> Boolean + -- check a global Lisp variable + showAll?() == true + + termsToOutputForm:(RN,RN,ST,OUT) -> OUT + termsToOutputForm(m,rat,uu,xxx) == + l : L OUT := empty() + empty? uu => 0 :: OUT + n : NNI; count : NNI := _$streamCount$Lisp + for n in 0..count while not empty? uu repeat + if frst(uu) ^= 0 then + l := concat(termOutput((n :: I) * rat + m,frst uu,xxx),l) + uu := rst uu + if showAll?() then + for n in (count + 1).. while explicitEntries? uu and _ + not eq?(uu,rst uu) repeat + if frst(uu) ^= 0 then + l := concat(termOutput((n :: I) * rat + m,frst uu,xxx),l) + uu := rst uu + l := + explicitlyEmpty? uu => l + eq?(uu,rst uu) and frst uu = 0 => l + concat(prefix("O" :: OUT,[xxx ** (((n::I) * rat + m) :: OUT)]),l) + empty? l => 0 :: OUT + reduce("+",reverse_! l) + + coerce(upxs:%):OUT == + rat := getExpon upxs; uls := laurentRep upxs + count : I := _$streamCount$Lisp + uls := removeZeroes(_$streamCount$Lisp,uls) + m : RN := (degree uls) * rat + p := coefficients taylorRep uls + xxx := + zero? cen => var :: OUT + paren(var :: OUT - cen :: OUT) + termsToOutputForm(m,rat,p,xxx) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain UPXSCONS UnivariatePuiseuxSeriesConstructor} +\pagehead{UnivariatePuiseuxSeriesConstructor}{UPXSCONS} +\pagepic{ps/v103univariatepuiseuxseriesconstructor.ps}{UPXSCONS}{1.00} +See also:\\ +\refto{UnivariatePuiseuxSeries}{UPXS} +<>= +)abbrev domain UPXSCONS UnivariatePuiseuxSeriesConstructor +++ Author: Clifton J. Williamson +++ Date Created: 9 May 1989 +++ Date Last Updated: 30 November 1994 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: series, Puiseux, Laurent +++ Examples: +++ References: +++ Description: +++ This package enables one to construct a univariate Puiseux series +++ domain from a univariate Laurent series domain. Univariate +++ Puiseux series are represented by a pair \spad{[r,f(x)]}, where r is +++ a positive rational number and \spad{f(x)} is a Laurent series. +++ This pair represents the Puiseux series \spad{f(x^r)}. + +UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ + Exports == Implementation where + Coef : Ring + ULS : UnivariateLaurentSeriesCategory Coef + I ==> Integer + L ==> List + NNI ==> NonNegativeInteger + OUT ==> OutputForm + PI ==> PositiveInteger + RN ==> Fraction Integer + ST ==> Stream Coef + LTerm ==> Record(k:I,c:Coef) + PTerm ==> Record(k:RN,c:Coef) + ST2LP ==> StreamFunctions2(LTerm,PTerm) + ST2PL ==> StreamFunctions2(PTerm,LTerm) + + Exports ==> UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS) + + Implementation ==> add + +--% representation + + Rep := Record(expon:RN,lSeries:ULS) + + getExpon: % -> RN + getULS : % -> ULS + + getExpon pxs == pxs.expon + getULS pxs == pxs.lSeries + +--% creation and destruction + + puiseux(n,ls) == [n,ls] + laurentRep x == getULS x + rationalPower x == getExpon x + degree x == getExpon(x) * degree(getULS(x)) + + 0 == puiseux(1,0) + 1 == puiseux(1,1) + + monomial(c,k) == + k = 0 => c :: % + k < 0 => puiseux(-k,monomial(c,-1)) + puiseux(k,monomial(c,1)) + + coerce(ls:ULS) == puiseux(1,ls) + coerce(r:Coef) == r :: ULS :: % + coerce(i:I) == i :: Coef :: % + + laurentIfCan upxs == + r := getExpon upxs +-- one? denom r => + (denom r) = 1 => + multiplyExponents(getULS upxs,numer(r) :: PI) + "failed" + + laurent upxs == + (uls := laurentIfCan upxs) case "failed" => + error "laurent: Puiseux series has fractional powers" + uls :: ULS + + multExp: (RN,LTerm) -> PTerm + multExp(r,lTerm) == [r * lTerm.k,lTerm.c] + + terms upxs == map(multExp(getExpon upxs,#1),terms getULS upxs)$ST2LP + + clearDen: (I,PTerm) -> LTerm + clearDen(n,lTerm) == + (int := retractIfCan(n * lTerm.k)@Union(I,"failed")) case "failed" => + error "series: inappropriate denominator" + [int :: I,lTerm.c] + + series(n,stream) == + str := map(clearDen(n,#1),stream)$ST2PL + puiseux(1/n,series str) + +--% normalizations + + rewrite:(%,PI) -> % + rewrite(upxs,m) == + -- rewrites a series in x**r as a series in x**(r/m) + puiseux((getExpon upxs)*(1/m),multiplyExponents(getULS upxs,m)) + + ratGcd: (RN,RN) -> RN + ratGcd(r1,r2) == + -- if r1 = prod(p prime,p ** ep(r1)) and + -- if r2 = prod(p prime,p ** ep(r2)), then + -- ratGcd(r1,r2) = prod(p prime,p ** min(ep(r1),ep(r2))) + gcd(numer r1,numer r2) / lcm(denom r1,denom r2) + + withNewExpon:(%,RN) -> % + withNewExpon(upxs,r) == + rewrite(upxs,numer(getExpon(upxs)/r) pretend PI) + +--% predicates + + upxs1 = upxs2 == + r1 := getExpon upxs1; r2 := getExpon upxs2 + ls1 := getULS upxs1; ls2 := getULS upxs2 + (r1 = r2) => (ls1 = ls2) + r := ratGcd(r1,r2) + m1 := numer(getExpon(upxs1)/r) pretend PI + m2 := numer(getExpon(upxs2)/r) pretend PI + multiplyExponents(ls1,m1) = multiplyExponents(ls2,m2) + + pole? upxs == pole? getULS upxs + +--% arithmetic + + applyFcn:((ULS,ULS) -> ULS,%,%) -> % + applyFcn(op,pxs1,pxs2) == + r1 := getExpon pxs1; r2 := getExpon pxs2 + ls1 := getULS pxs1; ls2 := getULS pxs2 + (r1 = r2) => puiseux(r1,op(ls1,ls2)) + r := ratGcd(r1,r2) + m1 := numer(getExpon(pxs1)/r) pretend PI + m2 := numer(getExpon(pxs2)/r) pretend PI + puiseux(r,op(multiplyExponents(ls1,m1),multiplyExponents(ls2,m2))) + + pxs1 + pxs2 == applyFcn(#1 +$ULS #2,pxs1,pxs2) + pxs1 - pxs2 == applyFcn(#1 -$ULS #2,pxs1,pxs2) + pxs1:% * pxs2:% == applyFcn(#1 *$ULS #2,pxs1,pxs2) + + pxs:% ** n:NNI == puiseux(getExpon pxs,getULS(pxs)**n) + + recip pxs == + rec := recip getULS pxs + rec case "failed" => "failed" + puiseux(getExpon pxs,rec :: ULS) + + RATALG : Boolean := Coef has Algebra(Fraction Integer) + + elt(upxs1:%,upxs2:%) == + uls1 := laurentRep upxs1; uls2 := laurentRep upxs2 + r1 := rationalPower upxs1; r2 := rationalPower upxs2 + (n := retractIfCan(r1)@Union(Integer,"failed")) case Integer => + puiseux(r2,uls1(uls2 ** r1)) + RATALG => + if zero? (coef := coefficient(uls2,deg := degree uls2)) then + deg := order(uls2,deg + 1000) + zero? (coef := coefficient(uls2,deg)) => + error "elt: series with many leading zero coefficients" + -- a fractional power of a Laurent series may not be defined: + -- if f(x) = c * x**n + ..., then f(x) ** (p/q) will be defined + -- only if q divides n + b := lcm(denom r1,deg); c := b quo deg + mon : ULS := monomial(1,c) + uls2 := elt(uls2,mon) ** r1 + puiseux(r2*(1/c),elt(uls1,uls2)) + error "elt: rational powers not available for this coefficient domain" + + if Coef has "**": (Coef,Integer) -> Coef and + Coef has "**": (Coef, RN) -> Coef then + eval(upxs:%,a:Coef) == eval(getULS upxs,a ** getExpon(upxs)) + + if Coef has Field then + + pxs1:% / pxs2:% == applyFcn(#1 /$ULS #2,pxs1,pxs2) + + inv upxs == + (invUpxs := recip upxs) case "failed" => + error "inv: multiplicative inverse does not exist" + invUpxs :: % + +--% values + + variable upxs == variable getULS upxs + center upxs == center getULS upxs + + coefficient(upxs,rn) == +-- one? denom(n := rn / getExpon upxs) => + (denom(n := rn / getExpon upxs)) = 1 => + coefficient(getULS upxs,numer n) + 0 + + elt(upxs:%,rn:RN) == coefficient(upxs,rn) + +--% other functions + + roundDown: RN -> I + roundDown rn == + -- returns the largest integer <= rn + (den := denom rn) = 1 => numer rn + n := (num := numer rn) quo den + positive?(num) => n + n - 1 + + roundUp: RN -> I + roundUp rn == + -- returns the smallest integer >= rn + (den := denom rn) = 1 => numer rn + n := (num := numer rn) quo den + positive?(num) => n + 1 + n + + order upxs == getExpon upxs * order getULS upxs + order(upxs,r) == + e := getExpon upxs + ord := order(getULS upxs, n := roundDown(r / e)) + ord = n => r + ord * e + + truncate(upxs,r) == + e := getExpon upxs + puiseux(e,truncate(getULS upxs,roundDown(r / e))) + + truncate(upxs,r1,r2) == + e := getExpon upxs + puiseux(e,truncate(getULS upxs,roundUp(r1 / e),roundDown(r2 / e))) + + complete upxs == puiseux(getExpon upxs,complete getULS upxs) + extend(upxs,r) == + e := getExpon upxs + puiseux(e,extend(getULS upxs,roundDown(r / e))) + + map(fcn,upxs) == puiseux(getExpon upxs,map(fcn,getULS upxs)) + + characteristic() == characteristic()$Coef + + -- multiplyCoefficients(f,upxs) == + -- r := getExpon upxs + -- puiseux(r,multiplyCoefficients(f(#1 * r),getULS upxs)) + + multiplyExponents(upxs:%,n:RN) == + puiseux(n * getExpon(upxs),getULS upxs) + multiplyExponents(upxs:%,n:PI) == + puiseux(n * getExpon(upxs),getULS upxs) + + if Coef has "*": (Fraction Integer, Coef) -> Coef then + + differentiate upxs == + r := getExpon upxs + puiseux(r,differentiate getULS upxs) * monomial(r :: Coef,r-1) + + if Coef has PartialDifferentialRing(Symbol) then + + differentiate(upxs:%,s:Symbol) == + (s = variable(upxs)) => differentiate upxs + dcds := differentiate(center upxs,s) + map(differentiate(#1,s),upxs) - dcds*differentiate(upxs) + + if Coef has Algebra Fraction Integer then + + coerce(r:RN) == r :: Coef :: % + + ratInv: RN -> Coef + ratInv r == + zero? r => 1 + inv(r) :: Coef + + integrate upxs == + not zero? coefficient(upxs,-1) => + error "integrate: series has term of order -1" + r := getExpon upxs + uls := getULS upxs + uls := multiplyCoefficients(ratInv(#1 * r + 1),uls) + monomial(1,1) * puiseux(r,uls) + + if Coef has integrate: (Coef,Symbol) -> Coef and _ + Coef has variables: Coef -> List Symbol then + + integrate(upxs:%,s:Symbol) == + (s = variable(upxs)) => integrate upxs + not entry?(s,variables center upxs) => map(integrate(#1,s),upxs) + error "integrate: center is a function of variable of integration" + + if Coef has TranscendentalFunctionCategory and _ + Coef has PrimitiveFunctionCategory and _ + Coef has AlgebraicallyClosedFunctionSpace Integer then + + integrateWithOneAnswer: (Coef,Symbol) -> Coef + integrateWithOneAnswer(f,s) == + res := integrate(f,s)$FunctionSpaceIntegration(I,Coef) + res case Coef => res :: Coef + first(res :: List Coef) + + integrate(upxs:%,s:Symbol) == + (s = variable(upxs)) => integrate upxs + not entry?(s,variables center upxs) => + map(integrateWithOneAnswer(#1,s),upxs) + error "integrate: center is a function of variable of integration" + + if Coef has Field then + (upxs:%) ** (q:RN) == + num := numer q; den := denom q +-- one? den => upxs ** num + den = 1 => upxs ** num + r := rationalPower upxs; uls := laurentRep upxs + deg := degree uls + if zero?(coef := coefficient(uls,deg)) then + deg := order(uls,deg + 1000) + zero?(coef := coefficient(uls,deg)) => + error "power of series with many leading zero coefficients" + ulsPow := (uls * monomial(1,-deg)$ULS) ** q + puiseux(r,ulsPow) * monomial(1,deg*q*r) + + applyUnary: (ULS -> ULS,%) -> % + applyUnary(fcn,upxs) == + puiseux(rationalPower upxs,fcn laurentRep upxs) + + exp upxs == applyUnary(exp,upxs) + log upxs == applyUnary(log,upxs) + sin upxs == applyUnary(sin,upxs) + cos upxs == applyUnary(cos,upxs) + tan upxs == applyUnary(tan,upxs) + cot upxs == applyUnary(cot,upxs) + sec upxs == applyUnary(sec,upxs) + csc upxs == applyUnary(csc,upxs) + asin upxs == applyUnary(asin,upxs) + acos upxs == applyUnary(acos,upxs) + atan upxs == applyUnary(atan,upxs) + acot upxs == applyUnary(acot,upxs) + asec upxs == applyUnary(asec,upxs) + acsc upxs == applyUnary(acsc,upxs) + sinh upxs == applyUnary(sinh,upxs) + cosh upxs == applyUnary(cosh,upxs) + tanh upxs == applyUnary(tanh,upxs) + coth upxs == applyUnary(coth,upxs) + sech upxs == applyUnary(sech,upxs) + csch upxs == applyUnary(csch,upxs) + asinh upxs == applyUnary(asinh,upxs) + acosh upxs == applyUnary(acosh,upxs) + atanh upxs == applyUnary(atanh,upxs) + acoth upxs == applyUnary(acoth,upxs) + asech upxs == applyUnary(asech,upxs) + acsch upxs == applyUnary(acsch,upxs) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain UPXSSING UnivariatePuiseuxSeriesWithExponentialSingularity} \pagehead{UnivariatePuiseuxSeriesWithExponentialSingularity}{UPXSSING} \pagepic{ps/v103univariatepuiseuxserieswithexponentialsingularity.ps}{UPXSSING}{1.00} @@ -55808,6 +62639,8 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> <> <> <> @@ -55893,6 +62726,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> <> @@ -55900,6 +62734,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> @@ -55925,6 +62760,8 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> +<> <> <> <> @@ -55990,14 +62827,32 @@ Note that this code is not included in the generated catdef.spad file. <> <> -<> +<> +<> +<> <> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> <> +<> +<> +<> <> <> <> +<> <> +<> <> +<> <> <> @@ -56018,6 +62873,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> <> @@ -56028,6 +62884,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> @@ -56038,6 +62895,9 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> +<> <> <> diff --git a/books/ps/v103balancedpadicinteger.ps b/books/ps/v103balancedpadicinteger.ps new file mode 100644 index 0000000..a669187 --- /dev/null +++ b/books/ps/v103balancedpadicinteger.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 186 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 186 80 +%%PageOrientation: Portrait +gsave +36 36 150 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +148 42 lineto +148 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +148 42 lineto +148 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% BalancedPAdicInteger +[ /Rect [ 0 0 142 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=BPADIC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 142 36 moveto +0 36 lineto +0 0 lineto +142 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 142 36 moveto +0 36 lineto +0 0 lineto +142 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(BalancedPAdicInteger) +[9.36 6.24 3.84 6.24 6.96 6.24 6.24 6.96 6.48 9.6 6.96 3.84 6.24 4.56 6.96 3.84 6.24 6.72 6.24 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103balancedpadicrational.ps b/books/ps/v103balancedpadicrational.ps new file mode 100644 index 0000000..ed11f77 --- /dev/null +++ b/books/ps/v103balancedpadicrational.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 194 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 194 80 +%%PageOrientation: Portrait +gsave +36 36 158 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +156 42 lineto +156 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +156 42 lineto +156 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% BalancedPAdicRational +[ /Rect [ 0 0 150 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=BPADICRT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 150 36 moveto +0 36 lineto +0 0 lineto +150 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 150 36 moveto +0 36 lineto +0 0 lineto +150 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(BalancedPAdicRational) +[9.36 6.24 3.84 6.24 6.96 6.24 6.24 6.96 6.48 9.6 6.96 3.84 6.24 9.36 6.24 3.84 3.84 6.96 6.96 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103freemodule.ps b/books/ps/v103freemodule.ps new file mode 100644 index 0000000..b9a670b --- /dev/null +++ b/books/ps/v103freemodule.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 128 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 128 80 +%%PageOrientation: Portrait +gsave +36 36 92 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +90 42 lineto +90 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +90 42 lineto +90 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FreeModule +[ /Rect [ 0 0 84 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FM) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 84 36 moveto +0 36 lineto +0 0 lineto +84 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 84 36 moveto +0 36 lineto +0 0 lineto +84 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FreeModule) +[7.44 4.8 6.24 6.24 12.48 6.96 6.96 6.96 3.84 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103generalpolynomialset.ps b/books/ps/v103generalpolynomialset.ps new file mode 100644 index 0000000..4b4b19a --- /dev/null +++ b/books/ps/v103generalpolynomialset.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 186 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 186 80 +%%PageOrientation: Portrait +gsave +36 36 150 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +148 42 lineto +148 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +148 42 lineto +148 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% GeneralPolynomialSet +[ /Rect [ 0 0 142 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=GPOLSET) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 142 36 moveto +0 36 lineto +0 0 lineto +142 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 142 36 moveto +0 36 lineto +0 0 lineto +142 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(GeneralPolynomialSet) +[10.08 6.24 6.96 6.24 4.8 6.24 3.84 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84 7.68 6 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103innerpadicinteger.ps b/books/ps/v103innerpadicinteger.ps new file mode 100644 index 0000000..0d24112 --- /dev/null +++ b/books/ps/v103innerpadicinteger.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 164 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 164 80 +%%PageOrientation: Portrait +gsave +36 36 128 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% InnerPAdicInteger +[ /Rect [ 0 0 120 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IPADIC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(InnerPAdicInteger) +[4.56 6.96 6.96 6.24 4.8 6.48 9.6 6.96 3.84 6.24 4.56 6.96 3.84 6.24 6.72 6.24 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103innerprimefield.ps b/books/ps/v103innerprimefield.ps new file mode 100644 index 0000000..7a0af19 --- /dev/null +++ b/books/ps/v103innerprimefield.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 152 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 152 80 +%%PageOrientation: Portrait +gsave +36 36 116 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +114 42 lineto +114 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +114 42 lineto +114 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% InnerPrimeField +[ /Rect [ 0 0 108 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IPF) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(InnerPrimeField) +[4.56 6.96 6.96 6.24 4.8 7.68 5.04 3.84 10.8 6.24 7.44 3.84 6.24 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103padicinteger.ps b/books/ps/v103padicinteger.ps new file mode 100644 index 0000000..c8d9c73 --- /dev/null +++ b/books/ps/v103padicinteger.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 134 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 134 80 +%%PageOrientation: Portrait +gsave +36 36 98 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +96 42 lineto +96 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +96 42 lineto +96 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PAdicInteger +[ /Rect [ 0 0 90 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PADIC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 90 36 moveto +0 36 lineto +0 0 lineto +90 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 90 36 moveto +0 36 lineto +0 0 lineto +90 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PAdicInteger) +[6.48 9.6 6.96 3.84 6.24 4.56 6.96 3.84 6.24 6.72 6.24 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103padicrational.ps b/books/ps/v103padicrational.ps new file mode 100644 index 0000000..acbb595 --- /dev/null +++ b/books/ps/v103padicrational.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 142 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 142 80 +%%PageOrientation: Portrait +gsave +36 36 106 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +104 42 lineto +104 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +104 42 lineto +104 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PAdicRational +[ /Rect [ 0 0 98 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PADICRAT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 98 36 moveto +0 36 lineto +0 0 lineto +98 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 98 36 moveto +0 36 lineto +0 0 lineto +98 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PAdicRational) +[6.48 9.6 6.96 3.84 6.24 9.36 6.24 3.84 3.84 6.96 6.96 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103padicrationalconstructor.ps b/books/ps/v103padicrationalconstructor.ps new file mode 100644 index 0000000..f86fa40 --- /dev/null +++ b/books/ps/v103padicrationalconstructor.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 208 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 208 80 +%%PageOrientation: Portrait +gsave +36 36 172 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +170 42 lineto +170 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +170 42 lineto +170 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PAdicRationalConstructor +[ /Rect [ 0 0 164 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PADICRC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 164 36 moveto +0 36 lineto +0 0 lineto +164 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 164 36 moveto +0 36 lineto +0 0 lineto +164 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PAdicRationalConstructor) +[6.48 9.6 6.96 3.84 6.24 9.36 6.24 3.84 3.84 6.96 6.96 6.24 3.84 9.36 6.96 6.96 5.28 3.84 5.04 6.96 6.24 3.84 6.96 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103parametricplanecurve.ps b/books/ps/v103parametricplanecurve.ps new file mode 100644 index 0000000..a57a8ab --- /dev/null +++ b/books/ps/v103parametricplanecurve.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 186 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 186 80 +%%PageOrientation: Portrait +gsave +36 36 150 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +148 42 lineto +148 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +148 42 lineto +148 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% ParametricPlaneCurve +[ /Rect [ 0 0 142 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PARPCURV) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 142 36 moveto +0 36 lineto +0 0 lineto +142 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 142 36 moveto +0 36 lineto +0 0 lineto +142 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(ParametricPlaneCurve) +[7.44 6.24 4.8 6.24 10.8 6 3.84 5.04 3.84 6.24 7.68 3.84 6.24 6.96 6.24 9.36 6.96 5.04 6.48 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103parametricspacecurve.ps b/books/ps/v103parametricspacecurve.ps new file mode 100644 index 0000000..c1eb792 --- /dev/null +++ b/books/ps/v103parametricspacecurve.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 190 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 190 80 +%%PageOrientation: Portrait +gsave +36 36 154 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +152 42 lineto +152 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +152 42 lineto +152 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% ParametricSpaceCurve +[ /Rect [ 0 0 146 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PARSCURV) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 146 36 moveto +0 36 lineto +0 0 lineto +146 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 146 36 moveto +0 36 lineto +0 0 lineto +146 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(ParametricSpaceCurve) +[7.44 6.24 4.8 6.24 10.8 6 3.84 5.04 3.84 6.24 7.68 6.96 6.24 6.24 6.24 9.36 6.96 5.04 6.48 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103parametricsurface.ps b/books/ps/v103parametricsurface.ps new file mode 100644 index 0000000..38bafb0 --- /dev/null +++ b/books/ps/v103parametricsurface.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 164 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 164 80 +%%PageOrientation: Portrait +gsave +36 36 128 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% ParametricSurface +[ /Rect [ 0 0 120 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PARSURF) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(ParametricSurface) +[7.44 6.24 4.8 6.24 10.8 6 3.84 5.04 3.84 6.24 7.68 6.96 5.04 4.32 6.24 6.24 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103partialfraction.ps b/books/ps/v103partialfraction.ps new file mode 100644 index 0000000..9076c49 --- /dev/null +++ b/books/ps/v103partialfraction.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 144 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 144 80 +%%PageOrientation: Portrait +gsave +36 36 108 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +106 42 lineto +106 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +106 42 lineto +106 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PartialFraction +[ /Rect [ 0 0 100 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PFR) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 100 36 moveto +0 36 lineto +0 0 lineto +100 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 100 36 moveto +0 36 lineto +0 0 lineto +100 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PartialFraction) +[7.44 6.24 5.04 3.84 3.84 6.24 3.84 7.44 4.8 6.24 6.24 3.84 3.84 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103partition.ps b/books/ps/v103partition.ps new file mode 100644 index 0000000..f6d70d4 --- /dev/null +++ b/books/ps/v103partition.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 110 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 80 +%%PageOrientation: Portrait +gsave +36 36 74 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +72 42 lineto +72 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +72 42 lineto +72 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Partition +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PRTITION) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 66 36 moveto +0 36 lineto +0 0 lineto +66 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 66 36 moveto +0 36 lineto +0 0 lineto +66 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Partition) +[7.44 6.24 5.04 3.84 3.84 3.84 3.84 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103pattern.ps b/books/ps/v103pattern.ps new file mode 100644 index 0000000..26b3a1c --- /dev/null +++ b/books/ps/v103pattern.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 100 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 100 80 +%%PageOrientation: Portrait +gsave +36 36 64 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +62 42 lineto +62 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +62 42 lineto +62 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Pattern +[ /Rect [ 0 0 56 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PATTERN) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 56 36 moveto +0 36 lineto +0 0 lineto +56 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 56 36 moveto +0 36 lineto +0 0 lineto +56 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Pattern) +[7.44 6.24 3.84 3.84 6.24 5.04 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103patternmatchlistresult.ps b/books/ps/v103patternmatchlistresult.ps new file mode 100644 index 0000000..61b9fa2 --- /dev/null +++ b/books/ps/v103patternmatchlistresult.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 194 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 194 80 +%%PageOrientation: Portrait +gsave +36 36 158 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +156 42 lineto +156 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +156 42 lineto +156 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PatternMatchListResult +[ /Rect [ 0 0 150 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PATLRES) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 150 36 moveto +0 36 lineto +0 0 lineto +150 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 150 36 moveto +0 36 lineto +0 0 lineto +150 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PatternMatchListResult) +[7.44 6.24 3.84 3.84 6.24 5.04 6.96 12.48 6.24 3.84 6 6.96 8.64 3.84 5.28 3.84 9.12 6.24 5.52 6.96 3.84 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103patternmatchresult.ps b/books/ps/v103patternmatchresult.ps new file mode 100644 index 0000000..538b389 --- /dev/null +++ b/books/ps/v103patternmatchresult.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 172 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 172 80 +%%PageOrientation: Portrait +gsave +36 36 136 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +134 42 lineto +134 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +134 42 lineto +134 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PatternMatchResult +[ /Rect [ 0 0 128 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PATRES) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 128 36 moveto +0 36 lineto +0 0 lineto +128 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 128 36 moveto +0 36 lineto +0 0 lineto +128 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PatternMatchResult) +[7.44 6.24 3.84 3.84 6.24 5.04 6.96 12.48 6.24 3.84 6 6.96 9.12 6.24 5.52 6.96 3.84 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103permutation.ps b/books/ps/v103permutation.ps new file mode 100644 index 0000000..f5ab1c6 --- /dev/null +++ b/books/ps/v103permutation.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 130 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 130 80 +%%PageOrientation: Portrait +gsave +36 36 94 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +92 42 lineto +92 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +92 42 lineto +92 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Permutation +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PERM) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Permutation) +[7.44 6.24 5.04 10.8 6.96 4.08 6.24 3.84 3.84 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103permutationgroup.ps b/books/ps/v103permutationgroup.ps new file mode 100644 index 0000000..c67260a --- /dev/null +++ b/books/ps/v103permutationgroup.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 166 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 166 80 +%%PageOrientation: Portrait +gsave +36 36 130 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +128 42 lineto +128 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +128 42 lineto +128 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PermutationGroup +[ /Rect [ 0 0 122 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PERMGRP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 122 36 moveto +0 36 lineto +0 0 lineto +122 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 122 36 moveto +0 36 lineto +0 0 lineto +122 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PermutationGroup) +[7.44 6.24 5.04 10.8 6.96 4.08 6.24 3.84 3.84 6.96 6.96 10.08 4.8 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103plot.ps b/books/ps/v103plot.ps new file mode 100644 index 0000000..f074345 --- /dev/null +++ b/books/ps/v103plot.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Plot +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PLOT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +15 13 moveto +(Plot) +[7.68 3.84 6.72 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103plot3d.ps b/books/ps/v103plot3d.ps new file mode 100644 index 0000000..1404da4 --- /dev/null +++ b/books/ps/v103plot3d.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 100 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 100 80 +%%PageOrientation: Portrait +gsave +36 36 64 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +62 42 lineto +62 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +62 42 lineto +62 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Plot3D +[ /Rect [ 0 0 56 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PLOT3D) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 56 36 moveto +0 36 lineto +0 0 lineto +56 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 56 36 moveto +0 36 lineto +0 0 lineto +56 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Plot3D) +[7.68 3.84 6.72 3.84 6.96 10.08] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103polynomialring.ps b/books/ps/v103polynomialring.ps new file mode 100644 index 0000000..9e8e872 --- /dev/null +++ b/books/ps/v103polynomialring.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 152 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 152 80 +%%PageOrientation: Portrait +gsave +36 36 116 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +114 42 lineto +114 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +114 42 lineto +114 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PolynomialRing +[ /Rect [ 0 0 108 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PR) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PolynomialRing) +[7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84 9.36 3.84 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103primefield.ps b/books/ps/v103primefield.ps new file mode 100644 index 0000000..586f4c3 --- /dev/null +++ b/books/ps/v103primefield.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 124 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 124 80 +%%PageOrientation: Portrait +gsave +36 36 88 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +86 42 lineto +86 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +86 42 lineto +86 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PrimeField +[ /Rect [ 0 0 80 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PF) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 80 36 moveto +0 36 lineto +0 0 lineto +80 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 80 36 moveto +0 36 lineto +0 0 lineto +80 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PrimeField) +[7.68 5.04 3.84 10.8 6.24 7.44 3.84 6.24 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103product.ps b/books/ps/v103product.ps new file mode 100644 index 0000000..c673c8f --- /dev/null +++ b/books/ps/v103product.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 104 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 104 80 +%%PageOrientation: Portrait +gsave +36 36 68 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +66 42 lineto +66 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +66 42 lineto +66 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Product +[ /Rect [ 0 0 60 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PRODUCT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 60 36 moveto +0 36 lineto +0 0 lineto +60 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 60 36 moveto +0 36 lineto +0 0 lineto +60 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Product) +[7.68 4.8 6.96 6.96 6.96 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103sparseunivariatepolynomial.ps b/books/ps/v103sparseunivariatepolynomial.ps new file mode 100644 index 0000000..3d5073b --- /dev/null +++ b/books/ps/v103sparseunivariatepolynomial.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 220 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 220 80 +%%PageOrientation: Portrait +gsave +36 36 184 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +182 42 lineto +182 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +182 42 lineto +182 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SparseUnivariatePolynomial +[ /Rect [ 0 0 176 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SUP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 176 36 moveto +0 36 lineto +0 0 lineto +176 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 176 36 moveto +0 36 lineto +0 0 lineto +176 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(SparseUnivariatePolynomial) +[7.68 6.96 6.24 4.8 5.52 6.24 9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103symmetricpolynomial.ps b/books/ps/v103symmetricpolynomial.ps new file mode 100644 index 0000000..92ff862 --- /dev/null +++ b/books/ps/v103symmetricpolynomial.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 184 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 184 80 +%%PageOrientation: Portrait +gsave +36 36 148 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +146 42 lineto +146 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +146 42 lineto +146 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SymmetricPolynomial +[ /Rect [ 0 0 140 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SYMPOLY) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 140 36 moveto +0 36 lineto +0 0 lineto +140 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 140 36 moveto +0 36 lineto +0 0 lineto +140 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SymmetricPolynomial) +[7.68 6.96 10.8 10.8 6 3.84 5.04 3.84 6.24 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103univariatepolynomial.ps b/books/ps/v103univariatepolynomial.ps new file mode 100644 index 0000000..11d51e8 --- /dev/null +++ b/books/ps/v103univariatepolynomial.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 184 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 184 80 +%%PageOrientation: Portrait +gsave +36 36 148 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +146 42 lineto +146 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +146 42 lineto +146 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% UnivariatePolynomial +[ /Rect [ 0 0 140 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=UP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 140 36 moveto +0 36 lineto +0 0 lineto +140 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 140 36 moveto +0 36 lineto +0 0 lineto +140 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(UnivariatePolynomial) +[9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103univariatepuiseuxseries.ps b/books/ps/v103univariatepuiseuxseries.ps new file mode 100644 index 0000000..78c5c54 --- /dev/null +++ b/books/ps/v103univariatepuiseuxseries.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 198 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 198 80 +%%PageOrientation: Portrait +gsave +36 36 162 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +160 42 lineto +160 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +160 42 lineto +160 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% UnivariatePuiseuxSeries +[ /Rect [ 0 0 154 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=UPXS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 154 36 moveto +0 36 lineto +0 0 lineto +154 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 154 36 moveto +0 36 lineto +0 0 lineto +154 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(UnivariatePuiseuxSeries) +[9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.68 6.96 3.84 5.52 6.24 6.96 6.96 7.68 6.24 5.04 3.84 6.24 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103univariatepuiseuxseriesconstructor.ps b/books/ps/v103univariatepuiseuxseriesconstructor.ps new file mode 100644 index 0000000..7a20416 --- /dev/null +++ b/books/ps/v103univariatepuiseuxseriesconstructor.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 264 80 +%%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 + dup 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 aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + 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 +%%Page: 1 1 +%%PageBoundingBox: 36 36 264 80 +%%PageOrientation: Portrait +gsave +36 36 228 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +226 42 lineto +226 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +226 42 lineto +226 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% UnivariatePuiseuxSeriesConstructor +[ /Rect [ 0 0 220 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=UPXSCONS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 220 36 moveto +0 36 lineto +0 0 lineto +220 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 220 36 moveto +0 36 lineto +0 0 lineto +220 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(UnivariatePuiseuxSeriesConstructor) +[9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.68 6.96 3.84 5.52 6.24 6.96 6.96 7.68 6.24 5.04 3.84 6.24 5.52 9.36 6.96 6.96 5.28 3.84 5.04 6.96 6.24 3.84 6.96 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/changelog b/changelog index ffc5154..8d2230b 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,57 @@ +20081213 tpd src/axiom-website/patches.html 20081213.02.tpd.patch +20081213 tpd books/ps/v103univariatepuiseuxseriesconstructor.ps added +20081213 tpd books/ps/v103univariatepuiseuxseries.ps added +20081213 tpd books/ps/v103univariatepolynomial.ps added +20081213 tpd books/ps/v103symmetricpolynomial.ps added +20081213 tpd books/ps/v103sparseunivariatepolynomial.ps added +20081213 tpd books/ps/v103product.ps added +20081213 tpd books/ps/v103primefield.ps added +20081213 tpd books/ps/v103polynomialring.ps added +20081213 tpd books/ps/v103plot3d.ps added +20081213 tpd books/ps/v103plot.ps added +20081213 tpd books/ps/v103permutationgroup.ps added +20081213 tpd books/ps/v103permutation.ps added +20081213 tpd books/ps/v103patternmatchresult.ps added +20081213 tpd books/ps/v103patternmatchlistresult.ps added +20081213 tpd books/ps/v103pattern.ps added +20081213 tpd books/ps/v103partition.ps added +20081213 tpd books/ps/v103partialfraction.ps added +20081213 tpd books/ps/v103parametricsurface.ps added +20081213 tpd books/ps/v103parametricspacecurve.ps added +20081213 tpd books/ps/v103parametricplanecurve.ps added +20081213 tpd books/ps/v103padicrationalconstructor.ps added +20081213 tpd books/ps/v103padicrational.ps added +20081213 tpd books/ps/v103padicinteger.ps added +20081213 tpd books/ps/v103innerprimefield.ps added +20081213 tpd books/ps/v103innerpadicinteger.ps added +20081213 tpd books/ps/v103generalpolynomialset.ps added +20081213 tpd books/ps/v103freemodule.ps added +20081213 tpd books/ps/v103balancedpadicrational.ps added +20081213 tpd books/ps/v103balancedpadicinteger.ps added +20081213 tpd books/bookvol10.3 add domains +20081213 tpd src/algebra/Makefile fixup help file references +20081213 tpd src/algebra/puiseux.spad move domains to bookvol10.3 +20081213 tpd src/algebra/Makefile remove prtition.spad +20081213 tpd src/algebra/prtition.spad removed, move domain to bookvol10.3 +20081213 tpd src/algebra/Makefile remove product.spad +20081213 tpd src/algebra/product.spad removed, move domain to bookvol10.3 +20081213 tpd src/algebra/poly.spad move domains to bookvol10.3 +20081213 tpd src/algebra/Makefile remove polset.spad +20081213 tpd src/algebra/polset.spad removed, move domain to bookvol10.3 +20081213 tpd src/algebra/plot.spad move domain to bookvol10.3 +20081213 tpd src/algebra/Makefile remove plot3d.spad +20081213 tpd src/algebra/plot3d.spad removed, move domain to bookvol10.3 +20081213 tpd src/algebra/Makefile remove pf.spad +20081213 tpd src/algebra/pf.spad removed, move domains to bookvol10.3 +20081213 tpd src/algebra/pfr.spad move domain to bookvol10.3 +20081213 tpd src/algebra/Makefile remove perm.spad +20081213 tpd src/algebra/perm.spad removed, move domain to bookvol10.3 +20081213 tpd src/algebra/permgrps.spad move domain to bookvol10.3 +20081213 tpd src/algebra/pattern.spad move domain to bookvol10.3 +20081213 tpd src/algebra/patmatch1.spad move domains to bookvol10.3 +20081213 tpd src/algebra/paramete.spad move domains to bookvol10.3 +20081213 tpd src/algebra/Makefile remove padic.spad +20081213 tpd src/algebra/padic.spad removed, move domains to bookvol10.3 20081213 tpd src/axiom-website/patches.html 20081213.01.tpd.patch 20081213 tpd zips/gcl-2.6.8pre3.unixport.makefile.patch move to gcl-pre3 20081213 tpd zips/gcl-2.6.8pre3.unixport.init_gcl.lsp.in.patch move to gcl-pre3 diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 16cf251..08aa905 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -338,7 +338,6 @@ LAYER8=\ \subsubsection{Completed spad files} \begin{verbatim} degred.spad.pamphlet (DEGRED) -product.spad.pamphlet (PRODUCT) retract.spad.pamphlet (RETRACT FRETRCT RATRET) sf.spad.pamphlet (REAL RADCAT RNS FPS DFLOAT) \end{verbatim} @@ -418,8 +417,6 @@ ffx.spad.pamphlet (IRREDFFX) galutil.spad.pamphlet (GALUTIL) matstor.spad.pamphlet (MATSTOR) ore.spad.pamphlet (OREPCAT APPLYORE AUTOMOR OREPCTO ORESUP OREUP) -plot3d.spad.pamphlet (PLOT3D) -prtition.spad.pamphlet (PRTITION SYMPOLY) stream.spad.pamphlet (LZSTAGG CSTTOOLS STREAM STREAM1 STREAM2 STREAM3) xlpoly.spad.pamphlet (MAGMA LWORD LIECAT FLALG XEXPPKG LPOLY PBWLB XPBWPOLY LEXP) @@ -541,7 +538,6 @@ numtheor.spad.pamphlet (INTHEORY PNTHEORY) npcoef.spad.pamphlet (NPCOEF) omdev.spad.pamphlet (OMENC OMDEV OMCONN OMPKG) omserver.spad.pamphlet (OMSERVER) -padic.spad.pamphlet (PADICCT IPADIC PADIC BPADIC PADICRC PADICRAT BPADICRT) pdecomp.spad.pamphlet (PCOMP PDECOMP) pfbr.spad.pamphlet (PFBRU PFBR) pfr.spad.pamphlet (PFR PFRPAC) @@ -684,7 +680,6 @@ aggcat2.spad.pamphlet (FLAGG2 FSAGG2) galfact.spad.pamphlet (GALFACT) intfact.spad.pamphlet (PRIMES IROOT INTFACT) padiclib.spad.pamphlet (IBPTOOLS IBACHIN PWFFINTB) -perm.spad.pamphlet (PERMCAT PERM) permgrps.spad.pamphlet (PERMGRP PGE) random.spad.pamphlet (RANDSRC RDIST INTBIT RIDIST RFDIST) sgcf.spad.pamphlet (SGCF) @@ -709,7 +704,6 @@ LAYER17=\ \begin{verbatim} d01package.spad.pamphlet (INTPACK) list.spad.pamphlet (ILIST LIST LIST2 LIST3 LIST2MAP ALIST) -pf.spad.pamphlet (IPF PF) table.spad.pamphlet (HASHTBL INTABL TABLE EQTBL STRTBL GSTBL STBL) \end{verbatim} @@ -857,7 +851,6 @@ openmath.spad.pamphlet (OMEXPR) pade.spad.pamphlet (PADEPAC PADE) patmatch2.spad.pamphlet (PMINS PMQFCAT PMPLCT PMFS PATMATCH) pfo.spad.pamphlet (FORDER RDIV PFOTOOLS PFOQ FSRED PFO) -polset.spad.pamphlet (PSETCAT GPOLSET) primelt.spad.pamphlet (PRIMELT FSPRMELT) quat.spad.pamphlet (QUATCAT QUAT QUATCT2) rdeef.spad.pamphlet (INTTOOLS RDEEF) @@ -1193,17 +1186,17 @@ SPADFILES= \ ${OUTSRC}/omserver.spad \ ${OUTSRC}/openmath.spad ${OUTSRC}/op.spad ${OUTSRC}/ore.spad \ ${OUTSRC}/outform.spad ${OUTSRC}/out.spad \ - ${OUTSRC}/pade.spad ${OUTSRC}/padiclib.spad ${OUTSRC}/padic.spad \ + ${OUTSRC}/pade.spad ${OUTSRC}/padiclib.spad \ ${OUTSRC}/paramete.spad ${OUTSRC}/partperm.spad ${OUTSRC}/patmatch1.spad \ ${OUTSRC}/patmatch2.spad ${OUTSRC}/pattern.spad \ ${OUTSRC}/pdecomp.spad ${OUTSRC}/perman.spad ${OUTSRC}/permgrps.spad \ - ${OUTSRC}/perm.spad ${OUTSRC}/pfbr.spad ${OUTSRC}/pfo.spad \ - ${OUTSRC}/pfr.spad ${OUTSRC}/pf.spad ${OUTSRC}/pgcd.spad \ + ${OUTSRC}/pfbr.spad ${OUTSRC}/pfo.spad \ + ${OUTSRC}/pfr.spad ${OUTSRC}/pgcd.spad \ ${OUTSRC}/pgrobner.spad ${OUTSRC}/pinterp.spad ${OUTSRC}/pleqn.spad \ - ${OUTSRC}/plot3d.spad ${OUTSRC}/plot.spad ${OUTSRC}/plottool.spad \ - ${OUTSRC}/polset.spad ${OUTSRC}/poltopol.spad ${OUTSRC}/polycat.spad \ + ${OUTSRC}/plot.spad ${OUTSRC}/plottool.spad \ + ${OUTSRC}/poltopol.spad ${OUTSRC}/polycat.spad \ ${OUTSRC}/poly.spad ${OUTSRC}/primelt.spad ${OUTSRC}/print.spad \ - ${OUTSRC}/product.spad ${OUTSRC}/prs.spad ${OUTSRC}/prtition.spad \ + ${OUTSRC}/prs.spad \ ${OUTSRC}/pseudolin.spad ${OUTSRC}/puiseux.spad \ ${OUTSRC}/qalgset.spad ${OUTSRC}/quat.spad \ ${OUTSRC}/radeigen.spad ${OUTSRC}/radix.spad ${OUTSRC}/random.spad \ @@ -1347,17 +1340,17 @@ DOCFILES= \ ${DOC}/omserver.spad.dvi \ ${DOC}/openmath.spad.dvi ${DOC}/op.spad.dvi ${DOC}/ore.spad.dvi \ ${DOC}/outform.spad.dvi ${DOC}/out.spad.dvi \ - ${DOC}/pade.spad.dvi ${DOC}/padiclib.spad.dvi ${DOC}/padic.spad.dvi \ + ${DOC}/pade.spad.dvi ${DOC}/padiclib.spad.dvi \ ${DOC}/paramete.spad.dvi ${DOC}/partperm.spad.dvi ${DOC}/patmatch1.spad.dvi \ ${DOC}/patmatch2.spad.dvi ${DOC}/pattern.spad.dvi \ ${DOC}/pdecomp.spad.dvi ${DOC}/perman.spad.dvi ${DOC}/permgrps.spad.dvi \ - ${DOC}/perm.spad.dvi ${DOC}/pfbr.spad.dvi ${DOC}/pfo.spad.dvi \ - ${DOC}/pfr.spad.dvi ${DOC}/pf.spad.dvi ${DOC}/pgcd.spad.dvi \ + ${DOC}/pfbr.spad.dvi ${DOC}/pfo.spad.dvi \ + ${DOC}/pfr.spad.dvi ${DOC}/pgcd.spad.dvi \ ${DOC}/pgrobner.spad.dvi ${DOC}/pinterp.spad.dvi ${DOC}/pleqn.spad.dvi \ - ${DOC}/plot3d.spad.dvi ${DOC}/plot.spad.dvi ${DOC}/plottool.spad.dvi \ - ${DOC}/polset.spad.dvi ${DOC}/poltopol.spad.dvi ${DOC}/polycat.spad.dvi \ + ${DOC}/plot.spad.dvi ${DOC}/plottool.spad.dvi \ + ${DOC}/poltopol.spad.dvi ${DOC}/polycat.spad.dvi \ ${DOC}/poly.spad.dvi ${DOC}/primelt.spad.dvi ${DOC}/print.spad.dvi \ - ${DOC}/product.spad.dvi ${DOC}/prs.spad.dvi ${DOC}/prtition.spad.dvi \ + ${DOC}/prs.spad.dvi \ ${DOC}/pseudolin.spad.dvi ${DOC}/puiseux.spad.dvi \ ${DOC}/qalgset.spad.dvi ${DOC}/quat.spad.dvi \ ${DOC}/radeigen.spad.dvi ${DOC}/radix.spad.dvi ${DOC}/random.spad.dvi \ @@ -2687,12 +2680,13 @@ ${HELP}/OrderlyDifferentialPolynomial.help: ${BOOKS}/bookvol10.3.pamphlet ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/OrderlyDifferentialPolynomial.input -${HELP}/PartialFraction.help: ${IN}/pfr.spad.pamphlet - @echo 7061 create PartialFraction.help from ${IN}/pfr.spad.pamphlet - @${TANGLE} -R"PartialFraction.help" ${IN}/pfr.spad.pamphlet \ +${HELP}/PartialFraction.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7061 create PartialFraction.help from \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"PartialFraction.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/PartialFraction.help @cp ${HELP}/PartialFraction.help ${HELP}/PFR.help - @${TANGLE} -R"PartialFraction.input" ${IN}/pfr.spad.pamphlet \ + @${TANGLE} -R"PartialFraction.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/PartialFraction.input ${HELP}/Permanent.help: ${IN}/perman.spad.pamphlet @@ -2703,12 +2697,12 @@ ${HELP}/Permanent.help: ${IN}/perman.spad.pamphlet @${TANGLE} -R"Permanent.input" ${IN}/perman.spad.pamphlet \ >${INPUT}/Permanent.input -${HELP}/Permutation.help: ${IN}/perm.spad.pamphlet - @echo 7063 create Permutation.help from ${IN}/perm.spad.pamphlet - @${TANGLE} -R"Permutation.help" ${IN}/perm.spad.pamphlet \ +${HELP}/Permutation.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7063 create Permutation.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Permutation.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Permutation.help @cp ${HELP}/Permutation.help ${HELP}/PERM.help - @${TANGLE} -R"Permutation.input" ${IN}/perm.spad.pamphlet \ + @${TANGLE} -R"Permutation.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Permutation.input ${HELP}/PlaneAlgebraicCurvePlot.help: ${BOOKS}/bookvol10.3.pamphlet @@ -2722,11 +2716,13 @@ ${HELP}/PlaneAlgebraicCurvePlot.help: ${BOOKS}/bookvol10.3.pamphlet ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/PlaneAlgebraicCurvePlot.input -${HELP}/Plot.help: ${IN}/plot.spad.pamphlet - @echo 7064 create Plot.help from ${IN}/plot.spad.pamphlet - @${TANGLE} -R"Plot.help" ${IN}/plot.spad.pamphlet >${HELP}/Plot.help +${HELP}/Plot.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7064 create Plot.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Plot.help" ${BOOKS}/bookvol10.3.pamphlet \ + >${HELP}/Plot.help @-cp ${HELP}/Plot.help ${HELP}/PLOT.help - @${TANGLE} -R"Plot.input" ${IN}/plot.spad.pamphlet >${INPUT}/Plot.input + @${TANGLE} -R"Plot.input" ${BOOKS}/bookvol10.3.pamphlet \ + >${INPUT}/Plot.input ${HELP}/Polynomial.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7065 create Polynomial.help from ${BOOKS}/bookvol10.3.pamphlet @@ -2903,13 +2899,15 @@ ${HELP}/TwoDimensionalViewport.help: ${IN}/view2d.spad.pamphlet @cp ${HELP}/TwoDimensionalViewport.help ${HELP}/VIEW2D.help # Note:no input regression file due to graphics -${HELP}/UnivariatePolynomial.help: ${IN}/poly.spad.pamphlet +${HELP}/UnivariatePolynomial.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7086 create UnivariatePolynomial.help from \ - ${IN}/poly.spad.pamphlet - @${TANGLE} -R"UnivariatePolynomial.help" ${IN}/poly.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"UnivariatePolynomial.help" \ + ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/UnivariatePolynomial.help @cp ${HELP}/UnivariatePolynomial.help ${HELP}/UP.help - @${TANGLE} -R"UnivariatePolynomial.input" ${IN}/poly.spad.pamphlet \ + @${TANGLE} -R"UnivariatePolynomial.input" \ + ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/UnivariatePolynomial.input ${HELP}/UniversalSegment.help: ${IN}/seg.spad.pamphlet diff --git a/src/algebra/paramete.spad.pamphlet b/src/algebra/paramete.spad.pamphlet index 8cf1a25..cc85e58 100644 --- a/src/algebra/paramete.spad.pamphlet +++ b/src/algebra/paramete.spad.pamphlet @@ -9,45 +9,6 @@ \eject \tableofcontents \eject -\section{domain PARPCURV ParametricPlaneCurve} -<>= -)abbrev domain PARPCURV ParametricPlaneCurve -++ Author: Clifton J. Williamson -++ Date Created: 24 May 1990 -++ Date Last Updated: 24 May 1990 -++ Basic Operations: curve, coordinate -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: parametric curve, graphics -++ References: -++ Description: ParametricPlaneCurve is used for plotting parametric plane -++ curves in the affine plane. - -ParametricPlaneCurve(ComponentFunction): Exports == Implementation where - ComponentFunction : Type - NNI ==> NonNegativeInteger - - Exports ==> with - curve: (ComponentFunction,ComponentFunction) -> % - ++ curve(c1,c2) creates a plane curve from 2 component functions \spad{c1} - ++ and \spad{c2}. - coordinate: (%,NNI) -> ComponentFunction - ++ coordinate(c,i) returns a coordinate function for c using 1-based - ++ indexing according to i. This indicates what the function for the - ++ coordinate component i of the plane curve is. - - Implementation ==> add - - Rep := Record(xCoord:ComponentFunction,yCoord:ComponentFunction) - - curve(x,y) == [x,y] - coordinate(c,n) == - n = 1 => c.xCoord - n = 2 => c.yCoord - error "coordinate: index out of bounds" - -@ \section{package PARPC2 ParametricPlaneCurveFunctions2} <>= )abbrev package PARPC2 ParametricPlaneCurveFunctions2 @@ -60,48 +21,6 @@ ParametricPlaneCurveFunctions2(CF1: Type, CF2:Type): with map(f, c) == curve(f coordinate(c,1), f coordinate(c, 2)) @ -\section{domain PARSCURV ParametricSpaceCurve} -<>= -)abbrev domain PARSCURV ParametricSpaceCurve -++ Author: Clifton J. Williamson -++ Date Created: 24 May 1990 -++ Date Last Updated: 24 May 1990 -++ Basic Operations: curve, coordinate -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: parametric curve, graphics -++ References: -++ Description: ParametricSpaceCurve is used for plotting parametric space -++ curves in affine 3-space. - -ParametricSpaceCurve(ComponentFunction): Exports == Implementation where - ComponentFunction : Type - NNI ==> NonNegativeInteger - - Exports ==> with - curve: (ComponentFunction,ComponentFunction,ComponentFunction) -> % - ++ curve(c1,c2,c3) creates a space curve from 3 component functions - ++ \spad{c1}, \spad{c2}, and \spad{c3}. - coordinate: (%,NNI) -> ComponentFunction - ++ coordinate(c,i) returns a coordinate function of c using 1-based - ++ indexing according to i. This indicates what the function for the - ++ coordinate component, i, of the space curve is. - - Implementation ==> add - - Rep := Record(xCoord:ComponentFunction,_ - yCoord:ComponentFunction,_ - zCoord:ComponentFunction) - - curve(x,y,z) == [x,y,z] - coordinate(c,n) == - n = 1 => c.xCoord - n = 2 => c.yCoord - n = 3 => c.zCoord - error "coordinate: index out of bounds" - -@ \section{package PARSC2 ParametricSpaceCurveFunctions2} <>= )abbrev package PARSC2 ParametricSpaceCurveFunctions2 @@ -114,48 +33,6 @@ ParametricSpaceCurveFunctions2(CF1: Type, CF2:Type): with map(f, c) == curve(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3)) @ -\section{domain PARSURF ParametricSurface} -<>= -)abbrev domain PARSURF ParametricSurface -++ Author: Clifton J. Williamson -++ Date Created: 24 May 1990 -++ Date Last Updated: 24 May 1990 -++ Basic Operations: surface, coordinate -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: parametric surface, graphics -++ References: -++ Description: ParametricSurface is used for plotting parametric surfaces in -++ affine 3-space. - -ParametricSurface(ComponentFunction): Exports == Implementation where - ComponentFunction : Type - NNI ==> NonNegativeInteger - - Exports ==> with - surface: (ComponentFunction,ComponentFunction,ComponentFunction) -> % - ++ surface(c1,c2,c3) creates a surface from 3 parametric component - ++ functions \spad{c1}, \spad{c2}, and \spad{c3}. - coordinate: (%,NNI) -> ComponentFunction - ++ coordinate(s,i) returns a coordinate function of s using 1-based - ++ indexing according to i. This indicates what the function for the - ++ coordinate component, i, of the surface is. - - Implementation ==> add - - Rep := Record(xCoord:ComponentFunction,_ - yCoord:ComponentFunction,_ - zCoord:ComponentFunction) - - surface(x,y,z) == [x,y,z] - coordinate(c,n) == - n = 1 => c.xCoord - n = 2 => c.yCoord - n = 3 => c.zCoord - error "coordinate: index out of bounds" - -@ \section{package PARSU2 ParametricSurfaceFunctions2} <>= )abbrev package PARSU2 ParametricSurfaceFunctions2 @@ -204,11 +81,8 @@ ParametricSurfaceFunctions2(CF1: Type, CF2:Type): with <<*>>= <> -<> <> -<> <> -<> <> @ \eject diff --git a/src/algebra/patmatch1.spad.pamphlet b/src/algebra/patmatch1.spad.pamphlet index 5d4f0ca..3cc20b6 100644 --- a/src/algebra/patmatch1.spad.pamphlet +++ b/src/algebra/patmatch1.spad.pamphlet @@ -9,113 +9,6 @@ \eject \tableofcontents \eject -\section{domain PATRES PatternMatchResult} -<>= -"PATRES" -> "SETCAT" -"PatternMatchResult(a:SetCategory, b:SetCategory)" -> "SetCategory()" -@ -<>= -)abbrev domain PATRES PatternMatchResult -++ Result returned by the pattern matcher -++ Author: Manuel Bronstein -++ Date Created: 28 Nov 1989 -++ Date Last Updated: 5 Jul 1990 -++ Description: -++ A PatternMatchResult is an object internally returned by the -++ pattern matcher; It is either a failed match, or a list of -++ matches of the form (var, expr) meaning that the variable var -++ matches the expression expr. -++ Keywords: pattern, matching. --- not exported -PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with - failed? : % -> Boolean - ++ failed?(r) tests if r is a failed match. - failed : () -> % - ++ failed() returns a failed match. - new : () -> % - ++ new() returns a new empty match result. - union : (%, %) -> % - ++ union(a, b) makes the set-union of two match results. - getMatch : (Pattern R, %) -> Union(S, "failed") - ++ getMatch(var, r) returns the expression that var matches - ++ in the result r, and "failed" if var is not matched in r. - addMatch : (Pattern R, S, %) -> % - ++ addMatch(var, expr, r) adds the match (var, expr) in r, - ++ provided that expr satisfies the predicates attached to var, - ++ and that var is not matched to another expression already. - insertMatch : (Pattern R, S, %) -> % - ++ insertMatch(var, expr, r) adds the match (var, expr) in r, - ++ without checking predicates or previous matches for var. - addMatchRestricted: (Pattern R, S, %, S) -> % - ++ addMatchRestricted(var, expr, r, val) adds the match - ++ (var, expr) in r, - ++ provided that expr satisfies the predicates attached to var, - ++ that var is not matched to another expression already, - ++ and that either var is an optional pattern variable or that - ++ expr is not equal to val (usually an identity). - destruct : % -> List Record(key:Symbol, entry:S) - ++ destruct(r) returns the list of matches (var, expr) in r. - ++ Error: if r is a failed match. - construct : List Record(key:Symbol, entry:S) -> % - ++ construct([v1,e1],...,[vn,en]) returns the match result - ++ containing the matches (v1,e1),...,(vn,en). - satisfy? : (%, Pattern R) -> Union(Boolean, "failed") - ++ satisfy?(r, p) returns true if the matches satisfy the - ++ top-level predicate of p, false if they don't, and "failed" - ++ if not enough variables of p are matched in r to decide. - - == add - LR ==> AssociationList(Symbol, S) - - import PatternFunctions1(R, S) - - Rep := Union(LR, "failed") - - new() == empty() - failed() == "failed" - failed? x == x case "failed" - insertMatch(p, x, l) == concat([retract p, x], l::LR) - construct l == construct(l)$LR - destruct l == entries(l::LR)$LR - --- returns "failed" if not all the variables of the pred. are matched - satisfy?(r, p) == - failed? r => false - lr := r::LR - lv := [if (u := search(v, lr)) case "failed" then return "failed" - else u::S for v in topPredicate(p).var]$List(S) - satisfy?(lv, p) - - union(x, y) == - failed? x or failed? y => failed() - removeDuplicates concat(x::LR, y::LR) - - x = y == - failed? x => failed? y - failed? y => false - x::LR =$LR y::LR - - coerce(x:%):OutputForm == - failed? x => "Does not match"::OutputForm - destruct(x)::OutputForm - - addMatchRestricted(p, x, l, ident) == - (not optional? p) and (x = ident) => failed() - addMatch(p, x, l) - - addMatch(p, x, l) == - failed?(l) or not(satisfy?(x, p)) => failed() - al := l::LR - sy := retract(p)@Symbol - (r := search(sy, al)) case "failed" => insertMatch(p, x, l) - r::S = x => l - failed() - - getMatch(p, l) == - failed? l => "failed" - search(retract(p)@Symbol, l::LR) - -@ \section{package PATRES2 PatternMatchResultFunctions2} <>= "PATRES2" -> "PACKAGE" @@ -146,59 +39,6 @@ PatternMatchResultFunctions2(R, A, B): Exports == Implementation where construct [[rec.key, f(rec.entry)] for rec in destruct r] @ -\section{domain PATLRES PatternMatchListResult} -<>= -"PATLRES" -> "SETCAT" -"PatternMatchListResult(a:SETCAT,b:SETCAT,c:LSAGG(SETCAT))" - -> "SetCategory()" -@ -<>= -)abbrev domain PATLRES PatternMatchListResult -++ Result returned by the pattern matcher when using lists -++ Author: Manuel Bronstein -++ Date Created: 4 Dec 1989 -++ Date Last Updated: 4 Dec 1989 -++ Description: -++ A PatternMatchListResult is an object internally returned by the -++ pattern matcher when matching on lists. -++ It is either a failed match, or a pair of PatternMatchResult, -++ one for atoms (elements of the list), and one for lists. -++ Keywords: pattern, matching, list. --- not exported -PatternMatchListResult(R:SetCategory, S:SetCategory, L:ListAggregate S): - SetCategory with - failed? : % -> Boolean - ++ failed?(r) tests if r is a failed match. - failed : () -> % - ++ failed() returns a failed match. - new : () -> % - ++ new() returns a new empty match result. - makeResult: (PatternMatchResult(R,S), PatternMatchResult(R,L)) -> % - ++ makeResult(r1,r2) makes the combined result [r1,r2]. - atoms : % -> PatternMatchResult(R, S) - ++ atoms(r) returns the list of matches that match atoms - ++ (elements of the lists). - lists : % -> PatternMatchResult(R, L) - ++ lists(r) returns the list of matches that match lists. - == add - Rep := Record(a:PatternMatchResult(R, S), l:PatternMatchResult(R, L)) - - new() == [new(), new()] - atoms r == r.a - lists r == r.l - failed() == [failed(), failed()] - failed? r == failed?(atoms r) - x = y == (atoms x = atoms y) and (lists x = lists y) - - makeResult(r1, r2) == - failed? r1 or failed? r2 => failed() - [r1, r2] - - coerce(r:%):OutputForm == - failed? r => atoms(r)::OutputForm - RecordPrint(r, Rep)$Lisp - -@ \section{package PMSYM PatternMatchSymbol} <>= "PMSYM" -> "PACKAGE" @@ -692,9 +532,7 @@ PatternMatchListAggregate(S, R, L): Exports == Implementation where <<*>>= <> -<> <> -<> <> <> <> diff --git a/src/algebra/pattern.spad.pamphlet b/src/algebra/pattern.spad.pamphlet index 751e4dd..d4e899f 100644 --- a/src/algebra/pattern.spad.pamphlet +++ b/src/algebra/pattern.spad.pamphlet @@ -9,388 +9,6 @@ \eject \tableofcontents \eject -\section{domain PATTERN Pattern} -<>= -"RETRACT" -> "CATEGORY" -"RetractableTo(a:Type)" -> "Category" -"RetractableTo(SetCategory)" -> "RetractableTo(a:Type)" -"RetractableTo(Symbol)" -> "RetractableTo(a:Type)" -@ -<>= -)abbrev domain PATTERN Pattern -++ Patterns for use by the pattern matcher -++ Author: Manuel Bronstein -++ Date Created: 10 Nov 1988 -++ Date Last Updated: 20 June 1991 -++ Description: Patterns for use by the pattern matcher. -++ Keywords: pattern, matching. --- Not exposed. --- Patterns are optimized for quick answers to structural questions. -Pattern(R:SetCategory): Exports == Implementation where - B ==> Boolean - SI ==> SingleInteger - Z ==> Integer - SY ==> Symbol - O ==> OutputForm - BOP ==> BasicOperator - QOT ==> Record(num:%, den:%) - REC ==> Record(val:%, exponent:NonNegativeInteger) - RSY ==> Record(tag:SI, val: SY, pred:List Any, bad:List Any) - KER ==> Record(tag:SI, op:BOP, arg:List %) - PAT ==> Union(ret:R, ker: KER, exp:REC, qot: QOT, sym:RSY) - --- the following MUST be the name of the formal exponentiation operator - POWER ==> "%power"::Symbol - --- the 4 SYM_ constants must be disting powers of 2 (bitwise arithmetic) - SYM_GENERIC ==> 1::SI - SYM_MULTIPLE ==> 2::SI - SYM_OPTIONAL ==> 4::SI - - PAT_PLUS ==> 1::SI - PAT_TIMES ==> 2::SI - PAT_LIST ==> 3::SI - PAT_ZERO ==> 4::SI - PAT_ONE ==> 5::SI - PAT_EXPT ==> 6::SI - - Exports ==> Join(SetCategory, RetractableTo R, RetractableTo SY) with - 0 : constant -> % ++ 0 - 1 : constant -> % ++ 1 - isPlus : % -> Union(List %, "failed") - ++ isPlus(p) returns \spad{[a1,...,an]} if \spad{n > 1} - ++ and \spad{p = a1 + ... + an}, - ++ and "failed" otherwise. - isTimes : % -> Union(List %, "failed") - ++ isTimes(p) returns \spad{[a1,...,an]} if \spad{n > 1} and - ++ \spad{p = a1 * ... * an}, and - ++ "failed" otherwise. - isOp : (%, BOP) -> Union(List %, "failed") - ++ isOp(p, op) returns \spad{[a1,...,an]} if \spad{p = op(a1,...,an)}, and - ++ "failed" otherwise. - isOp : % -> Union(Record(op:BOP, arg:List %), "failed") - ++ isOp(p) returns \spad{[op, [a1,...,an]]} if - ++ \spad{p = op(a1,...,an)}, and - ++ "failed" otherwise; - isExpt : % -> Union(REC, "failed") - ++ isExpt(p) returns \spad{[q, n]} if \spad{n > 0} and \spad{p = q ** n}, - ++ and "failed" otherwise. - isQuotient : % -> Union(QOT, "failed") - ++ isQuotient(p) returns \spad{[a, b]} if \spad{p = a / b}, and - ++ "failed" otherwise. - isList : % -> Union(List %, "failed") - ++ isList(p) returns \spad{[a1,...,an]} if \spad{p = [a1,...,an]}, - ++ "failed" otherwise; - isPower : % -> Union(Record(val:%, exponent:%), "failed") - ++ isPower(p) returns \spad{[a, b]} if \spad{p = a ** b}, and - ++ "failed" otherwise. - elt : (BOP, List %) -> % - ++ \spad{elt(op, [a1,...,an])} returns \spad{op(a1,...,an)}. - "+" : (%, %) -> % - ++ \spad{a + b} returns the pattern \spad{a + b}. - "*" : (%, %) -> % - ++ \spad{a * b} returns the pattern \spad{a * b}. - "**" : (%, NonNegativeInteger) -> % - ++ \spad{a ** n} returns the pattern \spad{a ** n}. - "**" : (%, %) -> % - ++ \spad{a ** b} returns the pattern \spad{a ** b}. - "/" : (%, %) -> % - ++ \spad{a / b} returns the pattern \spad{a / b}. - depth : % -> NonNegativeInteger - ++ depth(p) returns the nesting level of p. - convert : List % -> % - ++ \spad{convert([a1,...,an])} returns the pattern \spad{[a1,...,an]}. - copy : % -> % - ++ copy(p) returns a recursive copy of p. - inR? : % -> B - ++ inR?(p) tests if p is an atom (i.e. an element of R). - quoted? : % -> B - ++ quoted?(p) tests if p is of the form 's for a symbol s. - symbol? : % -> B - ++ symbol?(p) tests if p is a symbol. - constant? : % -> B - ++ constant?(p) tests if p contains no matching variables. - generic? : % -> B - ++ generic?(p) tests if p is a single matching variable. - multiple? : % -> B - ++ multiple?(p) tests if p is a single matching variable - ++ allowing list matching or multiple term matching in a - ++ sum or product. - optional? : % -> B - ++ optional?(p) tests if p is a single matching variable - ++ which can match an identity. - hasPredicate?: % -> B - ++ hasPredicate?(p) tests if p has predicates attached to it. - predicates : % -> List Any - ++ predicates(p) returns \spad{[p1,...,pn]} such that the predicate - ++ attached to p is p1 and ... and pn. - setPredicates: (%, List Any) -> % - ++ \spad{setPredicates(p, [p1,...,pn])} attaches the predicate - ++ p1 and ... and pn to p. - withPredicates:(%, List Any) -> % - ++ \spad{withPredicates(p, [p1,...,pn])} makes a copy of p and attaches - ++ the predicate p1 and ... and pn to the copy, which is - ++ returned. - patternVariable: (SY, B, B, B) -> % - ++ patternVariable(x, c?, o?, m?) creates a pattern variable x, - ++ which is constant if \spad{c? = true}, optional if \spad{o? = true}, - ++ and multiple if \spad{m? = true}. - setTopPredicate: (%, List SY, Any) -> % - ++ \spad{setTopPredicate(x, [a1,...,an], f)} returns x with - ++ the top-level predicate set to \spad{f(a1,...,an)}. - topPredicate: % -> Record(var:List SY, pred:Any) - ++ topPredicate(x) returns \spad{[[a1,...,an], f]} where the top-level - ++ predicate of x is \spad{f(a1,...,an)}. - ++ Note: n is 0 if x has no top-level - ++ predicate. - hasTopPredicate?: % -> B - ++ hasTopPredicate?(p) tests if p has a top-level predicate. - resetBadValues: % -> % - ++ resetBadValues(p) initializes the list of "bad values" for p - ++ to \spad{[]}. - ++ Note: p is not allowed to match any of its "bad values". - addBadValue: (%, Any) -> % - ++ addBadValue(p, v) adds v to the list of "bad values" for p. - ++ Note: p is not allowed to match any of its "bad values". - getBadValues: % -> List Any - ++ getBadValues(p) returns the list of "bad values" for p. - ++ Note: p is not allowed to match any of its "bad values". - variables: % -> List % - ++ variables(p) returns the list of matching variables - ++ appearing in p. - optpair: List % -> Union(List %, "failed") - ++ optpair(l) returns l has the form \spad{[a, b]} and - ++ a is optional, and - ++ "failed" otherwise; - - Implementation ==> add - Rep := Record(cons?: B, pat:PAT, lev: NonNegativeInteger, - topvar: List SY, toppred: Any) - - dummy:BOP := operator(new()$Symbol) - nopred := coerce(0$Integer)$AnyFunctions1(Integer) - - mkPat : (B, PAT, NonNegativeInteger) -> % - mkrsy : (SY, B, B, B) -> RSY - SYM2O : RSY -> O - PAT2O : PAT -> O - patcopy : PAT -> PAT - bitSet? : (SI , SI) -> B - pateq? : (PAT, PAT) -> B - LPAT2O : ((O, O) -> O, List %) -> O - taggedElt : (SI, List %) -> % - isTaggedOp: (%, SI) -> Union(List %, "failed") - incmax : List % -> NonNegativeInteger - - coerce(r:R):% == mkPat(true, [r], 0) - mkPat(c, p, l) == [c, p, l, empty(), nopred] - hasTopPredicate? x == not empty?(x.topvar) - topPredicate x == [x.topvar, x.toppred] - setTopPredicate(x, l, f) == (x.topvar := l; x.toppred := f; x) - constant? p == p.cons? - depth p == p.lev - inR? p == p.pat case ret - symbol? p == p.pat case sym - isPlus p == isTaggedOp(p, PAT_PLUS) - isTimes p == isTaggedOp(p, PAT_TIMES) - isList p == isTaggedOp(p, PAT_LIST) - isExpt p == (p.pat case exp => p.pat.exp; "failed") - isQuotient p == (p.pat case qot => p.pat.qot; "failed") - hasPredicate? p == not empty? predicates p - quoted? p == symbol? p and zero?(p.pat.sym.tag) - generic? p == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC) - multiple? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE) - optional? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL) - bitSet?(a, b) == And(a, b) ^= 0 - coerce(p:%):O == PAT2O(p.pat) - p1:% ** p2:% == taggedElt(PAT_EXPT, [p1, p2]) - LPAT2O(f, l) == reduce(f, [x::O for x in l])$List(O) - retract(p:%):R == (inR? p => p.pat.ret; error "Not retractable") - convert(l:List %):% == taggedElt(PAT_LIST, l) - retractIfCan(p:%):Union(R,"failed") ==(inR? p => p.pat.ret;"failed") - withPredicates(p, l) == setPredicates(copy p, l) - coerce(sy:SY):% == patternVariable(sy, false, false, false) - copy p == [constant? p, patcopy(p.pat), p.lev, p.topvar, p.toppred] - - -- returns [a, b] if #l = 2 and optional? a, "failed" otherwise - optpair l == - empty? rest rest l => - b := first rest l - optional?(a := first l) => l - optional? b => reverse l - "failed" - "failed" - - incmax l == - 1 + reduce("max", [p.lev for p in l], 0)$List(NonNegativeInteger) - - p1 = p2 == - (p1.cons? = p2.cons?) and (p1.lev = p2.lev) and - (p1.topvar = p2.topvar) and - ((EQ(p1.toppred, p2.toppred)$Lisp) pretend B) and - pateq?(p1.pat, p2.pat) - - isPower p == - (u := isTaggedOp(p, PAT_EXPT)) case "failed" => "failed" - [first(u::List(%)), second(u::List(%))] - - taggedElt(n, l) == - mkPat(every?(constant?, l), [[n, dummy, l]$KER], incmax l) - - elt(o, l) == - is?(o, POWER) and #l = 2 => first(l) ** last(l) - mkPat(every?(constant?, l), [[0, o, l]$KER], incmax l) - - isOp p == - (p.pat case ker) and zero?(p.pat.ker.tag) => - [p.pat.ker.op, p.pat.ker.arg] - "failed" - - isTaggedOp(p,t) == - (p.pat case ker) and (p.pat.ker.tag = t) => p.pat.ker.arg - "failed" - - if R has Monoid then - 1 == 1::R::% - else - 1 == taggedElt(PAT_ONE, empty()) - - if R has AbelianMonoid then - 0 == 0::R::% - else - 0 == taggedElt(PAT_ZERO, empty()) - - p:% ** n:NonNegativeInteger == - p = 0 and n > 0 => 0 - p = 1 or zero? n => 1 --- one? n => p - (n = 1) => p - mkPat(constant? p, [[p, n]$REC], 1 + (p.lev)) - - p1 / p2 == - p2 = 1 => p1 - mkPat(constant? p1 and constant? p2, [[p1, p2]$QOT], - 1 + max(p1.lev, p2.lev)) - - p1 + p2 == - p1 = 0 => p2 - p2 = 0 => p1 - (u1 := isPlus p1) case List(%) => - (u2 := isPlus p2) case List(%) => - taggedElt(PAT_PLUS, concat(u1::List %, u2::List %)) - taggedElt(PAT_PLUS, concat(u1::List %, p2)) - (u2 := isPlus p2) case List(%) => - taggedElt(PAT_PLUS, concat(p1, u2::List %)) - taggedElt(PAT_PLUS, [p1, p2]) - - p1 * p2 == - p1 = 0 or p2 = 0 => 0 - p1 = 1 => p2 - p2 = 1 => p1 - (u1 := isTimes p1) case List(%) => - (u2 := isTimes p2) case List(%) => - taggedElt(PAT_TIMES, concat(u1::List %, u2::List %)) - taggedElt(PAT_TIMES, concat(u1::List %, p2)) - (u2 := isTimes p2) case List(%) => - taggedElt(PAT_TIMES, concat(p1, u2::List %)) - taggedElt(PAT_TIMES, [p1, p2]) - - isOp(p, o) == - (p.pat case ker) and zero?(p.pat.ker.tag) and (p.pat.ker.op =o) => - p.pat.ker.arg - "failed" - - predicates p == - symbol? p => p.pat.sym.pred - empty() - - setPredicates(p, l) == - generic? p => (p.pat.sym.pred := l; p) - error "Can only attach predicates to generic symbol" - - resetBadValues p == - generic? p => (p.pat.sym.bad := empty()$List(Any); p) - error "Can only attach bad values to generic symbol" - - addBadValue(p, a) == - generic? p => - if not member?(a, p.pat.sym.bad) then - p.pat.sym.bad := concat(a, p.pat.sym.bad) - p - error "Can only attach bad values to generic symbol" - - getBadValues p == - generic? p => p.pat.sym.bad - error "Not a generic symbol" - - SYM2O p == - sy := (p.val)::O - empty?(p.pred) => sy - paren infix(" | "::O, sy, - reduce("and",[sub("f"::O, i::O) for i in 1..#(p.pred)])$List(O)) - - variables p == - constant? p => empty() - generic? p => [p] - q := p.pat - q case ret => empty() - q case exp => variables(q.exp.val) - q case qot => concat_!(variables(q.qot.num), variables(q.qot.den)) - q case ker => concat [variables r for r in q.ker.arg] - empty() - - PAT2O p == - p case ret => (p.ret)::O - p case sym => SYM2O(p.sym) - p case exp => (p.exp.val)::O ** (p.exp.exponent)::O - p case qot => (p.qot.num)::O / (p.qot.den)::O - p.ker.tag = PAT_PLUS => LPAT2O("+", p.ker.arg) - p.ker.tag = PAT_TIMES => LPAT2O("*", p.ker.arg) - p.ker.tag = PAT_LIST => (p.ker.arg)::O - p.ker.tag = PAT_ZERO => 0::Integer::O - p.ker.tag = PAT_ONE => 1::Integer::O - l := [x::O for x in p.ker.arg]$List(O) - (u:=display(p.ker.op)) case "failed" =>prefix(name(p.ker.op)::O,l) - (u::(List O -> O)) l - - patcopy p == - p case ret => [p.ret] - p case sym => - [[p.sym.tag, p.sym.val, copy(p.sym.pred), copy(p.sym.bad)]$RSY] - p case ker=>[[p.ker.tag,p.ker.op,[copy x for x in p.ker.arg]]$KER] - p case qot => [[copy(p.qot.num), copy(p.qot.den)]$QOT] - [[copy(p.exp.val), p.exp.exponent]$REC] - - pateq?(p1, p2) == - p1 case ret => (p2 case ret) and (p1.ret = p2.ret) - p1 case qot => - (p2 case qot) and (p1.qot.num = p2.qot.num) - and (p1.qot.den = p2.qot.den) - p1 case sym => - (p2 case sym) and (p1.sym.val = p2.sym.val) - and {p1.sym.pred} =$Set(Any) {p2.sym.pred} - and {p1.sym.bad} =$Set(Any) {p2.sym.bad} - p1 case ker => - (p2 case ker) and (p1.ker.tag = p2.ker.tag) - and (p1.ker.op = p2.ker.op) and (p1.ker.arg = p2.ker.arg) - (p2 case exp) and (p1.exp.exponent = p2.exp.exponent) - and (p1.exp.val = p2.exp.val) - - retractIfCan(p:%):Union(SY, "failed") == - symbol? p => p.pat.sym.val - "failed" - - mkrsy(t, c?, o?, m?) == - c? => [0, t, empty(), empty()] - mlt := (m? => SYM_MULTIPLE; 0) - opt := (o? => SYM_OPTIONAL; 0) - [Or(Or(SYM_GENERIC, mlt), opt), t, empty(), empty()] - - patternVariable(sy, c?, o?, m?) == - rsy := mkrsy(sy, c?, o?, m?) - mkPat(zero?(rsy.tag), [rsy], 0) - -@ \section{package PATTERN1 PatternFunctions1} <>= "PATTERN1" -> "PACKAGE" @@ -538,7 +156,6 @@ PatternFunctions2(R:SetCategory, S:SetCategory): with <<*>>= <> -<> <> <> @ diff --git a/src/algebra/perm.spad.pamphlet b/src/algebra/perm.spad.pamphlet deleted file mode 100644 index 67116d0..0000000 --- a/src/algebra/perm.spad.pamphlet +++ /dev/null @@ -1,589 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra perm.spad} -\author{Holger Gollan, Johannes Grabmeier, Gerhard Schneider} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain PERM Permutation} -<>= -)abbrev domain PERM Permutation -++ Authors: Johannes Grabmeier, Holger Gollan, Martin Rubey -++ Date Created: 19 May 1989 -++ Date Last Updated: 2 June 2006 -++ Basic Operations: _*, degree, movedPoints, cyclePartition, order, -++ numberOfCycles, sign, even?, odd? -++ Related Constructors: PermutationGroup, PermutationGroupExamples -++ Also See: RepresentationTheoryPackage1 -++ AMS Classifications: -++ Keywords: -++ Reference: G. James/A. Kerber: The Representation Theory of the Symmetric -++ Group. Encycl. of Math. and its Appl., Vol. 16., Cambridge -++ Description: Permutation(S) implements the group of all bijections -++ on a set S, which move only a finite number of points. -++ A permutation is considered as a map from S into S. In particular -++ multiplication is defined as composition of maps: -++ {\em pi1 * pi2 = pi1 o pi2}. -++ The internal representation of permuatations are two lists -++ of equal length representing preimages and images. - -Permutation(S:SetCategory): public == private where - - B ==> Boolean - PI ==> PositiveInteger - I ==> Integer - L ==> List - NNI ==> NonNegativeInteger - V ==> Vector - PT ==> Partition - OUTFORM ==> OutputForm - RECCYPE ==> Record(cycl: L L S, permut: %) - RECPRIM ==> Record(preimage: L S, image : L S) - - public ==> PermutationCategory S with - - listRepresentation: % -> RECPRIM - ++ listRepresentation(p) produces a representation {\em rep} of - ++ the permutation p as a list of preimages and images, i.e - ++ p maps {\em (rep.preimage).k} to {\em (rep.image).k} for all - ++ indices k. Elements of \spad{S} not in {\em (rep.preimage).k} - ++ are fixed points, and these are the only fixed points of the - ++ permutation. - coercePreimagesImages : List List S -> % - ++ coercePreimagesImages(lls) coerces the representation {\em lls} - ++ of a permutation as a list of preimages and images to a permutation. - ++ We assume that both preimage and image do not contain repetitions. - coerce : List List S -> % - ++ coerce(lls) coerces a list of cycles {\em lls} to a - ++ permutation, each cycle being a list with no - ++ repetitions, is coerced to the permutation, which maps - ++ {\em ls.i} to {\em ls.i+1}, indices modulo the length of the list, - ++ then these permutations are mutiplied. - ++ Error: if repetitions occur in one cycle. - coerce : List S -> % - ++ coerce(ls) coerces a cycle {\em ls}, i.e. a list with not - ++ repetitions to a permutation, which maps {\em ls.i} to - ++ {\em ls.i+1}, indices modulo the length of the list. - ++ Error: if repetitions occur. - coerceListOfPairs : List List S -> % - ++ coerceListOfPairs(lls) coerces a list of pairs {\em lls} to a - ++ permutation. - ++ Error: if not consistent, i.e. the set of the first elements - ++ coincides with the set of second elements. - --coerce : % -> OUTFORM - ++ coerce(p) generates output of the permutation p with domain - ++ OutputForm. - degree : % -> NonNegativeInteger - ++ degree(p) retuns the number of points moved by the - ++ permutation p. - movedPoints : % -> Set S - ++ movedPoints(p) returns the set of points moved by the permutation p. - cyclePartition : % -> Partition - ++ cyclePartition(p) returns the cycle structure of a permutation - ++ p including cycles of length 1 only if S is finite. - order : % -> NonNegativeInteger - ++ order(p) returns the order of a permutation p as a group element. - numberOfCycles : % -> NonNegativeInteger - ++ numberOfCycles(p) returns the number of non-trivial cycles of - ++ the permutation p. - sign : % -> Integer - ++ sign(p) returns the signum of the permutation p, +1 or -1. - even? : % -> Boolean - ++ even?(p) returns true if and only if p is an even permutation, - ++ i.e. {\em sign(p)} is 1. - odd? : % -> Boolean - ++ odd?(p) returns true if and only if p is an odd permutation - ++ i.e. {\em sign(p)} is {\em -1}. - sort : L % -> L % - ++ sort(lp) sorts a list of permutations {\em lp} according to - ++ cycle structure first according to length of cycles, - ++ second, if S has \spadtype{Finite} or S has - ++ \spadtype{OrderedSet} according to lexicographical order of - ++ entries in cycles of equal length. - if S has Finite then - fixedPoints : % -> Set S - ++ fixedPoints(p) returns the points fixed by the permutation p. - if S has IntegerNumberSystem or S has Finite then - coerceImages : L S -> % - ++ coerceImages(ls) coerces the list {\em ls} to a permutation - ++ whose image is given by {\em ls} and the preimage is fixed - ++ to be {\em [1,...,n]}. - ++ Note: {coerceImages(ls)=coercePreimagesImages([1,...,n],ls)}. - ++ We assume that both preimage and image do not contain repetitions. - - private ==> add - - -- representation of the object: - - Rep := V L S -@ - -We represent a permutation as two lists of equal length representing preimages -and images of moved points. I.e., fixed points do not occur in either of these -lists. This enables us to compute the set of fixed points and the set of moved -points easily. - -Note that this was not respected in versions before [[patch--50]] of this -domain. - -<>= --- perm.spad.pamphlet Permutation.input -)spool Permutation.output -)set message test on -)set message auto off -)clear all ---S 1 of 8 -p := coercePreimagesImages([[1,2,3],[1,2,3]]) ---R ---R ---R (1) 1 ---R Type: Permutation PositiveInteger ---E 1 - ---S 2 of 8 -movedPoints p -- should return {} ---R ---R ---R (2) {} ---R Type: Set PositiveInteger ---E 2 - ---S 3 of 8 -even? p -- should return true ---R ---R ---R (3) true ---R Type: Boolean ---E 3 - ---S 4 of 8 -p := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4 ---R ---R ---R (4) (1 0 3) ---R Type: Permutation IntegerMod 4 ---E 4 - ---S 5 of 8 -fixedPoints p -- should return {2} ---R ---R ---R (5) {2} ---R Type: Set IntegerMod 4 ---E 5 - ---S 6 of 8 -q := coercePreimagesImages([[0,1,2,3],[1,0]])$PERM ZMOD 4 ---R ---R ---R (6) (1 0) ---R Type: Permutation IntegerMod 4 ---E 6 - ---S 7 of 8 -fixedPoints(p*q) -- should return {2,0} ---R ---R ---R (7) {2,0} ---R Type: Set IntegerMod 4 ---E 7 - ---S 8 of 8 -even?(p*q) -- should return false ---R ---R ---R (8) false ---R Type: Boolean ---E 8 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Permutation Examples -==================================================================== - - p := coercePreimagesImages([[1,2,3],[1,2,3]]) - 1 - Type: Permutation PositiveInteger - - movedPoints p - {} - Type: Set PositiveInteger - - even? p - true - Type: Boolean - - p := coercePreimagesImages([[0,1,2,3],[3,0,2,1]])$PERM ZMOD 4 - (1 0 3) - Type: Permutation IntegerMod 4 - - fixedPoints p - {2} - Type: Set IntegerMod 4 - - q := coercePreimagesImages([[0,1,2,3],[1,0]])$PERM ZMOD 4 - (1 0) - Type: Permutation IntegerMod 4 - - fixedPoints(p*q) - {2,0} - Type: Set IntegerMod 4 - even?(p*q) - false - Type: Boolean - -See Also: -o )show Permutation -o $AXIOM/doc/src/algebra/perm.spad.dvi - -@ -<>= - -- import of domains and packages - - import OutputForm - import Vector List S - - -- variables - - p,q : % - exp : I - - -- local functions first, signatures: - - smaller? : (S,S) -> B - rotateCycle: L S -> L S - coerceCycle: L L S -> % - smallerCycle?: (L S, L S) -> B - shorterCycle?:(L S, L S) -> B - permord:(RECCYPE,RECCYPE) -> B - coerceToCycle:(%,B) -> L L S - duplicates?: L S -> B - - smaller?(a:S, b:S): B == - S has OrderedSet => a <$S b - S has Finite => lookup a < lookup b - false - - rotateCycle(cyc: L S): L S == - -- smallest element is put in first place - -- doesn't change cycle if underlying set - -- is not ordered or not finite. - min:S := first cyc - minpos:I := 1 -- 1 = minIndex cyc - for i in 2..maxIndex cyc repeat - if smaller?(cyc.i,min) then - min := cyc.i - minpos := i --- one? minpos => cyc - (minpos = 1) => cyc - concat(last(cyc,((#cyc-minpos+1)::NNI)),first(cyc,(minpos-1)::NNI)) - - coerceCycle(lls : L L S): % == - perm : % := 1 - for lists in reverse lls repeat - perm := cycle lists * perm - perm - - smallerCycle?(cyca: L S, cycb: L S): B == - #cyca ^= #cycb => - #cyca < #cycb - for i in cyca for j in cycb repeat - i ^= j => return smaller?(i, j) - false - - shorterCycle?(cyca: L S, cycb: L S): B == - #cyca < #cycb - - permord(pa: RECCYPE, pb : RECCYPE): B == - for i in pa.cycl for j in pb.cycl repeat - i ^= j => return smallerCycle?(i, j) - #pa.cycl < #pb.cycl - - coerceToCycle(p: %, doSorting?: B): L L S == - preim := p.1 - im := p.2 - cycles := nil()$(L L S) - while not null preim repeat - -- start next cycle - firstEltInCycle: S := first preim - nextCycle : L S := list firstEltInCycle - preim := rest preim - nextEltInCycle := first im - im := rest im - while nextEltInCycle ^= firstEltInCycle repeat - nextCycle := cons(nextEltInCycle, nextCycle) - i := position(nextEltInCycle, preim) - preim := delete(preim,i) - nextEltInCycle := im.i - im := delete(im,i) - nextCycle := reverse nextCycle - -- check on 1-cycles, we don't list these - if not null rest nextCycle then - if doSorting? and (S has OrderedSet or S has Finite) then - -- put smallest element in cycle first: - nextCycle := rotateCycle nextCycle - cycles := cons(nextCycle, cycles) - not doSorting? => cycles - -- sort cycles - S has OrderedSet or S has Finite => - sort(smallerCycle?,cycles)$(L L S) - sort(shorterCycle?,cycles)$(L L S) - - duplicates? (ls : L S ): B == - x := copy ls - while not null x repeat - member? (first x ,rest x) => return true - x := rest x - false - - -- now the exported functions - - listRepresentation p == - s : RECPRIM := [p.1,p.2] - - coercePreimagesImages preImageAndImage == - preImage: List S := [] - image: List S := [] - for i in preImageAndImage.1 - for pi in preImageAndImage.2 repeat - if i ~= pi then - preImage := cons(i, preImage) - image := cons(pi, image) - - [preImage, image] -@ - -This operation transforms a pair of preimages and images into an element of the -domain. Since we assume that fixed points do not occur in the representation, -we have to sort them out here. - -Note that before [[patch--50]] this read -\begin{verbatim} - coercePreimagesImages preImageAndImage == - p : % := [preImageAndImage.1,preImageAndImage.2] -\end{verbatim} -causing bugs when computing [[movedPoints]], [[fixedPoints]], [[even?]], -[[odd?]], etc., as reported in Issue~\#295. - -The other coercion facilities check for fixed points. It also seems that [[*]] -removes fixed points from its result. - -<>= - - movedPoints p == construct p.1 - - degree p == #movedPoints p - - p = q == - #(preimp := p.1) ^= #(preimq := q.1) => false - for i in 1..maxIndex preimp repeat - pos := position(preimp.i, preimq) - pos = 0 => return false - (p.2).i ^= (q.2).pos => return false - true - - orbit(p ,el) == - -- start with a 1-element list: - out : Set S := brace list el - el2 := eval(p, el) - while el2 ^= el repeat - -- be carefull: insert adds one element - -- as side effect to out - insert_!(el2, out) - el2 := eval(p, el2) - out - - cyclePartition p == - partition([#c for c in coerceToCycle(p, false)])$Partition - - order p == - ord: I := lcm removeDuplicates convert cyclePartition p - ord::NNI - - sign(p) == - even? p => 1 - - 1 - - - even?(p) == even?(#(p.1) - numberOfCycles p) - -- see the book of James and Kerber on symmetric groups - -- for this formula. - - odd?(p) == odd?(#(p.1) - numberOfCycles p) - - pa < pb == - pacyc:= coerceToCycle(pa,true) - pbcyc:= coerceToCycle(pb,true) - for i in pacyc for j in pbcyc repeat - i ^= j => return smallerCycle? ( i, j ) - maxIndex pacyc < maxIndex pbcyc - - coerce(lls : L L S): % == coerceCycle lls - - coerce(ls : L S): % == cycle ls - - sort(inList : L %): L % == - not (S has OrderedSet or S has Finite) => inList - ownList: L RECCYPE := nil()$(L RECCYPE) - for sigma in inList repeat - ownList := - cons([coerceToCycle(sigma,true),sigma]::RECCYPE, ownList) - ownList := sort(permord, ownList)$(L RECCYPE) - outList := nil()$(L %) - for rec in ownList repeat - outList := cons(rec.permut, outList) - reverse outList - - coerce (p: %): OUTFORM == - cycles: L L S := coerceToCycle(p,true) - outfmL : L OUTFORM := nil() - for cycle in cycles repeat - outcycL: L OUTFORM := nil() - for elt in cycle repeat - outcycL := cons(elt :: OUTFORM, outcycL) - outfmL := cons(paren blankSeparate reverse outcycL, outfmL) - -- The identity element will be output as 1: - null outfmL => outputForm(1@Integer) - -- represent a single cycle in the form (a b c d) - -- and not in the form ((a b c d)): - null rest outfmL => first outfmL - hconcat reverse outfmL - - cycles(vs ) == coerceCycle vs - - cycle(ls) == - #ls < 2 => 1 - duplicates? ls => error "cycle: the input contains duplicates" - [ls, append(rest ls, list first ls)] - - coerceListOfPairs(loP) == - preim := nil()$(L S) - im := nil()$(L S) - for pair in loP repeat - if first pair ^= second pair then - preim := cons(first pair, preim) - im := cons(second pair, im) - duplicates?(preim) or duplicates?(im) or brace(preim)$(Set S) _ - ^= brace(im)$(Set S) => - error "coerceListOfPairs: the input cannot be interpreted as a permutation" - [preim, im] - - q * p == - -- use vectors for efficiency?? - preimOfp : V S := construct p.1 - imOfp : V S := construct p.2 - preimOfq := q.1 - imOfq := q.2 - preimOfqp := nil()$(L S) - imOfqp := nil()$(L S) - -- 1 = minIndex preimOfp - for i in 1..(maxIndex preimOfp) repeat - -- find index of image of p.i in q if it exists - j := position(imOfp.i, preimOfq) - if j = 0 then - -- it does not exist - preimOfqp := cons(preimOfp.i, preimOfqp) - imOfqp := cons(imOfp.i, imOfqp) - else - -- it exists - el := imOfq.j - -- if the composition fixes the element, we don't - -- have to do anything - if el ^= preimOfp.i then - preimOfqp := cons(preimOfp.i, preimOfqp) - imOfqp := cons(el, imOfqp) - -- we drop the parts of q which have to do with p - preimOfq := delete(preimOfq, j) - imOfq := delete(imOfq, j) - [append(preimOfqp, preimOfq), append(imOfqp, imOfq)] - - 1 == new(2,empty())$Rep - - inv p == [p.2, p.1] - - eval(p, el) == - pos := position(el, p.1) - pos = 0 => el - (p.2).pos - - elt(p, el) == eval(p, el) - - numberOfCycles p == #coerceToCycle(p, false) - - - if S has IntegerNumberSystem then - - coerceImages (image) == - preImage : L S := [i::S for i in 1..maxIndex image] - coercePreimagesImages [preImage,image] -@ - -Up to [[patch--50]] we did not check for duplicates. - -<>= - if S has Finite then - - coerceImages (image) == - preImage : L S := [index(i::PI)::S for i in 1..maxIndex image] - coercePreimagesImages [preImage,image] -@ - -Up to [[patch--50]] we did not check for duplicates. - -<>= - fixedPoints ( p ) == complement movedPoints p - - cyclePartition p == - pt := partition([#c for c in coerceToCycle(p, false)])$Partition - pt +$PT conjugate(partition([#fixedPoints(p)])$PT)$PT - -@ -\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/permgrps.spad.pamphlet b/src/algebra/permgrps.spad.pamphlet index 0b3fa62..af5af2c 100644 --- a/src/algebra/permgrps.spad.pamphlet +++ b/src/algebra/permgrps.spad.pamphlet @@ -9,765 +9,6 @@ \eject \tableofcontents \eject -\section{domain PERMGRP PermutationGroup} -<>= -)abbrev domain PERMGRP PermutationGroup -++ Authors: G. Schneider, H. Gollan, J. Grabmeier -++ Date Created: 13 February 1987 -++ Date Last Updated: 24 May 1991 -++ Basic Operations: -++ Related Constructors: PermutationGroupExamples, Permutation -++ Also See: RepresentationTheoryPackage1 -++ AMS Classifications: -++ Keywords: permutation, permutation group, group operation, word problem -++ References: -++ C. Sims: Determining the conjugacy classes of a permutation group, -++ in Computers in Algebra and Number Theory, SIAM-AMS Proc., Vol. 4, -++ Amer. Math. Soc., Providence, R. I., 1971, pp. 191-195 -++ Description: -++ PermutationGroup implements permutation groups acting -++ on a set S, i.e. all subgroups of the symmetric group of S, -++ represented as a list of permutations (generators). Note that -++ therefore the objects are not members of the \Language category -++ \spadtype{Group}. -++ Using the idea of base and strong generators by Sims, -++ basic routines and algorithms -++ are implemented so that the word problem for -++ permutation groups can be solved. ---++ Note: we plan to implement lattice operations on the subgroup ---++ lattice in a later release - -PermutationGroup(S:SetCategory): public == private where - - L ==> List - PERM ==> Permutation - FSET ==> Set - I ==> Integer - NNI ==> NonNegativeInteger - V ==> Vector - B ==> Boolean - OUT ==> OutputForm - SYM ==> Symbol - REC ==> Record ( orb : L NNI , svc : V I ) - REC2 ==> Record(order:NNI,sgset:L V NNI,_ - gpbase:L NNI,orbs:L REC,mp:L S,wd:L L NNI) - REC3 ==> Record(elt:V NNI,lst:L NNI) - REC4 ==> Record(bool:B,lst:L NNI) - - public ==> SetCategory with - - coerce : % -> L PERM S - ++ coerce(gp) returns the generators of the group {\em gp}. - generators : % -> L PERM S - ++ generators(gp) returns the generators of the group {\em gp}. - elt : (%,NNI) -> PERM S - ++ elt(gp,i) returns the i-th generator of the group {\em gp}. - random : (%,I) -> PERM S - ++ random(gp,i) returns a random product of maximal i generators - ++ of the group {\em gp}. - random : % -> PERM S - ++ random(gp) returns a random product of maximal 20 generators - ++ of the group {\em gp}. - ++ Note: {\em random(gp)=random(gp,20)}. - order : % -> NNI - ++ order(gp) returns the order of the group {\em gp}. - degree : % -> NNI - ++ degree(gp) returns the number of points moved by all permutations - ++ of the group {\em gp}. - base : % -> L S - ++ base(gp) returns a base for the group {\em gp}. - strongGenerators : % -> L PERM S - ++ strongGenerators(gp) returns strong generators for - ++ the group {\em gp}. - wordsForStrongGenerators : % -> L L NNI - ++ wordsForStrongGenerators(gp) returns the words for the strong - ++ generators of the group {\em gp} in the original generators of - ++ {\em gp}, represented by their indices in the list, given by - ++ {\em generators}. - coerce : L PERM S -> % - ++ coerce(ls) coerces a list of permutations {\em ls} to the group - ++ generated by this list. - permutationGroup : L PERM S -> % - ++ permutationGroup(ls) coerces a list of permutations {\em ls} to - ++ the group generated by this list. - orbit : (%,S) -> FSET S - ++ orbit(gp,el) returns the orbit of the element {\em el} under the - ++ group {\em gp}, i.e. the set of all points gained by applying - ++ each group element to {\em el}. - orbits : % -> FSET FSET S - ++ orbits(gp) returns the orbits of the group {\em gp}, i.e. - ++ it partitions the (finite) of all moved points. - orbit : (%,FSET S)-> FSET FSET S - ++ orbit(gp,els) returns the orbit of the unordered - ++ set {\em els} under the group {\em gp}. - orbit : (%,L S) -> FSET L S - ++ orbit(gp,ls) returns the orbit of the ordered - ++ list {\em ls} under the group {\em gp}. - ++ Note: return type is L L S temporarily because FSET L S has an error. - -- (GILT DAS NOCH?) - member? : (PERM S, %)-> B - ++ member?(pp,gp) answers the question, whether the - ++ permutation {\em pp} is in the group {\em gp} or not. - wordInStrongGenerators : (PERM S, %)-> L NNI - ++ wordInStrongGenerators(p,gp) returns the word for the - ++ permutation p in the strong generators of the group {\em gp}, - ++ represented by the indices of the list, given by {\em strongGenerators}. - wordInGenerators : (PERM S, %)-> L NNI - ++ wordInGenerators(p,gp) returns the word for the permutation p - ++ in the original generators of the group {\em gp}, - ++ represented by the indices of the list, given by {\em generators}. - movedPoints : % -> FSET S - ++ movedPoints(gp) returns the points moved by the group {\em gp}. - "<" : (%,%) -> B - ++ gp1 < gp2 returns true if and only if {\em gp1} - ++ is a proper subgroup of {\em gp2}. - "<=" : (%,%) -> B - ++ gp1 <= gp2 returns true if and only if {\em gp1} - ++ is a subgroup of {\em gp2}. - ++ Note: because of a bug in the parser you have to call this - ++ function explicitly by {\em gp1 <=$(PERMGRP S) gp2}. - -- (GILT DAS NOCH?) - initializeGroupForWordProblem : % -> Void - ++ initializeGroupForWordProblem(gp) initializes the group {\em gp} - ++ for the word problem. - ++ Notes: it calls the other function of this name with parameters - ++ 0 and 1: {\em initializeGroupForWordProblem(gp,0,1)}. - ++ Notes: (1) be careful: invoking this routine will destroy the - ++ possibly information about your group (but will recompute it again) - ++ (2) users need not call this function normally for the soultion of - ++ the word problem. - initializeGroupForWordProblem :(%,I,I) -> Void - ++ initializeGroupForWordProblem(gp,m,n) initializes the group - ++ {\em gp} for the word problem. - ++ Notes: (1) with a small integer you get shorter words, but the - ++ routine takes longer than the standard routine for longer words. - ++ (2) be careful: invoking this routine will destroy the possibly stored - ++ information about your group (but will recompute it again). - ++ (3) users need not call this function normally for the soultion of - ++ the word problem. - - private ==> add - - -- representation of the object: - - Rep := Record ( gens : L PERM S , information : REC2 ) - - -- import of domains and packages - - import Permutation S - import OutputForm - import Symbol - import Void - - --first the local variables - - sgs : L V NNI := [] - baseOfGroup : L NNI := [] - sizeOfGroup : NNI := 1 - degree : NNI := 0 - gporb : L REC := [] - out : L L V NNI := [] - outword : L L L NNI := [] - wordlist : L L NNI := [] - basePoint : NNI := 0 - newBasePoint : B := true - supp : L S := [] - ord : NNI := 1 - wordProblem : B := true - - --local functions first, signatures: - - shortenWord:(L NNI, %)->L NNI - times:(V NNI, V NNI)->V NNI - strip:(V NNI,REC,L V NNI,L L NNI)->REC3 - orbitInternal:(%,L S )->L L S - inv: V NNI->V NNI - ranelt:(L V NNI,L L NNI, I)->REC3 - testIdentity:V NNI->B - pointList: %->L S - orbitWithSvc:(L V NNI ,NNI )->REC - cosetRep:(NNI ,REC ,L V NNI )->REC3 - bsgs1:(L V NNI,NNI,L L NNI,I,%,I)->NNI - computeOrbits: I->L NNI - reduceGenerators: I->Void - bsgs:(%, I, I)->NNI - initialize: %->FSET PERM S - knownGroup?: %->Void - subgroup:(%, %)->B - memberInternal:(PERM S, %, B)->REC4 - - --local functions first, implementations: - - shortenWord ( lw : L NNI , gp : % ) : L NNI == - -- tries to shorten a word in the generators by removing identities - gpgens : L PERM S := coerce gp - orderList : L NNI := [ order gen for gen in gpgens ] - newlw : L NNI := copy lw - for i in 1.. maxIndex orderList repeat - if orderList.i = 1 then - while member?(i,newlw) repeat - -- removing the trivial element - pos := position(i,newlw) - newlw := delete(newlw,pos) - flag : B := true - while flag repeat - actualLength : NNI := (maxIndex newlw) pretend NNI - pointer := actualLength - test := newlw.pointer - anzahl : NNI := 1 - flag := false - while pointer > 1 repeat - pointer := ( pointer - 1 )::NNI - if newlw.pointer ^= test then - -- don't get a trivial element, try next - test := newlw.pointer - anzahl := 1 - else - anzahl := anzahl + 1 - if anzahl = orderList.test then - -- we have an identity, so remove it - for i in (pointer+anzahl)..actualLength repeat - newlw.(i-anzahl) := newlw.i - newlw := first(newlw, (actualLength - anzahl) :: NNI) - flag := true - pointer := 1 - newlw - - times ( p : V NNI , q : V NNI ) : V NNI == - -- internal multiplication of permutations - [ qelt(p,qelt(q,i)) for i in 1..degree ] - - strip(element:V NNI,orbit:REC,group:L V NNI,words:L L NNI) : REC3 == - -- strip an element into the stabilizer - actelt := element - schreierVector := orbit.svc - point := orbit.orb.1 - outlist := nil()$(L NNI) - entryLessZero : B := false - while ^entryLessZero repeat - entry := schreierVector.(actelt.point) - entryLessZero := (entry < 0) - if ^entryLessZero then - actelt := times(group.entry, actelt) - if wordProblem then outlist := append ( words.(entry::NNI) , outlist ) - [ actelt , reverse outlist ] - - orbitInternal ( gp : % , startList : L S ) : L L S == - orbitList : L L S := [ startList ] - pos : I := 1 - while not zero? pos repeat - gpset : L PERM S := gp.gens - for gen in gpset repeat - newList := nil()$(L S) - workList := orbitList.pos - for j in #workList..1 by -1 repeat - newList := cons ( eval ( gen , workList.j ) , newList ) - if ^member?( newList , orbitList ) then - orbitList := cons ( newList , orbitList ) - pos := pos + 1 - pos := pos - 1 - reverse orbitList - - inv ( p : V NNI ) : V NNI == - -- internal inverse of a permutation - q : V NNI := new(degree,0)$(V NNI) - for i in 1..degree repeat q.(qelt(p,i)) := i - q - - ranelt ( group : L V NNI , word : L L NNI , maxLoops : I ) : REC3 == - -- generate a "random" element - numberOfGenerators := # group - randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) - randomElement : V NNI := group.randomInteger - words := nil()$(L NNI) - if wordProblem then words := word.(randomInteger::NNI) - if maxLoops > 0 then - numberOfLoops : I := 1 + (random()$Integer rem maxLoops) - else - numberOfLoops : I := maxLoops - while numberOfLoops > 0 repeat - randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) - randomElement := times ( group.randomInteger , randomElement ) - if wordProblem then words := append ( word.(randomInteger::NNI) , words) - numberOfLoops := numberOfLoops - 1 - [ randomElement , words ] - - testIdentity ( p : V NNI ) : B == - -- internal test for identity - for i in 1..degree repeat qelt(p,i) ^= i => return false - true - - pointList(group : %) : L S == - support : FSET S := brace() -- empty set !! - for perm in group.gens repeat - support := union(support, movedPoints perm) - parts support - - orbitWithSvc ( group : L V NNI , point : NNI ) : REC == - -- compute orbit with Schreier vector, "-2" means not in the orbit, - -- "-1" means starting point, the PI correspond to generators - newGroup := nil()$(L V NNI) - for el in group repeat - newGroup := cons ( inv el , newGroup ) - newGroup := reverse newGroup - orbit : L NNI := [ point ] - schreierVector : V I := new ( degree , -2 ) - schreierVector.point := -1 - position : I := 1 - while not zero? position repeat - for i in 1..#newGroup repeat - newPoint := orbit.position - newPoint := newGroup.i.newPoint - if ^ member? ( newPoint , orbit ) then - orbit := cons ( newPoint , orbit ) - position := position + 1 - schreierVector.newPoint := i - position := position - 1 - [ reverse orbit , schreierVector ] - - cosetRep ( point : NNI , o : REC , group : L V NNI ) : REC3 == - ppt := point - xelt : V NNI := [ n for n in 1..degree ] - word := nil()$(L NNI) - oorb := o.orb - osvc := o.svc - while degree > 0 repeat - p := osvc.ppt - p < 0 => return [ xelt , word ] - x := group.p - xelt := times ( x , xelt ) - if wordProblem then word := append ( wordlist.p , word ) - ppt := x.ppt - - bsgs1 (group:L V NNI,number1:NNI,words:L L NNI,maxLoops:I,gp:%,diff:I)_ - : NNI == - -- try to get a good approximation for the strong generators and base - for i in number1..degree repeat - ort := orbitWithSvc ( group , i ) - k := ort.orb - k1 := # k - if k1 ^= 1 then leave - gpsgs := nil()$(L V NNI) - words2 := nil()$(L L NNI) - gplength : NNI := #group - for jj in 1..gplength repeat if (group.jj).i ^= i then leave - for k in 1..gplength repeat - el2 := group.k - if el2.i ^= i then - gpsgs := cons ( el2 , gpsgs ) - if wordProblem then words2 := cons ( words.k , words2 ) - else - gpsgs := cons ( times ( group.jj , el2 ) , gpsgs ) - if wordProblem _ - then words2 := cons ( append ( words.jj , words.k ) , words2 ) - group2 := nil()$(L V NNI) - words3 := nil()$(L L NNI) - j : I := 15 - while j > 0 repeat - -- find generators for the stabilizer - ran := ranelt ( group , words , maxLoops ) - str := strip ( ran.elt , ort , group , words ) - el2 := str.elt - if ^ testIdentity el2 then - if ^ member?(el2,group2) then - group2 := cons ( el2 , group2 ) - if wordProblem then - help : L NNI := append ( reverse str.lst , ran.lst ) - help := shortenWord ( help , gp ) - words3 := cons ( help , words3 ) - j := j - 2 - j := j - 1 - -- this is for word length control - if wordProblem then maxLoops := maxLoops - diff - if ( null group2 ) or ( maxLoops < 0 ) then - sizeOfGroup := k1 - baseOfGroup := [ i ] - out := [ gpsgs ] - outword := [ words2 ] - return sizeOfGroup - k2 := bsgs1 ( group2 , i + 1 , words3 , maxLoops , gp , diff ) - sizeOfGroup := k1 * k2 - out := append ( out , [ gpsgs ] ) - outword := append ( outword , [ words2 ] ) - baseOfGroup := cons ( i , baseOfGroup ) - sizeOfGroup - - computeOrbits ( kkk : I ) : L NNI == - -- compute the orbits for the stabilizers - sgs := nil() - orbitLength := nil()$(L NNI) - gporb := nil() - for i in 1..#baseOfGroup repeat - sgs := append ( sgs , out.i ) - pt := #baseOfGroup - i + 1 - obs := orbitWithSvc ( sgs , baseOfGroup.pt ) - orbitLength := cons ( #obs.orb , orbitLength ) - gporb := cons ( obs , gporb ) - gporb := reverse gporb - reverse orbitLength - - reduceGenerators ( kkk : I ) : Void == - -- try to reduce number of strong generators - orbitLength := computeOrbits ( kkk ) - sgs := nil() - wordlist := nil() - for i in 1..(kkk-1) repeat - sgs := append ( sgs , out.i ) - if wordProblem then wordlist := append ( wordlist , outword.i ) - removedGenerator := false - baseLength : NNI := #baseOfGroup - for nnn in kkk..(baseLength-1) repeat - sgs := append ( sgs , out.nnn ) - if wordProblem then wordlist := append ( wordlist , outword.nnn ) - pt := baseLength - nnn + 1 - obs := orbitWithSvc ( sgs , baseOfGroup.pt ) - i := 1 - while not ( i > # out.nnn ) repeat - pos := position ( out.nnn.i , sgs ) - sgs2 := delete(sgs, pos) - obs2 := orbitWithSvc ( sgs2 , baseOfGroup.pt ) - if # obs2.orb = orbitLength.nnn then - test := true - for j in (nnn+1)..(baseLength-1) repeat - pt2 := baseLength - j + 1 - sgs2 := append ( sgs2 , out.j ) - obs2 := orbitWithSvc ( sgs2 , baseOfGroup.pt2 ) - if # obs2.orb ^= orbitLength.j then - test := false - leave - if test then - removedGenerator := true - sgs := delete (sgs, pos) - if wordProblem then wordlist := delete(wordlist, pos) - out.nnn := delete (out.nnn, i) - if wordProblem then _ - outword.nnn := delete(outword.nnn, i ) - else - i := i + 1 - else - i := i + 1 - if removedGenerator then orbitLength := computeOrbits ( kkk ) - void() - - - bsgs ( group : % ,maxLoops : I , diff : I ) : NNI == - -- the MOST IMPORTANT part of the package - supp := pointList group - degree := # supp - if degree = 0 then - sizeOfGroup := 1 - sgs := [ [ 0 ] ] - baseOfGroup := nil() - gporb := nil() - return sizeOfGroup - newGroup := nil()$(L V NNI) - gp : L PERM S := group.gens - words := nil()$(L L NNI) - for ggg in 1..#gp repeat - q := new(degree,0)$(V NNI) - for i in 1..degree repeat - newEl := eval ( gp.ggg , supp.i ) - pos2 := position ( newEl , supp ) - q.i := pos2 pretend NNI - newGroup := cons ( q , newGroup ) - if wordProblem then words := cons(list ggg, words) - if maxLoops < 1 then - -- try to get the (approximate) base length - if zero? (# ((group.information).gpbase)) then - wordProblem := false - k := bsgs1 ( newGroup , 1 , words , 20 , group , 0 ) - wordProblem := true - maxLoops := (# baseOfGroup) - 1 - else - maxLoops := (# ((group.information).gpbase)) - 1 - k := bsgs1 ( newGroup , 1 , words , maxLoops , group , diff ) - kkk : I := 1 - newGroup := reverse newGroup - noAnswer : B := true - while noAnswer repeat - reduceGenerators kkk --- *** Here is former "bsgs2" *** -- - -- test whether we have a base and a strong generating set - sgs := nil() - wordlist := nil() - for i in 1..(kkk-1) repeat - sgs := append ( sgs , out.i ) - if wordProblem then wordlist := append ( wordlist , outword.i ) - noresult : B := true - for i in kkk..#baseOfGroup while noresult repeat - sgs := append ( sgs , out.i ) - if wordProblem then wordlist := append ( wordlist , outword.i ) - gporbi := gporb.i - for pt in gporbi.orb while noresult repeat - ppp := cosetRep ( pt , gporbi , sgs ) - y1 := inv ppp.elt - word3 := ppp.lst - for jjj in 1..#sgs while noresult repeat - word := nil()$(L NNI) - z := times ( sgs.jjj , y1 ) - if wordProblem then word := append ( wordlist.jjj , word ) - ppp := cosetRep ( (sgs.jjj).pt , gporbi , sgs ) - z := times ( ppp.elt , z ) - if wordProblem then word := append ( ppp.lst , word ) - newBasePoint := false - for j in (i-1)..1 by -1 while noresult repeat - s := gporb.j.svc - p := gporb.j.orb.1 - while ( degree > 0 ) and noresult repeat - entry := s.(z.p) - if entry < 0 then - if entry = -1 then leave - basePoint := j::NNI - noresult := false - else - ee := sgs.entry - z := times ( ee , z ) - if wordProblem then word := append ( wordlist.entry , word ) - if noresult then - basePoint := 1 - newBasePoint := true - noresult := testIdentity z - noAnswer := not (testIdentity z) - if noAnswer then - -- we have missed something - word2 := nil()$(L NNI) - if wordProblem then - for wd in word3 repeat - ttt := newGroup.wd - while not (testIdentity ttt) repeat - word2 := cons ( wd , word2 ) - ttt := times ( ttt , newGroup.wd ) - word := append ( word , word2 ) - word := shortenWord ( word , group ) - if newBasePoint then - for i in 1..degree repeat - if z.i ^= i then - baseOfGroup := append ( baseOfGroup , [ i ] ) - leave - out := cons (list z, out ) - if wordProblem then outword := cons (list word , outword ) - else - out.basePoint := cons ( z , out.basePoint ) - if wordProblem then outword.basePoint := cons(word ,outword.basePoint ) - kkk := basePoint - sizeOfGroup := 1 - for j in 1..#baseOfGroup repeat - sizeOfGroup := sizeOfGroup * # gporb.j.orb - sizeOfGroup - - - initialize ( group : % ) : FSET PERM S == - group2 := brace()$(FSET PERM S) - gp : L PERM S := group.gens - for gen in gp repeat - if degree gen > 0 then insert_!(gen, group2) - group2 - - knownGroup? (gp : %) : Void == - -- do we know the group already? - result := gp.information - if result.order = 0 then - wordProblem := false - ord := bsgs ( gp , 20 , 0 ) - result := [ ord , sgs , baseOfGroup , gporb , supp , [] ] - gp.information := result - else - ord := result.order - sgs := result.sgset - baseOfGroup := result.gpbase - gporb := result.orbs - supp := result.mp - wordlist := result.wd - void - - subgroup ( gp1 : % , gp2 : % ) : B == - gpset1 := initialize gp1 - gpset2 := initialize gp2 - empty? difference (gpset1, gpset2) => true - for el in parts gpset1 repeat - not member? (el, gp2) => return false - true - - memberInternal ( p : PERM S , gp : % , flag : B ) : REC4 == - -- internal membership testing - supp := pointList gp - outlist := nil()$(L NNI) - mP : L S := parts movedPoints p - for x in mP repeat - not member? (x, supp) => return [ false , nil()$(L NNI) ] - if flag then - member? ( p , gp.gens ) => return [ true , nil()$(L NNI) ] - knownGroup? gp - else - result := gp.information - if #(result.wd) = 0 then - initializeGroupForWordProblem gp - else - ord := result.order - sgs := result.sgset - baseOfGroup := result.gpbase - gporb := result.orbs - supp := result.mp - wordlist := result.wd - degree := # supp - pp := new(degree,0)$(V NNI) - for i in 1..degree repeat - el := eval ( p , supp.i ) - pos := position ( el , supp ) - pp.i := pos::NNI - words := nil()$(L L NNI) - if wordProblem then - for i in 1..#sgs repeat - lw : L NNI := [ (#sgs - i + 1)::NNI ] - words := cons ( lw , words ) - for i in #baseOfGroup..1 by -1 repeat - str := strip ( pp , gporb.i , sgs , words ) - pp := str.elt - if wordProblem then outlist := append ( outlist , str.lst ) - [ testIdentity pp , reverse outlist ] - - --now the exported functions - - coerce ( gp : % ) : L PERM S == gp.gens - generators ( gp : % ) : L PERM S == gp.gens - - strongGenerators ( group ) == - knownGroup? group - degree := # supp - strongGens := nil()$(L PERM S) - for i in sgs repeat - pairs := nil()$(L L S) - for j in 1..degree repeat - pairs := cons ( [ supp.j , supp.(i.j) ] , pairs ) - strongGens := cons ( coerceListOfPairs pairs , strongGens ) - reverse strongGens - - elt ( gp , i ) == (gp.gens).i - - movedPoints ( gp ) == brace pointList gp - - random ( group , maximalNumberOfFactors ) == - maximalNumberOfFactors < 1 => 1$(PERM S) - gp : L PERM S := group.gens - numberOfGenerators := # gp - randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) - randomElement := gp.randomInteger - numberOfLoops : I := 1 + (random()$Integer rem maximalNumberOfFactors) - while numberOfLoops > 0 repeat - randomInteger : I := 1 + (random()$Integer rem numberOfGenerators) - randomElement := gp.randomInteger * randomElement - numberOfLoops := numberOfLoops - 1 - randomElement - - random ( group ) == random ( group , 20 ) - - order ( group ) == - knownGroup? group - ord - - degree ( group ) == # pointList group - - base ( group ) == - knownGroup? group - groupBase := nil()$(L S) - for i in baseOfGroup repeat - groupBase := cons ( supp.i , groupBase ) - reverse groupBase - - wordsForStrongGenerators ( group ) == - knownGroup? group - wordlist - - coerce ( gp : L PERM S ) : % == - result : REC2 := [ 0 , [] , [] , [] , [] , [] ] - group := [ gp , result ] - - permutationGroup ( gp : L PERM S ) : % == - result : REC2 := [ 0 , [] , [] , [] , [] , [] ] - group := [ gp , result ] - - coerce(group: %) : OUT == - outList := nil()$(L OUT) - gp : L PERM S := group.gens - for i in (maxIndex gp)..1 by -1 repeat - outList := cons(coerce gp.i, outList) - postfix(outputForm(">":SYM),postfix(commaSeparate outList,outputForm("<":SYM))) - - orbit ( gp : % , el : S ) : FSET S == - elList : L S := [ el ] - outList := orbitInternal ( gp , elList ) - outSet := brace()$(FSET S) - for i in 1..#outList repeat - insert_! ( outList.i.1 , outSet ) - outSet - - orbits ( gp ) == - spp := movedPoints gp - orbits := nil()$(L FSET S) - while cardinality spp > 0 repeat - el := extract_! spp - orbitSet := orbit ( gp , el ) - orbits := cons ( orbitSet , orbits ) - spp := difference ( spp , orbitSet ) - brace orbits - - member? (p, gp) == - wordProblem := false - mi := memberInternal ( p , gp , true ) - mi.bool - - wordInStrongGenerators (p, gp ) == - mi := memberInternal ( inv p , gp , false ) - not mi.bool => error "p is not an element of gp" - mi.lst - - wordInGenerators (p, gp) == - lll : L NNI := wordInStrongGenerators (p, gp) - outlist := nil()$(L NNI) - for wd in lll repeat - outlist := append ( outlist , wordlist.wd ) - shortenWord ( outlist , gp ) - - gp1 < gp2 == - not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false - not subgroup ( gp1 , gp2 ) => false - order gp1 = order gp2 => false - true - - gp1 <= gp2 == - not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false - subgroup ( gp1 , gp2 ) - - gp1 = gp2 == - movedPoints gp1 ^= movedPoints gp2 => false - if #(gp1.gens) <= #(gp2.gens) then - not subgroup ( gp1 , gp2 ) => return false - else - not subgroup ( gp2 , gp1 ) => return false - order gp1 = order gp2 => true - false - - orbit ( gp : % , startSet : FSET S ) : FSET FSET S == - startList : L S := parts startSet - outList := orbitInternal ( gp , startList ) - outSet := brace()$(FSET FSET S) - for i in 1..#outList repeat - newSet : FSET S := brace outList.i - insert_! ( newSet , outSet ) - outSet - - orbit ( gp : % , startList : L S ) : FSET L S == - brace orbitInternal(gp, startList) - - initializeGroupForWordProblem ( gp , maxLoops , diff ) == - wordProblem := true - ord := bsgs ( gp , maxLoops , diff ) - gp.information := [ ord , sgs , baseOfGroup , gporb , supp , wordlist ] - void - - initializeGroupForWordProblem ( gp ) == initializeGroupForWordProblem ( gp , 0 , 1 ) - -@ \section{package PGE PermutationGroupExamples} <>= )abbrev package PGE PermutationGroupExamples @@ -1178,7 +419,6 @@ PermutationGroupExamples():public == private where <<*>>= <> -<> <> @ \eject diff --git a/src/algebra/pf.spad.pamphlet b/src/algebra/pf.spad.pamphlet deleted file mode 100644 index 338b56c..0000000 --- a/src/algebra/pf.spad.pamphlet +++ /dev/null @@ -1,266 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra pf.spad} -\author{N.N., Johannes Grabmeier, Alfred Scheerhorn} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain IPF InnerPrimeField} -<>= -)abbrev domain IPF InnerPrimeField --- Argument MUST be a prime. --- This domain does not check, PrimeField does. -++ Authors: N.N., J.Grabmeier, A.Scheerhorn -++ Date Created: ?, November 1990, 26.03.1991 -++ Date Last Updated: 12 April 1991 -++ Basic Operations: -++ Related Constructors: PrimeField -++ Also See: -++ AMS Classifications: -++ Keywords: prime characteristic, prime field, finite field -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ AXIOM Technical Report Series, to appear. -++ Description: -++ InnerPrimeField(p) implements the field with p elements. -++ Note: argument p MUST be a prime (this domain does not check). -++ See \spadtype{PrimeField} for a domain that does check. - - -InnerPrimeField(p:PositiveInteger): Exports == Implementation where - - I ==> Integer - NNI ==> NonNegativeInteger - PI ==> PositiveInteger - TBL ==> Table(PI,NNI) - R ==> Record(key:PI,entry:NNI) - SUP ==> SparseUnivariatePolynomial - OUT ==> OutputForm - - Exports ==> Join(FiniteFieldCategory,FiniteAlgebraicExtensionField($),_ - ConvertibleTo(Integer)) - - Implementation ==> IntegerMod p add - - initializeElt:() -> Void - initializeLog:() -> Void - --- global variables ==================================================== - - primitiveElt:PI:=1 - -- for the lookup the primitive Element computed by createPrimitiveElement() - - sizeCG :=(p-1) pretend NonNegativeInteger - -- the size of the cyclic group - - facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer)) - -- the factorization of the cyclic group size - - initlog?:Boolean:=true - -- gets false after initialization of the logarithm table - - initelt?:Boolean:=true - -- gets false after initialization of the primitive Element - - - discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) - -- tables indexed by the factors of the size q of the cyclic group - -- discLogTable.factor is a table of with keys - -- primitiveElement() ** (i * (q quo factor)) and entries i for - -- i in 0..n-1, n computed in initialize() in order to use - -- the minimal size limit 'limit' optimal. - --- functions =========================================================== - - generator() == 1 - - -- This uses x**(p-1)=1 (mod p), so x**(q(p-1)+r) = x**r (mod p) - x:$ ** n:Integer == - zero?(n) => 1 - zero?(x) => 0 - r := positiveRemainder(n,p-1)::NNI - ((x pretend IntegerMod p) **$IntegerMod(p) r) pretend $ - - if p <= convert(max()$SingleInteger)@Integer then - q := p::SingleInteger - - recip x == - zero?(y := convert(x)@Integer :: SingleInteger) => "failed" - invmod(y, q)::Integer::$ - else - recip x == - zero?(y := convert(x)@Integer) => "failed" - invmod(y, p)::$ - - convert(x:$) == x pretend I - - normalElement() == 1 - - createNormalElement() == 1 - - characteristic() == p - - factorsOfCyclicGroupSize() == - p=2 => facOfGroupSize -- this fixes an infinite loop of functions - -- calls, problem was that factors factor(1) - -- is the empty list - if empty? facOfGroupSize then initializeElt() - facOfGroupSize - - representationType() == "prime" - - tableForDiscreteLogarithm(fac) == - if initlog? then initializeLog() - tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) - tbl case "failed" => - error "tableForDiscreteLogarithm: argument must be prime divisor_ - of the order of the multiplicative group" - tbl pretend TBL - - primitiveElement() == - if initelt? then initializeElt() - index(primitiveElt) - - initializeElt() == - facOfGroupSize:=factors(factor(sizeCG)$I)$(Factored I) - -- get a primitive element - primitiveElt:=lookup(createPrimitiveElement()) - -- set initialization flag - initelt? := false - void$Void - - initializeLog() == - if initelt? then initializeElt() - -- set up tables for discrete logarithm - limit:Integer:=30 - -- the minimum size for the discrete logarithm table - for f in facOfGroupSize repeat - fac:=f.factor - base:$:=primitiveElement() ** (sizeCG quo fac) - l:Integer:=length(fac)$Integer - n:Integer:=0 - if odd?(l)$Integer then n:=shift(fac,-(l quo 2)) - else n:=shift(1,(l quo 2)) - if n < limit then - d:=(fac-1) quo limit + 1 - n:=(fac-1) quo d + 1 - tbl:TBL:=table()$TBL - a:$:=1 - for i in (0::NNI)..(n-1)::NNI repeat - insert_!([lookup(a),i::NNI]$R,tbl)$TBL - a:=a*base - insert_!([fac::PI,copy(tbl)$TBL]_ - $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL) - -- tell user about initialization - -- print("discrete logarithm table initialized"::OUT) - -- set initialization flag - initlog? := false - void$Void - - degree(x):PI == 1::PositiveInteger - extensionDegree():PI == 1::PositiveInteger - --- sizeOfGroundField() == p::NonNegativeInteger - - inGroundField?(x) == true - - coordinates(x) == new(1,x)$(Vector $) - - represents(v) == v.1 - - retract(x) == x - - retractIfCan(x) == x - - basis() == new(1,1::$)$(Vector $) - basis(n:PI) == - n = 1 => basis() - error("basis: argument must divide extension degree") - - definingPolynomial() == - monomial(1,1)$(SUP $) - monomial(1,0)$(SUP $) - - - minimalPolynomial(x) == - monomial(1,1)$(SUP $) - monomial(x,0)$(SUP $) - - charthRoot x == x - -@ -\section{domain PF PrimeField} -<>= -)abbrev domain PF PrimeField -++ Authors: N.N., -++ Date Created: November 1990, 26.03.1991 -++ Date Last Updated: 31 March 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: prime characteristic, prime field, finite field -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ Description: -++ PrimeField(p) implements the field with p elements if p is a -++ prime number. -++ Error: if p is not prime. -++ Note: this domain does not check that argument is a prime. ---++ with new compiler, want to put the error check before the add -PrimeField(p:PositiveInteger): Exp == Impl where - Exp ==> Join(FiniteFieldCategory,FiniteAlgebraicExtensionField($),_ - ConvertibleTo(Integer)) - Impl ==> InnerPrimeField(p) add - if not prime?(p)$IntegerPrimesPackage(Integer) then - error "Argument to prime field must be a prime" - -@ -\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/pfr.spad.pamphlet b/src/algebra/pfr.spad.pamphlet index ce53bf8..9598392 100644 --- a/src/algebra/pfr.spad.pamphlet +++ b/src/algebra/pfr.spad.pamphlet @@ -9,608 +9,6 @@ \eject \tableofcontents \eject -\section{domain PFR PartialFraction} -<>= --- pfr.spad.pamphlet PartialFraction.input -)spool PartialFraction.output -)set message test on -)set message auto off -)clear all ---S 1 of 10 -partialFraction(1,factorial 10) ---R ---R ---R 159 23 12 1 ---R (1) --- - -- - -- + - ---R 8 4 2 7 ---R 2 3 5 ---R Type: PartialFraction Integer ---E 1 - ---S 2 of 10 -f := padicFraction(%) ---R ---R ---R 1 1 1 1 1 1 2 1 2 2 2 1 ---R (2) - + -- + -- + -- + -- + -- - -- - -- - -- - - - -- + - ---R 2 4 5 6 7 8 2 3 4 5 2 7 ---R 2 2 2 2 2 3 3 3 5 ---R Type: PartialFraction Integer ---E 2 - ---S 3 of 10 -compactFraction(f) ---R ---R ---R 159 23 12 1 ---R (3) --- - -- - -- + - ---R 8 4 2 7 ---R 2 3 5 ---R Type: PartialFraction Integer ---E 3 - ---S 4 of 10 -numberOfFractionalTerms(f) ---R ---R ---R (4) 12 ---R Type: PositiveInteger ---E 4 - ---S 5 of 10 -nthFractionalTerm(f,3) ---R ---R ---R 1 ---R (5) -- ---R 5 ---R 2 ---R Type: PartialFraction Integer ---E 5 - ---S 6 of 10 -partialFraction(1,- 13 + 14 * %i) ---R ---R ---R 1 4 ---R (6) - ------- + ------- ---R 1 + 2%i 3 + 8%i ---R Type: PartialFraction Complex Integer ---E 6 - ---S 7 of 10 -% :: Fraction Complex Integer ---R ---R ---R %i ---R (7) - --------- ---R 14 + 13%i ---R Type: Fraction Complex Integer ---E 7 - ---S 8 of 10 -u : FR UP(x, FRAC INT) := reduce(*,[primeFactor(x+i,i) for i in 1..4]) ---R ---R ---R 2 3 4 ---R (8) (x + 1)(x + 2) (x + 3) (x + 4) ---R Type: Factored UnivariatePolynomial(x,Fraction Integer) ---E 8 - ---S 9 of 10 -partialFraction(1,u) ---R ---R ---R (9) ---R 1 1 7 17 2 139 607 3 10115 2 391 44179 ---R --- - x + -- - -- x - 12x - --- --- x + ----- x + --- x + ----- ---R 648 4 16 8 8 324 432 4 324 ---R ----- + -------- + ------------------- + --------------------------------- ---R x + 1 2 3 4 ---R (x + 2) (x + 3) (x + 4) ---R Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) ---E 9 - ---S 10 of 10 -padicFraction % ---R ---R ---R (10) ---R 1 1 1 17 3 1 607 403 ---R --- - -- -- - - --- --- ---R 648 4 16 8 4 2 324 432 ---R ----- + ----- - -------- - ----- + -------- - -------- + ----- + -------- ---R x + 1 x + 2 2 x + 3 2 3 x + 4 2 ---R (x + 2) (x + 3) (x + 3) (x + 4) ---R + ---R 13 1 ---R -- -- ---R 36 12 ---R -------- + -------- ---R 3 4 ---R (x + 4) (x + 4) ---R Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) ---E 10 -)spool -)lisp (bye) -@ -<>= -==================================================================== -PartialFraction examples -==================================================================== - -A partial fraction is a decomposition of a quotient into a sum of -quotients where the denominators of the summands are powers of -primes. Most people first encounter partial fractions when they are -learning integral calculus. For a technical discussion of partial -fractions, see, for example, Lang's Algebra. For example, the rational -number 1/6 is decomposed into 1/2-1/3. You can compute partial -fractions of quotients of objects from domains belonging to the -category EuclideanDomain. For example, Integer, Complex Integer, and -UnivariatePolynomial(x, Fraction Integer) all belong to EuclideanDomain. -In the examples following, we demonstrate how to decompose quotients of -each of these kinds of object into partial fractions. - -It is necessary that we know how to factor the denominator when we -want to compute a partial fraction. Although the interpreter can -often do this automatically, it may be necessary for you to include a -call to factor. In these examples, it is not necessary to factor the -denominators explicitly. - -The main operation for computing partial fractions is called partialFraction -and we use this to compute a decomposition of 1/10!. The first argument to -partialFraction is the numerator of the quotient and the second argument is -the factored denominator. - - partialFraction(1,factorial 10) - 159 23 12 1 - --- - -- - -- + - - 8 4 2 7 - 2 3 5 - Type: PartialFraction Integer - -Since the denominators are powers of primes, it may be possible to -expand the numerators further with respect to those primes. Use the -operation padicFraction to do this. - - f := padicFraction(%) - 1 1 1 1 1 1 2 1 2 2 2 1 - - + -- + -- + -- + -- + -- - -- - -- - -- - - - -- + - - 2 4 5 6 7 8 2 3 4 5 2 7 - 2 2 2 2 2 3 3 3 5 - Type: PartialFraction Integer - -The operation compactFraction returns an expanded fraction into the usual -form. The compacted version is used internally for computational efficiency. - - compactFraction(f) - 159 23 12 1 - --- - -- - -- + - - 8 4 2 7 - 2 3 5 - Type: PartialFraction Integer - -You can add, subtract, multiply and divide partial fractions. In addition, -you can extract the parts of the decomposition. numberOfFractionalTerms -computes the number of terms in the fractional part. This does not include -the whole part of the fraction, which you get by calling wholePart. In -this example, the whole part is just 0. - - numberOfFractionalTerms(f) - 12 - Type: PositiveInteger - -The operation nthFractionalTerm returns the individual terms in the -decomposition. Notice that the object returned is a partial fraction -itself. firstNumer and firstDenom extract the numerator and denominator -of the first term of the fraction. - - nthFractionalTerm(f,3) - 1 - -- - 5 - 2 - Type: PartialFraction Integer - -Given two gaussian integers, you can decompose their quotient into a -partial fraction. - - partialFraction(1,- 13 + 14 * %i) - 1 4 - - ------- + ------- - 1 + 2%i 3 + 8%i - Type: PartialFraction Complex Integer - -To convert back to a quotient, simply use a conversion. - - % :: Fraction Complex Integer - %i - - --------- - 14 + 13%i - Type: Fraction Complex Integer - -To conclude this section, we compute the decomposition of - - 1 - ------------------------------- - 2 3 4 - (x + 1)(x + 2) (x + 3) (x + 4) - - -The polynomials in this object have type -UnivariatePolynomial(x, Fraction Integer). - -We use the primeFactor operation to create the denominator in factored -form directly. - - u : FR UP(x, FRAC INT) := reduce(*,[primeFactor(x+i,i) for i in 1..4]) - 2 3 4 - (x + 1)(x + 2) (x + 3) (x + 4) - Type: Factored UnivariatePolynomial(x,Fraction Integer) - -These are the compact and expanded partial fractions for the quotient. - - partialFraction(1,u) - 1 1 7 17 2 139 607 3 10115 2 391 44179 - --- - x + -- - -- x - 12x - --- --- x + ----- x + --- x + ----- - 648 4 16 8 8 324 432 4 324 - ----- + -------- + ------------------- + --------------------------------- - x + 1 2 3 4 - (x + 2) (x + 3) (x + 4) - Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) - - padicFraction % - 1 1 1 17 3 1 607 403 - --- - -- -- - - --- --- - 648 4 16 8 4 2 324 432 - ----- + ----- - -------- - ----- + -------- - -------- + ----- + -------- - x + 1 x + 2 2 x + 3 2 3 x + 4 2 - (x + 2) (x + 3) (x + 3) (x + 4) - + - 13 1 - -- -- - 36 12 - -------- + -------- - 3 4 - (x + 4) (x + 4) - Type: PartialFraction UnivariatePolynomial(x,Fraction Integer) - -See Also: -o )help Factored -o )help Complex -o )help FullPartialFractionExpansionXmpPage -o )show PartialFraction -o $AXIOM/doc/src/algebra/pfr.spad.dvi - -@ -<>= -)abbrev domain PFR PartialFraction -++ Author: Robert S. Sutor -++ Date Created: 1986 -++ Change History: -++ 05/20/91 BMT Converted to the new library -++ Basic Operations: (Field), (Algebra), -++ coerce, compactFraction, firstDenom, firstNumer, -++ nthFractionalTerm, numberOfFractionalTerms, padicallyExpand, -++ padicFraction, partialFraction, wholePart -++ Related Constructors: -++ Also See: ContinuedFraction -++ AMS Classifications: -++ Keywords: partial fraction, factorization, euclidean domain -++ References: -++ Description: -++ The domain \spadtype{PartialFraction} implements partial fractions -++ over a euclidean domain \spad{R}. This requirement on the -++ argument domain allows us to normalize the fractions. Of -++ particular interest are the 2 forms for these fractions. The -++ ``compact'' form has only one fractional term per prime in the -++ denominator, while the ``p-adic'' form expands each numerator -++ p-adically via the prime p in the denominator. For computational -++ efficiency, the compact form is used, though the p-adic form may -++ be gotten by calling the function \spadfunFrom{padicFraction}{PartialFraction}. For a -++ general euclidean domain, it is not known how to factor the -++ denominator. Thus the function \spadfunFrom{partialFraction}{PartialFraction} takes as its -++ second argument an element of \spadtype{Factored(R)}. - -PartialFraction(R: EuclideanDomain): Cat == Capsule where - FRR ==> Factored R - SUPR ==> SparseUnivariatePolynomial R - - Cat == Join(Field, Algebra R) with - coerce: % -> Fraction R - ++ coerce(p) sums up the components of the partial fraction and - ++ returns a single fraction. - - coerce: Fraction FRR -> % - ++ coerce(f) takes a fraction with numerator and denominator in - ++ factored form and creates a partial fraction. It is - ++ necessary for the parts to be factored because it is not - ++ known in general how to factor elements of \spad{R} and - ++ this is needed to decompose into partial fractions. - - compactFraction: % -> % - ++ compactFraction(p) normalizes the partial fraction \spad{p} - ++ to the compact representation. In this form, the partial - ++ fraction has only one fractional term per prime in the - ++ denominator. - - firstDenom: % -> FRR - ++ firstDenom(p) extracts the denominator of the first fractional - ++ term. This returns 1 if there is no fractional part (use - ++ \spadfunFrom{wholePart}{PartialFraction} to get the whole part). - - firstNumer: % -> R - ++ firstNumer(p) extracts the numerator of the first fractional - ++ term. This returns 0 if there is no fractional part (use - ++ \spadfunFrom{wholePart}{PartialFraction} to get the whole part). - - nthFractionalTerm: (%,Integer) -> % - ++ nthFractionalTerm(p,n) extracts the nth fractional term from - ++ the partial fraction \spad{p}. This returns 0 if the index - ++ \spad{n} is out of range. - - numberOfFractionalTerms: % -> Integer - ++ numberOfFractionalTerms(p) computes the number of fractional - ++ terms in \spad{p}. This returns 0 if there is no fractional - ++ part. - - padicallyExpand: (R,R) -> SUPR - ++ padicallyExpand(p,x) is a utility function that expands - ++ the second argument \spad{x} ``p-adically'' in - ++ the first. - - padicFraction: % -> % - ++ padicFraction(q) expands the fraction p-adically in the primes - ++ \spad{p} in the denominator of \spad{q}. For example, - ++ \spad{padicFraction(3/(2**2)) = 1/2 + 1/(2**2)}. - ++ Use \spadfunFrom{compactFraction}{PartialFraction} to return to compact form. - - partialFraction: (R, FRR) -> % - ++ partialFraction(numer,denom) is the main function for - ++ constructing partial fractions. The second argument is the - ++ denominator and should be factored. - - wholePart: % -> R - ++ wholePart(p) extracts the whole part of the partial fraction - ++ \spad{p}. - - Capsule == add - - -- some constructor assignments and macros - - Ex ==> OutputForm - fTerm ==> Record(num: R, den: FRR) -- den should have - -- unit = 1 and only - -- 1 factor - LfTerm ==> List Record(num: R, den: FRR) - QR ==> Record(quotient: R, remainder: R) - - Rep := Record(whole:R, fract: LfTerm) - - -- private function signatures - - copypf: % -> % - LessThan: (fTerm, fTerm) -> Boolean - multiplyFracTerms: (fTerm, fTerm) -> % - normalizeFracTerm: fTerm -> % - partialFractionNormalized: (R, FRR) -> % - - -- declarations - - a,b: % - n: Integer - r: R - - -- private function definitions - - copypf(a: %): % == [a.whole,copy a.fract]$% - - LessThan(s: fTerm, t: fTerm) == - -- have to wait until FR has < operation - if (GGREATERP(s.den,t.den)$Lisp : Boolean) then false - else true - - multiplyFracTerms(s : fTerm, t : fTerm) == - nthFactor(s.den,1) = nthFactor(t.den,1) => - normalizeFracTerm([s.num * t.num, s.den * t.den]$fTerm) : Rep - i : Union(Record(coef1: R, coef2: R),"failed") - coefs : Record(coef1: R, coef2: R) - i := extendedEuclidean(expand t.den, expand s.den,s.num * t.num) - i case "failed" => error "PartialFraction: not in ideal" - coefs := (i :: Record(coef1: R, coef2: R)) - c : % := copypf 0$% - d : % - if coefs.coef2 ^= 0$R then - c := normalizeFracTerm ([coefs.coef2, t.den]$fTerm) - if coefs.coef1 ^= 0$R then - d := normalizeFracTerm ([coefs.coef1, s.den]$fTerm) - c.whole := c.whole + d.whole - not (null d.fract) => c.fract := append(d.fract,c.fract) - c - - normalizeFracTerm(s : fTerm) == - -- makes sure num is "less than" den, whole may be non-zero - qr : QR := divide(s.num, (expand s.den)) - qr.remainder = 0$R => [qr.quotient, nil()$LfTerm] - -- now verify num and den are coprime - f : R := nthFactor(s.den,1) - nexpon : Integer := nthExponent(s.den,1) - expon : Integer := 0 - q : QR := divide(qr.remainder, f) - while (q.remainder = 0$R) and (expon < nexpon) repeat - expon := expon + 1 - qr.remainder := q.quotient - q := divide(qr.remainder,f) - expon = 0 => [qr.quotient,[[qr.remainder, s.den]$fTerm]$LfTerm] - expon = nexpon => (qr.quotient + qr.remainder) :: % - [qr.quotient,[[qr.remainder, nilFactor(f,nexpon-expon)]$fTerm]$LfTerm] - - partialFractionNormalized(nm: R, dn : FRR) == - -- assume unit dn = 1 - nm = 0$R => 0$% - dn = 1$FRR => nm :: % - qr : QR := divide(nm, expand dn) - c : % := [0$R,[[qr.remainder, - nilFactor(nthFactor(dn,1), nthExponent(dn,1))]$fTerm]$LfTerm] - d : % - for i in 2..numberOfFactors(dn) repeat - d := - [0$R,[[1$R,nilFactor(nthFactor(dn,i), nthExponent(dn,i))]$fTerm]$LfTerm] - c := c * d - (qr.quotient :: %) + c - - -- public function definitions - - padicFraction(a : %) == - b: % := compactFraction a - null b.fract => b - l : LfTerm := nil - s : fTerm - f : R - e,d: Integer - for s in b.fract repeat - e := nthExponent(s.den,1) - e = 1 => l := cons(s,l) - f := nthFactor(s.den,1) - d := degree(sp := padicallyExpand(f,s.num)) - while (sp ^= 0$SUPR) repeat - l := cons([leadingCoefficient sp,nilFactor(f,e-d)]$fTerm, l) - d := degree(sp := reductum sp) - [b.whole, sort(LessThan,l)]$% - - compactFraction(a : %) == - -- only one power for each distinct denom will remain - 2 > # a.fract => a - af : LfTerm := reverse a.fract - bf : LfTerm := nil - bw : R := a.whole - b : % - s : fTerm := [(first af).num,(first af).den]$fTerm - f : R := nthFactor(s.den,1) - e : Integer := nthExponent(s.den,1) - t : fTerm - for t in rest af repeat - f = nthFactor(t.den,1) => - s.num := s.num + (t.num * - (f **$R ((e - nthExponent(t.den,1)) : NonNegativeInteger))) - b := normalizeFracTerm s - bw := bw + b.whole - if not (null b.fract) then bf := cons(first b.fract,bf) - s := [t.num, t.den]$fTerm - f := nthFactor(s.den,1) - e := nthExponent(s.den,1) - b := normalizeFracTerm s - [bw + b.whole,append(b.fract,bf)]$% - - 0 == [0$R, nil()$LfTerm] - 1 == [1$R, nil()$LfTerm] - characteristic() == characteristic()$R - - coerce(r): % == [r, nil()$LfTerm] - coerce(n): % == [(n :: R), nil()$LfTerm] - coerce(a): Fraction R == - q : Fraction R := (a.whole :: Fraction R) - s : fTerm - for s in a.fract repeat - q := q + (s.num / (expand s.den)) - q - coerce(q: Fraction FRR): % == - u : R := (recip unit denom q):: R - r1 : R := u * expand numer q - partialFractionNormalized(r1, u * denom q) - - a exquo b == - b = 0$% => "failed" - b = 1$% => a - br : Fraction R := inv (b :: Fraction R) - a * partialFraction(numer br,(denom br) :: FRR) - recip a == (1$% exquo a) - - firstDenom a == -- denominator of 1st fractional term - null a.fract => 1$FRR - (first a.fract).den - firstNumer a == -- numerator of 1st fractional term - null a.fract => 0$R - (first a.fract).num - numberOfFractionalTerms a == # a.fract - nthFractionalTerm(a,n) == - l : LfTerm := a.fract - (n < 1) or (n > # l) => 0$% - [0$R,[l.n]$LfTerm]$% - wholePart a == a.whole - - partialFraction(nm: R, dn : FRR) == - nm = 0$R => 0$% - -- move inv unit of den to numerator - u : R := unit dn - u := (recip u) :: R - partialFractionNormalized(u * nm,u * dn) - - padicallyExpand(p : R, r : R) == - -- expands r as a sum of powers of p, with coefficients - -- r = HornerEval(padicallyExpand(p,r),p) - qr : QR := divide(r, p) - qr.quotient = 0$R => qr.remainder :: SUPR - (qr.remainder :: SUPR) + monomial(1$R,1$NonNegativeInteger)$SUPR * - padicallyExpand(p,qr.quotient) - - a = b == - a.whole ^= b.whole => false -- must verify this - (null a.fract) => - null b.fract => a.whole = b.whole - false - null b.fract => false - -- oh, no! following is temporary - (a :: Fraction R) = (b :: Fraction R) - - - a == - s: fTerm - l: LfTerm := nil - for s in reverse a.fract repeat l := cons([- s.num,s.den]$fTerm,l) - [- a.whole,l] - - r * a == - r = 0$R => 0$% - r = 1$R => a - b : % := (r * a.whole) :: % - c : % - s : fTerm - for s in reverse a.fract repeat - c := normalizeFracTerm [r * s.num, s.den]$fTerm - b.whole := b.whole + c.whole - not (null c.fract) => b.fract := append(c.fract, b.fract) - b - - n * a == (n :: R) * a - - a + b == - compactFraction - [a.whole + b.whole, - sort(LessThan,append(a.fract,copy b.fract))]$% - - a * b == - null a.fract => a.whole * b - null b.fract => b.whole * a - af : % := [0$R, a.fract]$% -- a - a.whole - c: % := (a.whole * b) + (b.whole * af) - s,t : fTerm - for s in a.fract repeat - for t in b.fract repeat - c := c + multiplyFracTerms(s,t) - c - - coerce(a): Ex == - null a.fract => a.whole :: Ex - s : fTerm - l : List Ex - if a.whole = 0 then l := nil else l := [a.whole :: Ex] - for s in a.fract repeat - s.den = 1$FRR => l := cons(s.num :: Ex, l) - l := cons(s.num :: Ex / s.den :: Ex, l) - # l = 1 => first l - reduce("+", reverse l) - -@ \section{package PFRPAC PartialFractionPackage} <>= )abbrev package PFRPAC PartialFractionPackage @@ -701,7 +99,6 @@ PartialFractionPackage(R): Cat == Capsule where <<*>>= <> -<> <> @ \eject diff --git a/src/algebra/plot.spad.pamphlet b/src/algebra/plot.spad.pamphlet index 4c9ed69..3250c1d 100644 --- a/src/algebra/plot.spad.pamphlet +++ b/src/algebra/plot.spad.pamphlet @@ -9,665 +9,6 @@ \eject \tableofcontents \eject -\section{domain PLOT Plot} -<>= --- plot.spad.pamphlet Plot.input -)spool Plot.output -)set message test on -)set message auto off -)clear all ---S 1 of 2 -fp:=(t:DFLOAT):DFLOAT +-> sin(t) ---R ---R (1) theMap(Closure) ---R Type: (DoubleFloat -> DoubleFloat) ---E 1 - ---S 2 of 2 -plot(fp,-1.0..1.0)$PLOT ---R ---R ---R (2) PLOT(x = (- 1.)..1. y = (- 0.8414709848078965)..0.8414709848078965) ---R [- 1.,- 0.8414709848078965] ---R [- 0.95833333333333337,- 0.81823456433427133] ---R [- 0.91666666666666674,- 0.79357780324894212] ---R [- 0.87500000000000011,- 0.76754350223602708] ---R [- 0.83333333333333348,- 0.74017685319603721] ---R [- 0.79166666666666685,- 0.7115253607990657] ---R [- 0.75000000000000022,- 0.68163876002333434] ---R [- 0.70833333333333359,- 0.65056892982223602] ---R [- 0.66666666666666696,- 0.61836980306973721] ---R [- 0.62500000000000033,- 0.58509727294046243] ---R [- 0.5833333333333337,- 0.55080909588697013] ---R [- 0.54166666666666707,- 0.51556479138264011] ---R [- 0.50000000000000044,- 0.47942553860420339] ---R [- 0.45833333333333376,- 0.44245407023325911] ---R [- 0.41666666666666707,- 0.40471456356112506] ---R [- 0.37500000000000039,- 0.3662725290860479] ---R [- 0.3333333333333337,- 0.3271946967961526] ---R [- 0.29166666666666702,- 0.28754890033552849] ---R [- 0.25000000000000033,- 0.24740395925452324] ---R [- 0.20833333333333368,- 0.20682955954864138] ---R [- 0.16666666666666702,- 0.16589613269341538] ---R [- 0.12500000000000036,- 0.12467473338522805] ---R [- 8.3333333333333703E-2,- 8.3236916200310623E-2] ---R [- 4.1666666666667039E-2,- 4.1654611386019461E-2] ---R [- 3.7470027081099033E-16,- 3.7470027081099033E-16] ---R [4.166666666666629E-2,4.1654611386018711E-2] ---R [8.3333333333332954E-2,8.3236916200309874E-2] ---R [0.12499999999999961,0.1246747333852273] ---R [0.16666666666666627,0.16589613269341463] ---R [0.20833333333333293,0.20682955954864066] ---R [0.24999999999999958,0.24740395925452252] ---R [0.29166666666666624,0.28754890033552777] ---R [0.33333333333333293,0.32719469679615187] ---R [0.37499999999999961,0.36627252908604718] ---R [0.4166666666666663,0.4047145635611244] ---R [0.45833333333333298,0.44245407023325839] ---R [0.49999999999999967,0.47942553860420273] ---R [0.5416666666666663,0.51556479138263944] ---R [0.58333333333333293,0.55080909588696947] ---R [0.62499999999999956,0.58509727294046177] ---R [0.66666666666666619,0.61836980306973666] ---R [0.70833333333333282,0.65056892982223535] ---R [0.74999999999999944,0.68163876002333379] ---R [0.79166666666666607,0.71152536079906514] ---R [0.8333333333333327,0.74017685319603665] ---R [0.87499999999999933,0.76754350223602663] ---R [0.91666666666666596,0.79357780324894167] ---R [0.95833333333333259,0.81823456433427078] ---R [1.,0.8414709848078965] ---R Type: Plot ---E 2 -)spool -)lisp (bye) -@ -<>= -========================================================================= -Plot examples -========================================================================= - -The Plot (PLOT) domain supports plotting of functions defined over a -real number system. Plot is limited to 2 dimensional plots. - -The function plot: (F -> F,R) -> % plots the function f(x) on the -interval a..b. So we need to define a function that maps from -DoubleFloat to DoubleFloat: - - fp:=(t:DFLOAT):DFLOAT +-> sin(t) - -and then feed it to the plot function with a Segment DoubleFloat - - plot(fp,-1.0..1.0)$PLOT - -See Also: -o )show Plot -o $AXIOM/doc/src/algebra/plot.spad.dvi - -@ -<>= -)abbrev domain PLOT Plot -++ Author: Michael Monagan (revised by Clifton J. Williamson) -++ Date Created: Jan 1988 -++ Date Last Updated: 30 Nov 1990 by Jonathan Steinbach -++ Basic Operations: plot, pointPlot, plotPolar, parametric?, zoom, refine, -++ tRange, minPoints, setMinPoints, maxPoints, screenResolution, adaptive?, -++ setAdaptive, numFunEvals, debug -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: plot, function, parametric -++ References: -++ Description: The Plot domain supports plotting of functions defined over a -++ real number system. A real number system is a model for the real -++ numbers and as such may be an approximation. For example -++ floating point numbers and infinite continued fractions. -++ The facilities at this point are limited to 2-dimensional plots -++ or either a single function or a parametric function. -Plot(): Exports == Implementation where - B ==> Boolean - F ==> DoubleFloat - I ==> Integer - L ==> List - N ==> NonNegativeInteger - OUT ==> OutputForm - P ==> Point F - RN ==> Fraction Integer - S ==> String - SEG ==> Segment - R ==> Segment F - C ==> Record(source: F -> P,ranges: L R,knots: L F,points: L P) - - Exports ==> PlottablePlaneCurveCategory with - ---% function plots - - plot: (F -> F,R) -> % - ++ plot(f,a..b) plots the function \spad{f(x)} - ++ on the interval \spad{[a,b]}. - ++ - ++X fp:=(t:DFLOAT):DFLOAT +-> sin(t) - ++X plot(fp,-1.0..1.0)$PLOT - - plot: (F -> F,R,R) -> % - ++ plot(f,a..b,c..d) plots the function \spad{f(x)} on the interval - ++ \spad{[a,b]}; y-range of \spad{[c,d]} is noted in Plot object. - ---% multiple function plots - - plot: (L(F -> F),R) -> % - ++ plot([f1,...,fm],a..b) plots the functions \spad{y = f1(x)},..., - ++ \spad{y = fm(x)} on the interval \spad{a..b}. - plot: (L(F -> F),R,R) -> % - ++ plot([f1,...,fm],a..b,c..d) plots the functions \spad{y = f1(x)},..., - ++ \spad{y = fm(x)} on the interval \spad{a..b}; y-range of \spad{[c,d]} is - ++ noted in Plot object. - ---% parametric plots - - plot: (F -> F,F -> F,R) -> % - ++ plot(f,g,a..b) plots the parametric curve \spad{x = f(t)}, \spad{y = g(t)} - ++ as t ranges over the interval \spad{[a,b]}. - plot: (F -> F,F -> F,R,R,R) -> % - ++ plot(f,g,a..b,c..d,e..f) plots the parametric curve \spad{x = f(t)}, - ++ \spad{y = g(t)} as t ranges over the interval \spad{[a,b]}; x-range - ++ of \spad{[c,d]} and y-range of \spad{[e,f]} are noted in Plot object. - ---% parametric plots - - pointPlot: (F -> P,R) -> % - ++ pointPlot(t +-> (f(t),g(t)),a..b) plots the parametric curve - ++ \spad{x = f(t)}, \spad{y = g(t)} as t ranges over the interval \spad{[a,b]}. - pointPlot: (F -> P,R,R,R) -> % - ++ pointPlot(t +-> (f(t),g(t)),a..b,c..d,e..f) plots the parametric - ++ curve \spad{x = f(t)}, \spad{y = g(t)} as t ranges over the interval \spad{[a,b]}; - ++ x-range of \spad{[c,d]} and y-range of \spad{[e,f]} are noted in Plot object. - ---% polar plots - - plotPolar: (F -> F,R) -> % - ++ plotPolar(f,a..b) plots the polar curve \spad{r = f(theta)} as - ++ theta ranges over the interval \spad{[a,b]}; this is the same as - ++ the parametric curve \spad{x = f(t) * cos(t)}, \spad{y = f(t) * sin(t)}. - - plotPolar: (F -> F) -> % - ++ plotPolar(f) plots the polar curve \spad{r = f(theta)} as theta - ++ ranges over the interval \spad{[0,2*%pi]}; this is the same as - ++ the parametric curve \spad{x = f(t) * cos(t)}, \spad{y = f(t) * sin(t)}. - - plot: (%,R) -> % -- change the range - ++ plot(x,r) \undocumented - parametric?: % -> B - ++ parametric? determines whether it is a parametric plot? - - zoom: (%,R) -> % - ++ zoom(x,r) \undocumented - zoom: (%,R,R) -> % - ++ zoom(x,r,s) \undocumented - refine: (%,R) -> % - ++ refine(x,r) \undocumented - refine: % -> % - ++ refine(p) performs a refinement on the plot p - - tRange: % -> R - ++ tRange(p) returns the range of the parameter in a parametric plot p - - minPoints: () -> I - ++ minPoints() returns the minimum number of points in a plot - setMinPoints: I -> I - ++ setMinPoints(i) sets the minimum number of points in a plot to i - maxPoints: () -> I - ++ maxPoints() returns the maximum number of points in a plot - setMaxPoints: I -> I - ++ setMaxPoints(i) sets the maximum number of points in a plot to i - screenResolution: () -> I - ++ screenResolution() returns the screen resolution - setScreenResolution: I -> I - ++ setScreenResolution(i) sets the screen resolution to i - adaptive?: () -> B - ++ adaptive?() determines whether plotting be done adaptively - setAdaptive: B -> B - ++ setAdaptive(true) turns adaptive plotting on - ++ \spad{setAdaptive(false)} turns adaptive plotting off - numFunEvals: () -> I - ++ numFunEvals() returns the number of points computed - debug: B -> B - ++ debug(true) turns debug mode on - ++ \spad{debug(false)} turns debug mode off - - Implementation ==> add - import PointPackage(DoubleFloat) - ---% local functions - - checkRange : R -> R - -- checks that left-hand endpoint is less than right-hand endpoint - intersect : (R,R) -> R - -- intersection of two intervals - union : (R,R) -> R - -- union of two intervals - join : (L C,I) -> R - parametricRange: % -> R - select : (L P,P -> F,(F,F) -> F) -> F - rangeRefine : (C,R) -> C - adaptivePlot : (C,R,R,R,I) -> C - basicPlot : (F -> P,R) -> C - basicRefine : (C,R) -> C - pt : (F,F) -> P - Fnan? : F -> Boolean - Pnan? : P -> Boolean - ---% representation - - Rep := Record( parametric: B, _ - display: L R, _ - bounds: L R, _ - axisLabels: L S, _ - functions: L C ) - ---% global constants - - ADAPTIVE: B := true - MINPOINTS: I := 49 - MAXPOINTS: I := 1000 - NUMFUNEVALS: I := 0 - SCREENRES: I := 500 - ANGLEBOUND: F := cos inv (4::F) - DEBUG: B := false - - Fnan?(x) == x ~= x - Pnan?(x) == any?(Fnan?,x) - ---% graphics output - - listBranches plot == - outList : L L P := nil() - for curve in plot.functions repeat - -- curve is C - newl:L P:=nil() - for p in curve.points repeat - if not Pnan? p then newl:=cons(p,newl) - else if not empty? newl then - outList := concat(newl:=reverse! newl,outList) - newl:=nil() - if not empty? newl then outList := concat(newl:=reverse! newl,outList) --- print(outList::OutputForm) - outList - - checkRange r == (lo r > hi r => error "ranges cannot be negative"; r) - intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t)) - union(s,t) == min(lo s,lo t) .. max(hi s,hi t) - join(l,i) == - rr := first l - u : R := - i = 0 => first(rr.ranges) - i = 1 => second(rr.ranges) - third(rr.ranges) - for r in rest l repeat - i = 0 => u := union(u,first(r.ranges)) - i = 1 => u := union(u,second(r.ranges)) - u := union(u,third(r.ranges)) - u - parametricRange r == first(r.bounds) - - minPoints() == MINPOINTS - setMinPoints n == - if n < 3 then error "three points minimum required" - if MAXPOINTS < n then MAXPOINTS := n - MINPOINTS := n - maxPoints() == MAXPOINTS - setMaxPoints n == - if n < 3 then error "three points minimum required" - if MINPOINTS > n then MINPOINTS := n - MAXPOINTS := n - screenResolution() == SCREENRES - setScreenResolution n == - if n < 2 then error "buy a new terminal" - SCREENRES := n - adaptive?() == ADAPTIVE - setAdaptive b == ADAPTIVE := b - parametric? p == p.parametric - - numFunEvals() == NUMFUNEVALS - debug b == DEBUG := b - - xRange plot == second plot.bounds - yRange plot == third plot.bounds - tRange plot == first plot.bounds - - select(l,f,g) == - m := f first l - if Fnan? m then m := 0 - for p in rest l repeat - n := m - m := g(m, f p) - if Fnan? m then m := n - m - - rangeRefine(curve,nRange) == - checkRange nRange; l := lo nRange; h := hi nRange - t := curve.knots; p := curve.points; f := curve.source - while not null t and first t < l repeat - (t := rest t; p := rest p) - c: L F := nil(); q: L P := nil() - while not null t and (first t) <= h repeat - c := concat(first t,c); q := concat(first p,q) - t := rest t; p := rest p - if null c then return basicPlot(f,nRange) - if first c < h then - c := concat(h,c) - q := concat(f h,q) - NUMFUNEVALS := NUMFUNEVALS + 1 - t := c := reverse_! c; p := q := reverse_! q - s := (h-l)/(minPoints()::F-1) - if (first t) ^= l then - t := c := concat(l,c) - p := q := concat(f l,p) - NUMFUNEVALS := NUMFUNEVALS + 1 - while not null rest t repeat - n := wholePart((second(t) - first(t))/s) - d := (second(t) - first(t))/((n+1)::F) - for i in 1..n repeat - t.rest := concat(first(t) + d,rest t) - p.rest := concat(f second t,rest p) - NUMFUNEVALS := NUMFUNEVALS + 1 - t := rest t; p := rest p - t := rest t - p := rest p - xRange := select(q,xCoord,min) .. select(q,xCoord,max) - yRange := select(q,yCoord,min) .. select(q,yCoord,max) - [ f, [nRange,xRange,yRange], c, q] - - adaptivePlot(curve,tRange,xRange,yRange,pixelfraction) == - xDiff := hi xRange - lo xRange - yDiff := hi yRange - lo yRange - xDiff = 0 or yDiff = 0 => curve - l := lo tRange; h := hi tRange - (tDiff := h-l) = 0 => curve --- if (EQL(yDiff, _$NaNvalue$Lisp)$Lisp) then yDiff := 1::F - t := curve.knots - #t < 3 => curve - p := curve.points; f := curve.source - minLength:F := 4::F/500::F - maxLength:F := 1::F/6::F - tLimit := tDiff/(pixelfraction*500)::F - while not null t and first t < l repeat (t := rest t; p := rest p) - #t < 3 => curve - headert := t; headerp := p - - -- jitter the input points --- while not null rest rest t repeat --- t0 := second(t); t1 := third(t) --- jitter := (random()$I) :: F --- jitter := sin (jitter) --- val := t0 + jitter * (t1-t0)/10::F --- t.2 := val; p.2 := f val --- t := rest t; p := rest p --- t := headert; p := headerp - - st := t; sp := p - todot : L L F := nil() - todop : L L P := nil() - while not null rest rest st repeat - todot := concat_!(todot, st) - todop := concat_!(todop, sp) - st := rest st; sp := rest sp - st := headert; sp := headerp - todo1 := todot; todo2 := todop - n : I := 0 - while not null todo1 repeat - st := first(todo1) - t0 := first(st); t1 := second(st); t2 := third(st) - if t2 > h then leave - t2 - t0 < tLimit => - todo1 := rest todo1 - todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - sp := first(todo2) - x0 := xCoord first(sp); y0 := yCoord first(sp) - x1 := xCoord second(sp); y1 := yCoord second(sp) - x2 := xCoord third(sp); y2 := yCoord third(sp) - a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff - a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff - s1 := sqrt(a1**2+b1**2); s2 := sqrt(a2**2+b2**2) - dp := a1*a2+b1*b2 - - s1 < maxLength and s2 < maxLength and _ - (s1 = 0::F or s2 = 0::F or - s1 < minLength and s2 < minLength or _ - dp/s1/s2 > ANGLEBOUND) => - todo1 := rest todo1 - todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - if n > MAXPOINTS then leave else n := n + 1 - st := rest t - if not null rest rest st then - tm := (t0+t1)/2::F - tj := tm - t.rest := concat(tj,rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := rest todo1; todo2 := rest todo2 - - tm := (t1+t2)/2::F - tj := tm - t.rest := concat(tj, rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - todo1 := rest todo1 - todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - else - tm := (t0+t1)/2::F - tj := tm - t.rest := concat(tj,rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - - tm := (t1+t2)/2::F - tj := tm - t.rest := concat(tj, rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - todo1 := rest todo1 - todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - n > 0 => - NUMFUNEVALS := NUMFUNEVALS + n - t := curve.knots; p := curve.points - xRange := select(p,xCoord,min) .. select(p,xCoord,max) - yRange := select(p,yCoord,min) .. select(p,yCoord,max) - [ curve.source, [tRange,xRange,yRange], t, p ] - curve - - basicPlot(f,tRange) == - checkRange tRange - l := lo tRange - h := hi tRange - t : L F := list l - p : L P := list f l - s := (h-l)/(minPoints()-1)::F - for i in 2..minPoints()-1 repeat - l := l+s - t := concat(l,t) - p := concat(f l,p) - t := reverse_! concat(h,t) - p := reverse_! concat(f h,p) --- print(p::OutputForm) - xRange : R := select(p,xCoord,min) .. select(p,xCoord,max) - yRange : R := select(p,yCoord,min) .. select(p,yCoord,max) - [ f, [tRange,xRange,yRange], t, p ] - - zoom(p,xRange) == - [p.parametric, [xRange,third(p.display)], p.bounds, _ - p.axisLabels, p.functions] - zoom(p,xRange,yRange) == - [p.parametric, [xRange,yRange], p.bounds, _ - p.axisLabels, p.functions] - - basicRefine(curve,nRange) == - tRange:R := first curve.ranges - -- curve := copy$C curve -- Yet another compiler bug - curve: C := [curve.source,curve.ranges,curve.knots,curve.points] - t := curve.knots := copy curve.knots - p := curve.points := copy curve.points - l := lo nRange; h := hi nRange - f := curve.source - while not null rest t and first t < h repeat - second(t) < l => (t := rest t; p := rest p) - -- insert new point between t.0 and t.1 - tm : F := (first(t) + second(t))/2::F --- if DEBUG then output$O (tm::E) - pm := f tm - NUMFUNEVALS := NUMFUNEVALS + 1 - t.rest := concat(tm,rest t); t := rest rest t - p.rest := concat(pm,rest p); p := rest rest p - t := curve.knots; p := curve.points - xRange := select(p,xCoord,min) .. select(p,xCoord,max) - yRange := select(p,yCoord,min) .. select(p,yCoord,max) - [ curve.source, [tRange,xRange,yRange], t, p ] - - refine p == refine(p,parametricRange p) - refine(p,nRange) == - NUMFUNEVALS := 0 - tRange := parametricRange p - nRange := intersect(tRange,nRange) - curves: L C := [basicRefine(c,nRange) for c in p.functions] - xRange := join(curves,1); yRange := join(curves,2) - if adaptive? then - tlimit := if parametric? p then 8 else 1 - curves := [adaptivePlot(c,nRange,xRange,yRange, _ - tlimit) for c in curves] - xRange := join(curves,1); yRange := join(curves,2) --- print(NUMFUNEVALS::OUT) - [p.parametric, p.display, [tRange,xRange,yRange], _ - p.axisLabels, curves ] - - plot(p:%,tRange:R) == - -- re plot p on a new range making use of the points already - -- computed if possible - NUMFUNEVALS := 0 - curves: L C := [rangeRefine(c,tRange) for c in p.functions] - xRange := join(curves,1); yRange := join(curves,2) - if adaptive? then - tlimit := if parametric? p then 8 else 1 - curves := [adaptivePlot(c,tRange,xRange,yRange,tlimit) for c in curves] - xRange := join(curves,1); yRange := join(curves,2) --- print(NUMFUNEVALS::OUT) - [ p.parametric, [xRange,yRange], [tRange,xRange,yRange], - p.axisLabels, curves ] - - pt(xx,yy) == point(l : L F := [xx,yy]) - - myTrap: (F-> F, F) -> F - myTrap(ff:F-> F, f:F):F == - s := trapNumericErrors(ff(f))$Lisp :: Union(F, "failed") - s case "failed" => _$NaNvalue$Lisp - r:F:=s::F - r > max()$F or r < min()$F => _$NaNvalue$Lisp - r - - plot(f:F -> F,xRange:R) == - p := basicPlot(pt(#1,myTrap(f,#1)),xRange) - r := p.ranges - NUMFUNEVALS := minPoints() - if adaptive? then - p := adaptivePlot(p,first r,second r,third r,1) - r := p.ranges - [ false, rest r, r, nil(), [ p ] ] - - plot(f:F -> F,xRange:R,yRange:R) == - p := plot(f,xRange) - p.display := [xRange,checkRange yRange] - p - - plot(f:F -> F,g:F -> F,tRange:R) == - p := basicPlot(pt(myTrap(f,#1),myTrap(g,#1)),tRange) - r := p.ranges - NUMFUNEVALS := minPoints() - if adaptive? then - p := adaptivePlot(p,first r,second r,third r,8) - r := p.ranges - [ true, rest r, r, nil(), [ p ] ] - - plot(f:F -> F,g:F -> F,tRange:R,xRange:R,yRange:R) == - p := plot(f,g,tRange) - p.display := [checkRange xRange,checkRange yRange] - p - - pointPlot(f:F -> P,tRange:R) == - p := basicPlot(f,tRange) - r := p.ranges - NUMFUNEVALS := minPoints() - if adaptive? then - p := adaptivePlot(p,first r,second r,third r,8) - r := p.ranges - [ true, rest r, r, nil(), [ p ] ] - - pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R) == - p := pointPlot(f,tRange) - p.display := [checkRange xRange,checkRange yRange] - p - - plot(l:L(F -> F),xRange:R) == - if null l then error "empty list of functions" - t: L C := [ basicPlot(pt(#1,myTrap(f,#1)),xRange) for f in l ] - yRange := join(t,2) - NUMFUNEVALS := # l * minPoints() - if adaptive? then - t := [adaptivePlot(p,xRange,xRange,yRange,1) _ - for f in l for p in t] - yRange := join(t,2) --- print(NUMFUNEVALS::OUT) - [false, [xRange,yRange], [xRange,xRange,yRange], nil(), t ] - - plot(l:L(F -> F),xRange:R,yRange:R) == - p := plot(l,xRange) - p.display := [xRange,checkRange yRange] - p - - plotPolar(f,thetaRange) == - plot(f(#1) * cos(#1),f(#1) * sin(#1),thetaRange) - - plotPolar f == plotPolar(f,segment(0,2*pi())) - ---% terminal output - - coerce r == - spaces: OUT := coerce " " - xSymbol := "x = " :: OUT - ySymbol := "y = " :: OUT - tSymbol := "t = " :: OUT - plotSymbol := "PLOT" :: OUT - tRange := (parametricRange r) :: OUT - f : L OUT := nil() - for curve in r.functions repeat - xRange := second(curve.ranges) :: OUT - yRange := third(curve.ranges) :: OUT - l : L OUT := [xSymbol,xRange,spaces,ySymbol,yRange] - if parametric? r then - l := concat_!([tSymbol,tRange,spaces],l) - h : OUT := hconcat l - l := [p::OUT for p in curve.points] - f := concat(vconcat concat(h,l),f) - prefix("PLOT" :: OUT, reverse_! f) - -@ \section{package PLOT1 PlotFunctions1} <>= )abbrev package PLOT1 PlotFunctions1 @@ -741,7 +82,6 @@ PlotFunctions1(S:ConvertibleTo InputForm): with <<*>>= <> -<> <> @ \eject diff --git a/src/algebra/plot3d.spad.pamphlet b/src/algebra/plot3d.spad.pamphlet deleted file mode 100644 index 804a120..0000000 --- a/src/algebra/plot3d.spad.pamphlet +++ /dev/null @@ -1,541 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra plot3d.spad} -\author{Clifton J. Williamson, Michael Monagan, Jon Steinbach} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain PLOT3D Plot3D} -<>= -)abbrev domain PLOT3D Plot3D -++ Author: Clifton J. Williamson based on code by Michael Monagan -++ Date Created: Jan 1989 -++ Date Last Updated: 22 November 1990 (Jon Steinbach) -++ Basic Operations: pointPlot, plot, zoom, refine, tRange, tValues, -++ minPoints3D, setMinPoints3D, maxPoints3D, setMaxPoints3D, -++ screenResolution3D, setScreenResolution3D, adaptive3D?, setAdaptive3D, -++ numFunEvals3D, debug3D -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: plot, parametric -++ References: -++ Description: Plot3D supports parametric plots defined over a real -++ number system. A real number system is a model for the real -++ numbers and as such may be an approximation. For example, -++ floating point numbers and infinite continued fractions are -++ real number systems. The facilities at this point are limited -++ to 3-dimensional parametric plots. -Plot3D(): Exports == Implementation where - B ==> Boolean - F ==> DoubleFloat - I ==> Integer - L ==> List - N ==> NonNegativeInteger - OUT ==> OutputForm - P ==> Point F - S ==> String - R ==> Segment F - O ==> OutputPackage - C ==> Record(source: F -> P,ranges: L R, knots: L F, points: L P) - - Exports ==> PlottableSpaceCurveCategory with - - pointPlot: (F -> P,R) -> % - ++ pointPlot(f,g,h,a..b) plots {/emx = f(t), y = g(t), z = h(t)} as - ++ t ranges over {/em[a,b]}. - pointPlot: (F -> P,R,R,R,R) -> % - ++ pointPlot(f,x,y,z,w) \undocumented - plot: (F -> F,F -> F,F -> F,F -> F,R) -> % - ++ plot(f,g,h,a..b) plots {/emx = f(t), y = g(t), z = h(t)} as - ++ t ranges over {/em[a,b]}. - plot: (F -> F,F -> F,F -> F,F -> F,R,R,R,R) -> % - ++ plot(f1,f2,f3,f4,x,y,z,w) \undocumented - - plot: (%,R) -> % -- change the range - ++ plot(x,r) \undocumented - zoom: (%,R,R,R) -> % - ++ zoom(x,r,s,t) \undocumented - refine: (%,R) -> % - ++ refine(x,r) \undocumented - refine: % -> % - ++ refine(x) \undocumented - - tRange: % -> R - ++ tRange(p) returns the range of the parameter in a parametric plot p. - tValues: % -> L L F - ++ tValues(p) returns a list of lists of the values of the parameter for - ++ which a point is computed, one list for each curve in the plot p. - - minPoints3D: () -> I - ++ minPoints3D() returns the minimum number of points in a plot. - setMinPoints3D: I -> I - ++ setMinPoints3D(i) sets the minimum number of points in a plot to i. - maxPoints3D: () -> I - ++ maxPoints3D() returns the maximum number of points in a plot. - setMaxPoints3D: I -> I - ++ setMaxPoints3D(i) sets the maximum number of points in a plot to i. - screenResolution3D: () -> I - ++ screenResolution3D() returns the screen resolution for a 3d graph. - setScreenResolution3D: I -> I - ++ setScreenResolution3D(i) sets the screen resolution for a 3d graph to i. - adaptive3D?: () -> B - ++ adaptive3D?() determines whether plotting be done adaptively. - setAdaptive3D: B -> B - ++ setAdaptive3D(true) turns adaptive plotting on; - ++ setAdaptive3D(false) turns adaptive plotting off. - numFunEvals3D: () -> I - ++ numFunEvals3D() returns the number of points computed. - debug3D: B -> B - ++ debug3D(true) turns debug mode on; - ++ debug3D(false) turns debug mode off. - - Implementation ==> add - import PointPackage(F) - ---% local functions - - fourth : L R -> R - checkRange : R -> R - -- checks that left-hand endpoint is less than right-hand endpoint - intersect : (R,R) -> R - -- intersection of two intervals - union : (R,R) -> R - -- union of two intervals - join : (L C,I) -> R - parametricRange: % -> R --- setColor : (P,F) -> F - select : (L P,P -> F,(F,F) -> F) -> F --- normalizeColor : (P,F,F) -> F - rangeRefine : (C,R) -> C - adaptivePlot : (C,R,R,R,R,I,I) -> C - basicPlot : (F -> P,R) -> C - basicRefine : (C,R) -> C - point : (F,F,F,F) -> P - ---% representation - - Rep := Record( display: L R, _ - bounds: L R, _ - screenres: I, _ - axisLabels: L S, _ - functions: L C ) - ---% global constants - - ADAPTIVE : B := true - MINPOINTS : I := 49 - MAXPOINTS : I := 1000 - NUMFUNEVALS : I := 0 - SCREENRES : I := 500 - ANGLEBOUND : F := cos inv (4::F) - DEBUG : B := false - - point(xx,yy,zz,col) == point(l : L F := [xx,yy,zz,col]) - - fourth list == first rest rest rest list - - checkRange r == (lo r > hi r => error "ranges cannot be negative"; r) - intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t)) - union(s:R,t:R) == min(lo s,lo t) .. max(hi s,hi t) - join(l,i) == - rr := first l - u : R := - i = 0 => first(rr.ranges) - i = 1 => second(rr.ranges) - i = 2 => third(rr.ranges) - fourth(rr.ranges) - for r in rest l repeat - i = 0 => union(u,first(r.ranges)) - i = 1 => union(u,second(r.ranges)) - i = 2 => union(u,third(r.ranges)) - union(u,fourth(r.ranges)) - u - parametricRange r == first(r.bounds) - - minPoints3D() == MINPOINTS - setMinPoints3D n == - if n < 3 then error "three points minimum required" - if MAXPOINTS < n then MAXPOINTS := n - MINPOINTS := n - maxPoints3D() == MAXPOINTS - setMaxPoints3D n == - if n < 3 then error "three points minimum required" - if MINPOINTS > n then MINPOINTS := n - MAXPOINTS := n - screenResolution3D() == SCREENRES - setScreenResolution3D n == - if n < 2 then error "buy a new terminal" - SCREENRES := n - adaptive3D?() == ADAPTIVE - setAdaptive3D b == ADAPTIVE := b - - numFunEvals3D() == NUMFUNEVALS - debug3D b == DEBUG := b - --- setColor(p,c) == p.colNum := c - - xRange plot == second plot.bounds - yRange plot == third plot.bounds - zRange plot == fourth plot.bounds - tRange plot == first plot.bounds - - tValues plot == - outList : L L F := nil() - for curve in plot.functions repeat - outList := concat(curve.knots,outList) - outList - - select(l,f,g) == - m := f first l - if (EQL(m, _$NaNvalue$Lisp)$Lisp) then m := 0 --- for p in rest l repeat m := g(m,fp) - for p in rest l repeat - fp : F := f p - if (EQL(fp, _$NaNvalue$Lisp)$Lisp) then fp := 0 - m := g(m,fp) - m - --- normalizeColor(p,lo,diff) == --- p.colNum := (p.colNum - lo)/diff - - rangeRefine(curve,nRange) == - checkRange nRange; l := lo nRange; h := hi nRange - t := curve.knots; p := curve.points; f := curve.source - while not null t and first t < l repeat - (t := rest t; p := rest p) - c : L F := nil(); q : L P := nil() - while not null t and first t <= h repeat - c := concat(first t,c); q := concat(first p,q) - t := rest t; p := rest p - if null c then return basicPlot(f,nRange) - if first c < h then - c := concat(h,c); q := concat(f h,q) - NUMFUNEVALS := NUMFUNEVALS + 1 - t := c := reverse_! c; p := q := reverse_! q - s := (h-l)/(MINPOINTS::F-1) - if (first t) ^= l then - t := c := concat(l,c); p := q := concat(f l,p) - NUMFUNEVALS := NUMFUNEVALS + 1 - while not null rest t repeat - n := wholePart((second(t) - first(t))/s) - d := (second(t) - first(t))/((n+1)::F) - for i in 1..n repeat - t.rest := concat(first(t) + d,rest t); t1 := second t - p.rest := concat(f t1,rest p) - NUMFUNEVALS := NUMFUNEVALS + 1 - t := rest t; p := rest p - t := rest t - p := rest p - xRange := select(q,xCoord,min) .. select(q,xCoord,max) - yRange := select(q,yCoord,min) .. select(q,yCoord,max) - zRange := select(q,zCoord,min) .. select(q,zCoord,max) --- colorLo := select(q,color,min); colorHi := select(q,color,max) --- (diff := colorHi - colorLo) = 0 => --- error "all points are the same color" --- map(normalizeColor(#1,colorLo,diff),q)$ListPackage1(P) - [f,[nRange,xRange,yRange,zRange],c,q] - - - adaptivePlot(curve,tRg,xRg,yRg,zRg,pixelfraction,resolution) == - xDiff := hi xRg - lo xRg - yDiff := hi yRg - lo yRg - zDiff := hi zRg - lo zRg --- xDiff = 0 or yDiff = 0 or zDiff = 0 => curve--!! delete this? - if xDiff = 0::F then xDiff := 1::F - if yDiff = 0::F then yDiff := 1::F - if zDiff = 0::F then zDiff := 1::F - l := lo tRg; h := hi tRg - (tDiff := h-l) = 0 => curve - t := curve.knots - #t < 3 => curve - p := curve.points; f := curve.source - minLength:F := 4::F/resolution::F - maxLength := 1/4::F - tLimit := tDiff/(pixelfraction*resolution)::F - while not null t and first t < l repeat (t := rest t; p := rest p) - #t < 3 => curve - headert := t; headerp := p - st := t; sp := p - todot : L L F := nil() - todop : L L P := nil() - while not null rest rest st repeat - todot := concat_!(todot, st) - todop := concat_!(todop, sp) - st := rest st; sp := rest sp - st := headert; sp := headerp - todo1 := todot; todo2 := todop - n : I := 0 - - while not null todo1 repeat - st := first(todo1) - t0 := first(st); t1 := second(st); t2 := third(st) - if t2 > h then leave - t2 - t0 < tLimit => - todo1 := rest todo1 - todo2 := rest todo2; - if not null todo1 then (t := first(todo1); p := first(todo2)) - sp := first(todo2) - x0 := xCoord first(sp); y0 := yCoord first(sp); z0 := zCoord first(sp) - x1 := xCoord second(sp); y1 := yCoord second(sp); z1 := zCoord second(sp) - x2 := xCoord third(sp); y2 := yCoord third(sp); z2 := zCoord third(sp) - a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff; c1 := (z1-z0)/zDiff - a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff; c2 := (z2-z1)/zDiff - s1 := sqrt(a1**2+b1**2+c1**2); s2 := sqrt(a2**2+b2**2+c2**2) - dp := a1*a2+b1*b2+c1*c2 - s1 < maxLength and s2 < maxLength and _ - (s1 = 0 or s2 = 0 or - s1 < minLength and s2 < minLength or _ - dp/s1/s2 > ANGLEBOUND) => - todo1 := rest todo1 - todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - if n = MAXPOINTS then leave else n := n + 1 - --if DEBUG then - --r : L F := [minLength,maxLength,s1,s2,dp/s1/s2,ANGLEBOUND] - --output(r::E)$O - st := rest t - if not null rest rest st then - tm := (t0+t1)/2::F - tj := tm - t.rest := concat(tj,rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := rest todo1; todo2 := rest todo2 - - tm := (t1+t2)/2::F - tj := tm - t.rest := concat(tj, rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - todo1 := rest todo1; todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - else - tm := (t0+t1)/2::F - tj := tm - t.rest := concat(tj,rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - t := rest t; p := rest p - - tm := (t1+t2)/2::F - tj := tm - t.rest := concat(tj, rest t) - p.rest := concat(f tj, rest p) - todo1 := concat_!(todo1, t) - todo2 := concat_!(todo2, p) - todo1 := rest todo1; todo2 := rest todo2 - if not null todo1 then (t := first(todo1); p := first(todo2)) - if n > 0 then - NUMFUNEVALS := NUMFUNEVALS + n - t := curve.knots; p := curve.points - xRg := select(p,xCoord,min) .. select(p,xCoord,max) - yRg := select(p,yCoord,min) .. select(p,yCoord,max) - zRg := select(p,zCoord,min) .. select(p,zCoord,max) - [curve.source,[tRg,xRg,yRg,zRg],t,p] - else curve - - basicPlot(f,tRange) == - checkRange tRange; l := lo tRange; h := hi tRange - t : L F := list l; p : L P := list f l - s := (h-l)/(MINPOINTS-1)::F - for i in 2..MINPOINTS-1 repeat - l := l+s; t := concat(l,t) - p := concat(f l,p) - t := reverse_! concat(h,t) - p := reverse_! concat(f h,p) - xRange : R := select(p,xCoord,min) .. select(p,xCoord,max) - yRange : R := select(p,yCoord,min) .. select(p,yCoord,max) - zRange : R := select(p,zCoord,min) .. select(p,zCoord,max) - [f,[tRange,xRange,yRange,zRange],t,p] - - zoom(p,xRange,yRange,zRange) == - [[xRange,yRange,zRange],p.bounds, - p.screenres,p.axisLabels,p.functions] - - basicRefine(curve,nRange) == - tRange:R := first curve.ranges - -- curve := copy$C curve -- Yet another @#$%^&* compiler bug - curve: C := [curve.source,curve.ranges,curve.knots,curve.points] - t := curve.knots := copy curve.knots - p := curve.points := copy curve.points - l := lo nRange; h := hi nRange - f := curve.source - while not null rest t and first(t) < h repeat - second(t) < l => (t := rest t; p := rest p) - -- insert new point between t.0 and t.1 - tm:F := (first(t) + second(t))/2::F - -- if DEBUG then output$O (tm::E) - pm := f tm - NUMFUNEVALS := NUMFUNEVALS + 1 - t.rest := concat(tm,rest t); t := rest rest t - p.rest := concat(pm,rest p); p := rest rest p - t := curve.knots; p := curve.points - xRange := select(p,xCoord,min) .. select(p,xCoord,max) - yRange := select(p,yCoord,min) .. select(p,yCoord,max) - zRange := select(p,zCoord,min) .. select(p,zCoord,max) - [curve.source,[tRange,xRange,yRange,zRange],t,p] - - refine p == refine(p,parametricRange p) - refine(p,nRange) == - NUMFUNEVALS := 0 - tRange := parametricRange p - nRange := intersect(tRange,nRange) - curves: L C := [basicRefine(c,nRange) for c in p.functions] - xRange := join(curves,1); yRange := join(curves,2) - zRange := join(curves,3) - scrres := p.screenres - if adaptive3D? then - tlimit := 8 - curves := [adaptivePlot(c,nRange,xRange,yRange,zRange, _ - tlimit,scrres := 2*scrres) for c in curves] - xRange := join(curves,1); yRange := join(curves,2) - zRange := join(curves,3) - [p.display,[tRange,xRange,yRange,zRange], _ - scrres,p.axisLabels,curves] - - plot(p:%,tRange:R) == - -- re plot p on a new range making use of the points already - -- computed if possible - NUMFUNEVALS := 0 - curves: L C := [rangeRefine(c,tRange) for c in p.functions] - xRange := join(curves,1); yRange := join(curves,2) - zRange := join(curves,3) - if adaptive3D? then - tlimit := 8 - curves := [adaptivePlot(c,tRange,xRange,yRange,zRange,tlimit, _ - p.screenres) for c in curves] - xRange := join(curves,1); yRange := join(curves,2) - zRange := join(curves,3) --- print(NUMFUNEVALS::OUT) - [[xRange,yRange,zRange],[tRange,xRange,yRange,zRange], - p.screenres,p.axisLabels,curves] - - pointPlot(f:F -> P,tRange:R) == - p := basicPlot(f,tRange) - r := p.ranges - NUMFUNEVALS := MINPOINTS - if adaptive3D? then - p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES) --- print(NUMFUNEVALS::OUT) --- print(p::OUT) - [ rest r, r, SCREENRES, nil(), [ p ] ] - - pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R,zRange:R) == - p := pointPlot(f,tRange) - p.display:= [checkRange xRange,checkRange yRange,checkRange zRange] - p - - myTrap: (F-> F, F) -> F - myTrap(ff:F-> F, f:F):F == - s := trapNumericErrors(ff(f))$Lisp :: Union(F, "failed") - if (s) case "failed" then - r:F := _$NaNvalue$Lisp - else - r:F := s - r - - plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,tRange:R) == - p := basicPlot(point(myTrap(f1,#1),myTrap(f2,#1),myTrap(f3,#1),col(#1)),tRange) - r := p.ranges - NUMFUNEVALS := MINPOINTS - if adaptive3D? then - p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES) --- print(NUMFUNEVALS::OUT) - [ rest r, r, SCREENRES, nil(), [ p ] ] - - plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,_ - tRange:R,xRange:R,yRange:R,zRange:R) == - p := plot(f1,f2,f3,col,tRange) - p.display:= [checkRange xRange,checkRange yRange,checkRange zRange] - p - ---% terminal output - - coerce r == - spaces := " " :: OUT - xSymbol := "x = " :: OUT; ySymbol := "y = " :: OUT - zSymbol := "z = " :: OUT; tSymbol := "t = " :: OUT - tRange := (parametricRange r) :: OUT - f : L OUT := nil() - for curve in r.functions repeat - xRange := coerce curve.ranges.1 - yRange := coerce curve.ranges.2 - zRange := coerce curve.ranges.3 - l : L OUT := [xSymbol,xRange,spaces,ySymbol,yRange,_ - spaces,zSymbol,zRange] - l := concat_!([tSymbol,tRange,spaces],l) - h : OUT := hconcat l - l := [p::OUT for p in curve.points] - f := concat(vconcat concat(h,l),f) - prefix("PLOT" :: OUT,reverse_! f) - -----% graphics output - - listBranches plot == - outList : L L P := nil() - for curve in plot.functions repeat - outList := concat(curve.points,outList) - outList - -@ -\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/polset.spad.pamphlet b/src/algebra/polset.spad.pamphlet deleted file mode 100644 index d6aac5b..0000000 --- a/src/algebra/polset.spad.pamphlet +++ /dev/null @@ -1,135 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra polset.spad} -\author{Marc Moreno Maza} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain GPOLSET GeneralPolynomialSet} -<>= -)abbrev domain GPOLSET GeneralPolynomialSet -++ Author: Marc Moreno Maza -++ Date Created: 04/26/1994 -++ Date Last Updated: 12/15/1998 -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: polynomial, multivariate, ordered variables set -++ References: -++ Description: A domain for polynomial sets. -++ Version: 1 - -GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where - - R:Ring - VarSet:OrderedSet - E:OrderedAbelianMonoidSup - P:RecursivePolynomialCategory(R,E,VarSet) - LP ==> List P - PtoP ==> P -> P - - Exports == PolynomialSetCategory(R,E,VarSet,P) with - - convert : LP -> $ - ++ \axiom{convert(lp)} returns the polynomial set whose members - ++ are the polynomials of \axiom{lp}. - - finiteAggregate - shallowlyMutable - - Implementation == add - - Rep := List P - - construct lp == - (removeDuplicates(lp)$List(P))::$ - - copy ps == - construct(copy(members(ps)$$)$LP)$$ - - empty() == - [] - - parts ps == - ps pretend LP - - map (f : PtoP, ps : $) : $ == - construct(map(f,members(ps))$LP)$$ - - map! (f : PtoP, ps : $) : $ == - construct(map!(f,members(ps))$LP)$$ - - member? (p,ps) == - member?(p,members(ps))$LP - - ps1 = ps2 == - {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)} - - coerce(ps:$) : OutputForm == - lp : List(P) := sort(infRittWu?,members(ps))$(List P) - brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm - - mvar ps == - empty? ps => error"Error from GPOLSET in mvar : #1 is empty" - lv : List VarSet := variables(ps) - empty? lv => error"Error from GPOLSET in mvar : every polynomial in #1 is constant" - reduce(max,lv)$(List VarSet) - - retractIfCan(lp) == - (construct(lp))::Union($,"failed") - - coerce(ps:$) : (List P) == - ps pretend (List P) - - convert(lp:LP) : $ == - construct lp - -@ -\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/poly.spad.pamphlet b/src/algebra/poly.spad.pamphlet index 9f28927..1510a53 100644 --- a/src/algebra/poly.spad.pamphlet +++ b/src/algebra/poly.spad.pamphlet @@ -9,733 +9,6 @@ \eject \tableofcontents \eject -\section{domain FM FreeModule} -<>= -)abbrev domain FM FreeModule -++ Author: Dave Barton, James Davenport, Barry Trager -++ Date Created: -++ Date Last Updated: -++ Basic Functions: BiModule(R,R) -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A bi-module is a free module -++ over a ring with generators indexed by an ordered set. -++ Each element can be expressed as a finite linear combination of -++ generators. Only non-zero terms are stored. - -FreeModule(R:Ring,S:OrderedSet): - Join(BiModule(R,R),IndexedDirectProductCategory(R,S)) with - if R has CommutativeRing then Module(R) - == IndexedDirectProductAbelianGroup(R,S) add - --representations - Term:= Record(k:S,c:R) - Rep:= List Term - --declarations - x,y: % - r: R - n: Integer - f: R -> R - s: S - --define - if R has EntireRing then - r * x == - zero? r => 0 --- one? r => x - (r = 1) => x - --map(r*#1,x) - [[u.k,r*u.c] for u in x ] - else - r * x == - zero? r => 0 --- one? r => x - (r = 1) => x - --map(r*#1,x) - [[u.k,a] for u in x | (a:=r*u.c) ^= 0$R] - if R has EntireRing then - x * r == - zero? r => 0 --- one? r => x - (r = 1) => x - --map(r*#1,x) - [[u.k,u.c*r] for u in x ] - else - x * r == - zero? r => 0 --- one? r => x - (r = 1) => x - --map(r*#1,x) - [[u.k,a] for u in x | (a:=u.c*r) ^= 0$R] - - coerce(x) : OutputForm == - null x => (0$R) :: OutputForm - le : List OutputForm := nil - for rec in reverse x repeat - rec.c = 1 => le := cons(rec.k :: OutputForm, le) - le := cons(rec.c :: OutputForm * rec.k :: OutputForm, le) - reduce("+",le) - -@ -\section{domain PR PolynomialRing} -<>= -)abbrev domain PR PolynomialRing -++ Author: Dave Barton, James Davenport, Barry Trager -++ Date Created: -++ Date Last Updated: 14.08.2000. Improved exponentiation [MMM/TTT] -++ Basic Functions: Ring, degree, coefficient, monomial, reductum -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain represents generalized polynomials with coefficients -++ (from a not necessarily commutative ring), and terms -++ indexed by their exponents (from an arbitrary ordered abelian monoid). -++ This type is used, for example, -++ by the \spadtype{DistributedMultivariatePolynomial} domain where -++ the exponent domain is a direct product of non negative integers. - -PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C - where - T == FiniteAbelianMonoidRing(R,E) with - --assertions - if R has IntegralDomain and E has CancellationAbelianMonoid then - fmecg: (%,E,R,%) -> % - ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 - if R has canonicalUnitNormal then canonicalUnitNormal - ++ canonicalUnitNormal guarantees that the function - ++ unitCanonical returns the same representative for all - ++ associates of any particular element. - - C == FreeModule(R,E) add - --representations - Term:= Record(k:E,c:R) - Rep:= List Term - - - --declarations - x,y,p,p1,p2: % - n: Integer - nn: NonNegativeInteger - np: PositiveInteger - e: E - r: R - --local operations - 1 == [[0$E,1$R]] - characteristic == characteristic$R - numberOfMonomials x == (# x)$Rep - degree p == if null p then 0 else p.first.k - minimumDegree p == if null p then 0 else (last p).k - leadingCoefficient p == if null p then 0$R else p.first.c - leadingMonomial p == if null p then 0 else [p.first] - reductum p == if null p then p else p.rest - retractIfCan(p:%):Union(R,"failed") == - null p => 0$R - not null p.rest => "failed" - zero?(p.first.k) => p.first.c - "failed" - coefficient(p,e) == - for tm in p repeat - tm.k=e => return tm.c - tm.k < e => return 0$R - 0$R - recip(p) == - null p => "failed" - p.first.k > 0$E => "failed" - (u:=recip(p.first.c)) case "failed" => "failed" - (u::R)::% - - coerce(r) == if zero? r then 0$% else [[0$E,r]] - coerce(n) == (n::R)::% - - ground?(p): Boolean == empty? p or (empty? rest p and zero? degree p) - - qsetrest!: (Rep, Rep) -> Rep - qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp - - times!: (R, %) -> % - times: (R, E, %) -> % - - entireRing? := R has EntireRing - - times!(r: R, x: %): % == - res, endcell, newend, xx: Rep - if entireRing? then - for tx in x repeat tx.c := r*tx.c - else - xx := x - res := empty() - while not empty? xx repeat - tx := first xx - tx.c := r * tx.c - if zero? tx.c then - xx := rest xx - else - newend := xx - xx := rest xx - if empty? res then - res := newend - endcell := res - else - qsetrest!(endcell, newend) - endcell := newend - res; - - --- term * polynomial - termTimes: (R, E, Term) -> Term - termTimes(r: R, e: E, tx:Term): Term == [e+tx.k, r*tx.c] - times(tco: R, tex: E, rx: %): % == - if entireRing? then - map(termTimes(tco, tex, #1), rx::Rep) - else - [[tex + tx.k, r] for tx in rx::Rep | not zero? (r := tco * tx.c)] - - - - -- local addm! - addm!: (Rep, R, E, Rep) -> Rep - -- p1 + coef*x^E * p2 - -- `spare' (commented out) is for storage efficiency (not so good for - -- performance though. - addm!(p1:Rep, coef:R, exp: E, p2:Rep): Rep == - --local res, newend, last: Rep - res, newcell, endcell: Rep - spare: List Rep - res := empty() - endcell := empty() - --spare := empty() - while not empty? p1 and not empty? p2 repeat - tx := first p1 - ty := first p2 - exy := exp + ty.k - newcell := empty(); - if tx.k = exy then - newcoef := tx.c + coef * ty.c - if not zero? newcoef then - tx.c := newcoef - newcell := p1 - --else - -- spare := cons(p1, spare) - p1 := rest p1 - p2 := rest p2 - else if tx.k > exy then - newcell := p1 - p1 := rest p1 - else - newcoef := coef * ty.c - if not entireRing? and zero? newcoef then - newcell := empty() - --else if empty? spare then - -- ttt := [exy, newcoef] - -- newcell := cons(ttt, empty()) - --else - -- newcell := first spare - -- spare := rest spare - -- ttt := first newcell - -- ttt.k := exy - -- ttt.c := newcoef - else - ttt := [exy, newcoef] - newcell := cons(ttt, empty()) - p2 := rest p2 - if not empty? newcell then - if empty? res then - res := newcell - endcell := res - else - qsetrest!(endcell, newcell) - endcell := newcell - if not empty? p1 then -- then end is const * p1 - newcell := p1 - else -- then end is (coef, exp) * p2 - newcell := times(coef, exp, p2) - empty? res => newcell - qsetrest!(endcell, newcell) - res - pomopo! (p1, r, e, p2) == addm!(p1, r, e, p2) - p1 * p2 == - xx := p1::Rep - empty? xx => p1 - yy := p2::Rep - empty? yy => p2 - zero? first(xx).k => first(xx).c * p2 - zero? first(yy).k => p1 * first(yy).c - --if #xx > #yy then - -- (xx, yy) := (yy, xx) - -- (p1, p2) := (p2, p1) - xx := reverse xx - res : Rep := empty() - for tx in xx repeat res:=addm!(res,tx.c,tx.k,yy) - res - --- if R has EntireRing then --- p1 * p2 == --- null p1 => 0 --- null p2 => 0 --- zero?(p1.first.k) => p1.first.c * p2 --- one? p2 => p1 --- +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2] --- for t1 in reverse(p1)] --- -- This 'reverse' is an efficiency improvement: --- -- reduces both time and space [Abbott/Bradford/Davenport] --- else --- p1 * p2 == --- null p1 => 0 --- null p2 => 0 --- zero?(p1.first.k) => p1.first.c * p2 --- one? p2 => p1 --- +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0] --- for t1 in reverse(p1)] --- -- This 'reverse' is an efficiency improvement: --- -- reduces both time and space [Abbott/Bradford/Davenport] - if R has CommutativeRing then - p ** np == p ** (np pretend NonNegativeInteger) - p ^ np == p ** (np pretend NonNegativeInteger) - p ^ nn == p ** nn - - - p ** nn == - null p => 0 - zero? nn => 1 --- one? nn => p - (nn = 1) => p - empty? p.rest => - zero?(cc:=p.first.c ** nn) => 0 - [[nn * p.first.k, cc]] - binomThmExpt([p.first], p.rest, nn) - - if R has Field then - unitNormal(p) == - null p or (lcf:R:=p.first.c) = 1 => [1,p,1] - a := inv lcf - [lcf::%, [[p.first.k,1],:(a * p.rest)], a::%] - unitCanonical(p) == - null p or (lcf:R:=p.first.c) = 1 => p - a := inv lcf - [[p.first.k,1],:(a * p.rest)] - else if R has IntegralDomain then - unitNormal(p) == - null p or p.first.c = 1 => [1,p,1] - (u,cf,a):=unitNormal(p.first.c) - [u::%, [[p.first.k,cf],:(a * p.rest)], a::%] - unitCanonical(p) == - null p or p.first.c = 1 => p - (u,cf,a):=unitNormal(p.first.c) - [[p.first.k,cf],:(a * p.rest)] - if R has IntegralDomain then - associates?(p1,p2) == - null p1 => null p2 - null p2 => false - p1.first.k = p2.first.k and - associates?(p1.first.c,p2.first.c) and - ((p2.first.c exquo p1.first.c)::R * p1.rest = p2.rest) - p exquo r == - [(if (a:= tm.c exquo r) case "failed" - then return "failed" else [tm.k,a]) - for tm in p] :: Union(%,"failed") - if E has CancellationAbelianMonoid then - fmecg(p1:%,e:E,r:R,p2:%):% == -- p1 - r * X**e * p2 - rout:%:= [] - r:= - r - for tm in p2 repeat - e2:= e + tm.k - c2:= r * tm.c - c2 = 0 => "next term" - while not null p1 and p1.first.k > e2 repeat - (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? - null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] - if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] - p1:=p1.rest - NRECONC(rout,p1)$Lisp - if R has approximate then - p1 exquo p2 == - null p2 => error "Division by 0" - p2 = 1 => p1 - p1=p2 => 1 - --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" - rout:= []@List(Term) - while not null p1 repeat - (a:= p1.first.c exquo p2.first.c) - a case "failed" => return "failed" - ee:= subtractIfCan(p1.first.k, p2.first.k) - ee case "failed" => return "failed" - p1:= fmecg(p1.rest, ee, a, p2.rest) - rout:= [[ee,a], :rout] - null p1 => reverse(rout)::% -- nreverse? - "failed" - else -- R not approximate - p1 exquo p2 == - null p2 => error "Division by 0" - p2 = 1 => p1 - --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" - rout:= []@List(Term) - while not null p1 repeat - (a:= p1.first.c exquo p2.first.c) - a case "failed" => return "failed" - ee:= subtractIfCan(p1.first.k, p2.first.k) - ee case "failed" => return "failed" - p1:= fmecg(p1.rest, ee, a, p2.rest) - rout:= [[ee,a], :rout] - null p1 => reverse(rout)::% -- nreverse? - "failed" - if R has Field then - x/r == inv(r)*x - -@ -\section{domain SUP SparseUnivariatePolynomial} -<>= -)abbrev domain SUP SparseUnivariatePolynomial -++ Author: Dave Barton, Barry Trager -++ Date Created: -++ Date Last Updated: -++ Basic Functions: Ring, monomial, coefficient, reductum, differentiate, -++ elt, map, resultant, discriminant -++ Related Constructors: UnivariatePolynomial, Polynomial -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain represents univariate polynomials over arbitrary -++ (not necessarily commutative) coefficient rings. The variable is -++ unspecified so that the variable displays as \spad{?} on output. -++ If it is necessary to specify the variable name, use type \spadtype{UnivariatePolynomial}. -++ The representation is sparse -++ in the sense that only non-zero terms are represented. -++ Note: if the coefficient ring is a field, this domain forms a euclidean domain. - -SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with - outputForm : (%,OutputForm) -> OutputForm - ++ outputForm(p,var) converts the SparseUnivariatePolynomial p to - ++ an output form (see \spadtype{OutputForm}) printed as a polynomial in the - ++ output form variable. - fmecg: (%,NonNegativeInteger,R,%) -> % - ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 - == PolynomialRing(R,NonNegativeInteger) - add - --representations - Term := Record(k:NonNegativeInteger,c:R) - Rep := List Term - p:% - n:NonNegativeInteger - np: PositiveInteger - FP ==> SparseUnivariatePolynomial % - pp,qq: FP - lpp:List FP - - -- for karatsuba - kBound: NonNegativeInteger := 63 - upmp := UnivariatePolynomialMultiplicationPackage(R,%) - - - if R has FieldOfPrimeCharacteristic then - p ** np == p ** (np pretend NonNegativeInteger) - p ^ np == p ** (np pretend NonNegativeInteger) - p ^ n == p ** n - p ** n == - null p => 0 - zero? n => 1 --- one? n => p - (n = 1) => p - empty? p.rest => - zero?(cc:=p.first.c ** n) => 0 - [[n * p.first.k, cc]] - -- not worth doing special trick if characteristic is too small - if characteristic()$R < 3 then return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%) - y:%:=1 - -- break up exponent in qn * characteristic + rn - -- exponentiating by the characteristic is fast - rec := divide(n, characteristic()$R) - qn:= rec.quotient - rn:= rec.remainder - repeat - if rn = 1 then y := y * p - if rn > 1 then y:= y * binomThmExpt([p.first], p.rest, rn) - zero? qn => return y - -- raise to the characteristic power - p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term for t in p] - rec := divide(qn, characteristic()$R) - qn:= rec.quotient - rn:= rec.remainder - y - - - - zero?(p): Boolean == empty?(p) --- one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) - one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) - ground?(p): Boolean == empty? p or (empty? rest p and zero? first(p).k) - multiplyExponents(p,n) == [ [u.k*n,u.c] for u in p] - divideExponents(p,n) == - null p => p - m:= (p.first.k :: Integer exquo n::Integer) - m case "failed" => "failed" - u:= divideExponents(p.rest,n) - u case "failed" => "failed" - [[m::Integer::NonNegativeInteger,p.first.c],:u] - karatsubaDivide(p, n) == - zero? n => [p, 0] - lowp: Rep := p - highp: Rep := [] - repeat - if empty? lowp then break - t := first lowp - if t.k < n then break - lowp := rest lowp - highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp) - [ reverse highp, lowp] - shiftRight(p, n) == - [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p] - shiftLeft(p, n) == - [[t.k + n,t.c]$Term for t in p] - pomopo!(p1,r,e,p2) == - rout:%:= [] - for tm in p2 repeat - e2:= e + tm.k - c2:= r * tm.c - c2 = 0 => "next term" - while not null p1 and p1.first.k > e2 repeat - (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? - null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] - if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] - p1:=p1.rest - NRECONC(rout,p1)$Lisp - --- implementation using karatsuba algorithm conditionally --- --- p1 * p2 == --- xx := p1::Rep --- empty? xx => p1 --- yy := p2::Rep --- empty? yy => p2 --- zero? first(xx).k => first(xx).c * p2 --- zero? first(yy).k => p1 * first(yy).c --- (first(xx).k > kBound) and (first(yy).k > kBound) and (#xx > kBound) and (#yy > kBound) => --- karatsubaOnce(p1,p2)$upmp --- xx := reverse xx --- res : Rep := empty() --- for tx in xx repeat res:= rep pomopo!( res,tx.c,tx.k,p2) --- res - - - univariate(p:%) == p pretend SparseUnivariatePolynomial(R) - multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) == - sup pretend % - univariate(p:%,v:SingletonAsOrderedSet) == - zero? p => 0 - monomial(leadingCoefficient(p)::%,degree p) + - univariate(reductum p,v) - multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) == - zero? supp => 0 - lc:=leadingCoefficient supp - degree lc > 0 => error "bad form polynomial" - monomial(leadingCoefficient lc,degree supp) + - multivariate(reductum supp,v) - if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then - RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R - squareFreePolynomial pp == - squareFree(pp)$UnivariatePolynomialSquareFree(%,FP) - factorPolynomial pp == - (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) - pretend Factored SparseUnivariatePolynomial % - factorSquareFreePolynomial pp == - (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) - pretend Factored SparseUnivariatePolynomial % - gcdPolynomial(pp,qq) == gcd(pp,qq)$FP - factor p == factor(p)$DistinctDegreeFactorize(R,%) - solveLinearPolynomialEquation(lpp,pp) == - solveLinearPolynomialEquation(lpp, pp)$FiniteFieldSolveLinearPolynomialEquation(R,%,FP) - else if R has PolynomialFactorizationExplicit then - import PolynomialFactorizationByRecursionUnivariate(R,%) - solveLinearPolynomialEquation(lpp,pp)== - solveLinearPolynomialEquationByRecursion(lpp,pp) - factorPolynomial(pp) == - factorByRecursion(pp) - factorSquareFreePolynomial(pp) == - factorSquareFreeByRecursion(pp) - - if R has IntegralDomain then - if R has approximate then - p1 exquo p2 == - null p2 => error "Division by 0" - p2 = 1 => p1 - p1=p2 => 1 - --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" - rout:= []@List(Term) - while not null p1 repeat - (a:= p1.first.c exquo p2.first.c) - a case "failed" => return "failed" - ee:= subtractIfCan(p1.first.k, p2.first.k) - ee case "failed" => return "failed" - p1:= fmecg(p1.rest, ee, a, p2.rest) - rout:= [[ee,a], :rout] - null p1 => reverse(rout)::% -- nreverse? - "failed" - else -- R not approximate - p1 exquo p2 == - null p2 => error "Division by 0" - p2 = 1 => p1 - --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" - rout:= []@List(Term) - while not null p1 repeat - (a:= p1.first.c exquo p2.first.c) - a case "failed" => return "failed" - ee:= subtractIfCan(p1.first.k, p2.first.k) - ee case "failed" => return "failed" - p1:= fmecg(p1.rest, ee, a, p2.rest) - rout:= [[ee,a], :rout] - null p1 => reverse(rout)::% -- nreverse? - "failed" - fmecg(p1,e,r,p2) == -- p1 - r * X**e * p2 - rout:%:= [] - r:= - r - for tm in p2 repeat - e2:= e + tm.k - c2:= r * tm.c - c2 = 0 => "next term" - while not null p1 and p1.first.k > e2 repeat - (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? - null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] - if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] - p1:=p1.rest - NRECONC(rout,p1)$Lisp - pseudoRemainder(p1,p2) == - null p2 => error "PseudoDivision by Zero" - null p1 => 0 - co:=p2.first.c; - e:=p2.first.k; - p2:=p2.rest; - e1:=max(p1.first.k:Integer-e+1,0):NonNegativeInteger - while not null p1 repeat - if (u:=subtractIfCan(p1.first.k,e)) case "failed" then leave - p1:=fmecg(co * p1.rest, u, p1.first.c, p2) - e1:= (e1 - 1):NonNegativeInteger - e1 = 0 => p1 - co ** e1 * p1 - toutput(t1:Term,v:OutputForm):OutputForm == - t1.k = 0 => t1.c :: OutputForm - if t1.k = 1 - then mon:= v - else mon := v ** t1.k::OutputForm - t1.c = 1 => mon - t1.c = -1 and - ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon - t1.c::OutputForm * mon - outputForm(p:%,v:OutputForm) == - l: List(OutputForm) - l:=[toutput(t,v) for t in p] - null l => (0$Integer)::OutputForm -- else FreeModule 0 problems - reduce("+",l) - - coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm) - elt(p:%,val:R) == - null p => 0$R - co:=p.first.c - n:=p.first.k - for tm in p.rest repeat - co:= co * val ** (n - (n:=tm.k)):NonNegativeInteger + tm.c - n = 0 => co - co * val ** n - elt(p:%,val:%) == - null p => 0$% - coef:% := p.first.c :: % - n:=p.first.k - for tm in p.rest repeat - coef:= coef * val ** (n-(n:=tm.k)):NonNegativeInteger+(tm.c::%) - n = 0 => coef - coef * val ** n - - monicDivide(p1:%,p2:%) == - null p2 => error "monicDivide: division by 0" - leadingCoefficient p2 ^= 1 => error "Divisor Not Monic" - p2 = 1 => [p1,0] - null p1 => [0,0] - degree p1 < (n:=degree p2) => [0,p1] - rout:Rep := [] - p2 := p2.rest - while not null p1 repeat - (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave - rout:=[[u, p1.first.c], :rout] - p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) - [reverse_!(rout),p1] - - if R has IntegralDomain then - discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%) --- discriminant(p) == --- null p or zero?(p.first.k) => error "cannot take discriminant of constants" --- dp:=differentiate p --- corr:= p.first.c ** ((degree p - 1 - degree dp)::NonNegativeInteger) --- (-1)**((p.first.k*(p.first.k-1)) quo 2):NonNegativeInteger --- * (corr * resultant(p,dp) exquo p.first.c)::R - - subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%) --- subResultantGcd(p1,p2) == --args # 0, non-coef, prim, ans not prim --- --see algorithm 1 (p. 4) of Brown's latest (unpublished) paper --- if p1.first.k < p2.first.k then (p1,p2):=(p2,p1) --- p:=pseudoRemainder(p1,p2) --- co:=1$R; --- e:= (p1.first.k - p2.first.k):NonNegativeInteger --- while not null p and p.first.k ^= 0 repeat --- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) --- null p or p.first.k = 0 => "enuf" --- co:=(p1.first.c ** e exquo co ** max(0, (e-1))::NonNegativeInteger)::R --- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e --- p:=[[tm.k,((tm.c exquo p1.first.c)::R exquo c1)::R] for tm in p] --- if null p then p2 else 1$% - - resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%) --- resultant(p1,p2) == --SubResultant PRS Algorithm --- null p1 or null p2 => 0$R --- 0 = degree(p1) => ((first p1).c)**degree(p2) --- 0 = degree(p2) => ((first p2).c)**degree(p1) --- if p1.first.k < p2.first.k then --- (if odd?(p1.first.k) then p1:=-p1; (p1,p2):=(p2,p1)) --- p:=pseudoRemainder(p1,p2) --- co:=1$R; e:=(p1.first.k-p2.first.k):NonNegativeInteger --- while not null p repeat --- if not odd?(e) then p:=-p --- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) --- co:=(p1.first.c ** e exquo co ** max(e:Integer-1,0):NonNegativeInteger)::R --- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e --- p:=(p exquo ((leadingCoefficient p1) * c1))::% --- degree p2 > 0 => 0$R --- (p2.first.c**e exquo co**((e-1)::NonNegativeInteger))::R - if R has GcdDomain then - content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p] - --make CONTENT more efficient? - - primitivePart(p) == - null p => p - ct :=content(p) - unitCanonical((p exquo ct)::%) - -- exquo present since % is now an IntegralDomain - - gcd(p1,p2) == - gcdPolynomial(p1 pretend SparseUnivariatePolynomial R, - p2 pretend SparseUnivariatePolynomial R) pretend % - - if R has Field then - divide( p1, p2) == - zero? p2 => error "Division by 0" --- one? p2 => [p1,0] - (p2 = 1) => [p1,0] - ct:=inv(p2.first.c) - n:=p2.first.k - p2:=p2.rest - rout:=empty()$List(Term) - while p1 ^= 0 repeat - (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave - rout:=[[u, ct * p1.first.c], :rout] - p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) - [reverse_!(rout),p1] - - p / co == inv(co) * p - -@ \section{package SUP2 SparseUnivariatePolynomialFunctions2} <>= )abbrev package SUP2 SparseUnivariatePolynomialFunctions2 @@ -765,665 +38,6 @@ SparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with SparseUnivariatePolynomial R, S, SparseUnivariatePolynomial S) @ -\section{domain UP UnivariatePolynomial} -<>= --- poly.spad.pamphlet UnivariatePolynomial.input -)spool UnivariatePolynomial.output -)set message test on -)set message auto off -)clear all ---S 1 of 35 -(p,q) : UP(x,INT) ---R ---R Type: Void ---E 1 - ---S 2 of 35 -p := (3*x-1)**2 * (2*x + 8) ---R ---R ---R 3 2 ---R (2) 18x + 60x - 46x + 8 ---R Type: UnivariatePolynomial(x,Integer) ---E 2 - ---S 3 of 35 -q := (1 - 6*x + 9*x**2)**2 ---R ---R ---R 4 3 2 ---R (3) 81x - 108x + 54x - 12x + 1 ---R Type: UnivariatePolynomial(x,Integer) ---E 3 - ---S 4 of 35 -p**2 + p*q ---R ---R ---R 7 6 5 4 3 2 ---R (4) 1458x + 3240x - 7074x + 10584x - 9282x + 4120x - 878x + 72 ---R Type: UnivariatePolynomial(x,Integer) ---E 4 - ---S 5 of 35 -leadingCoefficient p ---R ---R ---R (5) 18 ---R Type: PositiveInteger ---E 5 - ---S 6 of 35 -degree p ---R ---R ---R (6) 3 ---R Type: PositiveInteger ---E 6 - ---S 7 of 35 -reductum p ---R ---R ---R 2 ---R (7) 60x - 46x + 8 ---R Type: UnivariatePolynomial(x,Integer) ---E 7 - ---S 8 of 35 -gcd(p,q) ---R ---R ---R 2 ---R (8) 9x - 6x + 1 ---R Type: UnivariatePolynomial(x,Integer) ---E 8 - ---S 9 of 35 -lcm(p,q) ---R ---R ---R 5 4 3 2 ---R (9) 162x + 432x - 756x + 408x - 94x + 8 ---R Type: UnivariatePolynomial(x,Integer) ---E 9 - ---S 10 of 35 -resultant(p,q) ---R ---R ---R (10) 0 ---R Type: NonNegativeInteger ---E 10 - ---S 11 of 35 -D p ---R ---R ---R 2 ---R (11) 54x + 120x - 46 ---R Type: UnivariatePolynomial(x,Integer) ---E 11 - ---S 12 of 35 -p(2) ---R ---R ---R (12) 300 ---R Type: PositiveInteger ---E 12 - ---S 13 of 35 -p(q) ---R ---R ---R (13) ---R 12 11 10 9 8 ---R 9565938x - 38263752x + 70150212x - 77944680x + 58852170x ---R + ---R 7 6 5 4 3 2 ---R - 32227632x + 13349448x - 4280688x + 1058184x - 192672x + 23328x ---R + ---R - 1536x + 40 ---R Type: UnivariatePolynomial(x,Integer) ---E 13 - ---S 14 of 35 -q(p) ---R ---R ---R (14) ---R 12 11 10 9 8 ---R 8503056x + 113374080x + 479950272x + 404997408x - 1369516896x ---R + ---R 7 6 5 4 3 ---R - 626146848x + 2939858712x - 2780728704x + 1364312160x - 396838872x ---R + ---R 2 ---R 69205896x - 6716184x + 279841 ---R Type: UnivariatePolynomial(x,Integer) ---E 14 - ---S 15 of 35 -l := coefficients p ---R ---R ---R (15) [18,60,- 46,8] ---R Type: List Integer ---E 15 - ---S 16 of 35 -reduce(gcd,l) ---R ---R ---R (16) 2 ---R Type: PositiveInteger ---E 16 - ---S 17 of 35 -content p ---R ---R ---R (17) 2 ---R Type: PositiveInteger ---E 17 - ---S 18 of 35 -ux := (x**4+2*x+3)::UP(x,INT) ---R ---R ---R 4 ---R (18) x + 2x + 3 ---R Type: UnivariatePolynomial(x,Integer) ---E 18 - ---S 19 of 35 -vectorise(ux,5) ---R ---R ---R (19) [3,2,0,0,1] ---R Type: Vector Integer ---E 19 - ---S 20 of 35 -squareTerms(p) == reduce(+,[t**2 for t in monomials p]) ---R ---R Type: Void ---E 20 - ---S 21 of 35 -p ---R ---R ---R 3 2 ---R (21) 18x + 60x - 46x + 8 ---R Type: UnivariatePolynomial(x,Integer) ---E 21 - ---S 22 of 35 -squareTerms p ---R ---R Compiling function squareTerms with type UnivariatePolynomial(x, ---R Integer) -> UnivariatePolynomial(x,Integer) ---R ---R 6 4 2 ---R (22) 324x + 3600x + 2116x + 64 ---R Type: UnivariatePolynomial(x,Integer) ---E 22 - ---S 23 of 35 -(r,s) : UP(a1,FRAC INT) ---R ---R Type: Void ---E 23 - ---S 24 of 35 -r := a1**2 - 2/3 ---R ---R ---R 2 2 ---R (24) a1 - - ---R 3 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 24 - ---S 25 of 35 -s := a1 + 4 ---R ---R ---R (25) a1 + 4 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 25 - ---S 26 of 35 -r quo s ---R ---R ---R (26) a1 - 4 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 26 - ---S 27 of 35 -r rem s ---R ---R ---R 46 ---R (27) -- ---R 3 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 27 - ---S 28 of 35 -d := divide(r, s) ---R ---R ---R 46 ---R (28) [quotient= a1 - 4,remainder= --] ---R 3 ---RType: Record(quotient: UnivariatePolynomial(a1,Fraction Integer),remainder: UnivariatePolynomial(a1,Fraction Integer)) ---E 28 - ---S 29 of 35 -r - (d.quotient * s + d.remainder) ---R ---R ---R (29) 0 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 29 - ---S 30 of 35 -integrate r ---R ---R ---R 1 3 2 ---R (30) - a1 - - a1 ---R 3 3 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 30 - ---S 31 of 35 -integrate s ---R ---R ---R 1 2 ---R (31) - a1 + 4a1 ---R 2 ---R Type: UnivariatePolynomial(a1,Fraction Integer) ---E 31 - ---S 32 of 35 -t : UP(a1,FRAC POLY INT) ---R ---R Type: Void ---E 32 - ---S 33 of 35 -t := a1**2 - a1/b2 + (b1**2-b1)/(b2+3) ---R ---R ---R 2 ---R 2 1 b1 - b1 ---R (33) a1 - -- a1 + -------- ---R b2 b2 + 3 ---R Type: UnivariatePolynomial(a1,Fraction Polynomial Integer) ---E 33 - ---S 34 of 35 -u : FRAC POLY INT := t ---R ---R ---R 2 2 2 2 ---R a1 b2 + (b1 - b1 + 3a1 - a1)b2 - 3a1 ---R (34) --------------------------------------- ---R 2 ---R b2 + 3b2 ---R Type: Fraction Polynomial Integer ---E 34 - ---S 35 of 35 -u :: UP(b1,?) ---R ---R ---R 2 ---R 1 2 1 a1 b2 - a1 ---R (35) ------ b1 - ------ b1 + ---------- ---R b2 + 3 b2 + 3 b2 ---R Type: UnivariatePolynomial(b1,Fraction Polynomial Integer) ---E 35 -)spool -)lisp (bye) -@ -<>= -==================================================================== -UnivariatePolynomial examples -==================================================================== - -The domain constructor UnivariatePolynomial (abbreviated UP) creates -domains of univariate polynomials in a specified variable. For -example, the domain UP(a1,POLY FRAC INT) provides polynomials in the -single variable a1 whose coefficients are general polynomials with -rational number coefficients. - -Restriction: Axiom does not allow you to create types where -UnivariatePolynomial is contained in the coefficient type of -Polynomial. Therefore, UP(x,POLY INT) is legal but POLY UP(x,INT) -is not. - -UP(x,INT) is the domain of polynomials in the single variable x with -integer coefficients. - - (p,q) : UP(x,INT) - Type: Void - - p := (3*x-1)**2 * (2*x + 8) - 3 2 - 18x + 60x - 46x + 8 - Type: UnivariatePolynomial(x,Integer) - - q := (1 - 6*x + 9*x**2)**2 - 4 3 2 - 81x - 108x + 54x - 12x + 1 - Type: UnivariatePolynomial(x,Integer) - -The usual arithmetic operations are available for univariate polynomials. - - p**2 + p*q - 7 6 5 4 3 2 - 1458x + 3240x - 7074x + 10584x - 9282x + 4120x - 878x + 72 - Type: UnivariatePolynomial(x,Integer) - -The operation leadingCoefficient extracts the coefficient of the term -of highest degree. - - leadingCoefficient p - 18 - Type: PositiveInteger - -The operation degree returns the degree of the polynomial. Since the -polynomial has only one variable, the variable is not supplied to -operations like degree. - - degree p - 3 - Type: PositiveInteger - -The reductum of the polynomial, the polynomial obtained by subtracting -the term of highest order, is returned by reductum. - - reductum p - 2 - 60x - 46x + 8 - Type: UnivariatePolynomial(x,Integer) - -The operation gcd computes the greatest common divisor of two polynomials. - - gcd(p,q) - 2 - 9x - 6x + 1 - Type: UnivariatePolynomial(x,Integer) - -The operation lcm computes the least common multiple. - - lcm(p,q) - 5 4 3 2 - 162x + 432x - 756x + 408x - 94x + 8 - Type: UnivariatePolynomial(x,Integer) - -The operation resultant computes the resultant of two univariate -polynomials. In the case of p and q, the resultant is 0 because they -share a common root. - - resultant(p,q) - 0 - Type: NonNegativeInteger - -To compute the derivative of a univariate polynomial with respect to its -variable, use the function D. - - D p - 2 - 54x + 120x - 46 - Type: UnivariatePolynomial(x,Integer) - -Univariate polynomials can also be used as if they were functions. To -evaluate a univariate polynomial at some point, apply the polynomial -to the point. - - p(2) - 300 - Type: PositiveInteger - -The same syntax is used for composing two univariate polynomials, i.e. -substituting one polynomial for the variable in another. This substitutes -q for the variable in p. - - p(q) - 12 11 10 9 8 - 9565938x - 38263752x + 70150212x - 77944680x + 58852170x - + - 7 6 5 4 3 2 - - 32227632x + 13349448x - 4280688x + 1058184x - 192672x + 23328x - + - - 1536x + 40 - Type: UnivariatePolynomial(x,Integer) - -This substitutes p for the variable in q. - - q(p) - 12 11 10 9 8 - 8503056x + 113374080x + 479950272x + 404997408x - 1369516896x - + - 7 6 5 4 3 - - 626146848x + 2939858712x - 2780728704x + 1364312160x - 396838872x - + - 2 - 69205896x - 6716184x + 279841 - Type: UnivariatePolynomial(x,Integer) - -To obtain a list of coefficients of the polynomial, use coefficients. - - l := coefficients p - [18,60,- 46,8] - Type: List Integer - -From this you can use gcd and reduce to compute the content of the polynomial. - - reduce(gcd,l) - 2 - Type: PositiveInteger - -Alternatively (and more easily), you can just call content. - - content p - 2 - Type: PositiveInteger - -Note that the operation coefficients omits the zero coefficients from -the list. Sometimes it is useful to convert a univariate polynomial -to a vector whose i-th position contains the degree i-1 coefficient of -the polynomial. - - ux := (x**4+2*x+3)::UP(x,INT) - 4 - x + 2x + 3 - Type: UnivariatePolynomial(x,Integer) - -To get a complete vector of coefficients, use the operation vectorise, -which takes a univariate polynomial and an integer denoting the length -of the desired vector. - - vectorise(ux,5) - [3,2,0,0,1] - Type: Vector Integer - -It is common to want to do something to every term of a polynomial, -creating a new polynomial in the process. - -This is a function for iterating across the terms of a polynomial, -squaring each term. - - squareTerms(p) == reduce(+,[t**2 for t in monomials p]) - Type: Void - -Recall what p looked like. - - p - 3 2 - 18x + 60x - 46x + 8 - Type: UnivariatePolynomial(x,Integer) - -We can demonstrate squareTerms on p. - - squareTerms p - 6 4 2 - 324x + 3600x + 2116x + 64 - Type: UnivariatePolynomial(x,Integer) - -When the coefficients of the univariate polynomial belong to a field, -it is possible to compute quotients and remainders. For example, when -the coefficients are rational numbers, as opposed to integers. The -important property of a field is that non-zero elements can be divided -and produce another element. The quotient of the integers 2 and 3 is -not another integer. - - (r,s) : UP(a1,FRAC INT) - Type: Void - - r := a1**2 - 2/3 - 2 2 - a1 - - - 3 - Type: UnivariatePolynomial(a1,Fraction Integer) - - s := a1 + 4 - a1 + 4 - Type: UnivariatePolynomial(a1,Fraction Integer) - -When the coefficients are rational numbers or rational expressions, -the operation quo computes the quotient of two polynomials. - - r quo s - a1 - 4 - Type: UnivariatePolynomial(a1,Fraction Integer) - -The operation rem computes the remainder. - - r rem s - 46 - -- - 3 - Type: UnivariatePolynomial(a1,Fraction Integer) - -The operation divide can be used to return a record of both components. - - d := divide(r, s) - 46 - [quotient= a1 - 4,remainder= --] - 3 - Type: Record(quotient: UnivariatePolynomial(a1,Fraction Integer), - remainder: UnivariatePolynomial(a1,Fraction Integer)) - -Now we check the arithmetic! - - r - (d.quotient * s + d.remainder) - 0 - Type: UnivariatePolynomial(a1,Fraction Integer) - -It is also possible to integrate univariate polynomials when the -coefficients belong to a field. - - integrate r - 1 3 2 - - a1 - - a1 - 3 3 - Type: UnivariatePolynomial(a1,Fraction Integer) - - integrate s - 1 2 - - a1 + 4a1 - 2 - Type: UnivariatePolynomial(a1,Fraction Integer) - -One application of univariate polynomials is to see expressions in terms -of a specific variable. - -We start with a polynomial in a1 whose coefficients are quotients of -polynomials in b1 and b2. - - t : UP(a1,FRAC POLY INT) - Type: Void - -Since in this case we are not talking about using multivariate -polynomials in only two variables, we use Polynomial. We also use -Fraction because we want fractions. - - t := a1**2 - a1/b2 + (b1**2-b1)/(b2+3) - 2 - 2 1 b1 - b1 - a1 - -- a1 + -------- - b2 b2 + 3 - Type: UnivariatePolynomial(a1,Fraction Polynomial Integer) - -We push all the variables into a single quotient of polynomials. - - u : FRAC POLY INT := t - 2 2 2 2 - a1 b2 + (b1 - b1 + 3a1 - a1)b2 - 3a1 - --------------------------------------- - 2 - b2 + 3b2 - Type: Fraction Polynomial Integer - -Alternatively, we can view this as a polynomial in the variable This -is a mode-directed conversion: you indicate as much of the structure -as you care about and let Axiom decide on the full type and how to do -the transformation. - - u :: UP(b1,?) - 2 - 1 2 1 a1 b2 - a1 - ------ b1 - ------ b1 + ---------- - b2 + 3 b2 + 3 b2 - Type: UnivariatePolynomial(b1,Fraction Polynomial Integer) - -See Also: -o )help MultivariatePolynomial -o )help DistributedMultivariatePolynomial -o )show UnivariatePolynomial -o $AXIOM/doc/src/algebra/poly.spad.dvi - -@ -<>= -)abbrev domain UP UnivariatePolynomial -++ Author: -++ Date Created: -++ Date Last Updated: -++ Basic Functions: Ring, monomial, coefficient, reductum, differentiate, -++ elt, map, resultant, discriminant -++ Related Constructors: SparseUnivariatePolynomial, MultivariatePolynomial -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain represents univariate polynomials in some symbol -++ over arbitrary (not necessarily commutative) coefficient rings. -++ The representation is sparse -++ in the sense that only non-zero terms are represented. -++ Note: if the coefficient ring is a field, then this domain forms a euclidean domain. - -UnivariatePolynomial(x:Symbol, R:Ring): - UnivariatePolynomialCategory(R) with - coerce: Variable(x) -> % - ++ coerce(x) converts the variable x to a univariate polynomial. - fmecg: (%,NonNegativeInteger,R,%) -> % - ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 - == SparseUnivariatePolynomial(R) add - Rep:=SparseUnivariatePolynomial(R) - coerce(p:%):OutputForm == outputForm(p, outputForm x) - coerce(v:Variable(x)):% == monomial(1, 1) - -@ \section{package UP2 UnivariatePolynomialFunctions2} <>= )abbrev package UP2 UnivariatePolynomialFunctions2 @@ -1858,14 +472,10 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego <<*>>= <> -<> -<> <> <> <> -<> <> -<> <> <> @ diff --git a/src/algebra/product.spad.pamphlet b/src/algebra/product.spad.pamphlet deleted file mode 100644 index 0787277..0000000 --- a/src/algebra/product.spad.pamphlet +++ /dev/null @@ -1,151 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra product.spad} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain PRODUCT Product} -<>= -)abbrev domain PRODUCT Product -++ Description: -++ This domain implements cartesian product -Product (A:SetCategory,B:SetCategory) : C == T - where - C == SetCategory with - if A has Finite and B has Finite then Finite - if A has Monoid and B has Monoid then Monoid - if A has AbelianMonoid and B has AbelianMonoid then AbelianMonoid - if A has CancellationAbelianMonoid and - B has CancellationAbelianMonoid then CancellationAbelianMonoid - if A has Group and B has Group then Group - if A has AbelianGroup and B has AbelianGroup then AbelianGroup - if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup - then OrderedAbelianMonoidSup - if A has OrderedSet and B has OrderedSet then OrderedSet - - makeprod : (A,B) -> % - ++ makeprod(a,b) \undocumented - selectfirst : % -> A - ++ selectfirst(x) \undocumented - selectsecond : % -> B - ++ selectsecond(x) \undocumented - - T == add - - --representations - Rep := Record(acomp:A,bcomp:B) - - --declarations - x,y: % - i: NonNegativeInteger - p: NonNegativeInteger - a: A - b: B - d: Integer - - --define - coerce(x):OutputForm == paren [(x.acomp)::OutputForm, - (x.bcomp)::OutputForm] - x=y == - x.acomp = y.acomp => x.bcomp = y.bcomp - false - makeprod(a:A,b:B) :% == [a,b] - - selectfirst(x:%) : A == x.acomp - - selectsecond (x:%) : B == x.bcomp - - if A has Monoid and B has Monoid then - 1 == [1$A,1$B] - x * y == [x.acomp * y.acomp,x.bcomp * y.bcomp] - x ** p == [x.acomp ** p ,x.bcomp ** p] - - if A has Finite and B has Finite then - size == size$A () * size$B () - - if A has Group and B has Group then - inv(x) == [inv(x.acomp),inv(x.bcomp)] - - if A has AbelianMonoid and B has AbelianMonoid then - 0 == [0$A,0$B] - - x + y == [x.acomp + y.acomp,x.bcomp + y.bcomp] - - c:NonNegativeInteger * x == [c * x.acomp,c*x.bcomp] - - if A has CancellationAbelianMonoid and - B has CancellationAbelianMonoid then - subtractIfCan(x, y) : Union(%,"failed") == - (na:= subtractIfCan(x.acomp, y.acomp)) case "failed" => "failed" - (nb:= subtractIfCan(x.bcomp, y.bcomp)) case "failed" => "failed" - [na::A,nb::B] - - if A has AbelianGroup and B has AbelianGroup then - - x == [- x.acomp,-x.bcomp] - (x - y):% == [x.acomp - y.acomp,x.bcomp - y.bcomp] - d * x == [d * x.acomp,d * x.bcomp] - - if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup then - sup(x,y) == [sup(x.acomp,y.acomp),sup(x.bcomp,y.bcomp)] - - if A has OrderedSet and B has OrderedSet then - x < y == - xa:= x.acomp ; ya:= y.acomp - xa < ya => true - xb:= x.bcomp ; yb:= y.bcomp - xa = ya => (xb < yb) - false - --- coerce(x:%):Symbol == --- PrintableForm() --- formList([x.acomp::Expression,x.bcomp::Expression])$PrintableForm - -@ -\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/prtition.spad.pamphlet b/src/algebra/prtition.spad.pamphlet deleted file mode 100644 index 6b3cd53..0000000 --- a/src/algebra/prtition.spad.pamphlet +++ /dev/null @@ -1,218 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra prtition.spad} -\author{William H. Burge} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain PRTITION Partition} -<>= -)abbrev domain PRTITION Partition -++ Domain for partitions of positive integers -++ Author: William H. Burge -++ Date Created: 29 October 1987 -++ Date Last Updated: 23 Sept 1991 -++ Keywords: -++ Examples: -++ References: -Partition: Exports == Implementation where - ++ Partition is an OrderedCancellationAbelianMonoid which is used - ++ as the basis for symmetric polynomial representation of the - ++ sums of powers in SymmetricPolynomial. Thus, \spad{(5 2 2 1)} will - ++ represent \spad{s5 * s2**2 * s1}. - L ==> List - I ==> Integer - OUT ==> OutputForm - NNI ==> NonNegativeInteger - UN ==> Union(%,"failed") - - Exports ==> Join(OrderedCancellationAbelianMonoid, - ConvertibleTo List Integer) with - partition: L I -> % - ++ partition(li) converts a list of integers li to a partition - powers: L I -> L L I - ++ powers(li) returns a list of 2-element lists. For each 2-element - ++ list, the first element is an entry of li and the second - ++ element is the multiplicity with which the first element - ++ occurs in li. There is a 2-element list for each value - ++ occurring in l. - pdct: % -> I - ++ \spad{pdct(a1**n1 a2**n2 ...)} returns - ++ \spad{n1! * a1**n1 * n2! * a2**n2 * ...}. - ++ This function is used in the package \spadtype{CycleIndicators}. - conjugate: % -> % - ++ conjugate(p) returns the conjugate partition of a partition p - coerce:% -> List Integer - ++ coerce(p) coerces a partition into a list of integers - - Implementation ==> add - - import PartitionsAndPermutations - - Rep := List Integer - 0 == nil() - - coerce (s:%) == s pretend List Integer - convert x == copy(x pretend L I) - - partition list == sort(#2 < #1,list) - - x < y == - empty? x => not empty? y - empty? y => false - first x = first y => rest x < rest y - first x < first y - - x = y == - EQUAL(x,y)$Lisp --- empty? x => empty? y --- empty? y => false --- first x = first y => rest x = rest y --- false - - x + y == - empty? x => y - empty? y => x - first x > first y => concat(first x,rest(x) + y) - concat(first y,x + rest(y)) - n:NNI * x:% == (zero? n => 0; x + (subtractIfCan(n,1) :: NNI) * x) - - dp: (I,%) -> % - dp(i,x) == - empty? x => 0 - first x = i => rest x - concat(first x,dp(i,rest x)) - - remv: (I,%) -> UN - remv(i,x) == (member?(i,x) => dp(i,x); "failed") - - subtractIfCan(x, y) == - empty? x => - empty? y => 0 - "failed" - empty? y => x - (aa := remv(first y,x)) case "failed" => "failed" - subtractIfCan((aa :: %), rest y) - - li1 : L I --!! 'bite' won't compile without this - bite: (I,L I) -> L I - bite(i,li) == - empty? li => concat(0,nil()) - first li = i => - li1 := bite(i,rest li) - concat(first(li1) + 1,rest li1) - concat(0,li) - - li : L I --!! 'powers' won't compile without this - powers l == - empty? l => nil() - li := bite(first l,rest l) - concat([first l,first(li) + 1],powers(rest li)) - - conjugate x == conjugate(x pretend Rep)$PartitionsAndPermutations - - mkterm: (I,I) -> OUT - mkterm(i1,i2) == - i2 = 1 => (i1 :: OUT) ** (" " :: OUT) - (i1 :: OUT) ** (i2 :: OUT) - - mkexp1: L L I -> L OUT - mkexp1 lli == - empty? lli => nil() - li := first lli - empty?(rest lli) and second(li) = 1 => - concat(first(li) :: OUT,nil()) - concat(mkterm(first li,second li),mkexp1(rest lli)) - - coerce(x:%):OUT == - empty? (x pretend Rep) => coerce(x pretend Rep)$Rep - paren(reduce("*",mkexp1(powers(x pretend Rep)))) - - pdct x == - */[factorial(second a) * (first(a) ** (second(a) pretend NNI)) - for a in powers(x pretend Rep)] - -@ -\section{domain SYMPOLY SymmetricPolynomial} -<>= -)abbrev domain SYMPOLY SymmetricPolynomial -++ Description: -++ This domain implements symmetric polynomial -SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add - Term:= Record(k:Partition,c:R) - Rep:= List Term - --- override PR implementation because coeff. arithmetic too expensive (??) - - if R has EntireRing then - (p1:%) * (p2:%) == - null p1 => 0 - null p2 => 0 - zero?(p1.first.k) => p1.first.c * p2 --- one? p2 => p1 - (p2 = 1) => p1 - +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2] - for t1 in reverse(p1)] - -- This 'reverse' is an efficiency improvement: - -- reduces both time and space [Abbott/Bradford/Davenport] - else - (p1:%) * (p2:%) == - null p1 => 0 - null p2 => 0 - zero?(p1.first.k) => p1.first.c * p2 --- one? p2 => p1 - (p2 = 1) => p1 - +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0] - for t1 in reverse(p1)] - -- This 'reverse' is an efficiency improvement: - -- reduces both time and space [Abbott/Bradford/Davenport] - -@ -\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/puiseux.spad.pamphlet b/src/algebra/puiseux.spad.pamphlet index f63575a..ab53530 100644 --- a/src/algebra/puiseux.spad.pamphlet +++ b/src/algebra/puiseux.spad.pamphlet @@ -9,514 +9,6 @@ \eject \tableofcontents \eject -\section{domain UPXSCONS UnivariatePuiseuxSeriesConstructor} -<>= -)abbrev domain UPXSCONS UnivariatePuiseuxSeriesConstructor -++ Author: Clifton J. Williamson -++ Date Created: 9 May 1989 -++ Date Last Updated: 30 November 1994 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: series, Puiseux, Laurent -++ Examples: -++ References: -++ Description: -++ This package enables one to construct a univariate Puiseux series -++ domain from a univariate Laurent series domain. Univariate -++ Puiseux series are represented by a pair \spad{[r,f(x)]}, where r is -++ a positive rational number and \spad{f(x)} is a Laurent series. -++ This pair represents the Puiseux series \spad{f(x^r)}. - -UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ - Exports == Implementation where - Coef : Ring - ULS : UnivariateLaurentSeriesCategory Coef - I ==> Integer - L ==> List - NNI ==> NonNegativeInteger - OUT ==> OutputForm - PI ==> PositiveInteger - RN ==> Fraction Integer - ST ==> Stream Coef - LTerm ==> Record(k:I,c:Coef) - PTerm ==> Record(k:RN,c:Coef) - ST2LP ==> StreamFunctions2(LTerm,PTerm) - ST2PL ==> StreamFunctions2(PTerm,LTerm) - - Exports ==> UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS) - - Implementation ==> add - ---% representation - - Rep := Record(expon:RN,lSeries:ULS) - - getExpon: % -> RN - getULS : % -> ULS - - getExpon pxs == pxs.expon - getULS pxs == pxs.lSeries - ---% creation and destruction - - puiseux(n,ls) == [n,ls] - laurentRep x == getULS x - rationalPower x == getExpon x - degree x == getExpon(x) * degree(getULS(x)) - - 0 == puiseux(1,0) - 1 == puiseux(1,1) - - monomial(c,k) == - k = 0 => c :: % - k < 0 => puiseux(-k,monomial(c,-1)) - puiseux(k,monomial(c,1)) - - coerce(ls:ULS) == puiseux(1,ls) - coerce(r:Coef) == r :: ULS :: % - coerce(i:I) == i :: Coef :: % - - laurentIfCan upxs == - r := getExpon upxs --- one? denom r => - (denom r) = 1 => - multiplyExponents(getULS upxs,numer(r) :: PI) - "failed" - - laurent upxs == - (uls := laurentIfCan upxs) case "failed" => - error "laurent: Puiseux series has fractional powers" - uls :: ULS - - multExp: (RN,LTerm) -> PTerm - multExp(r,lTerm) == [r * lTerm.k,lTerm.c] - - terms upxs == map(multExp(getExpon upxs,#1),terms getULS upxs)$ST2LP - - clearDen: (I,PTerm) -> LTerm - clearDen(n,lTerm) == - (int := retractIfCan(n * lTerm.k)@Union(I,"failed")) case "failed" => - error "series: inappropriate denominator" - [int :: I,lTerm.c] - - series(n,stream) == - str := map(clearDen(n,#1),stream)$ST2PL - puiseux(1/n,series str) - ---% normalizations - - rewrite:(%,PI) -> % - rewrite(upxs,m) == - -- rewrites a series in x**r as a series in x**(r/m) - puiseux((getExpon upxs)*(1/m),multiplyExponents(getULS upxs,m)) - - ratGcd: (RN,RN) -> RN - ratGcd(r1,r2) == - -- if r1 = prod(p prime,p ** ep(r1)) and - -- if r2 = prod(p prime,p ** ep(r2)), then - -- ratGcd(r1,r2) = prod(p prime,p ** min(ep(r1),ep(r2))) - gcd(numer r1,numer r2) / lcm(denom r1,denom r2) - - withNewExpon:(%,RN) -> % - withNewExpon(upxs,r) == - rewrite(upxs,numer(getExpon(upxs)/r) pretend PI) - ---% predicates - - upxs1 = upxs2 == - r1 := getExpon upxs1; r2 := getExpon upxs2 - ls1 := getULS upxs1; ls2 := getULS upxs2 - (r1 = r2) => (ls1 = ls2) - r := ratGcd(r1,r2) - m1 := numer(getExpon(upxs1)/r) pretend PI - m2 := numer(getExpon(upxs2)/r) pretend PI - multiplyExponents(ls1,m1) = multiplyExponents(ls2,m2) - - pole? upxs == pole? getULS upxs - ---% arithmetic - - applyFcn:((ULS,ULS) -> ULS,%,%) -> % - applyFcn(op,pxs1,pxs2) == - r1 := getExpon pxs1; r2 := getExpon pxs2 - ls1 := getULS pxs1; ls2 := getULS pxs2 - (r1 = r2) => puiseux(r1,op(ls1,ls2)) - r := ratGcd(r1,r2) - m1 := numer(getExpon(pxs1)/r) pretend PI - m2 := numer(getExpon(pxs2)/r) pretend PI - puiseux(r,op(multiplyExponents(ls1,m1),multiplyExponents(ls2,m2))) - - pxs1 + pxs2 == applyFcn(#1 +$ULS #2,pxs1,pxs2) - pxs1 - pxs2 == applyFcn(#1 -$ULS #2,pxs1,pxs2) - pxs1:% * pxs2:% == applyFcn(#1 *$ULS #2,pxs1,pxs2) - - pxs:% ** n:NNI == puiseux(getExpon pxs,getULS(pxs)**n) - - recip pxs == - rec := recip getULS pxs - rec case "failed" => "failed" - puiseux(getExpon pxs,rec :: ULS) - - RATALG : Boolean := Coef has Algebra(Fraction Integer) - - elt(upxs1:%,upxs2:%) == - uls1 := laurentRep upxs1; uls2 := laurentRep upxs2 - r1 := rationalPower upxs1; r2 := rationalPower upxs2 - (n := retractIfCan(r1)@Union(Integer,"failed")) case Integer => - puiseux(r2,uls1(uls2 ** r1)) - RATALG => - if zero? (coef := coefficient(uls2,deg := degree uls2)) then - deg := order(uls2,deg + 1000) - zero? (coef := coefficient(uls2,deg)) => - error "elt: series with many leading zero coefficients" - -- a fractional power of a Laurent series may not be defined: - -- if f(x) = c * x**n + ..., then f(x) ** (p/q) will be defined - -- only if q divides n - b := lcm(denom r1,deg); c := b quo deg - mon : ULS := monomial(1,c) - uls2 := elt(uls2,mon) ** r1 - puiseux(r2*(1/c),elt(uls1,uls2)) - error "elt: rational powers not available for this coefficient domain" - - if Coef has "**": (Coef,Integer) -> Coef and - Coef has "**": (Coef, RN) -> Coef then - eval(upxs:%,a:Coef) == eval(getULS upxs,a ** getExpon(upxs)) - - if Coef has Field then - - pxs1:% / pxs2:% == applyFcn(#1 /$ULS #2,pxs1,pxs2) - - inv upxs == - (invUpxs := recip upxs) case "failed" => - error "inv: multiplicative inverse does not exist" - invUpxs :: % - ---% values - - variable upxs == variable getULS upxs - center upxs == center getULS upxs - - coefficient(upxs,rn) == --- one? denom(n := rn / getExpon upxs) => - (denom(n := rn / getExpon upxs)) = 1 => - coefficient(getULS upxs,numer n) - 0 - - elt(upxs:%,rn:RN) == coefficient(upxs,rn) - ---% other functions - - roundDown: RN -> I - roundDown rn == - -- returns the largest integer <= rn - (den := denom rn) = 1 => numer rn - n := (num := numer rn) quo den - positive?(num) => n - n - 1 - - roundUp: RN -> I - roundUp rn == - -- returns the smallest integer >= rn - (den := denom rn) = 1 => numer rn - n := (num := numer rn) quo den - positive?(num) => n + 1 - n - - order upxs == getExpon upxs * order getULS upxs - order(upxs,r) == - e := getExpon upxs - ord := order(getULS upxs, n := roundDown(r / e)) - ord = n => r - ord * e - - truncate(upxs,r) == - e := getExpon upxs - puiseux(e,truncate(getULS upxs,roundDown(r / e))) - - truncate(upxs,r1,r2) == - e := getExpon upxs - puiseux(e,truncate(getULS upxs,roundUp(r1 / e),roundDown(r2 / e))) - - complete upxs == puiseux(getExpon upxs,complete getULS upxs) - extend(upxs,r) == - e := getExpon upxs - puiseux(e,extend(getULS upxs,roundDown(r / e))) - - map(fcn,upxs) == puiseux(getExpon upxs,map(fcn,getULS upxs)) - - characteristic() == characteristic()$Coef - - -- multiplyCoefficients(f,upxs) == - -- r := getExpon upxs - -- puiseux(r,multiplyCoefficients(f(#1 * r),getULS upxs)) - - multiplyExponents(upxs:%,n:RN) == - puiseux(n * getExpon(upxs),getULS upxs) - multiplyExponents(upxs:%,n:PI) == - puiseux(n * getExpon(upxs),getULS upxs) - - if Coef has "*": (Fraction Integer, Coef) -> Coef then - - differentiate upxs == - r := getExpon upxs - puiseux(r,differentiate getULS upxs) * monomial(r :: Coef,r-1) - - if Coef has PartialDifferentialRing(Symbol) then - - differentiate(upxs:%,s:Symbol) == - (s = variable(upxs)) => differentiate upxs - dcds := differentiate(center upxs,s) - map(differentiate(#1,s),upxs) - dcds*differentiate(upxs) - - if Coef has Algebra Fraction Integer then - - coerce(r:RN) == r :: Coef :: % - - ratInv: RN -> Coef - ratInv r == - zero? r => 1 - inv(r) :: Coef - - integrate upxs == - not zero? coefficient(upxs,-1) => - error "integrate: series has term of order -1" - r := getExpon upxs - uls := getULS upxs - uls := multiplyCoefficients(ratInv(#1 * r + 1),uls) - monomial(1,1) * puiseux(r,uls) - - if Coef has integrate: (Coef,Symbol) -> Coef and _ - Coef has variables: Coef -> List Symbol then - - integrate(upxs:%,s:Symbol) == - (s = variable(upxs)) => integrate upxs - not entry?(s,variables center upxs) => map(integrate(#1,s),upxs) - error "integrate: center is a function of variable of integration" - - if Coef has TranscendentalFunctionCategory and _ - Coef has PrimitiveFunctionCategory and _ - Coef has AlgebraicallyClosedFunctionSpace Integer then - - integrateWithOneAnswer: (Coef,Symbol) -> Coef - integrateWithOneAnswer(f,s) == - res := integrate(f,s)$FunctionSpaceIntegration(I,Coef) - res case Coef => res :: Coef - first(res :: List Coef) - - integrate(upxs:%,s:Symbol) == - (s = variable(upxs)) => integrate upxs - not entry?(s,variables center upxs) => - map(integrateWithOneAnswer(#1,s),upxs) - error "integrate: center is a function of variable of integration" - - if Coef has Field then - (upxs:%) ** (q:RN) == - num := numer q; den := denom q --- one? den => upxs ** num - den = 1 => upxs ** num - r := rationalPower upxs; uls := laurentRep upxs - deg := degree uls - if zero?(coef := coefficient(uls,deg)) then - deg := order(uls,deg + 1000) - zero?(coef := coefficient(uls,deg)) => - error "power of series with many leading zero coefficients" - ulsPow := (uls * monomial(1,-deg)$ULS) ** q - puiseux(r,ulsPow) * monomial(1,deg*q*r) - - applyUnary: (ULS -> ULS,%) -> % - applyUnary(fcn,upxs) == - puiseux(rationalPower upxs,fcn laurentRep upxs) - - exp upxs == applyUnary(exp,upxs) - log upxs == applyUnary(log,upxs) - sin upxs == applyUnary(sin,upxs) - cos upxs == applyUnary(cos,upxs) - tan upxs == applyUnary(tan,upxs) - cot upxs == applyUnary(cot,upxs) - sec upxs == applyUnary(sec,upxs) - csc upxs == applyUnary(csc,upxs) - asin upxs == applyUnary(asin,upxs) - acos upxs == applyUnary(acos,upxs) - atan upxs == applyUnary(atan,upxs) - acot upxs == applyUnary(acot,upxs) - asec upxs == applyUnary(asec,upxs) - acsc upxs == applyUnary(acsc,upxs) - sinh upxs == applyUnary(sinh,upxs) - cosh upxs == applyUnary(cosh,upxs) - tanh upxs == applyUnary(tanh,upxs) - coth upxs == applyUnary(coth,upxs) - sech upxs == applyUnary(sech,upxs) - csch upxs == applyUnary(csch,upxs) - asinh upxs == applyUnary(asinh,upxs) - acosh upxs == applyUnary(acosh,upxs) - atanh upxs == applyUnary(atanh,upxs) - acoth upxs == applyUnary(acoth,upxs) - asech upxs == applyUnary(asech,upxs) - acsch upxs == applyUnary(acsch,upxs) - -@ -\section{domain UPXS UnivariatePuiseuxSeries} -<>= -)abbrev domain UPXS UnivariatePuiseuxSeries -++ Author: Clifton J. Williamson -++ Date Created: 28 January 1990 -++ Date Last Updated: 21 September 1993 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: series, Puiseux -++ Examples: -++ References: -++ Description: Dense Puiseux series in one variable -++ \spadtype{UnivariatePuiseuxSeries} is a domain representing Puiseux -++ series in one variable with coefficients in an arbitrary ring. The -++ parameters of the type specify the coefficient ring, the power series -++ variable, and the center of the power series expansion. For example, -++ \spad{UnivariatePuiseuxSeries(Integer,x,3)} represents Puiseux series in -++ \spad{(x - 3)} with \spadtype{Integer} coefficients. -UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where - Coef : Ring - var : Symbol - cen : Coef - I ==> Integer - L ==> List - NNI ==> NonNegativeInteger - OUT ==> OutputForm - RN ==> Fraction Integer - ST ==> Stream Coef - UTS ==> UnivariateTaylorSeries(Coef,var,cen) - ULS ==> UnivariateLaurentSeries(Coef,var,cen) - - Exports ==> Join(UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS),_ - RetractableTo UTS) with - coerce: Variable(var) -> % - ++ coerce(var) converts the series variable \spad{var} into a - ++ Puiseux series. - differentiate: (%,Variable(var)) -> % - ++ \spad{differentiate(f(x),x)} returns the derivative of - ++ \spad{f(x)} with respect to \spad{x}. - if Coef has Algebra Fraction Integer then - integrate: (%,Variable(var)) -> % - ++ \spad{integrate(f(x))} returns an anti-derivative of the power - ++ series \spad{f(x)} with constant coefficient 0. - ++ We may integrate a series when we can divide coefficients - ++ by integers. - - Implementation ==> UnivariatePuiseuxSeriesConstructor(Coef,ULS) add - - Rep := Record(expon:RN,lSeries:ULS) - - getExpon: % -> RN - getExpon pxs == pxs.expon - - variable upxs == var - center upxs == cen - - coerce(uts:UTS) == uts :: ULS :: % - - retractIfCan(upxs:%):Union(UTS,"failed") == - (ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" => - "failed" - retractIfCan(ulsIfCan :: ULS) - - --retract(upxs:%):UTS == - --(ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" => - --error "retractIfCan: series has fractional exponents" - --utsIfCan := retractIfCan(ulsIfCan :: ULS)@Union(UTS,"failed") - --utsIfCan case "failed" => - --error "retractIfCan: series has negative exponents" - --utsIfCan :: UTS - - coerce(v:Variable(var)) == - zero? cen => monomial(1,1) - monomial(1,1) + monomial(cen,0) - - if Coef has "*": (Fraction Integer, Coef) -> Coef then - differentiate(upxs:%,v:Variable(var)) == differentiate upxs - - if Coef has Algebra Fraction Integer then - integrate(upxs:%,v:Variable(var)) == integrate upxs - - if Coef has coerce: Symbol -> Coef then - if Coef has "**": (Coef,RN) -> Coef then - - roundDown: RN -> I - roundDown rn == - -- returns the largest integer <= rn - (den := denom rn) = 1 => numer rn - n := (num := numer rn) quo den - positive?(num) => n - n - 1 - - stToCoef: (ST,Coef,NNI,NNI) -> Coef - stToCoef(st,term,n,n0) == - (n > n0) or (empty? st) => 0 - frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0) - - approximateLaurent: (ULS,Coef,I) -> Coef - approximateLaurent(x,term,n) == - (m := n - (e := degree x)) < 0 => 0 - app := stToCoef(coefficients taylorRep x,term,0,m :: NNI) - zero? e => app - app * term ** (e :: RN) - - approximate(x,r) == - e := rationalPower(x) - term := ((variable(x) :: Coef) - center(x)) ** e - approximateLaurent(laurentRep x,term,roundDown(r / e)) - - termOutput:(RN,Coef,OUT) -> OUT - termOutput(k,c,vv) == - -- creates a term c * vv ** k - k = 0 => c :: OUT - mon := - k = 1 => vv - vv ** (k :: OUT) - c = 1 => mon - c = -1 => -mon - (c :: OUT) * mon - - showAll?:() -> Boolean - -- check a global Lisp variable - showAll?() == true - - termsToOutputForm:(RN,RN,ST,OUT) -> OUT - termsToOutputForm(m,rat,uu,xxx) == - l : L OUT := empty() - empty? uu => 0 :: OUT - n : NNI; count : NNI := _$streamCount$Lisp - for n in 0..count while not empty? uu repeat - if frst(uu) ^= 0 then - l := concat(termOutput((n :: I) * rat + m,frst uu,xxx),l) - uu := rst uu - if showAll?() then - for n in (count + 1).. while explicitEntries? uu and _ - not eq?(uu,rst uu) repeat - if frst(uu) ^= 0 then - l := concat(termOutput((n :: I) * rat + m,frst uu,xxx),l) - uu := rst uu - l := - explicitlyEmpty? uu => l - eq?(uu,rst uu) and frst uu = 0 => l - concat(prefix("O" :: OUT,[xxx ** (((n::I) * rat + m) :: OUT)]),l) - empty? l => 0 :: OUT - reduce("+",reverse_! l) - - coerce(upxs:%):OUT == - rat := getExpon upxs; uls := laurentRep upxs - count : I := _$streamCount$Lisp - uls := removeZeroes(_$streamCount$Lisp,uls) - m : RN := (degree uls) * rat - p := coefficients taylorRep uls - xxx := - zero? cen => var :: OUT - paren(var :: OUT - cen :: OUT) - termsToOutputForm(m,rat,p,xxx) - -@ \section{package UPXS2 UnivariatePuiseuxSeriesFunctions2} <>= )abbrev package UPXS2 UnivariatePuiseuxSeriesFunctions2 @@ -589,8 +81,6 @@ UnivariatePuiseuxSeriesFunctions2(Coef1,Coef2,var1,var2,cen1,cen2):_ <<*>>= <> -<> -<> <> @ \eject diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index fb4cca2..9369a9f 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -799,6 +799,8 @@ regression test suite cleanup
bookvol10.3 add domains
20081213.01.tpd.patch lisp move to GCL-pre3
+20081213.02.tpd.patch +bookvol10.3 add domains
\ No newline at end of file