diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index b926659..76752eb 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -1235,6 +1235,75 @@ AlgebraicManipulations(R, F): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ALGMFACT AlgebraicMultFact} +\pagehead{AlgebraicMultFact}{ALGMFACT} +\pagepic{ps/v104algebraicmultfact.ps}{ALGMFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ALGMFACT AlgebraicMultFact +++ Author: P. Gianni +++ Date Created: 1990 +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package factors multivariate polynomials over the +++ domain of \spadtype{AlgebraicNumber} by allowing the user +++ to specify a list of algebraic numbers generating the particular +++ extension to factor over. + +AlgebraicMultFact(OV,E,P) : C == T + where + AN ==> AlgebraicNumber + OV : OrderedSet + E : OrderedAbelianMonoidSup + P : PolynomialCategory(AN,E,OV) + BP ==> SparseUnivariatePolynomial AN + Z ==> Integer + MParFact ==> Record(irr:P,pow:Z) + USP ==> SparseUnivariatePolynomial P + SUParFact ==> Record(irr:USP,pow:Z) + SUPFinalFact ==> Record(contp:R,factors:List SUParFact) + MFinalFact ==> Record(contp:R,factors:List MParFact) + + -- contp = content, + -- factors = List of irreducible factors with exponent + L ==> List + + C == with + factor : (P,L AN) -> Factored P + ++ factor(p,lan) factors the polynomial p over the extension + ++ generated by the algebraic numbers given by the list lan. + factor : (USP,L AN) -> Factored USP + ++ factor(p,lan) factors the polynomial p over the extension + ++ generated by the algebraic numbers given by the list lan. + ++ p is presented as a univariate polynomial with multivariate + ++ coefficients. + T == add + AF := AlgFactor(BP) + + factor(p:P,lalg:L AN) : Factored P == + factor(p,factor(#1,lalg)$AF)$InnerMultFact(OV,E,AN,P) + + factor(up:USP,lalg:L AN) : Factored USP == + factor(up,factor(#1,lalg)$AF)$InnerMultFact(OV,E,AN,P) + +@ +<>= +"ALGMFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ALGMFACT"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"ALGMFACT" -> "ACF" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package ALGFACT AlgFactor} \pagehead{AlgFactor}{ALGFACT} \pagepic{ps/v104algfactor.ps}{ALGFACT}{1.00} @@ -32552,6 +32621,1044 @@ InnerCommonDenominator(R, Q, A, B): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IMATLIN InnerMatrixLinearAlgebraFunctions} +\pagehead{InnerMatrixLinearAlgebraFunctions}{IMATLIN} +\pagepic{ps/v104innermatrixlinearalgebrafunctions.ps}{IMATLIN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IMATLIN InnerMatrixLinearAlgebraFunctions +++ Author: Clifton J. Williamson, P.Gianni +++ Date Created: 13 November 1989 +++ Date Last Updated: September 1993 +++ Basic Operations: +++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), +++ RectangularMatrix(n,m,R), SquareMatrix(n,R) +++ Also See: +++ AMS Classifications: +++ Keywords: matrix, canonical forms, linear algebra +++ Examples: +++ References: +++ Description: +++ \spadtype{InnerMatrixLinearAlgebraFunctions} is an internal package +++ which provides standard linear algebra functions on domains in +++ \spad{MatrixCategory} +InnerMatrixLinearAlgebraFunctions(R,Row,Col,M):_ + Exports == Implementation where + R : Field + Row : FiniteLinearAggregate R + Col : FiniteLinearAggregate R + M : MatrixCategory(R,Row,Col) + I ==> Integer + + Exports ==> with + rowEchelon: M -> M + ++ \spad{rowEchelon(m)} returns the row echelon form of the matrix m. + rank: M -> NonNegativeInteger + ++ \spad{rank(m)} returns the rank of the matrix m. + nullity: M -> NonNegativeInteger + ++ \spad{nullity(m)} returns the mullity of the matrix m. This is the + ++ dimension of the null space of the matrix m. + if Col has shallowlyMutable then + nullSpace: M -> List Col + ++ \spad{nullSpace(m)} returns a basis for the null space of the + ++ matrix m. + determinant: M -> R + ++ \spad{determinant(m)} returns the determinant of the matrix m. + ++ an error message is returned if the matrix is not square. + generalizedInverse: M -> M + ++ \spad{generalizedInverse(m)} returns the generalized (Moore--Penrose) + ++ inverse of the matrix m, i.e. the matrix h such that + ++ m*h*m=h, h*m*h=m, m*h and h*m are both symmetric matrices. + inverse: M -> Union(M,"failed") + ++ \spad{inverse(m)} returns the inverse of the matrix m. + ++ If the matrix is not invertible, "failed" is returned. + ++ Error: if the matrix is not square. + + Implementation ==> add + + rowAllZeroes?: (M,I) -> Boolean + rowAllZeroes?(x,i) == + -- determines if the ith row of x consists only of zeroes + -- internal function: no check on index i + for j in minColIndex(x)..maxColIndex(x) repeat + qelt(x,i,j) ^= 0 => return false + true + + colAllZeroes?: (M,I) -> Boolean + colAllZeroes?(x,j) == + -- determines if the ith column of x consists only of zeroes + -- internal function: no check on index j + for i in minRowIndex(x)..maxRowIndex(x) repeat + qelt(x,i,j) ^= 0 => return false + true + + rowEchelon y == + -- row echelon form via Gaussian elimination + x := copy y + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := maxColIndex x + i := minR + n: I := minR - 1 + for j in minC..maxC repeat + i > maxR => return x + n := minR - 1 + -- n = smallest k such that k >= i and x(k,j) ^= 0 + for k in i..maxR repeat + if qelt(x,k,j) ^= 0 then leave (n := k) + n = minR - 1 => "no non-zeroes" + -- put nth row in ith position + if i ^= n then swapRows_!(x,i,n) + -- divide ith row by its first non-zero entry + b := inv qelt(x,i,j) + qsetelt_!(x,i,j,1) + for k in (j+1)..maxC repeat qsetelt_!(x,i,k,b * qelt(x,i,k)) + -- perform row operations so that jth column has only one 1 + for k in minR..maxR repeat + if k ^= i and qelt(x,k,j) ^= 0 then + for k1 in (j+1)..maxC repeat + qsetelt_!(x,k,k1,qelt(x,k,k1) - qelt(x,k,j) * qelt(x,i,k1)) + qsetelt_!(x,k,j,0) + -- increment i + i := i + 1 + x + + rank x == + y := + (rk := nrows x) > (rh := ncols x) => + rk := rh + transpose x + copy x + y := rowEchelon y; i := maxRowIndex y + while rk > 0 and rowAllZeroes?(y,i) repeat + i := i - 1 + rk := (rk - 1) :: NonNegativeInteger + rk :: NonNegativeInteger + + nullity x == (ncols x - rank x) :: NonNegativeInteger + + if Col has shallowlyMutable then + + nullSpace y == + x := rowEchelon y + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := maxColIndex x + nrow := nrows x; ncol := ncols x + basis : List Col := nil() + rk := nrow; row := maxR + -- compute rank = # rows - # rows of all zeroes + while rk > 0 and rowAllZeroes?(x,row) repeat + rk := (rk - 1) :: NonNegativeInteger + row := (row - 1) :: NonNegativeInteger + -- if maximal rank, return zero vector + ncol <= nrow and rk = ncol => [new(ncol,0)] + -- if rank = 0, return standard basis vectors + rk = 0 => + for j in minC..maxC repeat + w : Col := new(ncol,0) + qsetelt_!(w,j,1) + basis := cons(w,basis) + basis + -- v contains information about initial 1's in the rows of x + -- if the ith row has an initial 1 in the jth column, then + -- v.j = i; v.j = minR - 1, otherwise + v : IndexedOneDimensionalArray(I,minC) := new(ncol,minR - 1) + for i in minR..(minR + rk - 1) repeat + for j in minC.. while qelt(x,i,j) = 0 repeat j + qsetelt_!(v,j,i) + j := maxC; l := minR + ncol - 1 + while j >= minC repeat + w : Col := new(ncol,0) + -- if there is no row with an initial 1 in the jth column, + -- create a basis vector with a 1 in the jth row + if qelt(v,j) = minR - 1 then + colAllZeroes?(x,j) => + qsetelt_!(w,l,1) + basis := cons(w,basis) + for k in minC..(j-1) for ll in minR..(l-1) repeat + if qelt(v,k) ^= minR - 1 then + qsetelt_!(w,ll,-qelt(x,qelt(v,k),j)) + qsetelt_!(w,l,1) + basis := cons(w,basis) + j := j - 1; l := l - 1 + basis + + determinant y == + (ndim := nrows y) ^= (ncols y) => + error "determinant: matrix must be square" + -- Gaussian Elimination + ndim = 1 => qelt(y,minRowIndex y,minColIndex y) + x := copy y + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := maxColIndex x + ans : R := 1 + for i in minR..(maxR - 1) for j in minC..(maxC - 1) repeat + if qelt(x,i,j) = 0 then + rown := minR - 1 + for k in (i+1)..maxR repeat + qelt(x,k,j) ^= 0 => leave (rown := k) + if rown = minR - 1 then return 0 + swapRows_!(x,i,rown); ans := -ans + ans := qelt(x,i,j) * ans; b := -inv qelt(x,i,j) + for l in (j+1)..maxC repeat qsetelt_!(x,i,l,b * qelt(x,i,l)) + for k in (i+1)..maxR repeat + if (b := qelt(x,k,j)) ^= 0 then + for l in (j+1)..maxC repeat + qsetelt_!(x,k,l,qelt(x,k,l) + b * qelt(x,i,l)) + qelt(x,maxR,maxC) * ans + + generalizedInverse(x) == + SUP:=SparseUnivariatePolynomial R + FSUP := Fraction SUP + VFSUP := Vector FSUP + MATCAT2 := MatrixCategoryFunctions2(R, Row, Col, M, + FSUP, VFSUP, VFSUP, Matrix FSUP) + MATCAT22 := MatrixCategoryFunctions2(FSUP, VFSUP, VFSUP, Matrix FSUP, + R, Row, Col, M) + y:= map(coerce(coerce(#1)$SUP)$(Fraction SUP),x)$MATCAT2 + ty:=transpose y + yy:=ty*y + nc:=ncols yy + var:=monomial(1,1)$SUP ::(Fraction SUP) + yy:=inverse(yy+scalarMatrix(ncols yy,var))::Matrix(FSUP)*ty + map(elt(#1,0),yy)$MATCAT22 + + inverse x == + (ndim := nrows x) ^= (ncols x) => + error "inverse: matrix must be square" + ndim = 2 => + ans2 : M := zero(ndim, ndim) + zero?(det := x(1,1)*x(2,2)-x(1,2)*x(2,1)) => "failed" + detinv := inv det + ans2(1,1) := x(2,2)*detinv + ans2(1,2) := -x(1,2)*detinv + ans2(2,1) := -x(2,1)*detinv + ans2(2,2) := x(1,1)*detinv + ans2 + AB : M := zero(ndim,ndim + ndim) + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := maxColIndex x + kmin := minRowIndex AB; kmax := kmin + ndim - 1 + lmin := minColIndex AB; lmax := lmin + ndim - 1 + for i in minR..maxR for k in kmin..kmax repeat + for j in minC..maxC for l in lmin..lmax repeat + qsetelt_!(AB,k,l,qelt(x,i,j)) + qsetelt_!(AB,k,lmin + ndim + k - kmin,1) + AB := rowEchelon AB + elt(AB,kmax,lmax) = 0 => "failed" + subMatrix(AB,kmin,kmax,lmin + ndim,lmax + ndim) + +@ +<>= +"IMATLIN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IMATLIN"] +"PFECAT" -> "IVECTOR" +"IMATLIN" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IMATQF InnerMatrixQuotientFieldFunctions} +\pagehead{InnerMatrixQuotientFieldFunctions}{IMATQF} +\pagepic{ps/v104innermatrixquotientfieldfunctions.ps}{IMATQF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IMATQF InnerMatrixQuotientFieldFunctions +++ Author: Clifton J. Williamson +++ Date Created: 22 November 1989 +++ Date Last Updated: 22 November 1989 +++ Basic Operations: +++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), RectangularMatrix(n,m,R), SquareMatrix(n,R) +++ Also See: +++ AMS Classifications: +++ Keywords: matrix, inverse, integral domain +++ Examples: +++ References: +++ Description: +++ \spadtype{InnerMatrixQuotientFieldFunctions} provides functions on matrices +++ over an integral domain which involve the quotient field of that integral +++ domain. The functions rowEchelon and inverse return matrices with +++ entries in the quotient field. +InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2):_ + Exports == Implementation where + R : IntegralDomain + Row : FiniteLinearAggregate R + Col : FiniteLinearAggregate R + M : MatrixCategory(R,Row,Col) + QF : QuotientFieldCategory R + Row2 : FiniteLinearAggregate QF + Col2 : FiniteLinearAggregate QF + M2 : MatrixCategory(QF,Row2,Col2) + IMATLIN ==> InnerMatrixLinearAlgebraFunctions(QF,Row2,Col2,M2) + MATCAT2 ==> MatrixCategoryFunctions2(R,Row,Col,M,QF,Row2,Col2,M2) + CDEN ==> InnerCommonDenominator(R,QF,Col,Col2) + + Exports ==> with + rowEchelon: M -> M2 + ++ \spad{rowEchelon(m)} returns the row echelon form of the matrix m. + ++ the result will have entries in the quotient field. + inverse: M -> Union(M2,"failed") + ++ \spad{inverse(m)} returns the inverse of the matrix m. + ++ If the matrix is not invertible, "failed" is returned. + ++ Error: if the matrix is not square. + ++ Note: the result will have entries in the quotient field. + if Col2 has shallowlyMutable then + nullSpace : M -> List Col + ++ \spad{nullSpace(m)} returns a basis for the null space of the + ++ matrix m. + Implementation ==> add + + qfMat: M -> M2 + qfMat m == map(#1 :: QF,m)$MATCAT2 + + rowEchelon m == rowEchelon(qfMat m)$IMATLIN + inverse m == + (inv := inverse(qfMat m)$IMATLIN) case "failed" => "failed" + inv :: M2 + + if Col2 has shallowlyMutable then + nullSpace m == + [clearDenominator(v)$CDEN for v in nullSpace(qfMat m)$IMATLIN] + +@ +<>= +"IMATQF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IMATQF"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"IMATQF" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INMODGCD InnerModularGcd} +\pagehead{InnerModularGcd}{INMODGCD} +\pagepic{ps/v104innermodulargcd.ps}{INMODGCD}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INMODGCD InnerModularGcd +++ Author: J.H. Davenport and P. Gianni +++ Date Created: July 1990 +++ Date Last Updated: November 1991 +++ Description: +++ This file contains the functions for modular gcd algorithm +++ for univariate polynomials with coefficients in a +++ non-trivial euclidean domain (i.e. not a field). +++ The package parametrised by the coefficient domain, +++ the polynomial domain, a prime, +++ and a function for choosing the next prime + +Z ==> Integer +NNI ==> NonNegativeInteger + +InnerModularGcd(R,BP,pMod,nextMod):C == T + where + R : EuclideanDomain + BP : UnivariatePolynomialCategory(R) + pMod : R + nextMod : (R,NNI) -> R + + C == with + modularGcdPrimitive : List BP -> BP + ++ modularGcdPrimitive(f1,f2) computes the gcd of the two polynomials + ++ f1 and f2 by modular methods. + modularGcd : List BP -> BP + ++ modularGcd(listf) computes the gcd of the list of polynomials + ++ listf by modular methods. + reduction : (BP,R) -> BP + ++ reduction(f,p) reduces the coefficients of the polynomial f + ++ modulo the prime p. + + T == add + + -- local functions -- + height : BP -> NNI + mbound : (BP,BP) -> NNI + modGcdPrimitive : (BP,BP) -> BP + test : (BP,BP,BP) -> Boolean + merge : (R,R) -> Union(R,"failed") + modInverse : (R,R) -> R + exactquo : (BP,BP,R) -> Union(BP,"failed") + constNotZero : BP -> Boolean + constcase : (List NNI ,List BP ) -> BP + lincase : (List NNI ,List BP ) -> BP + + + if R has IntegerNumberSystem then + reduction(u:BP,p:R):BP == + p = 0 => u + map(symmetricRemainder(#1,p),u) + else + reduction(u:BP,p:R):BP == + p = 0 => u + map(#1 rem p,u) + + FP:=EuclideanModularRing(R,BP,R,reduction,merge,exactquo) + zeroChar : Boolean := R has CharacteristicZero + + -- exported functions -- + + -- modular Gcd for a list of primitive polynomials + modularGcdPrimitive(listf : List BP) :BP == + empty? listf => 0$BP + g := first listf + for f in rest listf | ^zero? f while degree g > 0 repeat + g:=modGcdPrimitive(g,f) + g + + -- gcd for univariate polynomials + modularGcd(listf : List BP): BP == + listf:=remove!(0$BP,listf) + empty? listf => 0$BP + # listf = 1 => first listf + minpol:=1$BP + -- extract a monomial gcd + mdeg:= "min"/[minimumDegree f for f in listf] + if mdeg>0 then + minpol1:= monomial(1,mdeg) + listf:= [(f exquo minpol1)::BP for f in listf] + minpol:=minpol*minpol1 + listdeg:=[degree f for f in listf ] + -- make the polynomials primitive + listCont := [content f for f in listf] + contgcd:= gcd listCont + -- make the polynomials primitive + listf :=[(f exquo cf)::BP for f in listf for cf in listCont] + minpol:=contgcd*minpol + ans:BP := + --one polynomial is constant + member?(1,listf) => 1 + --one polynomial is linear + member?(1,listdeg) => lincase(listdeg,listf) + modularGcdPrimitive listf + minpol*ans + + -- local functions -- + + --one polynomial is linear, remark that they are primitive + lincase(listdeg:List NNI ,listf:List BP ): BP == + n:= position(1,listdeg) + g:=listf.n + for f in listf repeat + if (f1:=f exquo g) case "failed" then return 1$BP + g + + -- test if d is the gcd + test(f:BP,g:BP,d:BP):Boolean == + d0:=coefficient(d,0) + coefficient(f,0) exquo d0 case "failed" => false + coefficient(g,0) exquo d0 case "failed" => false + f exquo d case "failed" => false + g exquo d case "failed" => false + true + + -- gcd and cofactors for PRIMITIVE univariate polynomials + -- also assumes that constant terms are non zero + modGcdPrimitive(f:BP,g:BP): BP == + df:=degree f + dg:=degree g + dp:FP + lcf:=leadingCoefficient f + lcg:=leadingCoefficient g + testdeg:NNI + lcd:R:=gcd(lcf,lcg) + prime:=pMod + bound:=mbound(f,g) + while zero? (lcd rem prime) repeat + prime := nextMod(prime,bound) + soFar:=gcd(reduce(f,prime),reduce(g,prime))::BP + testdeg:=degree soFar + zero? testdeg => return 1$BP + ldp:FP:= + ((lcdp:=leadingCoefficient(soFar::BP)) = 1) => + reduce(lcd::BP,prime) + reduce((modInverse(lcdp,prime)*lcd)::BP,prime) + soFar:=reduce(ldp::BP *soFar,prime)::BP + soFarModulus:=prime + -- choose the prime + while true repeat + prime := nextMod(prime,bound) + lcd rem prime =0 => "next prime" + fp:=reduce(f,prime) + gp:=reduce(g,prime) + dp:=gcd(fp,gp) + dgp :=euclideanSize dp + if dgp =0 then return 1$BP + if dgp=dg and ^(f exquo g case "failed") then return g + if dgp=df and ^(g exquo f case "failed") then return f + dgp > testdeg => "next prime" + ldp:FP:= + ((lcdp:=leadingCoefficient(dp::BP)) = 1) => + reduce(lcd::BP,prime) + reduce((modInverse(lcdp,prime)*lcd)::BP,prime) + dp:=ldp *dp + dgp=testdeg => + correction:=reduce(dp::BP-soFar,prime)::BP + zero? correction => + ans:=reduce(lcd::BP*soFar,soFarModulus)::BP + cont:=content ans + ans:=(ans exquo cont)::BP + test(f,g,ans) => return ans + soFarModulus:=soFarModulus*prime + correctionFactor:=modInverse(soFarModulus rem prime,prime) + -- the initial rem is just for efficiency + soFar:=soFar+soFarModulus*(correctionFactor*correction) + soFarModulus:=soFarModulus*prime + soFar:=reduce(soFar,soFarModulus)::BP + dgp + soFarModulus:=prime + soFar:=dp::BP + testdeg:=dgp + if ^zeroChar and euclideanSize(prime)>1 then + result:=dp::BP + test(f,g,result) => return result + -- this is based on the assumption that the caller of this package, + -- in non-zero characteristic, will use primes of the form + -- x-alpha as long as possible, but, if these are exhausted, + -- will switch to a prime of degree larger than the answer + -- so the result can be used directly. + + merge(p:R,q:R):Union(R,"failed") == + p = q => p + p = 0 => q + q = 0 => p + "failed" + + modInverse(c:R,p:R):R == + (extendedEuclidean(c,p,1)::Record(coef1:R,coef2:R)).coef1 + + exactquo(u:BP,v:BP,p:R):Union(BP,"failed") == + invlcv:=modInverse(leadingCoefficient v,p) + r:=monicDivide(u,reduction(invlcv*v,p)) + reduction(r.remainder,p) ^=0 => "failed" + reduction(invlcv*r.quotient,p) + + + -- compute the height of a polynomial -- + height(f:BP):NNI == + degf:=degree f + "max"/[euclideanSize cc for cc in coefficients f] + + -- compute the bound + mbound(f:BP,g:BP):NNI == + hf:=height f + hg:=height g + 2*min(hf,hg) + +\section{package FOMOGCD ForModularGcd} +-- ForModularGcd(R,BP) : C == T +-- where +-- R : EuclideanDomain -- characteristic 0 +-- BP : UnivariatePolynomialCategory(R) +-- +-- C == with +-- nextMod : (R,NNI) -> R +-- +-- T == add +-- nextMod(val:R,bound:NNI) : R == +-- ival:Z:= val pretend Z +-- (nextPrime(ival)$IntegerPrimesPackage(Z))::R +-- +-- ForTwoGcd(F) : C == T +-- where +-- F : Join(Finite,Field) +-- SUP ==> SparseUnivariatePolynomial +-- R ==> SUP F +-- P ==> SUP R +-- UPCF2 ==> UnivariatePolynomialCategoryFunctions2 +-- +-- C == with +-- nextMod : (R,NNI) -> R +-- +-- T == add +-- nextMod(val:R,bound:NNI) : R == +-- ris:R:= nextItem(val) :: R +-- euclideanSize ris < 2 => ris +-- generateIrredPoly( +-- (bound+1)::PositiveInteger)$IrredPolyOverFiniteField(F) +-- +-- +-- ModularGcd(R,BP) == T +-- where +-- R : EuclideanDomain -- characteristic 0 +-- BP : UnivariatePolynomialCategory(R) +-- T ==> InnerModularGcd(R,BP,67108859::R,nextMod$ForModularGcd(R,BP)) +-- +-- TwoGcd(F) : C == T +-- where +-- F : Join(Finite,Field) +-- SUP ==> SparseUnivariatePolynomial +-- R ==> SUP F +-- P ==> SUP R +-- +-- T ==> InnerModularGcd(R,P,nextMod(monomial(1,1)$R)$ForTwoGcd(F), +-- nextMod$ForTwoGcd(F)) + +@ +<>= +"INMODGCD" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INMODGCD"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INMODGCD" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INNMFACT InnerMultFact} +\pagehead{InnerMultFact}{INNMFACT} +\pagepic{ps/v104innermultfact.ps}{INNMFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INNMFACT InnerMultFact +++ Author: P. Gianni +++ Date Created: 1983 +++ Date Last Updated: Sept. 1990 +++ Additional Comments: JHD Aug 1997 +++ Basic Functions: +++ Related Constructors: MultivariateFactorize, AlgebraicMultFact +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This is an inner package for factoring multivariate polynomials +++ over various coefficient domains in characteristic 0. +++ The univariate factor operation is passed as a parameter. +++ Multivariate hensel lifting is used to lift the univariate +++ factorization + +-- Both exposed functions call mFactor. This deals with issues such as +-- monomial factors, contents, square-freeness etc., then calls intfact. +-- This uses intChoose to find a "good" evaluation and factorise the +-- corresponding univariate, and then uses MultivariateLifting to find +-- the multivariate factors. + +InnerMultFact(OV,E,R,P) : C == T + where + R : Join(EuclideanDomain, CharacteristicZero) + -- with factor on R[x] + OV : OrderedSet + E : OrderedAbelianMonoidSup + P : PolynomialCategory(R,E,OV) + BP ==> SparseUnivariatePolynomial R + UFactor ==> (BP -> Factored BP) + Z ==> Integer + MParFact ==> Record(irr:P,pow:Z) + USP ==> SparseUnivariatePolynomial P + SUParFact ==> Record(irr:USP,pow:Z) + SUPFinalFact ==> Record(contp:R,factors:List SUParFact) + MFinalFact ==> Record(contp:R,factors:List MParFact) + + -- contp = content, + -- factors = List of irreducible factors with exponent + L ==> List + + C == with + factor : (P,UFactor) -> Factored P + ++ factor(p,ufact) factors the multivariate polynomial p + ++ by specializing variables and calling the univariate + ++ factorizer ufact. + factor : (USP,UFactor) -> Factored USP + ++ factor(p,ufact) factors the multivariate polynomial p + ++ by specializing variables and calling the univariate + ++ factorizer ufact. p is represented as a univariate + ++ polynomial with multivariate coefficients. + + T == add + + NNI ==> NonNegativeInteger + + LeadFact ==> Record(polfac:L P,correct:R,corrfact:L BP) + ContPrim ==> Record(cont:P,prim:P) + ParFact ==> Record(irr:BP,pow:Z) + FinalFact ==> Record(contp:R,factors:L ParFact) + NewOrd ==> Record(npol:USP,nvar:L OV,newdeg:L NNI) + pmod:R := (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R + + import GenExEuclid(R,BP) + import MultivariateLifting(E,OV,R,P) + import FactoringUtilities(E,OV,R,P) + import LeadingCoefDetermination(OV,E,R,P) + Valuf ==> Record(inval:L L R,unvfact:L BP,lu:R,complead:L R) + UPCF2 ==> UnivariatePolynomialCategoryFunctions2 + + ---- Local Functions ---- + mFactor : (P,UFactor) -> MFinalFact + supFactor : (USP,UFactor) -> SUPFinalFact + mfconst : (USP,L OV,L NNI,UFactor) -> L USP + mfpol : (USP,L OV,L NNI,UFactor) -> L USP + monicMfpol: (USP,L OV,L NNI,UFactor) -> L USP + varChoose : (P,L OV,L NNI) -> NewOrd + simplify : (P,L OV,L NNI,UFactor) -> MFinalFact + intChoose : (USP,L OV,R,L P,L L R,UFactor) -> Union(Valuf,"failed") + intfact : (USP,L OV,L NNI,MFinalFact,L L R,UFactor) -> L USP + pretest : (P,NNI,L OV,L R) -> FinalFact + checkzero : (USP,BP) -> Boolean + localNorm : L BP -> Z + + convertPUP(lfg:MFinalFact): SUPFinalFact == + [lfg.contp,[[lff.irr ::USP,lff.pow]$SUParFact + for lff in lfg.factors]]$SUPFinalFact + + -- intermediate routine if an SUP was passed in. + supFactor(um:USP,ufactor:UFactor) : SUPFinalFact == + ground?(um) => convertPUP(mFactor(ground um,ufactor)) + lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um] + empty? lvar => -- the polynomial is univariate + umv:= map(ground,um)$UPCF2(P,USP,R,BP) + lfact:=ufactor umv + [retract unit lfact,[[map(coerce,ff.factor)$UPCF2(R,BP,P,USP), + ff.exponent] for ff in factors lfact]]$SUPFinalFact + lcont:P + lf:L USP + flead : SUPFinalFact:=[0,empty()]$SUPFinalFact + factorlist:L SUParFact :=empty() + + mdeg :=minimumDegree um ---- is the Mindeg > 0? ---- + if mdeg>0 then + f1:USP:=monomial(1,mdeg) + um:=(um exquo f1)::USP + factorlist:=cons([monomial(1,1),mdeg],factorlist) + if degree um=0 then return + lfg:=convertPUP mFactor(ground um, ufactor) + [lfg.contp,append(factorlist,lfg.factors)] + uum:=unitNormal um + um :=uum.canonical + sqfacs := squareFree(um)$MultivariateSquareFree(E,OV,R,P) + lcont := ground(uum.unit * unit sqfacs) + ---- Factorize the content ---- + flead:=convertPUP mFactor(lcont,ufactor) + factorlist:=append(flead.factors,factorlist) + ---- Make the polynomial square-free ---- + sqqfact:=factors sqfacs + --- Factorize the primitive square-free terms --- + for fact in sqqfact repeat + ffactor:USP:=fact.factor + ffexp:=fact.exponent + zero? degree ffactor => + lfg:=mFactor(ground ffactor,ufactor) + lcont:=lfg.contp * lcont + factorlist := append(factorlist, + [[lff.irr ::USP,lff.pow * ffexp]$SUParFact + for lff in lfg.factors]) + coefs := coefficients ffactor + ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar] + lf := + ground?(leadingCoefficient ffactor) => + mfconst(ffactor,lvar,ldeg,ufactor) + mfpol(ffactor,lvar,ldeg,ufactor) + auxfl:=[[lfp,ffexp]$SUParFact for lfp in lf] + factorlist:=append(factorlist,auxfl) + lcfacs := */[leadingCoefficient leadingCoefficient(f.irr)**((f.pow)::NNI) + for f in factorlist] + [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R, + factorlist]$SUPFinalFact + + factor(um:USP,ufactor:UFactor):Factored USP == + flist := supFactor(um,ufactor) + (flist.contp):: P :: USP * + (*/[primeFactor(u.irr,u.pow) for u in flist.factors]) + + checkzero(u:USP,um:BP) : Boolean == + u=0 => um =0 + um = 0 => false + degree u = degree um => checkzero(reductum u, reductum um) + false + --- Choose the variable of less degree --- + varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd == + k:="min"/[d for d in ldeg] + k=degree(m,first lvar) => + [univariate(m,first lvar),lvar,ldeg]$NewOrd + i:=position(k,ldeg) + x:OV:=lvar.i + ldeg:=cons(k,delete(ldeg,i)) + lvar:=cons(x,delete(lvar,i)) + [univariate(m,x),lvar,ldeg]$NewOrd + + localNorm(lum: L BP): Z == + R is AlgebraicNumber => + "max"/[numberOfMonomials ff for ff in lum] + + "max"/[+/[euclideanSize cc for i in 0..degree ff| + (cc:= coefficient(ff,i))^=0] for ff in lum] + + --- Choose the integer to reduce to univariate case --- + intChoose(um:USP,lvar:L OV,clc:R,plist:L P,ltry:L L R, + ufactor:UFactor) : Union(Valuf,"failed") == + -- declarations + degum:NNI := degree um + nvar1:=#lvar + range:NNI:=5 + unifact:L BP + ctf1 : R := 1 + testp:Boolean := -- polynomial leading coefficient + empty? plist => false + true + leadcomp,leadcomp1 : L R + leadcomp:=leadcomp1:=empty() + nfatt:NNI := degum+1 + lffc:R:=1 + lffc1:=lffc + newunifact : L BP:=empty() + leadtest:=true --- the lc test with polCase has to be performed + int:L R:=empty() + + -- New sets of integers are chosen to reduce the multivariate problem to + -- a univariate one, until we find twice the + -- same (and minimal) number of "univariate" factors: + -- the set smaller in modulo is chosen. + -- Note that there is no guarantee that this is the truth: + -- merely the closest approximation we have found! + + while true repeat + testp and #ltry>10 => return "failed" + lval := [ ran(range) for i in 1..nvar1] + member?(lval,ltry) => range:=2*range + ltry := cons(lval,ltry) + leadcomp1:=[retract eval(pol,lvar,lval) for pol in plist] + testp and or/[unit? epl for epl in leadcomp1] => range:=2*range + newm:BP:=completeEval(um,lvar,lval) + degum ^= degree newm or minimumDegree newm ^=0 => range:=2*range + lffc1:=content newm + newm:=(newm exquo lffc1)::BP + testp and leadtest and ^ polCase(lffc1*clc,#plist,leadcomp1) + => range:=2*range + degree(gcd [newm,differentiate(newm)])^=0 => range:=2*range + luniv:=ufactor(newm) + lunivf:= factors luniv + lffc1:R:=retract(unit luniv)@R * lffc1 + nf:= #lunivf + + nf=0 or nf>nfatt => "next values" --- pretest failed --- + + --- the univariate polynomial is irreducible --- + if nf=1 then leave (unifact:=[newm]) + + -- the new integer give the same number of factors + nfatt = nf => + -- if this is the first univariate factorization with polCase=true + -- or if the last factorization has smaller norm and satisfies + -- polCase + if leadtest or + ((localNorm unifact > localNorm [ff.factor for ff in lunivf]) + and (^testp or polCase(lffc1*clc,#plist,leadcomp1))) then + unifact:=[uf.factor for uf in lunivf] + int:=lval + lffc:=lffc1 + if testp then leadcomp:=leadcomp1 + leave "foundit" + + -- the first univariate factorization, inizialize + nfatt > degum => + unifact:=[uf.factor for uf in lunivf] + lffc:=lffc1 + if testp then leadcomp:=leadcomp1 + int:=lval + leadtest := false + nfatt := nf + + nfatt>nf => -- for the previous values there were more factors + if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp) + else leadtest:= false + -- if polCase=true we can consider the univariate decomposition + if ^leadtest then + unifact:=[uf.factor for uf in lunivf] + lffc:=lffc1 + if testp then leadcomp:=leadcomp1 + int:=lval + nfatt := nf + [cons(int,ltry),unifact,lffc,leadcomp]$Valuf + + + ---- The polynomial has mindeg>0 ---- + + simplify(m:P,lvar:L OV,lmdeg:L NNI,ufactor:UFactor):MFinalFact == + factorlist:L MParFact:=[] + pol1:P:= 1$P + for x in lvar repeat + i := lmdeg.(position(x,lvar)) + i=0 => "next value" + pol1:=pol1*monomial(1$P,x,i) + factorlist:=cons([x::P,i]$MParFact,factorlist) + m := (m exquo pol1)::P + ground? m => [retract m,factorlist]$MFinalFact + flead:=mFactor(m,ufactor) + flead.factors:=append(factorlist,flead.factors) + flead + + -- This is the key internal function + -- We now know that the polynomial is square-free etc., + -- We use intChoose to find a set of integer values to reduce the + -- problem to univariate (and for efficiency, intChoose returns + -- the univariate factors). + -- In the case of a polynomial leading coefficient, we check that this + -- is consistent with leading coefficient determination (else try again) + -- We then lift the univariate factors to multivariate factors, and + -- return the result + intfact(um:USP,lvar: L OV,ldeg:L NNI,tleadpol:MFinalFact, + ltry:L L R,ufactor:UFactor) : L USP == + polcase:Boolean:=(not empty? tleadpol.factors) + vfchoo:Valuf:= + polcase => + leadpol:L P:=[ff.irr for ff in tleadpol.factors] + check:=intChoose(um,lvar,tleadpol.contp,leadpol,ltry,ufactor) + check case "failed" => return monicMfpol(um,lvar,ldeg,ufactor) + check::Valuf + intChoose(um,lvar,1,empty(),empty(),ufactor)::Valuf + unifact:List BP := vfchoo.unvfact + nfact:NNI := #unifact + nfact=1 => [um] + ltry:L L R:= vfchoo.inval + lval:L R:=first ltry + dd:= vfchoo.lu + leadval:L R:=empty() + lpol:List P:=empty() + if polcase then + leadval := vfchoo.complead + distf := distFact(vfchoo.lu,unifact,tleadpol,leadval,lvar,lval) + distf case "failed" => + return intfact(um,lvar,ldeg,tleadpol,ltry,ufactor) + dist := distf :: LeadFact + -- check the factorization of leading coefficient + lpol:= dist.polfac + dd := dist.correct + unifact:=dist.corrfact + if dd^=1 then +-- if polcase then lpol := [unitCanonical lp for lp in lpol] +-- dd:=unitCanonical(dd) + unifact := [dd * unif for unif in unifact] + umd := unitNormal(dd).unit * ((dd**(nfact-1)::NNI)::P)*um + else umd := um + (ffin:=lifting(umd,lvar,unifact,lval,lpol,ldeg,pmod)) + case "failed" => intfact(um,lvar,ldeg,tleadpol,ltry,ufactor) + factfin: L USP:=ffin :: L USP + if dd^=1 then + factfin:=[primitivePart ff for ff in factfin] + factfin + + ---- m square-free,primitive,lc constant ---- + mfconst(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP == + factfin:L USP:=empty() + empty? lvar => + lum:=factors ufactor(map(ground,um)$UPCF2(P,USP,R,BP)) + [map(coerce,uf.factor)$UPCF2(R,BP,P,USP) for uf in lum] + intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty(),ufactor) + + monicize(um:USP,c:P):USP == + n:=degree(um) + ans:USP := monomial(1,n) + n:=(n-1)::NonNegativeInteger + prod:P:=1 + while (um:=reductum(um)) ^= 0 repeat + i := degree um + lc := leadingCoefficient um + prod := prod * c ** (n-(n:=i))::NonNegativeInteger + ans := ans + monomial(prod*lc, i) + ans + + unmonicize(m:USP,c:P):USP == primitivePart m(monomial(c,1)) + + --- m is square-free,primitive,lc is a polynomial --- + monicMfpol(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP == + l := leadingCoefficient um + monpol := monicize(um,l) + nldeg := degree(monpol,lvar) + map(unmonicize(#1,l), + mfconst(monpol,lvar,nldeg,ufactor)) + + mfpol(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP == + R has Field => + monicMfpol(um,lvar,ldeg,ufactor) + tleadpol:=mFactor(leadingCoefficient um,ufactor) + intfact(um,lvar,ldeg,tleadpol,[],ufactor) + + mFactor(m:P,ufactor:UFactor) : MFinalFact == + ground?(m) => [retract(m),empty()]$MFinalFact + lvar:L OV:= variables m + lcont:P + lf:L USP + flead : MFinalFact:=[0,empty()]$MFinalFact + factorlist:L MParFact :=empty() + + lmdeg :=minimumDegree(m,lvar) ---- is the Mindeg > 0? ---- + or/[n>0 for n in lmdeg] => simplify(m,lvar,lmdeg,ufactor) + + sqfacs := squareFree m + lcont := unit sqfacs + + ---- Factorize the content ---- + if ground? lcont then flead.contp:=retract lcont + else flead:=mFactor(lcont,ufactor) + factorlist:=flead.factors + + + + ---- Make the polynomial square-free ---- + sqqfact:=factors sqfacs + + --- Factorize the primitive square-free terms --- + for fact in sqqfact repeat + ffactor:P:=fact.factor + ffexp := fact.exponent + lvar := variables ffactor + x:OV :=lvar.first + ldeg:=degree(ffactor,lvar) + --- Is the polynomial linear in one of the variables ? --- + member?(1,ldeg) => + x:OV:=lvar.position(1,ldeg) + lcont:= gcd coefficients(univariate(ffactor,x)) + ffactor:=(ffactor exquo lcont)::P + factorlist:=cons([ffactor,ffexp]$MParFact,factorlist) + for lcterm in mFactor(lcont,ufactor).factors repeat + factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist) + + varch:=varChoose(ffactor,lvar,ldeg) + um:=varch.npol + + x:=lvar.first + ldeg:=ldeg.rest + lvar := lvar.rest + if varch.nvar.first ^= x then + lvar:= varch.nvar + x := lvar.first + lvar := lvar.rest + pc:= gcd coefficients um + if pc^=1 then + um:=(um exquo pc)::USP + ffactor:=multivariate(um,x) + for lcterm in mFactor(pc,ufactor).factors repeat + factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist) + ldeg:=degree(ffactor,lvar) + um := unitCanonical um + if ground?(leadingCoefficient um) then + lf:= mfconst(um,lvar,ldeg,ufactor) + else lf:=mfpol(um,lvar,ldeg,ufactor) + auxfl:=[[unitCanonical multivariate(lfp,x),ffexp]$MParFact for lfp in lf] + factorlist:=append(factorlist,auxfl) + lcfacs := */[leadingCoefficient(f.irr)**((f.pow)::NNI) for f in factorlist] + [(leadingCoefficient(m) exquo lcfacs):: R,factorlist]$MFinalFact + + factor(m:P,ufactor:UFactor):Factored P == + flist := mFactor(m,ufactor) + (flist.contp):: P * + (*/[primeFactor(u.irr,u.pow) for u in flist.factors]) + +@ +<>= +"INNMFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INNMFACT"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INNMFACT" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package INBFF InnerNormalBasisFieldFunctions} \pagehead{InnerNormalBasisFieldFunctions}{INBFF} \pagepic{ps/v104innernormalbasisfieldfunctions.ps}{INBFF}{1.00} @@ -33100,6 +34207,49 @@ InnerTrigonometricManipulations(R,F,FG): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INFORM1 InputFormFunctions1} +\pagehead{InputFormFunctions1}{INFORM1} +\pagepic{ps/v104inputformfunctions1.ps}{INFORM1}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INFORM1 InputFormFunctions1 +--)boot $noSubsumption := false + +++ Tools for manipulating input forms +++ Author: Manuel Bronstein +++ Date Created: ??? +++ Date Last Updated: 19 April 1991 +++ Description: Tools for manipulating input forms. + +InputFormFunctions1(R:Type):with + packageCall: Symbol -> InputForm + ++ packageCall(f) returns the input form corresponding to f$R. + interpret : InputForm -> R + ++ interpret(f) passes f to the interpreter, and transforms + ++ the result into an object of type R. + == add + Rname := devaluate(R)$Lisp :: InputForm + + packageCall name == + convert([convert("$elt"::Symbol), Rname, + convert name]$List(InputForm))@InputForm + + interpret form == + retract(interpret(convert([convert("@"::Symbol), form, + Rname]$List(InputForm))@InputForm)$InputForm)$AnyFunctions1(R) + +@ +<>= +"INFORM1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INFORM1"] +"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] +"INFORM1" -> "ALIST" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package COMBINAT IntegerCombinatoricFunctions} \pagehead{IntegerCombinatoricFunctions}{COMBINAT} \pagepic{ps/v104integercombinatoricfunctions.ps}{COMBINAT}{1.00} @@ -37176,6 +38326,3950 @@ ListToMap(A:SetCategory, B:Type): Exports == Implementation where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter M} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MKBCFUNC MakeBinaryCompiledFunction} +\pagehead{MakeBinaryCompiledFunction}{MKBCFUNC} +\pagepic{ps/v104makebinarycompiledfunction.ps}{MKBCFUNC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MKBCFUNC MakeBinaryCompiledFunction +++ Tools for making compiled functions from top-level expressions +++ Author: Manuel Bronstein +++ Date Created: 1 Dec 1988 +++ Date Last Updated: 5 Mar 1990 +++ Description: transforms top-level objects into compiled functions. +MakeBinaryCompiledFunction(S, D1, D2, I):Exports == Implementation where + S: ConvertibleTo InputForm + D1, D2, I: Type + + SY ==> Symbol + DI ==> devaluate((D1, D2) -> I)$Lisp + + Exports ==> with + binaryFunction : SY -> ((D1, D2) -> I) + ++ binaryFunction(s) is a local function + compiledFunction: (S, SY, SY) -> ((D1, D2) -> I) + ++ compiledFunction(expr,x,y) returns a function \spad{f: (D1, D2) -> I} + ++ defined by \spad{f(x, y) == expr}. + ++ Function f is compiled and directly + ++ applicable to objects of type \spad{(D1, D2)} + + Implementation ==> add + import MakeFunction(S) + + func: (SY, D1, D2) -> I + + func(name, x, y) == FUNCALL(name, x, y, NIL$Lisp)$Lisp + binaryFunction name == func(name, #1, #2) + + compiledFunction(e, x, y) == + t := [devaluate(D1)$Lisp, devaluate(D2)$Lisp]$List(InputForm) + binaryFunction compile(function(e, declare DI, x, y), t) + +@ +<>= +"MKBCFUNC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MKBCFUNC"] +"KONVERT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KONVERT"] +"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"] +"MKBCFUNC" -> "KONVERT" +"MKBCFUNC" -> "TYPE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MKFLCFN MakeFloatCompiledFunction} +\pagehead{MakeFloatCompiledFunction}{MKFLCFN} +\pagepic{ps/v104makefloatcompiledfunction.ps}{MKFLCFN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MKFLCFN MakeFloatCompiledFunction +++ Tools for making compiled functions from top-level expressions +++ Author: Manuel Bronstein +++ Date Created: 2 Mar 1990 +++ Date Last Updated: 2 Dec 1996 (MCD) +++ Description: +++ MakeFloatCompiledFunction transforms top-level objects into +++ compiled Lisp functions whose arguments are Lisp floats. +++ This by-passes the \Language{} compiler and interpreter, +++ thereby gaining several orders of magnitude. +MakeFloatCompiledFunction(S): Exports == Implementation where + S: ConvertibleTo InputForm + + INF ==> InputForm + SF ==> DoubleFloat + DI1 ==> devaluate(SF -> SF)$Lisp + DI2 ==> devaluate((SF, SF) -> SF)$Lisp + + Exports ==> with + makeFloatFunction: (S, Symbol) -> (SF -> SF) + ++ makeFloatFunction(expr, x) returns a Lisp function + ++ \spad{f: \axiomType{DoubleFloat} -> \axiomType{DoubleFloat}} + ++ defined by \spad{f(x) == expr}. + ++ Function f is compiled and directly + ++ applicable to objects of type \axiomType{DoubleFloat}. + makeFloatFunction: (S, Symbol, Symbol) -> ((SF, SF) -> SF) + ++ makeFloatFunction(expr, x, y) returns a Lisp function + ++ \spad{f: (\axiomType{DoubleFloat}, + ++ \axiomType{DoubleFloat}) -> \axiomType{DoubleFloat}} + ++ defined by \spad{f(x, y) == expr}. + ++ Function f is compiled and directly + ++ applicable to objects of type \spad{(\axiomType{DoubleFloat}, + ++ \axiomType{DoubleFloat})}. + + Implementation ==> add + import MakeUnaryCompiledFunction(S, SF, SF) + import MakeBinaryCompiledFunction(S, SF, SF, SF) + + streq? : (INF, String) -> Boolean + streqlist?: (INF, List String) -> Boolean + gencode : (String, List INF) -> INF + mkLisp : INF -> Union(INF, "failed") + mkLispList: List INF -> Union(List INF, "failed") + mkDefun : (INF, List INF) -> INF + mkLispCall: INF -> INF + mkPretend : INF -> INF + mkCTOR : INF -> INF + + lsf := convert([convert("DoubleFloat"::Symbol)@INF]$List(INF))@INF + + streq?(s, st) == s = convert(st::Symbol)@INF + gencode(s, l) == convert(concat(convert(s::Symbol)@INF, l))@INF + streqlist?(s, l) == member?(string symbol s, l) + + mkPretend form == + convert([convert("pretend"::Symbol), form, lsf]$List(INF))@INF + + mkCTOR form == + convert([convert("C-TO-R"::Symbol), form]$List(INF))@INF + + + mkLispCall name == + convert([convert("$elt"::Symbol), + convert("Lisp"::Symbol), name]$List(INF))@INF + + mkDefun(s, lv) == + name := convert(new()$Symbol)@INF + fun := convert([convert("DEFUN"::Symbol), name, convert lv, + gencode("DECLARE",[gencode("FLOAT",lv)]),mkCTOR s]$List(INF))@INF + EVAL(fun)$Lisp + if _$compileDontDefineFunctions$Lisp then COMPILE(name)$Lisp + name + + makeFloatFunction(f, x, y) == + (u := mkLisp(convert(f)@INF)) case "failed" => + compiledFunction(f, x, y) + name := mkDefun(u::INF, [ix := convert x, iy := convert y]) + t := [lsf, lsf]$List(INF) + spadname := declare DI2 + spadform:=mkPretend convert([mkLispCall name,ix,iy]$List(INF))@INF + interpret function(spadform, [x, y], spadname) + binaryFunction compile(spadname, t) + + makeFloatFunction(f, var) == + (u := mkLisp(convert(f)@INF)) case "failed" => + compiledFunction(f, var) + name := mkDefun(u::INF, [ivar := convert var]) + t := [lsf]$List(INF) + spadname := declare DI1 + spadform:= mkPretend convert([mkLispCall name,ivar]$List(INF))@INF + interpret function(spadform, [var], spadname) + unaryFunction compile(spadname, t) + + mkLispList l == + ans := nil()$List(INF) + for s in l repeat + (u := mkLisp s) case "failed" => return "failed" + ans := concat(u::INF, ans) + reverse_! ans + + + mkLisp s == + atom? s => s + op := first(l := destruct s) + (u := mkLispList rest l) case "failed" => "failed" + ll := u::List(INF) + streqlist?(op, ["+","*","/","-"]) => convert(concat(op, ll))@INF + streq?(op, "**") => gencode("EXPT", ll) + streqlist?(op, ["exp","sin","cos","tan","atan", + "log", "sinh","cosh","tanh","asinh","acosh","atanh","sqrt"]) => + gencode(upperCase string symbol op, ll) + streq?(op, "nthRoot") => + second ll = convert(2::Integer)@INF =>gencode("SQRT",[first ll]) + gencode("EXPT", concat(first ll, [1$INF / second ll])) + streq?(op, "float") => + a := ll.1 + e := ll.2 + b := ll.3 + _*(a, EXPT(b, e)$Lisp)$Lisp pretend INF + "failed" + +@ +<>= +"MKFLCFN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MKFLCFN"] +"KONVERT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KONVERT"] +"MKFUNC" -> "KONVERT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MKFUNC MakeFunction} +<>= +-- mkfunc.spad.pamphlet MakeFunction.input +)spool MakeFunction.output +)set message test on +)set message auto off +)clear all +--S 1 of 9 +expr := (x - exp x + 1)^2 * (sin(x^2) * x + 1)^3 +--R +--R +--R (1) +--R 3 x 2 4 3 x 5 4 3 2 3 +--R (x (%e ) + (- 2x - 2x )%e + x + 2x + x )sin(x ) +--R + +--R 2 x 2 3 2 x 4 3 2 2 2 +--R (3x (%e ) + (- 6x - 6x )%e + 3x + 6x + 3x )sin(x ) +--R + +--R x 2 2 x 3 2 2 x 2 +--R (3x (%e ) + (- 6x - 6x)%e + 3x + 6x + 3x)sin(x ) + (%e ) +--R + +--R x 2 +--R (- 2x - 2)%e + x + 2x + 1 +--R Type: Expression Integer +--E 1 + +--S 2 of 9 +function(expr, f, x) +--R +--R +--R (2) f +--R Type: Symbol +--E 2 + +--S 3 of 9 +tbl := [f(0.1 * i - 1) for i in 0..20] +--R +--R Compiling function f with type Float -> Float +--R +--R (3) +--R [0.0005391844 0362701574, 0.0039657551 1844206653, +--R 0.0088545187 4833983689 2, 0.0116524883 0907069695, +--R 0.0108618220 9245751364 5, 0.0076366823 2120869965 06, +--R 0.0040584985 7597822062 55, 0.0015349542 8910500836 48, +--R 0.0003424903 1549879905 716, 0.0000233304 8276098819 6001, 0.0, +--R 0.0000268186 8782862599 4229, 0.0004691571 3720051642 621, +--R 0.0026924576 5968519586 08, 0.0101486881 7369135148 8, +--R 0.0313833725 8543810564 3, 0.0876991144 5154615297 9, +--R 0.2313019789 3439968362, 0.5843743955 958098772, 1.4114930171 992819197, +--R 3.2216948276 75164252] +--R Type: List Float +--E 3 + +--S 4 of 9 +e := (x - y + 1)^2 * (x^2 * y + 1)^2 +--R +--R +--R (4) +--R 4 4 5 4 2 3 6 5 4 3 2 2 +--R x y + (- 2x - 2x + 2x )y + (x + 2x + x - 4x - 4x + 1)y +--R + +--R 4 3 2 2 +--R (2x + 4x + 2x - 2x - 2)y + x + 2x + 1 +--R Type: Polynomial Integer +--E 4 + +--S 5 of 9 +function(e, g, [x, y]) +--R +--R +--R (5) g +--R Type: Symbol +--E 5 + +--S 6 of 9 +function(e, h, x, y) +--R +--R +--R (6) h +--R Type: Symbol +--E 6 + +--S 7 of 9 +m1 := squareMatrix [ [1, 2], [3, 4] ] +--R +--R +--R +1 2+ +--R (7) | | +--R +3 4+ +--R Type: SquareMatrix(2,Integer) +--E 7 + +--S 8 of 9 +m2 := squareMatrix [ [1, 0], [-1, 1] ] +--R +--R +--R + 1 0+ +--R (8) | | +--R +- 1 1+ +--R Type: SquareMatrix(2,Integer) +--E 8 + +--S 9 of 9 +h(m1, m2) +--R +--R Compiling function h with type (SquareMatrix(2,Integer),SquareMatrix +--R (2,Integer)) -> SquareMatrix(2,Integer) +--R +--R +- 7836 8960 + +--R (9) | | +--R +- 17132 19588+ +--R Type: SquareMatrix(2,Integer) +--E 9 +)spool +)lisp (bye) +@ +<>= +==================================================================== +MakeFunction examples +==================================================================== + +It is sometimes useful to be able to define a function given by +the result of a calculation. + +Suppose that you have obtained the following expression after several +computations and that you now want to tabulate the numerical values of +f for x between -1 and +1 with increment 0.1. + + expr := (x - exp x + 1)^2 * (sin(x^2) * x + 1)^3 + 3 x 2 4 3 x 5 4 3 2 3 + (x (%e ) + (- 2x - 2x )%e + x + 2x + x )sin(x ) + + + 2 x 2 3 2 x 4 3 2 2 2 + (3x (%e ) + (- 6x - 6x )%e + 3x + 6x + 3x )sin(x ) + + + x 2 2 x 3 2 2 x 2 + (3x (%e ) + (- 6x - 6x)%e + 3x + 6x + 3x)sin(x ) + (%e ) + + + x 2 + (- 2x - 2)%e + x + 2x + 1 + Type: Expression Integer + +You could, of course, use the function eval within a loop and evaluate +expr twenty-one times, but this would be quite slow. A better way is +to create a numerical function f such that f(x) is defined by the +expression expr above, but without retyping expr! The package +MakeFunction provides the operation function which does exactly this. + +Issue this to create the function f(x) given by expr. + + function(expr, f, x) + f + Type: Symbol + +To tabulate expr, we can now quickly evaluate f 21 times. + + tbl := [f(0.1 * i - 1) for i in 0..20]; + Type: List Float + +Use the list [x1,...,xn] as the third argument to function to create a +multivariate function f(x1,...,xn). + + e := (x - y + 1)^2 * (x^2 * y + 1)^2 + 4 4 5 4 2 3 6 5 4 3 2 2 + x y + (- 2x - 2x + 2x )y + (x + 2x + x - 4x - 4x + 1)y + + + 4 3 2 2 + (2x + 4x + 2x - 2x - 2)y + x + 2x + 1 + Type: Polynomial Integer + + function(e, g, [x, y]) + g + Type: Symbol + +In the case of just two variables, they can be given as arguments +without making them into a list. + + function(e, h, x, y) + h + Type: Symbol + +Note that the functions created by function are not limited to +floating point numbers, but can be applied to any type for which they +are defined. + + m1 := squareMatrix [ [1, 2], [3, 4] ] + +1 2+ + | | + +3 4+ + Type: SquareMatrix(2,Integer) + + m2 := squareMatrix [ [1, 0], [-1, 1] ] + + 1 0+ + | | + +- 1 1+ + Type: SquareMatrix(2,Integer) + + h(m1, m2) + +- 7836 8960 + + | | + +- 17132 19588+ + Type: SquareMatrix(2,Integer) + +See Also: +o )show MakeFunction + +@ +\pagehead{MakeFunction}{MKFUNC} +\pagepic{ps/v104makefunction.ps}{MKFUNC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MKFUNC MakeFunction +++ Tools for making interpreter functions from top-level expressions +++ Author: Manuel Bronstein +++ Date Created: 22 Nov 1988 +++ Date Last Updated: 8 Jan 1990 +++ Description: transforms top-level objects into interpreter functions. +MakeFunction(S:ConvertibleTo InputForm): Exports == Implementation where + SY ==> Symbol + + Exports ==> with + function: (S, SY ) -> SY + ++ function(e, foo) creates a function \spad{foo() == e}. + function: (S, SY, SY) -> SY + ++ function(e, foo, x) creates a function \spad{foo(x) == e}. + function: (S, SY, SY, SY) -> SY + ++ function(e, foo, x, y) creates a function \spad{foo(x, y) = e}. + function: (S, SY, List SY) -> SY + ++ \spad{function(e, foo, [x1,...,xn])} creates a function + ++ \spad{foo(x1,...,xn) == e}. + + Implementation ==> add + function(s, name) == function(s, name, nil()) + function(s:S, name:SY, x:SY) == function(s, name, [x]) + function(s, name, x, y) == function(s, name, [x, y]) + + function(s:S, name:SY, args:List SY) == + interpret function(convert s, args, name)$InputForm + name + +@ +<>= +"MKFUNC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MKFUNC"] +"KONVERT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KONVERT"] +"MKFUNC" -> "KONVERT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MKRECORD MakeRecord} +\pagehead{MakeRecord}{MKRECORD} +\pagepic{ps/v104makerecord.ps}{MKRECORD}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MKRECORD MakeRecord +++ Description: +++ MakeRecord is used internally by the interpreter to create record +++ types which are used for doing parallel iterations on streams. +MakeRecord(S: Type, T: Type): public == private where + public == with + makeRecord: (S,T) -> Record(part1: S, part2: T) + ++ makeRecord(a,b) creates a record object with type + ++ Record(part1:S, part2:R), + ++ where part1 is \spad{a} and part2 is \spad{b}. + private == add + makeRecord(s: S, t: T) == + [s,t]$Record(part1: S, part2: T) + +@ +<>= +"MKRECORD" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MKRECORD"] +"KONVERT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KONVERT"] +"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"] +"MKUCFUNC" -> "KONVERT" +"MKUCFUNC" -> "TYPE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MKUCFUNC MakeUnaryCompiledFunction} +\pagehead{MakeUnaryCompiledFunction}{MKUCFUNC} +\pagepic{ps/v104makeunarycompiledfunction.ps}{MKUCFUNC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MKUCFUNC MakeUnaryCompiledFunction +++ Tools for making compiled functions from top-level expressions +++ Author: Manuel Bronstein +++ Date Created: 1 Dec 1988 +++ Date Last Updated: 5 Mar 1990 +++ Description: transforms top-level objects into compiled functions. +MakeUnaryCompiledFunction(S, D, I): Exports == Implementation where + S: ConvertibleTo InputForm + D, I: Type + + SY ==> Symbol + DI ==> devaluate(D -> I)$Lisp + + Exports ==> with + unaryFunction : SY -> (D -> I) + ++ unaryFunction(a) is a local function + compiledFunction: (S, SY) -> (D -> I) + ++ compiledFunction(expr, x) returns a function \spad{f: D -> I} + ++ defined by \spad{f(x) == expr}. + ++ Function f is compiled and directly + ++ applicable to objects of type D. + + Implementation ==> add + import MakeFunction(S) + + func: (SY, D) -> I + + func(name, x) == FUNCALL(name, x, NIL$Lisp)$Lisp + unaryFunction name == func(name, #1) + + compiledFunction(e:S, x:SY) == + t := [convert([devaluate(D)$Lisp]$List(InputForm)) + ]$List(InputForm) + unaryFunction compile(function(e, declare DI, x), t) + +@ +<>= +"MKUCFUNC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MKUCFUNC"] +"KONVERT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KONVERT"] +"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"] +"MKUCFUNC" -> "KONVERT" +"MKUCFUNC" -> "TYPE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPHACK1 MappingPackageInternalHacks1} +\pagehead{MappingPackageInternalHacks1}{MAPHACK1} +\pagepic{ps/v104mappingpackageinternalhacks1.ps}{MAPHACK1}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPHACK1 MappingPackageInternalHacks1 +++ Author: S.M.Watt and W.H.Burge +++ Date Created:Jan 87 +++ Date Last Updated:Feb 92 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: various Currying operations. +MappingPackageInternalHacks1(A: SetCategory): MPcat == MPdef where + NNI ==> NonNegativeInteger + + MPcat == with + iter: ((A -> A), NNI, A) -> A + ++\spad{iter(f,n,x)} applies \spad{f n} times to \spad{x}. + recur: ((NNI, A)->A, NNI, A) -> A + ++\spad{recur(n,g,x)} is \spad{g(n,g(n-1,..g(1,x)..))}. + + MPdef == add + iter(g,n,x) == + for i in 1..n repeat x := g x -- g(g(..(x)..)) + x + recur(g,n,x) == + for i in 1..n repeat x := g(i,x) -- g(n,g(n-1,..g(1,x)..)) + x + +@ +<>= +"MAPHACK1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPHACK1"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"MAPHACK1" -> "BASTYPE" +"MAPHACK1" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPHACK2 MappingPackageInternalHacks2} +\pagehead{MappingPackageInternalHacks2}{MAPHACK2} +\pagepic{ps/v104mappingpackageinternalhacks2.ps}{MAPHACK2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPHACK2 MappingPackageInternalHacks2 +++ Description: various Currying operations. +MappingPackageInternalHacks2(A: SetCategory, C: SetCategory):_ + MPcat == MPdef where + NNI ==> NonNegativeInteger + + MPcat == with + arg1: (A, C) -> A + ++\spad{arg1(a,c)} selects its first argument. + arg2: (A, C) -> C + ++\spad{arg2(a,c)} selects its second argument. + + MPdef == add + arg1(a, c) == a + arg2(a, c) == c + +@ +<>= +"MAPHACK2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPHACK2"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"MAPHACK2" -> "BASTYPE" +"MAPHACK2" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPHACK3 MappingPackageInternalHacks3} +\pagehead{MappingPackageInternalHacks3}{MAPHACK3} +\pagepic{ps/v104mappingpackageinternalhacks3.ps}{MAPHACK3}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPHACK3 MappingPackageInternalHacks3 +++ Description: various Currying operations. +MappingPackageInternalHacks3(A: SetCategory, B: SetCategory, C: SetCategory):_ + MPcat == MPdef where + NNI ==> NonNegativeInteger + + MPcat == with + comp: (B->C, A->B, A) -> C + ++\spad{comp(f,g,x)} is \spad{f(g x)}. + + MPdef == add + comp(g,h,x) == g h x + +@ +<>= +"MAPHACK3" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPHACK3"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"MAPHACK3" -> "BASTYPE" +"MAPHACK3" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPPKG1 MappingPackage1} +<>= +-- mappkg.spad.pamphlet MappingPackage1.input +)spool MappingPackage1.output +)set message test on +)set message auto off +)clear all + +--S 1 of 26 +power(q: FRAC INT, n: INT): FRAC INT == q**n +--R +--R Function declaration power : (Fraction Integer,Integer) -> Fraction +--R Integer has been added to workspace. +--R Type: Void +--E 1 + +--S 2 of 26 +power(2,3) +--R +--R Compiling function power with type (Fraction Integer,Integer) -> +--R Fraction Integer +--R +--R (2) 8 +--R Type: Fraction Integer +--E 2 + +--S 3 of 26 +rewop := twist power +--R +--R +--I (3) theMap(MAPPKG3;twist;MM;5!0) +--R Type: ((Integer,Fraction Integer) -> Fraction Integer) +--E 3 + +--S 4 of 26 +rewop(3, 2) +--R +--R +--R (4) 8 +--R Type: Fraction Integer +--E 4 + +--S 5 of 26 +square: FRAC INT -> FRAC INT +--R +--R Type: Void +--E 5 + +--S 6 of 26 +square:= curryRight(power, 2) +--R +--R +--I (6) theMap(MAPPKG3;curryRight;MBM;1!0,0) +--R Type: (Fraction Integer -> Fraction Integer) +--E 6 + +--S 7 of 26 +square 4 +--R +--R +--R (7) 16 +--R Type: Fraction Integer +--E 7 + +--S 8 of 26 +squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) +--R +--R +--I (8) theMap(MAPPKG3;constantRight;MM;3!0) +--R Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) +--E 8 + +--S 9 of 26 +squirrel(1/2, 1/3) +--R +--R +--R 1 +--R (9) - +--R 4 +--R Type: Fraction Integer +--E 9 + +--S 10 of 26 +sixteen := curry(square, 4/1) +--R +--R +--I (10) theMap(MAPPKG2;curry;MAM;2!0,0) +--R Type: (() -> Fraction Integer) +--E 10 + +--S 11 of 26 +sixteen() +--R +--R +--R (11) 16 +--R Type: Fraction Integer +--E 11 + +--S 12 of 26 +square2:=square*square +--R +--R +--I (12) theMap(MAPPKG3;*;MMM;6!0,0) +--R Type: (Fraction Integer -> Fraction Integer) +--E 12 + +--S 13 of 26 +square2 3 +--R +--R +--R (13) 81 +--R Type: Fraction Integer +--E 13 + +--S 14 of 26 +sc(x: FRAC INT): FRAC INT == x + 1 +--R +--R Function declaration sc : Fraction Integer -> Fraction Integer has +--R been added to workspace. +--R Type: Void +--E 14 + +--S 15 of 26 +incfns := [sc**i for i in 0..10] +--R +--R Compiling function sc with type Fraction Integer -> Fraction Integer +--R +--R +--R (15) +--I [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0)] +--R Type: List (Fraction Integer -> Fraction Integer) +--E 15 + +--S 16 of 26 +[f 4 for f in incfns] +--R +--R +--R (16) [4,5,6,7,8,9,10,11,12,13,14] +--R Type: List Fraction Integer +--E 16 + +--S 17 of 26 +times(n:NNI, i:INT):INT == n*i +--R +--R Function declaration times : (NonNegativeInteger,Integer) -> Integer +--R has been added to workspace. +--R Type: Void +--E 17 + +--S 18 of 26 +r := recur(times) +--R +--R Compiling function times with type (NonNegativeInteger,Integer) -> +--R Integer +--R +--I (18) theMap(MAPPKG1;recur;2M;7!0,0) +--R Type: ((NonNegativeInteger,Integer) -> Integer) +--E 18 + +--S 19 of 26 +fact := curryRight(r, 1) +--R +--R +--I (19) theMap(MAPPKG3;curryRight;MBM;1!0,0) +--R Type: (NonNegativeInteger -> Integer) +--E 19 + +--S 20 of 26 +fact 4 +--R +--R +--R (20) 24 +--R Type: PositiveInteger +--E 20 + +--S 21 of 26 +mto2ton(m, n) == + raiser := square^n + raiser m +--R +--R Type: Void +--E 21 + +--S 22 of 26 +mto2ton(3, 3) +--R +--R Compiling function mto2ton with type (PositiveInteger, +--R PositiveInteger) -> Fraction Integer +--R +--R (22) 6561 +--R Type: Fraction Integer +--E 22 + +--S 23 of 26 +shiftfib(r: List INT) : INT == + t := r.1 + r.1 := r.2 + r.2 := r.2 + t + t +--R +--R Function declaration shiftfib : List Integer -> Integer has been +--R added to workspace. +--R Type: Void +--E 23 + +--S 24 of 26 +fibinit: List INT := [0, 1] +--R +--R +--R (24) [0,1] +--R Type: List Integer +--E 24 + +--S 25 of 26 +fibs := curry(shiftfib, fibinit) +--R +--R Compiling function shiftfib with type List Integer -> Integer +--R +--I (25) theMap(MAPPKG2;curry;MAM;2!0,0) +--R Type: (() -> Integer) +--E 25 + +--S 26 of 26 +[fibs() for i in 0..30] +--R +--R +--R (26) +--R [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, +--R 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, +--R 317811, 514229, 832040] +--R Type: List Integer +--E 26 + +)spool +)lisp (bye) + +@ +<>= +==================================================================== +MappingPackage examples +==================================================================== + +Function are objects of type Mapping. In this section we demonstrate +some library operations from the packages MappingPackage1, MappingPackage2, +and MappingPackage3 that manipulate and create functions. Some terminology: +a nullary function takes no arguments, a unary function takes one argument, +and a binary function takes two arguments. + +We begin by creating an example function that raises a rational number +to an integer exponent. + + power(q: FRAC INT, n: INT): FRAC INT == q**n + Type: Void + + power(2,3) + 8 + Type: Fraction Integer + +The twist operation transposes the arguments of a binary function. +Here rewop(a, b) is power(b, a). + + rewop := twist power + theMap(MAPPKG3;twist;MM;5!0) + Type: ((Integer,Fraction Integer) -> Fraction Integer) + +This is 2^3. + + rewop(3, 2) + 8 + Type: Fraction Integer + +Now we define square in terms of power. + + square: FRAC INT -> FRAC INT + Type: Void +The curryRight operation creates a unary function from a binary one by +providing a constant argument on the right. + + square:= curryRight(power, 2) + theMap(MAPPKG3;curryRight;MBM;1!0,0) + Type: (Fraction Integer -> Fraction Integer) + +Likewise, the curryLeft operation provides a constant argument on the +left. + + square 4 + 16 + Type: Fraction Integer + +The constantRight operation creates (in a trivial way) a binary +function from a unary one: constantRight(f) is the function g such +that g(a,b)= f(a). + + squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) + theMap(MAPPKG3;constantRight;MM;3!0) + Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) + +Likewise, constantLeft(f) is the function g such that g(a,b)= f(b). + + squirrel(1/2, 1/3) + 1 + - + 4 + Type: Fraction Integer + +The curry operation makes a unary function nullary. + + sixteen := curry(square, 4/1) + theMap(MAPPKG2;curry;MAM;2!0,0) + Type: (() -> Fraction Integer) + + sixteen() + 16 + Type: Fraction Integer + +The * operation constructs composed functions. + + square2:=square*square + theMap(MAPPKG3;*;MMM;6!0,0) + Type: (Fraction Integer -> Fraction Integer) + + square2 3 + 81 + Type: Fraction Integer + +Use the ** operation to create functions that are n-fold iterations of +other functions. + + sc(x: FRAC INT): FRAC INT == x + 1 + Type: Void + +This is a list of Mapping objects. + + incfns := [sc**i for i in 0..10] + [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0)] + Type: List (Fraction Integer -> Fraction Integer) + +This is a list of applications of those functions. + + [f 4 for f in incfns] + [4,5,6,7,8,9,10,11,12,13,14] + Type: List Fraction Integer + +Use the recur operation for recursion: + + g := recur f means g(n,x) == f(n,f(n-1,...f(1,x))). + + times(n:NNI, i:INT):INT == n*i + Type: Void + + r := recur(times) + theMap(MAPPKG1;recur;2M;7!0,0) + Type: ((NonNegativeInteger,Integer) -> Integer) + +This is a factorial function. + + fact := curryRight(r, 1) + theMap(MAPPKG3;curryRight;MBM;1!0,0) + Type: (NonNegativeInteger -> Integer) + + fact 4 + 24 + Type: PositiveInteger + +Constructed functions can be used within other functions. + + mto2ton(m, n) == + raiser := square^n + raiser m + Type: Void + +This is 3^(2^3). + + mto2ton(3, 3) + 6561 + Type: Fraction Integer + +Here shiftfib is a unary function that modifies its argument. + + shiftfib(r: List INT) : INT == + t := r.1 + r.1 := r.2 + r.2 := r.2 + t + t + Type: Void + +By currying over the argument we get a function with private state. + + fibinit: List INT := [0, 1] + [0,1] + Type: List Integer + + fibs := curry(shiftfib, fibinit) + theMap(MAPPKG2;curry;MAM;2!0,0) + Type: (() -> Integer) + + [fibs() for i in 0..30] + [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, + 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, + 317811, 514229, 832040] + Type: List Integer + +See Also: +o )show MappingPackage1 +o )help MappingPackage2 +o )help MappingPackage3 +o )help MappingPackage4 + +@ +\pagehead{MappingPackage1}{MAPPKG1} +\pagepic{ps/v104mappingpackage1.ps}{MAPPKG1}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPPKG1 MappingPackage1 +++ Author: S.M.Watt and W.H.Burge +++ Date Created:Jan 87 +++ Date Last Updated:Feb 92 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: various Currying operations. +MappingPackage1(A:SetCategory): MPcat == MPdef where + NNI ==> NonNegativeInteger + + MPcat == with + nullary: A -> (()->A) + ++\spad{nullary A} changes its argument into a + ++ nullary function. + coerce: A -> (()->A) + ++\spad{coerce A} changes its argument into a + ++ nullary function. + + fixedPoint: (A->A) -> A + ++\spad{fixedPoint f} is the fixed point of function \spad{f}. + ++ i.e. such that \spad{fixedPoint f = f(fixedPoint f)}. + fixedPoint: (List A->List A, Integer) -> List A + ++\spad{fixedPoint(f,n)} is the fixed point of function + ++ \spad{f} which is assumed to transform a list of length + ++ \spad{n}. + + + id: A -> A + ++\spad{id x} is \spad{x}. + "**": (A->A, NNI) -> (A->A) + ++\spad{f**n} is the function which is the n-fold application + ++ of \spad{f}. + + recur: ((NNI, A)->A) -> ((NNI, A)->A) + ++\spad{recur(g)} is the function \spad{h} such that + ++ \spad{h(n,x)= g(n,g(n-1,..g(1,x)..))}. + + + MPdef == add + + MappingPackageInternalHacks1(A) + + a: A + faa: A -> A + f0a: ()-> A + + nullary a == a + coerce a == nullary a + fixedPoint faa == + g0 := GENSYM()$Lisp + g1 := faa g0 + EQ(g0, g1)$Lisp => error "All points are fixed points" + GEQNSUBSTLIST([g0]$Lisp, [g1]$Lisp, g1)$Lisp + + fixedPoint(fll, n) == + g0 := [(GENSYM()$Lisp):A for i in 1..n] + g1 := fll g0 + or/[EQ(e0,e1)$Lisp for e0 in g0 for e1 in g1] => + error "All points are fixed points" + GEQNSUBSTLIST(g0, g1, g1)$Lisp + + -- Composition and recursion. + id a == a + g**n == iter(g, n, #1) + + recur fnaa == recur(fnaa, #1, #2) + +@ +<>= +"MAPPKG1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPPKG1"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"MAPPKG1" -> "BASTYPE" +"MAPPKG1" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPPKG2 MappingPackage2} +<>= +-- mappkg.spad.pamphlet MappingPackage2.input +)spool MappingPackage2.output +)set message test on +)set message auto off +)clear all +--S 1 +power(q: FRAC INT, n: INT): FRAC INT == q**n +--R +--R Function declaration power : (Fraction Integer,Integer) -> Fraction +--R Integer has been added to workspace. +--R Type: Void +--E 1 + +--S 2 +power(2,3) +--R +--R Compiling function power with type (Fraction Integer,Integer) -> +--R Fraction Integer +--R +--R (2) 8 +--R Type: Fraction Integer +--E 2 + +--S 3 +rewop := twist power +--R +--R +--I (3) theMap(MAPPKG3;twist;MM;5!0) +--R Type: ((Integer,Fraction Integer) -> Fraction Integer) +--E 3 + +--S 4 +rewop(3, 2) +--R +--R +--R (4) 8 +--R Type: Fraction Integer +--E 4 + +--S 5 +square: FRAC INT -> FRAC INT +--R +--R Type: Void +--E 5 + +--S 6 +square:= curryRight(power, 2) +--R +--R +--I (6) theMap(MAPPKG3;curryRight;MBM;1!0,0) +--R Type: (Fraction Integer -> Fraction Integer) +--E 6 + +--S 7 +square 4 +--R +--R +--R (7) 16 +--R Type: Fraction Integer +--E 7 + +--S 8 +squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) +--R +--R +--I (8) theMap(MAPPKG3;constantRight;MM;3!0) +--R Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) +--E 8 + +--S 9 +squirrel(1/2, 1/3) +--R +--R +--R 1 +--R (9) - +--R 4 +--R Type: Fraction Integer +--E 9 + +--S 10 +sixteen := curry(square, 4/1) +--R +--R +--I (10) theMap(MAPPKG2;curry;MAM;2!0,0) +--R Type: (() -> Fraction Integer) +--E 10 + +--S 11 +sixteen() +--R +--R +--R (11) 16 +--R Type: Fraction Integer +--E 11 + +--S 12 +square2:=square*square +--R +--R +--I (12) theMap(MAPPKG3;*;MMM;6!0,0) +--R Type: (Fraction Integer -> Fraction Integer) +--E 12 + +--S 13 +square2 3 +--R +--R +--R (13) 81 +--R Type: Fraction Integer +--E 13 + +--S 14 +sc(x: FRAC INT): FRAC INT == x + 1 +--R +--R Function declaration sc : Fraction Integer -> Fraction Integer has +--R been added to workspace. +--R Type: Void +--E 14 + +--S 15 +incfns := [sc**i for i in 0..10] +--R +--R Compiling function sc with type Fraction Integer -> Fraction Integer +--R +--R +--R (15) +--I [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0)] +--R Type: List (Fraction Integer -> Fraction Integer) +--E 15 + +--S 16 +[f 4 for f in incfns] +--R +--R +--R (16) [4,5,6,7,8,9,10,11,12,13,14] +--R Type: List Fraction Integer +--E 16 + +--S 17 +times(n:NNI, i:INT):INT == n*i +--R +--R Function declaration times : (NonNegativeInteger,Integer) -> Integer +--R has been added to workspace. +--R Type: Void +--E 17 + +--S 18 +r := recur(times) +--R +--R Compiling function times with type (NonNegativeInteger,Integer) -> +--R Integer +--R +--I (18) theMap(MAPPKG1;recur;2M;7!0,0) +--R Type: ((NonNegativeInteger,Integer) -> Integer) +--E 18 + +--S 19 +fact := curryRight(r, 1) +--R +--R +--I (19) theMap(MAPPKG3;curryRight;MBM;1!0,0) +--R Type: (NonNegativeInteger -> Integer) +--E 19 + +--S 20 +fact 4 +--R +--R +--R (20) 24 +--R Type: PositiveInteger +--E 20 + +--S 21 +mto2ton(m, n) == + raiser := square^n + raiser m +--R +--R Type: Void +--E 21 + +--S 22 +mto2ton(3, 3) +--R +--R Compiling function mto2ton with type (PositiveInteger, +--R PositiveInteger) -> Fraction Integer +--R +--R (22) 6561 +--R Type: Fraction Integer +--E 22 + +--S 23 +shiftfib(r: List INT) : INT == + t := r.1 + r.1 := r.2 + r.2 := r.2 + t + t +--R +--R Function declaration shiftfib : List Integer -> Integer has been +--R added to workspace. +--R Type: Void +--E 23 + +--S 24 +fibinit: List INT := [0, 1] +--R +--R +--R (24) [0,1] +--R Type: List Integer +--E 24 + +--S 25 +fibs := curry(shiftfib, fibinit) +--R +--R Compiling function shiftfib with type List Integer -> Integer +--R +--I (25) theMap(MAPPKG2;curry;MAM;2!0,0) +--R Type: (() -> Integer) +--E 25 + +--S 26 +[fibs() for i in 0..30] +--R +--R +--R (26) +--R [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, +--R 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, +--R 317811, 514229, 832040] +--R Type: List Integer +--E 26 +)spool +)lisp (bye) +@ +<>= +==================================================================== +MappingPackage examples +==================================================================== + +Function are objects of type Mapping. In this section we demonstrate +some library operations from the packages MappingPackage1, MappingPackage2, +and MappingPackage3 that manipulate and create functions. Some terminology: +a nullary function takes no arguments, a unary function takes one argument, +and a binary function takes two arguments. + +We begin by creating an example function that raises a rational number +to an integer exponent. + + power(q: FRAC INT, n: INT): FRAC INT == q**n + Type: Void + + power(2,3) + 8 + Type: Fraction Integer + +The twist operation transposes the arguments of a binary function. +Here rewop(a, b) is power(b, a). + + rewop := twist power + theMap(MAPPKG3;twist;MM;5!0) + Type: ((Integer,Fraction Integer) -> Fraction Integer) + +This is 2^3. + + rewop(3, 2) + 8 + Type: Fraction Integer + +Now we define square in terms of power. + + square: FRAC INT -> FRAC INT + Type: Void +The curryRight operation creates a unary function from a binary one by +providing a constant argument on the right. + + square:= curryRight(power, 2) + theMap(MAPPKG3;curryRight;MBM;1!0,0) + Type: (Fraction Integer -> Fraction Integer) + +Likewise, the curryLeft operation provides a constant argument on the +left. + + square 4 + 16 + Type: Fraction Integer + +The constantRight operation creates (in a trivial way) a binary +function from a unary one: constantRight(f) is the function g such +that g(a,b)= f(a). + + squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) + theMap(MAPPKG3;constantRight;MM;3!0) + Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) + +Likewise, constantLeft(f) is the function g such that g(a,b)= f(b). + + squirrel(1/2, 1/3) + 1 + - + 4 + Type: Fraction Integer + +The curry operation makes a unary function nullary. + + sixteen := curry(square, 4/1) + theMap(MAPPKG2;curry;MAM;2!0,0) + Type: (() -> Fraction Integer) + + sixteen() + 16 + Type: Fraction Integer + +The * operation constructs composed functions. + + square2:=square*square + theMap(MAPPKG3;*;MMM;6!0,0) + Type: (Fraction Integer -> Fraction Integer) + + square2 3 + 81 + Type: Fraction Integer + +Use the ** operation to create functions that are n-fold iterations of +other functions. + + sc(x: FRAC INT): FRAC INT == x + 1 + Type: Void + +This is a list of Mapping objects. + + incfns := [sc**i for i in 0..10] + [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0)] + Type: List (Fraction Integer -> Fraction Integer) + +This is a list of applications of those functions. + + [f 4 for f in incfns] + [4,5,6,7,8,9,10,11,12,13,14] + Type: List Fraction Integer + +Use the recur operation for recursion: + + g := recur f means g(n,x) == f(n,f(n-1,...f(1,x))). + + times(n:NNI, i:INT):INT == n*i + Type: Void + + r := recur(times) + theMap(MAPPKG1;recur;2M;7!0,0) + Type: ((NonNegativeInteger,Integer) -> Integer) + +This is a factorial function. + + fact := curryRight(r, 1) + theMap(MAPPKG3;curryRight;MBM;1!0,0) + Type: (NonNegativeInteger -> Integer) + + fact 4 + 24 + Type: PositiveInteger + +Constructed functions can be used within other functions. + + mto2ton(m, n) == + raiser := square^n + raiser m + Type: Void + +This is 3^(2^3). + + mto2ton(3, 3) + 6561 + Type: Fraction Integer + +Here shiftfib is a unary function that modifies its argument. + + shiftfib(r: List INT) : INT == + t := r.1 + r.1 := r.2 + r.2 := r.2 + t + t + Type: Void + +By currying over the argument we get a function with private state. + + fibinit: List INT := [0, 1] + [0,1] + Type: List Integer + + fibs := curry(shiftfib, fibinit) + theMap(MAPPKG2;curry;MAM;2!0,0) + Type: (() -> Integer) + + [fibs() for i in 0..30] + [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, + 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, + 317811, 514229, 832040] + Type: List Integer + +See Also: +o )help MappingPackage1 +o )show MappingPackage2 +o )help MappingPackage3 +o )help MappingPackage4 + +@ +\pagehead{MappingPackage2}{MAPPKG2} +\pagepic{ps/v104mappingpackage2.ps}{MAPPKG2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPPKG2 MappingPackage2 +++ Description: various Currying operations. +MappingPackage2(A:SetCategory, C:SetCategory): MPcat == MPdef where + NNI ==> NonNegativeInteger + + MPcat == with + const: C -> (A ->C) + ++\spad{const c} is a function which produces \spad{c} when + ++ applied to its argument. + + curry: (A ->C, A) -> (()->C) + ++\spad{cu(f,a)} is the function \spad{g} + ++ such that \spad{g ()= f a}. + constant: (()->C) -> (A ->C) + ++\spad{vu(f)} is the function \spad{g} + ++ such that \spad{g a= f ()}. + + diag: ((A,A)->C) -> (A->C) + ++\spad{diag(f)} is the function \spad{g} + ++ such that \spad{g a = f(a,a)}. + + + MPdef == add + + MappingPackageInternalHacks2(A, C) + + a: A + c: C + faa: A -> A + f0c: ()-> C + fac: A -> C + faac: (A,A)->C + + const c == arg2(#1, c) + curry(fac, a) == fac a + constant f0c == arg2(#1, f0c()) + + diag faac == faac(#1, #1) + +@ +<>= +"MAPPKG2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPPKG2"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"MAPPKG2" -> "BASTYPE" +"MAPPKG2" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPPKG3 MappingPackage3} +<>= +-- mappkg.spad.pamphlet MappingPackage3.input +)spool MappingPackage3.output +)set message test on +)set message auto off +)clear all +--S 1 +power(q: FRAC INT, n: INT): FRAC INT == q**n +--R +--R Function declaration power : (Fraction Integer,Integer) -> Fraction +--R Integer has been added to workspace. +--R Type: Void +--E 1 + +--S 2 +power(2,3) +--R +--R Compiling function power with type (Fraction Integer,Integer) -> +--R Fraction Integer +--R +--R (2) 8 +--R Type: Fraction Integer +--E 2 + +--S 3 +rewop := twist power +--R +--R +--I (3) theMap(MAPPKG3;twist;MM;5!0) +--R Type: ((Integer,Fraction Integer) -> Fraction Integer) +--E 3 + +--S 4 +rewop(3, 2) +--R +--R +--R (4) 8 +--R Type: Fraction Integer +--E 4 + +--S 5 +square: FRAC INT -> FRAC INT +--R +--R Type: Void +--E 5 + +--S 6 +square:= curryRight(power, 2) +--R +--R +--I (6) theMap(MAPPKG3;curryRight;MBM;1!0,0) +--R Type: (Fraction Integer -> Fraction Integer) +--E 6 + +--S 7 +square 4 +--R +--R +--R (7) 16 +--R Type: Fraction Integer +--E 7 + +--S 8 +squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) +--R +--R +--I (8) theMap(MAPPKG3;constantRight;MM;3!0) +--R Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) +--E 8 + +--S 9 +squirrel(1/2, 1/3) +--R +--R +--R 1 +--R (9) - +--R 4 +--R Type: Fraction Integer +--E 9 + +--S 10 +sixteen := curry(square, 4/1) +--R +--R +--I (10) theMap(MAPPKG2;curry;MAM;2!0,0) +--R Type: (() -> Fraction Integer) +--E 10 + +--S 11 +sixteen() +--R +--R +--R (11) 16 +--R Type: Fraction Integer +--E 11 + +--S 12 +square2:=square*square +--R +--R +--I (12) theMap(MAPPKG3;*;MMM;6!0,0) +--R Type: (Fraction Integer -> Fraction Integer) +--E 12 + +--S 13 +square2 3 +--R +--R +--R (13) 81 +--R Type: Fraction Integer +--E 13 + +--S 14 +sc(x: FRAC INT): FRAC INT == x + 1 +--R +--R Function declaration sc : Fraction Integer -> Fraction Integer has +--R been added to workspace. +--R Type: Void +--E 14 + +--S 15 +incfns := [sc**i for i in 0..10] +--R +--R Compiling function sc with type Fraction Integer -> Fraction Integer +--R +--R +--R (15) +--I [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), +--I theMap(MAPPKG1;**;MNniM;6!0,0)] +--R Type: List (Fraction Integer -> Fraction Integer) +--E 15 + +--S 16 +[f 4 for f in incfns] +--R +--R +--R (16) [4,5,6,7,8,9,10,11,12,13,14] +--R Type: List Fraction Integer +--E 16 + +--S 17 +times(n:NNI, i:INT):INT == n*i +--R +--R Function declaration times : (NonNegativeInteger,Integer) -> Integer +--R has been added to workspace. +--R Type: Void +--E 17 + +--S 18 +r := recur(times) +--R +--R Compiling function times with type (NonNegativeInteger,Integer) -> +--R Integer +--R +--I (18) theMap(MAPPKG1;recur;2M;7!0,0) +--R Type: ((NonNegativeInteger,Integer) -> Integer) +--E 18 + +--S 19 +fact := curryRight(r, 1) +--R +--R +--I (19) theMap(MAPPKG3;curryRight;MBM;1!0,0) +--R Type: (NonNegativeInteger -> Integer) +--E 19 + +--S 20 +fact 4 +--R +--R +--R (20) 24 +--R Type: PositiveInteger +--E 20 + +--S 21 +mto2ton(m, n) == + raiser := square^n + raiser m +--R +--R Type: Void +--E 21 + +--S 22 +mto2ton(3, 3) +--R +--R Compiling function mto2ton with type (PositiveInteger, +--R PositiveInteger) -> Fraction Integer +--R +--R (22) 6561 +--R Type: Fraction Integer +--E 22 + +--S 23 +shiftfib(r: List INT) : INT == + t := r.1 + r.1 := r.2 + r.2 := r.2 + t + t +--R +--R Function declaration shiftfib : List Integer -> Integer has been +--R added to workspace. +--R Type: Void +--E 23 + +--S 24 +fibinit: List INT := [0, 1] +--R +--R +--R (24) [0,1] +--R Type: List Integer +--E 24 + +--S 25 +fibs := curry(shiftfib, fibinit) +--R +--R Compiling function shiftfib with type List Integer -> Integer +--R +--I (25) theMap(MAPPKG2;curry;MAM;2!0,0) +--R Type: (() -> Integer) +--E 25 + +--S 26 +[fibs() for i in 0..30] +--R +--R +--R (26) +--R [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, +--R 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, +--R 317811, 514229, 832040] +--R Type: List Integer +--E 26 +)spool +)lisp (bye) +@ +<>= +==================================================================== +MappingPackage examples +==================================================================== + +Function are objects of type Mapping. In this section we demonstrate +some library operations from the packages MappingPackage1, MappingPackage2, +and MappingPackage3 that manipulate and create functions. Some terminology: +a nullary function takes no arguments, a unary function takes one argument, +and a binary function takes two arguments. + +We begin by creating an example function that raises a rational number +to an integer exponent. + + power(q: FRAC INT, n: INT): FRAC INT == q**n + Type: Void + + power(2,3) + 8 + Type: Fraction Integer + +The twist operation transposes the arguments of a binary function. +Here rewop(a, b) is power(b, a). + + rewop := twist power + theMap(MAPPKG3;twist;MM;5!0) + Type: ((Integer,Fraction Integer) -> Fraction Integer) + +This is 2^3. + + rewop(3, 2) + 8 + Type: Fraction Integer + +Now we define square in terms of power. + + square: FRAC INT -> FRAC INT + Type: Void +The curryRight operation creates a unary function from a binary one by +providing a constant argument on the right. + + square:= curryRight(power, 2) + theMap(MAPPKG3;curryRight;MBM;1!0,0) + Type: (Fraction Integer -> Fraction Integer) + +Likewise, the curryLeft operation provides a constant argument on the +left. + + square 4 + 16 + Type: Fraction Integer + +The constantRight operation creates (in a trivial way) a binary +function from a unary one: constantRight(f) is the function g such +that g(a,b)= f(a). + + squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) + theMap(MAPPKG3;constantRight;MM;3!0) + Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) + +Likewise, constantLeft(f) is the function g such that g(a,b)= f(b). + + squirrel(1/2, 1/3) + 1 + - + 4 + Type: Fraction Integer + +The curry operation makes a unary function nullary. + + sixteen := curry(square, 4/1) + theMap(MAPPKG2;curry;MAM;2!0,0) + Type: (() -> Fraction Integer) + + sixteen() + 16 + Type: Fraction Integer + +The * operation constructs composed functions. + + square2:=square*square + theMap(MAPPKG3;*;MMM;6!0,0) + Type: (Fraction Integer -> Fraction Integer) + + square2 3 + 81 + Type: Fraction Integer + +Use the ** operation to create functions that are n-fold iterations of +other functions. + + sc(x: FRAC INT): FRAC INT == x + 1 + Type: Void + +This is a list of Mapping objects. + + incfns := [sc**i for i in 0..10] + [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), + theMap(MAPPKG1;**;MNniM;6!0,0)] + Type: List (Fraction Integer -> Fraction Integer) + +This is a list of applications of those functions. + + [f 4 for f in incfns] + [4,5,6,7,8,9,10,11,12,13,14] + Type: List Fraction Integer + +Use the recur operation for recursion: + + g := recur f means g(n,x) == f(n,f(n-1,...f(1,x))). + + times(n:NNI, i:INT):INT == n*i + Type: Void + + r := recur(times) + theMap(MAPPKG1;recur;2M;7!0,0) + Type: ((NonNegativeInteger,Integer) -> Integer) + +This is a factorial function. + + fact := curryRight(r, 1) + theMap(MAPPKG3;curryRight;MBM;1!0,0) + Type: (NonNegativeInteger -> Integer) + + fact 4 + 24 + Type: PositiveInteger + +Constructed functions can be used within other functions. + + mto2ton(m, n) == + raiser := square^n + raiser m + Type: Void + +This is 3^(2^3). + + mto2ton(3, 3) + 6561 + Type: Fraction Integer + +Here shiftfib is a unary function that modifies its argument. + + shiftfib(r: List INT) : INT == + t := r.1 + r.1 := r.2 + r.2 := r.2 + t + t + Type: Void + +By currying over the argument we get a function with private state. + + fibinit: List INT := [0, 1] + [0,1] + Type: List Integer + + fibs := curry(shiftfib, fibinit) + theMap(MAPPKG2;curry;MAM;2!0,0) + Type: (() -> Integer) + + [fibs() for i in 0..30] + [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, + 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, + 317811, 514229, 832040] + Type: List Integer + +See Also: +o )help MappingPackage1 +o )help MappingPackage2 +o )show MappingPackage3 +o )help MappingPackage4 + +@ +\pagehead{MappingPackage3}{MAPPKG3} +\pagepic{ps/v104MappingPackage3.ps}{MAPPKG3}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPPKG3 MappingPackage3 +++ Description: various Currying operations. +MappingPackage3(A:SetCategory, B:SetCategory, C:SetCategory):_ + MPcat == MPdef where + NNI ==> NonNegativeInteger + + MPcat == with + curryRight: ((A,B)->C, B) -> (A ->C) + ++\spad{curryRight(f,b)} is the function \spad{g} such that + ++ \spad{g a = f(a,b)}. + curryLeft: ((A,B)->C, A) -> (B ->C) + ++\spad{curryLeft(f,a)} is the function \spad{g} + ++ such that \spad{g b = f(a,b)}. + + constantRight: (A -> C) -> ((A,B)->C) + ++\spad{constantRight(f)} is the function \spad{g} + ++ such that \spad{g (a,b)= f a}. + constantLeft: (B -> C) -> ((A,B)->C) + ++\spad{constantLeft(f)} is the function \spad{g} + ++ such that \spad{g (a,b)= f b}. + + twist: ((A,B)->C) -> ((B,A)->C) + ++\spad{twist(f)} is the function \spad{g} + ++ such that \spad{g (a,b)= f(b,a)}. + + "*": (B->C, A->B) -> (A->C) + ++\spad{f*g} is the function \spad{h} + ++ such that \spad{h x= f(g x)}. + + + MPdef == add + + MappingPackageInternalHacks3(A, B, C) + + a: A + b: B + c: C + faa: A -> A + f0c: ()-> C + fac: A -> C + fbc: B -> C + fab: A -> B + fabc: (A,B)->C + faac: (A,A)->C + + -- Fix left and right arguments as constants. + curryRight(fabc,b) == fabc(#1,b) + curryLeft(fabc,a) == fabc(a, #1) + + -- Add left and right arguments which are ignored. + constantRight fac == fac #1 + constantLeft fbc == fbc #2 + + -- Combinators to rearrange arguments. + twist fabc == fabc(#2, #1) + -- Functional composition + fbc*fab == comp(fbc,fab,#1) + +@ +<>= +"MAPPKG3" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPPKG3"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"MAPPKG3" -> "BASTYPE" +"MAPPKG3" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MAPPKG4 MappingPackage4} +<>= +-- mappkg.spad.pamphlet MappingPackage4.input +)spool MappingPackage4.output +)set message test on +)set message auto off +)clear all + +--S 1 of 21 +p:=(x:EXPR(INT)):EXPR(INT)+->3*x +--R +--R +--R (1) theMap(Closure) +--R Type: (Expression Integer -> Expression Integer) +--E 1 + +--S 2 of 21 +q:=(x:EXPR(INT)):EXPR(INT)+->2*x+3 +--R +--R +--R (2) theMap(Closure) +--R Type: (Expression Integer -> Expression Integer) +--E 2 + +--S 3 of 21 +(p+q)(4)-(p(4)+q(4)) +--R +--R +--R (3) 0 +--R Type: Expression Integer +--E 3 + +--S 4 of 21 +(p+q)(x)-(p(x)+q(x)) +--R +--R +--R (4) 0 +--R Type: Expression Integer +--E 4 + +--S 5 of 21 +(p-q)(4)-(p(4)-q(4)) +--R +--R +--R (5) 0 +--R Type: Expression Integer +--E 5 + +--S 6 of 21 +(p-q)(x)-(p(x)-q(x)) +--R +--R +--R (6) 0 +--R Type: Expression Integer +--E 6 + +--S 7 of 21 +(p*q)(4)-(p(4)*q(4)) +--R +--R +--R (7) 0 +--R Type: Expression Integer +--E 7 + +--S 8 of 21 +(p*q)(x)-(p(x)*q(x)) +--R +--R +--R (8) 0 +--R Type: Expression Integer +--E 8 + +--S 9 of 21 +(p/q)(4)-(p(4)/q(4)) +--R +--R +--R (9) 0 +--R Type: Expression Integer +--E 9 + +--S 10 of 21 +(p/q)(x)-(p(x)/q(x)) +--R +--R +--R (10) 0 +--R Type: Expression Integer +--E 10 + +--S 11 of 21 +r:=(x:INT):INT+-> (x*x*x) +--R +--R +--R (11) theMap(Closure) +--R Type: (Integer -> Integer) +--E 11 + +--S 12 of 21 +s:=(y:INT):INT+-> (y*y+3) +--R +--R +--R (12) theMap(Closure) +--R Type: (Integer -> Integer) +--E 12 + +--S 13 of 21 +(r+s)(4)-(r(4)+s(4)) +--R +--R +--R (13) 0 +--R Type: NonNegativeInteger +--E 13 + +--S 14 of 21 +(r-s)(4)-(r(4)-s(4)) +--R +--R +--R (14) 0 +--R Type: NonNegativeInteger +--E 14 + +--S 15 of 21 +(r*s)(4)-(r(4)*s(4)) +--R +--R +--R (15) 0 +--R Type: NonNegativeInteger +--E 15 + +--S 16 of 21 +t:=(x:INT):EXPR(INT)+-> (x*x*x) +--R +--R +--R (16) theMap(Closure) +--R Type: (Integer -> Expression Integer) +--E 16 + +--S 17 of 21 +u:=(y:INT):EXPR(INT)+-> (y*y+3) +--R +--R +--R (17) theMap(Closure) +--R Type: (Integer -> Expression Integer) +--E 17 + +--S 18 of 21 +(t/u)(4)-(t(4)/u(4)) +--R +--R +--R (18) 0 +--R Type: Expression Integer +--E 18 + +--S 19 of 21 +h:=(x:EXPR(INT)):EXPR(INT)+->1 +--R +--R (19) theMap(Closure) +--R Type: (Expression Integer -> Expression Integer) +--E 19 + +--S 20 of 21 +(p/h)(x) +--R +--R (20) 3x +--R Type: Expression Integer +--E 20 + +--S 21 of 21 +(q/h)(x) +--R +--R (21) 2x + 3 +--R Type: Expression Integer +--E 21 + +)spool +)lisp (bye) + +@ +<>= +==================================================================== +MappingPackage examples +==================================================================== + +We can construct some simple maps that take a variable x +into an equation: + + p:=(x:EXPR(INT)):EXPR(INT)+->3*x + q:=(x:EXPR(INT)):EXPR(INT)+->2*x+3 + +Now we can do the four arithmetic operations, +, -, *, / on these +newly constructed mappings. Since the maps are from the domain +Expression Integer to the same domain we can also use symbolic +values for the argument. All of the following will return 0, +showing that function composition is equivalent to the result +of doing the operations individually. + + (p+q)(4)-(p(4)+q(4)) + (p+q)(x)-(p(x)+q(x)) + + (p-q)(4)-(p(4)-q(4)) + (p-q)(x)-(p(x)-q(x)) + + (p*q)(4)-(p(4)*q(4)) + (p*q)(x)-(p(x)*q(x)) + + (p/q)(4)-(p(4)/q(4)) + (p/q)(x)-(p(x)/q(x)) + +We can construct simple maps from Integer to Integer but this +limits our ability to do division. + + r:=(x:INT):INT+-> (x*x*x) + s:=(y:INT):INT+-> (y*y+3) + +Again, all of these will return 0: + + (r+s)(4)-(r(4)+s(4)) + (r-s)(4)-(r(4)-s(4)) + (r*s)(4)-(r(4)*s(4)) + +If we want to do division with Integer inputs we create the +appropriate map: + + t:=(x:INT):EXPR(INT)+-> (x*x*x) + u:=(y:INT):EXPR(INT)+-> (y*y+3) + + (t/u)(4)-(t(4)/u(4)) + +We can even recover the original functions if we make a map +that always returns the constant 1: + + h:=(x:EXPR(INT)):EXPR(INT)+->1 + + theMap(Closure) + Type: (Expression Integer -> Expression Integer) + + (p/h)(x) + + 3x + Type: Expression Integer + (q/h)(x) + + 2x + 3 + Type: Expression Integer + +See Also: +o )show MappingPackage1 +o )help MappingPackage2 +o )help MappingPackage3 +o )help MappingPackage4 + +@ +\pagehead{MappingPackage4}{MAPPKG4} +\pagepic{ps/v104mappingpackage4.ps}{MAPPKG4}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MAPPKG4 MappingPackage4 +++ Author: Timothy Daly +++ Description: Functional Composition +++ Given functions f and g, returns the applicable closure +MappingPackage4(A:SetCategory, B:Ring): + with + "+": (A->B, A->B) -> (A->B) + ++ \spad(+) does functional addition + ++ + ++X f:=(x:INT):INT +-> 3*x + ++X g:=(x:INT):INT +-> 2*x+3 + ++X (f+g)(4) + "-": (A->B, A->B) -> (A->B) + ++ \spad(+) does functional addition + ++ + ++X f:=(x:INT):INT +-> 3*x + ++X g:=(x:INT):INT +-> 2*x+3 + ++X (f-g)(4) + "*": (A->B, A->B) -> (A->B) + ++ \spad(+) does functional addition + ++ + ++X f:=(x:INT):INT +-> 3*x + ++X g:=(x:INT):INT +-> 2*x+3 + ++X (f*g)(4) + "/": (A->Expression(Integer), A->Expression(Integer)) -> (A->Expression(Integer)) + ++ \spad(+) does functional addition + ++ + ++X p:=(x:EXPR(INT)):EXPR(INT)+->3*x + ++X q:=(x:EXPR(INT)):EXPR(INT)+->2*x+3 + ++X (p/q)(4) + ++X (p/q)(x) + == add + fab ==> (A -> B) + faei ==> (A -> Expression(Integer)) + + funcAdd(g:fab,h:fab,x:A):B == ((g x) + (h x))$B + + (a:fab)+(b:fab) == funcAdd(a,b,#1) + + funcSub(g:fab,h:fab,x:A):B == ((g x) - (h x))$B + + (a:fab)-(b:fab) == funcSub(a,b,#1) + + funcMul(g:fab,h:fab,x:A):B == ((g x) * (h x))$B + + (a:fab)*(b:fab) == funcMul(a,b,#1) + + funcDiv(g:faei,h:faei,x:A):Expression(Integer) + == ((g x) / (h x))$Expression(Integer) + + (a:faei)/(b:faei) == funcDiv(a,b,#1) + +@ +<>= +"MAPPKG4" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MAPPKG4"] +"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"] +"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"] +"MAPPKG4" -> "PID" +"MAPPKG4" -> "OAGROUP" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MMLFORM MathMLFormat} + +Both this code and documentation are still under development and +I don't pretend they are anywhere close to perfect or even finished. +However the code does work and I hope it might be useful to somebody +both for it's ability to output MathML from Axiom and as an example +of how to write a new output form. + +\subsection{Introduction to Mathematical Markup Language} + +MathML exists in two forms: presentation and content. +At this time (2007-02-11) the package only has a presentation +package. A content package is in the +works however it is more difficult. Unfortunately Axiom does +not make its semantics easily available. The \spadtype{OutputForm} +domain mediates between the individual Axiom domains and the +user visible output but \spadtype{OutputForm} does not provide full +semantic information. From my currently incomplete understanding +of Axiom it appears that remedying this would entail going back +to the individual domains and rewriting a lot of code. +However some semantics are conveyed directly by \spadtype{OutputForm} and other +things can be deduced from \spadtype{OutputForm} or from the original +user command. + +\subsection{Displaying MathML} + +The MathML string produced by ")set output mathml on" can be pasted +directly into an appropriate xhtml page and then viewed in Firefox +or some other MathML aware browser. The boiler plate code needed for +a test page, testmathml.xml, is: + +\begin{verbatim} + + + +]> + + + + + + MathML Test + + + + + + +\end{verbatim} + + +Paste the MathML string into the body element and it should display +nicely in Firefox. + +\subsection{Test Cases} + +Here's a list of test cases that currently format correctly: + +1. (x+y)**2 + +2. integrate(x**x,x) + +3. integral(x**x,x) + +4. (5 + sqrt 63 + sqrt 847)**(1/3) + +5. set $[$1,2,3$]$ + +6. multiset $[$x rem 5 for x in primes(2,1000)$]$ + +7. series(sin(a*x),x=0) + +8. matrix $[$ $[$x**i + y**j for i in 1..10$]$ for j in 1..10$]$ + +9. y := operator 'y + a. D(y(x,z),$[$x,x,z,x$]$) + b. D(y x,x,2) + +10. x := series 'x + a. sin(1+x) + +11. series(1/log(y),y=1) + +12. y:UTS(FLOAT,'z,0) := exp(z) + +13. a. c := continuedFraction(314159/100000) + b. c := continuedFraction(314159/100000) + +The \spadtype{TexFormat} domain has the capability to format an object with +subscripts, superscripts, presubscripts and presuperscripts however +I don't know of any Axiom command that produces such an object. In +fact at present I see the case of "SUPERSUB" being used for putting +primes in the superscript position to denote ordinary differentiation. +I also only see the "SUB" case being used to denote partial +derivatives. + +\subsection{)set output mathml on} + + +Making mathml appear as output during a normal Axiom session +by invoking ")set output mathml on" proved to be a bit tedious +and seems to be undocumented. I document my experience here +in case it proves useful to somebody else trying to get a new +output format from Axiom. + +In \spadtype{MathMLFormat} the functions +\spadfun{coerce(expr : OutputForm) : String} and +\spadfun{display(s : String) : Void} provide the desired mathml output. +Note that this package was constructed by close examination of +Robert Sutor's \spadtype{TexFormat} domain and much remains from that source. +To have mathml displayed as output we need to get Axiom to +call display(coerce(expr)) at the appropriate place. Here's what +I did to get that to happen. Note that my starting point here was +an attempt by Andrey Grozin to do the same. To figure things out +I searched through files for "tex" to see what was done for the +\spadtype{TexFormat} domain, and used grep to find which files had mention of +\spadtype{TexFormat}. + +\subsection{File src/interp/setvars.boot.pamphlet} + + + Create an output mathml section by analogy to the tex section. +Remember to add the code chunk "outputmathmlCode" at the end. + +setvars.boot is a bootstrap file which means that it has to be +precompiled into lisp code and then that code has to be inserted +back into setvars.boot. To do this extract the boot code by running +"notangle" on it. I did this from the "tmp" directory. +From inside axiom run ")lisp (boottran::boottocl "tmp/setvars.boot") +which put "setvars.clisp" into "int/interp/setvars.clisp". Then +replace the lisp in "setvars.boot.pamphlet" with that in the newly +generated "setvars.clisp". + +The relevant code chunks appearing in "setvars.boot.pamphlet" are: +\begin{verbatim} + outputmathmlCode + setOutputMathml + describeSetOutputMathml +\end{verbatim} +and the relevant variables are: +\begin{verbatim} + setOutputMathml + $mathmlOutputStream + $mathmlOutputFile + $mathmlFormat + describeSetOutputMathml +\end{verbatim} + +\subsection{File setvart.boot.pamphlet} + + +Create an output mathml section in "setvart.boot.pamphlet" again +patterned after the tex section. I changed the default file +extension from ".stex" to ".smml". + +To the "section{output}" table I added the line +\begin{verbatim} + mathml created output in MathML style Off:CONSOLE +\end{verbatim} +Added the code chunk "outputmathml" to the code chunk "output" +in "section{output}". + +Relevant code chunks: +\begin{verbatim} + outputmathml +\end{verbatim} +Relevant variables: +\begin{verbatim} + setOutputMathml + $mathmlFormat + $mathmlOutputFile +\end{verbatim} + +Note when copying the tex stuff I changed occurrences of "tex" +to "mathml", "Tex" to "Mathml" and "TeX" to "MathML". + +\subsection{File src/algebra/Makefile.pamphlet} + + +The file "src/algebra/tex.spad.pamphlet" contains +the domain \spadtype{TexFormat} (TEX) and the package +\spadtype{TexFormat1} (TEX1). +However the sole function of \spadtype{TexFormat1} is to \spadfun{coerce} +objects from a domain into \spadtype{OutputForm} and then apply +\spadtype{TexFormat} +to them. It is to save programmers the trouble of doing +the coercion themselves from inside spad code. It does +not appear to be used for the main purpose of delivering +Axiom output in TeX format. In order to keep the mathml +package as simple as possible, and because I didn't see much +use for this, I didn't copy the \spadtype{TexFormat1} package. So +no analog of the TEX1 entries in "Makefile.pamphlet" were +needed. One curiosity I don't understand is why TEX1 +appears in layer 4 when it seems to depend on TEX which +appears in layer 14. + +Initially I added "\${OUT}/MMLFORM.o" to layer 14 and +"mathml.spad.pamphlet" to completed spad files in layer 14. +When trying to compile the build failed at MMLFORM. It left +"MMLFORM.erlib" in "int/algebra" instead of "MMLFORM.NRLIB" +which confused me at first because mathml.spad compiled +under a running axiom. By examining the file "obj/tmp/trace" +I saw that a new dependency had been introduced, compared +to TexFormat, with the function eltName depending on the +domain FSAGG in layer 16. So the lines had to be moved +from layer 14 to layer 17. + +Added appropriate lines to "SPADFILES" and "DOCFILES". + +\subsection{File src/algebra/exposed.lsp.pamphlet} + +Add the line "($\vert{}$MathMLFormat$\vert$ . MMLFORM)" + +\subsection{File src/algebra/Lattice.pamphlet} + +I don't see that this file is used anywhere but I made +the appropriate changes anyway by searching for "TEX" and +mimicing everything for MMLFORM. + +\subsection{File src/doc/axiom.bib.pamphlet} + +Added mathml.spad subsection to "src/doc/axiom.bib.pamphlet". + +\subsection{File interp/i-output.boot.pamphlet} + + +This is where the \spadfun{coerce} and \spadfun{display} functions +from MathMLFormat +actually get called. The following was added: + +\begin{verbatim} +mathmlFormat expr == + mml := '(MathMLFormat) + mmlrep := '(String) + formatFn := getFunctionFromDomain("coerce",mml,[$OutputForm]) + displayFn := getFunctionFromDomain("display",mml,[mmlrep]) + SPADCALL(SPADCALL(expr,formatFn),displayFn) + TERPRI $mathmlOutputStream + FORCE_-OUTPUT $mathmlOutputStream + NIL +\end{verbatim} + +Note that compared to the texFormat function there are a couple +of differences. Since \spadtype{MathMLFormat} is currently a package rather +than a domain there is the "mmlrep" variable whereas in texFormat +the argument of the "display" function is an instance of the +domain. Also the \spadfun{coerce} function here only has one argument, +namely "\$OutputForm". + +Also for the function "output(expr,domain)" add lines for mathml, +e.g. "if \$mathmlFormat then mathmlFormat expr". + +After these changes Axiom compiled with mathml enabled under +)set output. + +\subsection{Public Declarations} + +The declarations +\begin{verbatim} + E ==> OutputForm + I ==> Integer + L ==> List + S ==> String + US ==> UniversalSegment(Integer) +\end{verbatim} +provide abbreviations for domains used heavily in the code. +The publicly exposed functions are: + + \spadfun{coerce: E -$>$ S} This function is the main one for converting +an expression in domain OutputForm into a MathML string. + + \spadfun{coerceS: E -$>$ S} This function is for use from the command line. +It converts an OutputForm expression into a MathML string and does +some formatting so that the output is not one long line. If you take +the output from this function, stick it in an emacs buffer in +nxml-mode and then indent according to mode, you'll get something that's +nicer to look at than what comes from coerce. Note that coerceS returns +the same value as coerce but invokes a display function as well so that +the result will be printed twice in different formats. The need for this +is that the output from coerce is automatically formatted with line breaks +by Axiom's output routine that are not in the right place. + + \spadfun{coerceL: E -$>$ S} Similar to coerceS except that the displayed result +is the MathML string in one long line. These functions can be used, +for instance, to get the MathML for the previous result by typing +coerceL(%)\$MMLFORM. + + \spadfun{exprex: E -$>$ S} Converts \spadtype{OutputForm} to +\spadtype{String} with +the structure preserved with braces. This is useful in developing this +package. Actually this is not quite accurate. The function +\spadfun{precondition} is first applied to the \spadtype{OutputForm} +expression before \spadfun{exprex}. Raw \spadtype{OutputForm} and the nature +of the \spadfun{precondition} function is still obscure to me at the time of +this writing (2007-02-14), however I probably need to understand it to make +sure I'm not missing any semantics. The spad function \spadfun{precondition} +is just a wrapper for the lisp function outputTran\$Lisp, which I guess is +compiled from boot. + + \spadfun{display: S -$>$ Void} This one prints the string returned by coerce as one +long line, adding "math" tags: $<$math ...$>$ ... $<$/math$>$. Thus the output +from this can be stuck directly into an appropriate html/xhtml page and will +be displayed nicely by a MathML aware browser. + + \spadfun{displayF: S -$>$ Void} This function doesn't exist +yet but it would be nice +to have a humanly readable formatted output as well. The basics do exist in +the coerceS function however the formatting still needs some work to be +really good. + +<>= +)abbrev domain MMLFORM MathMLFormat +++ Author: Arthur C. Ralfs +++ Date: January 2007 +++ This package is based on the TeXFormat domain by Robert S. Sutor +++ without which I wouldn't have known where to start. +++ Basic Operations: coerce, coerceS, coerceL, exprex, display +++ Description: +++ \spadtype{MathMLFormat} provides a coercion from \spadtype{OutputForm} +++ to MathML format. + +MathMLFormat(): public == private where + E ==> OutputForm + I ==> Integer + L ==> List + S ==> String + US ==> UniversalSegment(Integer) + + public == SetCategory with + coerce: E -> S + ++ coerceS(o) changes o in the standard output format to MathML + ++ format. + coerceS: E -> S + ++ coerceS(o) changes o in the standard output format to MathML + ++ format and displays formatted result. + coerceL: E -> S + ++ coerceS(o) changes o in the standard output format to MathML + ++ format and displays result as one long string. + exprex: E -> S + ++ coverts \spadtype{OutputForm} to \spadtype{String} with the + ++ structure preserved with braces. Actually this is not quite + ++ accurate. The function \spadfun{precondition} is first + ++ applied to the + ++ \spadtype{OutputForm} expression before \spadfun{exprex}. + ++ The raw \spadtype{OutputForm} and + ++ the nature of the \spadfun{precondition} function is + ++ still obscure to me + ++ at the time of this writing (2007-02-14). + display: S -> Void + ++ prints the string returned by coerce, adding tags. + +@ +\subsection{Private Constant Declarations} +<>= + private == add + import OutputForm + import Character + import Integer + import List OutputForm + import List String + + -- local variable declarations and definitions + + expr: E + prec,opPrec: I + str: S + blank : S := " \ " + + maxPrec : I := 1000000 + minPrec : I := 0 + + unaryOps : L S := ["-","^"]$(L S) + unaryPrecs : L I := [700,260]$(L I) + + -- the precedence of / in the following is relatively low because + -- the bar obviates the need for parentheses. + binaryOps : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S) + binaryPrecs : L I := [0,0,900, 700,400,400,400, 700]$(L I) + + naryOps : L S := ["-","+","*",blank,",",";"," ","ROW","", + " \cr ","&",""]$(L S) + naryPrecs : L I := [700,700,800, 800,110,110, 0, 0, 0, + 0, 0, 0]$(L I) + naryNGOps : L S := ["ROW","&"]$(L S) + + plexOps : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"]$(L S) + plexPrecs : L I := [ 700, 800, 700, 800 , 700, 700]$(L I) + + specialOps : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT", _ + "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG", _ + "SUPERSUB","ZAG","AGGSET","SC","PAREN", _ + "SEGMENT","QUOTE","theMap" ] + + -- the next two lists provide translations for some strings for + -- which MML provides special macros. + + specialStrings : L S := + ["cos", "cot", "csc", "log", "sec", "sin", "tan", + "cosh", "coth", "csch", "sech", "sinh", "tanh", + "acos","asin","atan","erf","...","$","infinity"] + specialStringsInMML : L S := + ["cos","cot","csc","log","sec","sin","tan", + "cosh","coth","csch","sech","sinh","tanh", + "arccos","arcsin","arctan","erf","…","$","∞"] + +@ +\subsection{Private Function Declarations} + +These are the local functions: + + addBraces:S -$>$ S + + addBrackets:S -$>$ S + + atomize:E -$>$ L E + + displayElt:S -$>$ Void + function for recursively displaying mathml nicely formatted + + eltLimit:(S,I,S) -$>$ I + demarcates end postion of mathml element with name:S starting at + position i:I in mathml string s:S and returns end of end tag as + i:I position in mathml string, i.e. find start and end of + substring: $<$name ...$>$...$<$/name$>$ + + eltName:(I,S) -$>$ S + find name of mathml element starting at position i:I in string s:S + + group:S -$>$ S + + formatBinary:(S,L E, I) -$>$ S + + formatFunction:(S,L E, I) -$>$ S + + formatMatrix:L E -$>$ S + + formatNary:(S,L E, I) -$>$ S + + formatNaryNoGroup:(S,L E, I) -$>$ S + + formatNullary:S -$>$ S + + formatPlex:(S,L E, I) -$>$ S + + formatSpecial:(S,L E, I) -$>$ S + + formatUnary:(S, E, I) -$>$ S + + formatMml:(E,I) -$>$ S + + newWithNum:I -$>$ \$ + this is a relic from tex.spad and is not used here so far. I'll + probably remove it. + + parenthesize:S -$>$ S + + precondition:E -$>$ E + this function is applied to the OutputForm expression before + doing anything else. + + postcondition:S -$>$ S + this function is applied after all other OutputForm -$>$ MathML + transformations. In the TexFormat domain the ungroup function + first peels off the outermost set of braces however I have + replaced braces with $<$mrow$>$s here and sometimes the outermost set + of $<$mrow$>$s is necessary to get proper display in Firefox. + For instance with getting the correct size of brackets on a matrix + the whole expression needs to be enclosed in a mrow element. + It also checks for $+-$ and removes the $+$. + + stringify:E -$>$ S + + tagEnd:(S,I,S) -$>$ I + finds closing "$>$" of start or end tag for mathML element for formatting + MathML string for human readability. No analog in TexFormat. + + ungroup:S -$>$ S + +<>= + -- local function signatures + + addBraces: S -> S + addBrackets: S -> S + atomize: E -> L E + displayElt: S -> Void + ++ function for recursively displaying mathml nicely formatted + eltLimit: (S,I,S) -> I + ++ demarcates end postion of mathml element with name:S starting at + ++ position i:I in mathml string s:S and returns end of end tag as + ++ i:I position in mathml string, i.e. find start and end of + ++ substring: ... + eltName: (I,S) -> S + ++ find name of mathml element starting at position i:I in string s:S + group: S -> S + formatBinary: (S,L E, I) -> S + formatFunction: (S,L E, I) -> S + formatIntSign: (L E, I) -> S + formatMatrix: L E -> S + formatNary: (S,L E, I) -> S + formatNaryNoGroup: (S,L E, I) -> S + formatNullary: S -> S + formatPlex: (S,L E, I) -> S + formatSpecial: (S,L E, I) -> S + formatSub: (E, L E, I) -> S + formatSuperSub: (E, L E, I) -> S + formatSuperSub1: (E, L E, I) -> S + formatUnary: (S, E, I) -> S + formatMml: (E,I) -> S + formatZag: L E -> S + formatZag1: L E -> S + newWithNum: I -> $ + parenthesize: S -> S + precondition: E -> E + postcondition: S -> S + stringify: E -> S + tagEnd: (S,I,S) -> I + ++ finds closing ">" of start or end tag for mathML element + ungroup: S -> S + +@ +\subsection{Public Function Definitions} + +Note that I use the function sayTeX\$Lisp much as I would printf in a +C program. I've noticed in grepping the code that there are other "say" +functions, sayBrightly and sayMessage for instance, but I have no idea +what the difference is between them at this point. sayTeX\$Lisp does the +job so for the time being I'll use that until I learn more. + +The functions coerceS and coerceL should probably be changed to display +functions, {\it i.e.}\/ \spadfun{displayS} and \spadfun{display L}, +returning Void. I really only need the one coerce function. + +<>= + -- public function definitions + + coerce(expr : E): S == + s : S := postcondition formatMml(precondition expr, minPrec) + s + + coerceS(expr : E): S == + s : S := postcondition formatMml(precondition expr, minPrec) + sayTeX$Lisp "" + displayElt(s) + sayTeX$Lisp "" + s + + coerceL(expr : E): S == + s : S := postcondition formatMml(precondition expr, minPrec) + sayTeX$Lisp "" + sayTeX$Lisp s + sayTeX$Lisp "" + s + + display(mathml : S): Void == + sayTeX$Lisp "" + sayTeX$Lisp mathml + sayTeX$Lisp "" + void()$Void + + + + exprex(expr : E): S == + -- This breaks down an expression into atoms and returns it as + -- a string. It's for developmental purposes to help understand + -- the expressions. + a : E + expr := precondition expr +-- sayTeX$Lisp "0: "stringify expr + (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") => + concat ["{",stringify expr,"}"] + le : L E := (expr pretend L E) + op := first le + sop : S := exprex op + args : L E := rest le + nargs : I := #args +-- sayTeX$Lisp concat ["1: ",stringify first le," : ",string(nargs)$S] + s : S := concat ["{",sop] + if nargs > 0 then + for a in args repeat +-- sayTeX$Lisp concat ["2: ",stringify a] + s1 : S := exprex a + s := concat [s,s1] + s := concat [s,"}"] + +@ +\subsection{Private Function Definitions} + +\subsubsection{Display Functions} + + displayElt(mathml:S):Void + + eltName(pos:I,mathml:S):S + + eltLimit(name:S,pos:I,mathml:S):I + + tagEnd(name:S,pos:I,mathml:S):I + +<>= + + displayElt(mathML:S): Void == + -- Takes a string of syntactically complete mathML + -- and formats it for display. +-- sayTeX$Lisp "****displayElt1****" +-- sayTeX$Lisp mathML + enT:I -- marks end of tag, e.g. "" + enE:I -- marks end of element, e.g. " ... " + end:I -- marks end of mathML string + u:US + end := #mathML + length:I := 60 +-- sayTeX$Lisp "****displayElt1.1****" + name:S := eltName(1,mathML) +-- sayTeX$Lisp name +-- sayTeX$Lisp concat("****displayElt1.2****",name) + enE := eltLimit(name,2+#name,mathML) +-- sayTeX$Lisp "****displayElt2****" + if enE < length then +-- sayTeX$Lisp "****displayElt3****" + u := segment(1,enE)$US + sayTeX$Lisp mathML.u + else +-- sayTeX$Lisp "****displayElt4****" + enT := tagEnd(name,1,mathML) + u := segment(1,enT)$US + sayTeX$Lisp mathML.u + u := segment(enT+1,enE-#name-3)$US + displayElt(mathML.u) + u := segment(enE-#name-2,enE)$US + sayTeX$Lisp mathML.u + if end > enE then +-- sayTeX$Lisp "****displayElt5****" + u := segment(enE+1,end)$US + displayElt(mathML.u) + + void()$Void + + eltName(pos:I,mathML:S): S == + -- Assuming pos is the position of "<" for a start tag of a mathML + -- element finds and returns the element's name. + i:I := pos+1 + --sayTeX$Lisp "eltName:mathmML string: "mathML + while member?(mathML.i,lowerCase()$CharacterClass)$CharacterClass repeat + i := i+1 + u:US := segment(pos+1,i-1) + name:S := mathML.u + + eltLimit(name:S,pos:I,mathML:S): I == + -- Finds the end of a mathML element like " ... " + -- where pos is the position of the space after name in the start tag + -- although it could point to the closing ">". Returns the position + -- of the ">" in the end tag. + pI:I := pos + startI:I + endI:I + startS:S := concat ["<",name] + endS:S := concat [""] + level:I := 1 + --sayTeX$Lisp "eltLimit: element name: "name + while (level > 0) repeat + startI := position(startS,mathML,pI)$String + + endI := position(endS,mathML,pI)$String + + if (startI = 0) then + level := level-1 + --sayTeX$Lisp "****eltLimit 1******" + pI := tagEnd(name,endI,mathML) + else + if (startI < endI) then + level := level+1 + pI := tagEnd(name,startI,mathML) + else + level := level-1 + pI := tagEnd(name,endI,mathML) + pI + + + tagEnd(name:S,pos:I,mathML:S):I == + -- Finds the closing ">" for either a start or end tag of a mathML + -- element, so the return value is the position of ">" in mathML. + pI:I := pos + while (mathML.pI ^= char ">") repeat + pI := pI+1 + u:US := segment(pos,pI)$US + --sayTeX$Lisp "tagEnd: "mathML.u + pI + +@ +\subsubsection{Formatting Functions} + +Still need to format \verb+\zag+ in formatSpecial! + +In formatPlex the case op = "INTSIGN" is now passed off to +formatIntSign which is a change from the TexFormat domain. +This is done here for presentation mark up to replace the +ugly bound variable that Axiom delivers. For content mark up +this has to be done anyway. + +The formatPlex function also allows for op = "INDEFINTEGRAL". +However I don't know what Axiom command gives rise to this case. +The INTSIGN case already allows for both definite and indefinite +integrals. + +In the function formatSpecial various cases are handled including +SUB and SUPERSUB. These cases are now caught in formatMml and so +the code in formatSpecial doesn't get executed. The only cases +I know of using these are partial derivatives for SUB and ordinary +derivatives or SUPERSUB however in TexFormat the capability is there +to handle multiscripts, i.e. an object with subscripts, superscripts, +pre-subscripts and pre-superscripts but I am so far unaware of any +Axiom command that produces such a multiscripted object. + +Another question is how to represent derivatives. At present I have +differential notation for partials and prime notation for ordinary +derivatives, +but it would be nice to allow for different derivative notations in +different circumstances, maybe some options to )set output mathml on. + +Ordinary derivatives are formatted in formatSuperSub and there are +2 versions, formatSuperSub and formatSuperSub1, which at this point +have to be switched by swapping names. + +<>= + + atomize(expr : E): L E == + -- This breaks down an expression into a flat list of atomic expressions. + -- expr should be preconditioned. + le : L E := nil() + a : E + letmp : L E + (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") => + le := append(le,list(expr)) + letmp := expr pretend L E + for a in letmp repeat + le := append(le,atomize a) + le + + + ungroup(str: S): S == + len : I := #str + len < 14 => str + lrow : S := "" + rrow : S := "" + -- drop leading and trailing mrows + u1 : US := segment(1,6)$US + u2 : US := segment(len-6,len)$US + if (str.u1 =$S lrow) and (str.u2 =$S rrow) then + u : US := segment(7,len-7)$US + str := str.u + str + + postcondition(str: S): S == +-- str := ungroup str + len : I := #str + plusminus : S := "+-" + pos : I := position(plusminus,str,1) + if pos > 0 then + ustart:US := segment(1,pos-1)$US + uend:US := segment(pos+20,len)$US + str := concat [str.ustart,"-",str.uend] + if pos < len-18 then + str := postcondition(str) + str + + stringify expr == (mathObject2String$Lisp expr)@S + + group str == + concat ["",str,""] + + addBraces str == + concat ["{",str,"}"] + + addBrackets str == + concat ["[",str,"]"] + + parenthesize str == + concat ["(",str,")"] + + precondition expr == + outputTran$Lisp expr + + formatSpecial(op : S, args : L E, prec : I) : S == + arg : E + prescript : Boolean := false + op = "theMap" => "theMap(...)" + op = "AGGLST" => + formatNary(",",args,prec) + op = "AGGSET" => + formatNary(";",args,prec) + op = "TAG" => + group concat [formatMml(first args,prec), + "→", + formatMml(second args,prec)] + --RightArrow + op = "VCONCAT" => + group concat("", + concat(concat([concat("",concat(formatMml(u, minPrec),"")) + for u in args]::L S), + "")) + op = "CONCATB" => + formatNary(" ",args,prec) + op = "CONCAT" => + formatNary("",args,minPrec) + op = "QUOTE" => + group concat("'",formatMml(first args, minPrec)) + op = "BRACKET" => + group addBrackets ungroup formatMml(first args, minPrec) + op = "BRACE" => + group addBraces ungroup formatMml(first args, minPrec) + op = "PAREN" => + group parenthesize ungroup formatMml(first args, minPrec) + op = "OVERBAR" => + null args => "" + group concat ["",formatMml(first args,minPrec),"¯"] + --OverBar + op = "ROOT" => + null args => "" + tmp : S := group formatMml(first args, minPrec) + null rest args => concat ["",tmp,""] + group concat + ["",tmp,"",formatMml(first rest args, minPrec),""] + op = "SEGMENT" => + tmp : S := concat [formatMml(first args, minPrec),".."] + group + null rest args => tmp + concat [tmp,formatMml(first rest args, minPrec)] + -- SUB should now be diverted in formatMml although I'll leave + -- the code here for now. + op = "SUB" => + group concat ["",formatMml(first args, minPrec), + formatSpecial("AGGLST",rest args,minPrec),""] + -- SUPERSUB should now be diverted in formatMml although I'll leave + -- the code here for now. + op = "SUPERSUB" => + base:S := formatMml(first args, minPrec) + args := rest args + if #args = 1 then + ""base""formatMml(first args, minPrec)"" + else if #args = 2 then + -- it would be nice to substitue ′ for , in the case of + -- an ordinary derivative, it looks a lot better. + ""base""formatMml(first args,minPrec)""formatMml(first rest args, minPrec)"" + else if #args = 3 then + ""base""formatMml(first args,minPrec)""formatMml(first rest args,minPrec)""formatMml(first rest rest args,minPrec)"" + else if #args = 4 then + ""base""formatMml(first args,minPrec)""formatMml(first rest args,minPrec)""formatMml(first rest rest args,minPrec)""formatMml(first rest rest rest args,minPrec)"" + else + "Problem with multiscript object" + op = "SC" => + -- need to handle indentation someday + null args => "" + tmp := formatNaryNoGroup("", args, minPrec) + group concat ["",tmp,""] + op = "MATRIX" => formatMatrix rest args + op = "ZAG" => +-- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} +-- to format continued fraction traditionally need to intercept it at the +-- formatNary of the "+" + concat [" \zag{",formatMml(first args, minPrec),"}{", + formatMml(first rest args,minPrec),"}"] + concat ["not done yet for: ",op,""] + + formatSub(expr : E, args : L E, opPrec : I) : S == + -- This one produces differential notation partial derivatives. + -- It doesn't work in all cases and may not be workable, use + -- formatSub1 below for now. + -- At this time this is only to handle partial derivatives. + -- If the SUB case handles anything else I'm not aware of it. + -- This an example of the 4th partial of y(x,z) w.r.t. x,x,z,x + -- {{{SUB}{y}{{CONCAT}{{CONCAT}{{CONCAT}{{CONCAT}{,}{1}}{{CONCAT}{,}{1}}}{{CONCAT}{,}{2}}}{{CONCAT}{,}{1}}}}{x}{z}} + atomE : L E := atomize(expr) + op : S := stringify first atomE + op ^= "SUB" => "Mistake in formatSub: no SUB" + stringify first rest rest atomE ^= "CONCAT" => "Mistake in formatSub: no CONCAT" + -- expecting form for atomE like + --[{SUB}{func}{CONCAT}...{CONCAT}{,}{n}{CONCAT}{,}{n}...{CONCAT}{,}{n}], + --counting the first CONCATs before the comma gives the number of + --derivatives + ndiffs : I := 0 + tmpLE : L E := rest rest atomE + while stringify first tmpLE = "CONCAT" repeat + ndiffs := ndiffs+1 + tmpLE := rest tmpLE + numLS : L S := nil + i : I := 1 + while i < ndiffs repeat + numLS := append(numLS,list(stringify first rest tmpLE)) + tmpLE := rest rest rest tmpLE + i := i+1 + numLS := append(numLS,list(stringify first rest tmpLE)) + -- numLS contains the numbers of the bound variables as strings + -- for the differentiations, thus for the differentiation [x,x,z,x] + -- for y(x,z) numLS = ["1","1","2","1"] + posLS : L S := nil + i := 0 + -- sayTeX$Lisp "formatSub: nargs = "string(#args) + while i < #args repeat + posLS := append(posLS,list(string(i+1))) + i := i+1 + -- posLS contains the positions of the bound variables in args + -- as a list of strings, e.g. for the above example ["1","2"] + tmpS: S := stringify atomE.2 + if ndiffs = 1 then + s : S := "∂"tmpS"" + else + s : S := "∂"string(ndiffs)""tmpS"" + -- need to find the order of the differentiation w.r.t. the i-th + -- variable + i := 1 + j : I + k : I + tmpS: S + while i < #posLS+1 repeat + j := 0 + k := 1 + while k < #numLS + 1 repeat + if numLS.k = string i then j := j + 1 + k := k+1 + if j > 0 then + tmpS := stringify args.i + if j = 1 then + s := s"∂"tmpS"" + else + s := s"∂"tmpS""string(j)"" + i := i + 1 + s := s"(" + i := 1 + while i < #posLS+1 repeat + tmpS := stringify args.i + s := s""tmpS"" + if i < #posLS then s := s"," + i := i+1 + s := s")" + + formatSub1(expr : E, args : L E, opPrec : I) : S == + -- This one produces partial derivatives notated by ",n" as + -- subscripts. + -- At this time this is only to handle partial derivatives. + -- If the SUB case handles anything else I'm not aware of it. + -- This an example of the 4th partial of y(x,z) w.r.t. x,x,z,x + -- {{{SUB}{y}{{CONCAT}{{CONCAT}{{CONCAT}{{CONCAT}{,}{1}} + -- {{CONCAT}{,}{1}}}{{CONCAT}{,}{2}}}{{CONCAT}{,}{1}}}}{x}{z}}, + -- here expr is everything in the first set of braces and + -- args is {{x}{z}} + atomE : L E := atomize(expr) + op : S := stringify first atomE + op ^= "SUB" => "Mistake in formatSub: no SUB" + stringify first rest rest atomE ^= "CONCAT" => "Mistake in formatSub: no CONCAT" + -- expecting form for atomE like + --[{SUB}{func}{CONCAT}...{CONCAT}{,}{n}{CONCAT}{,}{n}...{CONCAT}{,}{n}], + --counting the first CONCATs before the comma gives the number of + --derivatives + ndiffs : I := 0 + tmpLE : L E := rest rest atomE + while stringify first tmpLE = "CONCAT" repeat + ndiffs := ndiffs+1 + tmpLE := rest tmpLE + numLS : L S := nil + i : I := 1 + while i < ndiffs repeat + numLS := append(numLS,list(stringify first rest tmpLE)) + tmpLE := rest rest rest tmpLE + i := i+1 + numLS := append(numLS,list(stringify first rest tmpLE)) + -- numLS contains the numbers of the bound variables as strings + -- for the differentiations, thus for the differentiation [x,x,z,x] + -- for y(x,z) numLS = ["1","1","2","1"] + posLS : L S := nil + i := 0 + -- sayTeX$Lisp "formatSub: nargs = "string(#args) + while i < #args repeat + posLS := append(posLS,list(string(i+1))) + i := i+1 + -- posLS contains the positions of the bound variables in args + -- as a list of strings, e.g. for the above example ["1","2"] + funcS: S := stringify atomE.2 + s : S := ""funcS"" + i := 1 + while i < #numLS+1 repeat + s := s","numLS.i"" + i := i + 1 + s := s"(" + i := 1 + while i < #posLS+1 repeat +-- tmpS := stringify args.i + tmpS := formatMml(first args,minPrec) + args := rest args + s := s""tmpS"" + if i < #posLS then s := s"," + i := i+1 + s := s")" + + formatSuperSub(expr : E, args : L E, opPrec : I) : S == + -- this produces prime notation ordinary derivatives. + -- first have to divine the semantics, add cases as needed +-- WriteLine$Lisp "SuperSub1 begin" + atomE : L E := atomize(expr) + op : S := stringify first atomE +-- WriteLine$Lisp "op: "op + op ^= "SUPERSUB" => _ + "Mistake in formatSuperSub: no SUPERSUB1" + #args ^= 1 => "Mistake in SuperSub1: #args <> 1" + var : E := first args + -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}} for + -- example here's the second derivative of y w.r.t. x + -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the + -- {x} + funcS : S := stringify first rest atomE +-- WriteLine$Lisp "funcS: "funcS + bvarS : S := stringify first args +-- WriteLine$Lisp "bvarS: "bvarS + -- count the number of commas + commaS : S := stringify first rest rest rest atomE + commaTest : S := "," + i : I := 0 + while position(commaTest,commaS,1) > 0 repeat + i := i+1 + commaTest := commaTest"," + s : S := ""funcS"" +-- WriteLine$Lisp "s: "s + j : I := 0 + while j < i repeat + s := s"′" + j := j + 1 + s := s"⁡("formatMml(first args,minPrec)")" + + formatSuperSub1(expr : E, args : L E, opPrec : I) : S == + -- This one produces ordinary derivatives with differential notation, + -- it needs a little more work yet. + -- first have to divine the semantics, add cases as needed +-- WriteLine$Lisp "SuperSub begin" + atomE : L E := atomize(expr) + op : S := stringify first atomE + op ^= "SUPERSUB" => _ + "Mistake in formatSuperSub: no SUPERSUB" + #args ^= 1 => "Mistake in SuperSub: #args <> 1" + var : E := first args + -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}} for + -- example here's the second derivative of y w.r.t. x + -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the + -- {x} + funcS : S := stringify first rest atomE + bvarS : S := stringify first args + -- count the number of commas + commaS : S := stringify first rest rest rest atomE + commaTest : S := "," + ndiffs : I := 0 + while position(commaTest,commaS,1) > 0 repeat + ndiffs := ndiffs+1 + commaTest := commaTest"," + s : S := "ⅆ"string(ndiffs)""funcS"ⅆ"formatMml(first args,minPrec)""string(ndiffs)"⁡("formatMml(first args,minPrec)")" + + formatPlex(op : S, args : L E, prec : I) : S == + checkarg:Boolean := false + hold : S + p : I := position(op,plexOps) + p < 1 => error "unknown plex op" + op = "INTSIGN" => formatIntSign(args,minPrec) + opPrec := plexPrecs.p + n : I := #args + (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex" + s : S := + op = "SIGMA" => + checkarg := true + "∑" + -- Sum + op = "SIGMA2" => + checkarg := true + "∑" + -- Sum + op = "PI" => + checkarg := true + "∏" + -- Product + op = "PI2" => + checkarg := true + "∏" + -- Product +-- op = "INTSIGN" => "∫" + -- Integral, int + op = "INDEFINTEGRAL" => "∫" + -- Integral, int + "????" + hold := formatMml(first args,minPrec) + args := rest args + if op ^= "INDEFINTEGRAL" then + if hold ^= "" then + s := concat ["",s,group hold] + else + s := concat ["",s,group " "] + if not null rest args then + hold := formatMml(first args,minPrec) + if hold ^= "" then + s := concat [s,group hold,""] + else + s := concat [s,group " ",""] + args := rest args + -- if checkarg true need to test op arg for "+" at least + -- and wrap parentheses if so + if checkarg then + la : L E := (first args pretend L E) + opa : S := stringify first la + if opa = "+" then + s := concat [s,"(",formatMml(first args,minPrec),")"] + else s := concat [s,formatMml(first args,minPrec)] + else s := concat [s,formatMml(first args,minPrec)] + else + hold := group concat [hold,formatMml(first args,minPrec)] + s := concat [s,hold] +-- if opPrec < prec then s := parenthesize s +-- getting ugly parentheses on fractions + group s + + formatIntSign(args : L E, opPrec : I) : S == + -- the original OutputForm expression looks something like this: + -- {{INTSIGN}{NOTHING or lower limit?} + -- {bvar or upper limit?}{{*}{integrand}{{CONCAT}{d}{axiom var}}}} + -- the args list passed here consists of the rest of this list, i.e. + -- starting at the NOTHING or ... + (stringify first args) = "NOTHING" => + -- the bound variable is the second one in the argument list + bvar : E := first rest args + bvarS : S := stringify bvar + tmpS : S + i : I := 0 + u1 : US + u2 : US + -- this next one atomizes the integrand plus differential + atomE : L E := atomize(first rest rest args) + -- pick out the bound variable used by axiom + varRS : S := stringify last(atomE) + tmpLE : L E := ((first rest rest args) pretend L E) + integrand : S := formatMml(first rest tmpLE,minPrec) + -- replace the bound variable, i.e. axiom uses someting of the form + -- %A for the bound variable and puts the original variable used + -- in the input command as a superscript on the integral sign. + -- I'm assuming that the axiom variable is 2 characters. + while (i := position(varRS,integrand,i+1)) > 0 repeat + u1 := segment(1,i-1)$US + u2 := segment(i+2,#integrand)$US + integrand := concat [integrand.u1,bvarS,integrand.u2] + concat ["∫" integrand "ⅆ" bvarS ""] + + lowlim : S := stringify first args + highlim : S := stringify first rest args + bvar : E := last atomize(first rest rest args) + bvarS : S := stringify bvar + tmpLE : L E := ((first rest rest args) pretend L E) + integrand : S := formatMml(first rest tmpLE,minPrec) + concat ["∫" lowlim "" highlim "" integrand "ⅆ" bvarS ""] + + + formatMatrix(args : L E) : S == + -- format for args is [[ROW ...],[ROW ...],[ROW ...]] + -- generate string for formatting columns (centered) + group addBrackets concat + ["",formatNaryNoGroup("",args,minPrec), + ""] + + formatFunction(op : S, args : L E, prec : I) : S == + group concat ["",op,"",parenthesize formatNary(",",args,minPrec)] + + formatNullary(op : S) == + op = "NOTHING" => "" + group concat ["",op,"()"] + + formatUnary(op : S, arg : E, prec : I) == + p : I := position(op,unaryOps) + p < 1 => error "unknown unary op" + opPrec := unaryPrecs.p + s : S := concat ["",op,"",formatMml(arg,opPrec)] + opPrec < prec => group parenthesize s + op = "-" => s + group s + + formatBinary(op : S, args : L E, prec : I) : S == + p : I := position(op,binaryOps) + p < 1 => error "unknown binary op" + opPrec := binaryPrecs.p + -- if base op is product or sum need to add parentheses + if ATOM(first args)$Lisp@Boolean then + opa:S := stringify first args + else + la : L E := (first args pretend L E) + opa : S := stringify first la + if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2") _ + and op = "**" then + s1:S:=concat ["(",formatMml(first args, opPrec),")"] + else + s1 : S := formatMml(first args, opPrec) + s2 : S := formatMml(first rest args, opPrec) + op := + op = "|" => s := concat ["",s1,"",op,"",s2,""] + op = "**" => s := concat ["",s1,"",s2,""] + op = "/" => s := concat ["",s1,"",s2,""] + op = "OVER" => s := concat ["",s1,"",s2,""] + op = "+->" => s := concat ["",s1,"",op,"",s2,""] + s := concat ["",s1,"",op,"",s2,""] + group + op = "OVER" => s +-- opPrec < prec => parenthesize s +-- ugly parentheses? + s + + formatNary(op : S, args : L E, prec : I) : S == + group formatNaryNoGroup(op, args, prec) + + formatNaryNoGroup(op : S, args : L E, prec : I) : S == + checkargs:Boolean := false + null args => "" + p : I := position(op,naryOps) + p < 1 => error "unknown nary op" + -- need to test for "ZAG" case and divert it here + -- ex 1. continuedFraction(314159/100000) + -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}} + -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} + -- this is the preconditioned output form + -- including "op", the args list would be the rest of this + -- i.e op = '+' and args = {{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}} + -- {{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} + -- ex 2. continuedFraction(14159/100000) + -- this one doesn't have the leading integer + -- {{+}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}} + -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} + -- + -- ex 3. continuedFraction(3,repeating [1], repeating [3,6]) + -- {{+}{3}{{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}} + -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}} + -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{...}} + -- In each of these examples the args list consists of the terms + -- following the '+' op + -- so the first arg could be a "ZAG" or something + -- else, but the second arg looks like it has to be "ZAG", so maybe + -- test for #args > 1 and args.2 contains "ZAG". + -- Note that since the resulting MathML s are nested we need + -- to handle the whole continued fraction at once, i.e. we can't + -- just look for, e.g., {{ZAG}{1}{6}} + (#args > 1) and (position("ZAG",stringify first rest args,1) > 0) => + tmpS : S := stringify first args + position("ZAG",tmpS,1) > 0 => formatZag(args) +-- position("ZAG",tmpS,1) > 0 => formatZag1(args) + concat [formatMml(first args,minPrec) "+" formatZag(rest args)] + -- At least for the ops "*","+","-" we need to test to see if a sigma + -- or pi is one of their arguments because we might need parentheses + -- as indicated by the problem with + -- summation(operator(f)(i),i=1..n)+1 versus + -- summation(operator(f)(i)+1,i=1..n) having identical displays as + -- of 2007-21-21 + op := + op = "," => "," --originally , \: + op = ";" => ";" --originally ; \: should figure these out + op = "*" => "" + -- InvisibleTimes + op = " " => "" + op = "ROW" => "" + op = "+" => + checkargs := true + "+" + op = "-" => + checkargs := true + "-" + op + l : L S := nil + opPrec := naryPrecs.p + -- if checkargs is true check each arg except last one to see if it's + -- a sigma or pi and if so add parentheses. Other op's may have to be + -- checked for in future + count:I := 1 + for a in args repeat +-- WriteLine$Lisp "checking args" + if checkargs then + if count < #args then + -- check here for sum or product + if ATOM(a)$Lisp@Boolean then + opa:S := stringify a + else + la : L E := (a pretend L E) + opa : S := stringify first la + if opa = "SIGMA" or opa = "SIGMA2" or _ + opa = "PI" or opa = "PI2" then + l := concat(op,concat(_ + concat ["(",formatMml(a,opPrec),_ + ")"],l)$L(S))$L(S) + else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) + else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) + else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) + count := count + 1 + s : S := concat reverse rest l + opPrec < prec => parenthesize s + s + + formatZag(args : L E) : S == + -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG + -- must be there, the '1' and '7' could conceivably be more complex + -- expressions + tmpZag : L E := first args pretend L E + -- may want to test that tmpZag contains 'ZAG' + #args > 1 => ""formatMml(first rest tmpZag,minPrec)""formatMml(first rest rest tmpZag,minPrec)"+"formatZag(rest args)"" + -- EQUAL(tmpZag, "...")$Lisp => "…" + (first args = "..."::E)@Boolean => "…" + position("ZAG",stringify first args,1) > 0 => + ""formatMml(first rest tmpZag,minPrec)formatMml(first rest rest tmpZag,minPrec)"" + "formatZag: Unexpected kind of ZAG" + + + formatZag1(args : L E) : S == + -- make alternative ZAG format without diminishing fonts, maybe + -- use a table + -- {{ZAG}{1}{7}} + tmpZag : L E := first args pretend L E + #args > 1 => ""formatMml(first rest tmpZag,minPrec)""formatMml(first rest rest tmpZag,minPrec)"+"formatZag(rest args)"" + (first args = "...":: E)@Boolean => "…" + error "formatZag1: Unexpected kind of ZAG" + + + formatMml(expr : E,prec : I) == + i,len : Integer + intSplitLen : Integer := 20 + ATOM(expr)$Lisp@Boolean => + str := stringify expr + len := #str + -- this bit seems to deal with integers + FIXP$Lisp expr => + i := expr pretend Integer + if (i < 0) or (i > 9) + then + group + nstr : String := "" + -- insert some blanks into the string, if too long + while ((len := #str) > intSplitLen) repeat + nstr := concat [nstr," ", + elt(str,segment(1,intSplitLen)$US)] + str := elt(str,segment(intSplitLen+1)$US) + empty? nstr => concat ["",str,""] + nstr := + empty? str => nstr + concat [nstr," ",str] + concat ["",elt(nstr,segment(2)$US),""] + else str := concat ["",str,""] + str = "%pi" => "π" + -- pi + str = "%e" => "ⅇ" + -- ExponentialE + str = "%i" => "ⅈ" + -- ImaginaryI + len > 0 and str.1 = char "%" => concat(concat("",str),"") + len > 1 and digit? str.1 => concat ["",str,""] -- should handle floats + -- presumably this is a literal string + len > 0 and str.1 = char "_"" => + concat(concat("",str),"") + len = 1 and str.1 = char " " => " " + (i := position(str,specialStrings)) > 0 => + specialStringsInMML.i + (i := position(char " ",str)) > 0 => + -- We want to preserve spacing, so use a roman font. + -- What's this for? Leave the \rm in for now so I can see + -- where it arises. Removed 2007-02-14 + concat(concat("",str),"") + -- if we get to here does that mean it's a variable? + concat ["",str,""] + l : L E := (expr pretend L E) + null l => blank + op : S := stringify first l + args : L E := rest l + nargs : I := #args + -- need to test here in case first l is SUPERSUB case and then + -- pass first l and args to formatSuperSub. + position("SUPERSUB",op,1) > 0 => + formatSuperSub(first l,args,minPrec) + -- now test for SUB + position("SUB",op,1) > 0 => + formatSub1(first l,args,minPrec) + + -- special cases + member?(op, specialOps) => formatSpecial(op,args,prec) + member?(op, plexOps) => formatPlex(op,args,prec) + + -- nullary case + 0 = nargs => formatNullary op + + -- unary case + (1 = nargs) and member?(op, unaryOps) => + formatUnary(op, first args, prec) + + -- binary case + (2 = nargs) and member?(op, binaryOps) => + formatBinary(op, args, prec) + + -- nary case + member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) + member?(op,naryOps) => formatNary(op,args, prec) + + op := formatMml(first l,minPrec) + formatFunction(op,args,prec) + +@ +\subsection{Mathematical Markup Language Form} +\pagehead{MathMLForm}{MMLFORM} +\pagepic{ps/v104mathmlform.ps}{MMLFORM}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +<> +<> +<> +<> +<> +<> + +@ +<>= +"MMLFORM" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MMLFORM"] +"FSAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FSAGG"] +"MMLFORM" -> "FSAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MATCAT2 MatrixCategoryFunctions2} +\pagehead{MatrixCategoryFunctions2}{MATCAT2} +\pagepic{ps/v104MatrixCategoryFunctions2.ps}{MATCAT2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MATCAT2 MatrixCategoryFunctions2 +++ Author: Clifton J. Williamson +++ Date Created: 21 November 1989 +++ Date Last Updated: 21 March 1994 +++ Basic Operations: +++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), +++ RectangularMatrix(n,m,R), SquareMatrix(n,R) +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Keywords: matrix, map, reduce +++ Examples: +++ References: +++ Description: +++ \spadtype{MatrixCategoryFunctions2} provides functions between two matrix +++ domains. The functions provided are \spadfun{map} and \spadfun{reduce}. +MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ + Exports == Implementation where + R1 : Ring + Row1 : FiniteLinearAggregate R1 + Col1 : FiniteLinearAggregate R1 + M1 : MatrixCategory(R1,Row1,Col1) + R2 : Ring + Row2 : FiniteLinearAggregate R2 + Col2 : FiniteLinearAggregate R2 + M2 : MatrixCategory(R2,Row2,Col2) + + Exports ==> with + map: (R1 -> R2,M1) -> M2 + ++ \spad{map(f,m)} applies the function f to the elements of the matrix m. + map: (R1 -> Union(R2,"failed"),M1) -> Union(M2,"failed") + ++ \spad{map(f,m)} applies the function f to the elements of the matrix m. + reduce: ((R1,R2) -> R2,M1,R2) -> R2 + ++ \spad{reduce(f,m,r)} returns a matrix n where + ++ \spad{n[i,j] = f(m[i,j],r)} for all indices i and j. + + Implementation ==> add + minr ==> minRowIndex + maxr ==> maxRowIndex + minc ==> minColIndex + maxc ==> maxColIndex + + map(f:(R1->R2),m:M1):M2 == + ans : M2 := new(nrows m,ncols m,0) + for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat + for j in minc(m)..maxc(m) for l in minc(ans)..maxc(ans) repeat + qsetelt_!(ans,k,l,f qelt(m,i,j)) + ans + + map(f:(R1 -> (Union(R2,"failed"))),m:M1):Union(M2,"failed") == + ans : M2 := new(nrows m,ncols m,0) + for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat + for j in minc(m)..maxc(m) for l in minc(ans)..maxc(ans) repeat + (r := f qelt(m,i,j)) = "failed" => return "failed" + qsetelt_!(ans,k,l,r::R2) + ans + + reduce(f,m,ident) == + s := ident + for i in minr(m)..maxr(m) repeat + for j in minc(m)..maxc(m) repeat + s := f(qelt(m,i,j),s) + s + +@ +<>= +"MATCAT2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MATCAT2"] +"MATCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=MATCAT"] +"MATCAT2" -> "MATCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MCDEN MatrixCommonDenominator} \pagehead{MatrixCommonDenominator}{MCDEN} \pagepic{ps/v104matrixcommondenominator.ps}{MCDEN}{1.00} @@ -37237,6 +42331,352 @@ MatrixCommonDenominator(R, Q): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MATLIN MatrixLinearAlgebraFunctions} +\pagehead{MatrixLinearAlgebraFunctions}{MATLIN} +\pagepic{ps/v104matrixlinearalgebrafunctions.ps}{MATLIN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MATLIN MatrixLinearAlgebraFunctions +++ Author: Clifton J. Williamson, P.Gianni +++ Date Created: 13 November 1989 +++ Date Last Updated: December 1992 +++ Basic Operations: +++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), +++ RectangularMatrix(n,m,R), SquareMatrix(n,R) +++ Also See: +++ AMS Classifications: +++ Keywords: matrix, canonical forms, linear algebra +++ Examples: +++ References: +++ Description: +++ \spadtype{MatrixLinearAlgebraFunctions} provides functions to compute +++ inverses and canonical forms. +MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where + R : CommutativeRing + Row : FiniteLinearAggregate R + Col : FiniteLinearAggregate R + M : MatrixCategory(R,Row,Col) + I ==> Integer + + Exports ==> with + + determinant: M -> R + ++ \spad{determinant(m)} returns the determinant of the matrix m. + ++ an error message is returned if the matrix is not square. + minordet: M -> R + ++ \spad{minordet(m)} computes the determinant of the matrix m using + ++ minors. Error: if the matrix is not square. + elRow1! : (M,I,I) -> M + ++ elRow1!(m,i,j) swaps rows i and j of matrix m : elementary operation + ++ of first kind + elRow2! : (M,R,I,I) -> M + ++ elRow2!(m,a,i,j) adds to row i a*row(m,j) : elementary operation of + ++ second kind. (i ^=j) + elColumn2! : (M,R,I,I) -> M + ++ elColumn2!(m,a,i,j) adds to column i a*column(m,j) : elementary + ++ operation of second kind. (i ^=j) + + if R has IntegralDomain then + rank: M -> NonNegativeInteger + ++ \spad{rank(m)} returns the rank of the matrix m. + nullity: M -> NonNegativeInteger + ++ \spad{nullity(m)} returns the mullity of the matrix m. This is + ++ the dimension of the null space of the matrix m. + nullSpace: M -> List Col + ++ \spad{nullSpace(m)} returns a basis for the null space of the + ++ matrix m. + fractionFreeGauss! : M -> M + ++ \spad{fractionFreeGauss(m)} performs the fraction + ++ free gaussian elimination on the matrix m. + invertIfCan : M -> Union(M,"failed") + ++ \spad{invertIfCan(m)} returns the inverse of m over R + adjoint : M -> Record(adjMat:M, detMat:R) + ++ \spad{adjoint(m)} returns the ajoint matrix of m (i.e. the matrix + ++ n such that m*n = determinant(m)*id) and the detrminant of m. + + if R has EuclideanDomain then + rowEchelon: M -> M + ++ \spad{rowEchelon(m)} returns the row echelon form of the matrix m. + + normalizedDivide: (R, R) -> Record(quotient:R, remainder:R) + ++ normalizedDivide(n,d) returns a normalized quotient and + ++ remainder such that consistently unique representatives + ++ for the residue class are chosen, e.g. positive remainders + + if R has Field then + inverse: M -> Union(M,"failed") + ++ \spad{inverse(m)} returns the inverse of the matrix. + ++ If the matrix is not invertible, "failed" is returned. + ++ Error: if the matrix is not square. + + Implementation ==> add + + rowAllZeroes?: (M,I) -> Boolean + rowAllZeroes?(x,i) == + -- determines if the ith row of x consists only of zeroes + -- internal function: no check on index i + for j in minColIndex(x)..maxColIndex(x) repeat + qelt(x,i,j) ^= 0 => return false + true + + colAllZeroes?: (M,I) -> Boolean + colAllZeroes?(x,j) == + -- determines if the ith column of x consists only of zeroes + -- internal function: no check on index j + for i in minRowIndex(x)..maxRowIndex(x) repeat + qelt(x,i,j) ^= 0 => return false + true + + minorDet:(M,I,List I,I,PrimitiveArray(Union(R,"uncomputed")))-> R + minorDet(x,m,l,i,v) == + z := v.m + z case R => z + ans : R := 0; rl : List I := nil() + j := first l; l := rest l; pos := true + minR := minRowIndex x; minC := minColIndex x; + repeat + if qelt(x,j + minR,i + minC) ^= 0 then + ans := + md := minorDet(x,m - 2**(j :: NonNegativeInteger),_ + concat_!(reverse rl,l),i + 1,v) *_ + qelt(x,j + minR,i + minC) + pos => ans + md + ans - md + null l => + v.m := ans + return ans + pos := not pos; rl := cons(j,rl); j := first l; l := rest l + + minordet x == + (ndim := nrows x) ^= (ncols x) => + error "determinant: matrix must be square" + -- minor expansion with (s---loads of) memory + n1 : I := ndim - 1 + v : PrimitiveArray(Union(R,"uncomputed")) := + new((2**ndim - 1) :: NonNegativeInteger,"uncomputed") + minR := minRowIndex x; maxC := maxColIndex x + for i in 0..n1 repeat + qsetelt_!(v,(2**i - 1),qelt(x,i + minR,maxC)) + minorDet(x, 2**ndim - 2, [i for i in 0..n1], 0, v) + + -- elementary operation of first kind: exchange two rows -- + elRow1!(m:M,i:I,j:I) : M == + vec:=row(m,i) + setRow!(m,i,row(m,j)) + setRow!(m,j,vec) + m + + -- elementary operation of second kind: add to row i-- + -- a*row j (i^=j) -- + elRow2!(m : M,a:R,i:I,j:I) : M == + vec:= map(a*#1,row(m,j)) + vec:=map("+",row(m,i),vec) + setRow!(m,i,vec) + m + -- elementary operation of second kind: add to column i -- + -- a*column j (i^=j) -- + elColumn2!(m : M,a:R,i:I,j:I) : M == + vec:= map(a*#1,column(m,j)) + vec:=map("+",column(m,i),vec) + setColumn!(m,i,vec) + m + + if R has IntegralDomain then + -- Fraction-Free Gaussian Elimination + fractionFreeGauss! x == + (ndim := nrows x) = 1 => x + ans := b := 1$R + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := maxColIndex x + i := minR + for j in minC..maxC repeat + if qelt(x,i,j) = 0 then -- candidate for pivot = 0 + rown := minR - 1 + for k in (i+1)..maxR repeat + if qelt(x,k,j) ^= 0 then + rown := k -- found a pivot + leave + if rown > minR - 1 then + swapRows_!(x,i,rown) + ans := -ans + (c := qelt(x,i,j)) = 0 => "next j" -- try next column + for k in (i+1)..maxR repeat + if qelt(x,k,j) = 0 then + for l in (j+1)..maxC repeat + qsetelt_!(x,k,l,(c * qelt(x,k,l) exquo b) :: R) + else + pv := qelt(x,k,j) + qsetelt_!(x,k,j,0) + for l in (j+1)..maxC repeat + val := c * qelt(x,k,l) - pv * qelt(x,i,l) + qsetelt_!(x,k,l,(val exquo b) :: R) + b := c + (i := i+1)>maxR => leave + if ans=-1 then + lasti := i-1 + for j in 1..maxC repeat x(lasti, j) := -x(lasti,j) + x + + -- + lastStep(x:M) : M == + ndim := nrows x + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := minC+ndim -1 + exCol:=maxColIndex x + det:=x(maxR,maxC) + maxR1:=maxR-1 + maxC1:=maxC+1 + minC1:=minC+1 + iRow:=maxR + iCol:=maxC-1 + for i in maxR1..1 by -1 repeat + for j in maxC1..exCol repeat + ss:=+/[x(i,iCol+k)*x(i+k,j) for k in 1..(maxR-i)] + x(i,j) := _exquo((det * x(i,j) - ss),x(i,iCol))::R + iCol:=iCol-1 + subMatrix(x,minR,maxR,maxC1,exCol) + + invertIfCan(y) == + (nr:=nrows y) ^= (ncols y) => + error "invertIfCan: matrix must be square" + adjRec := adjoint y + (den:=recip(adjRec.detMat)) case "failed" => "failed" + den::R * adjRec.adjMat + + adjoint(y) == + (nr:=nrows y) ^= (ncols y) => error "adjoint: matrix must be square" + maxR := maxRowIndex y + maxC := maxColIndex y + x := horizConcat(copy y,scalarMatrix(nr,1$R)) + ffr:= fractionFreeGauss!(x) + det:=ffr(maxR,maxC) + [lastStep(ffr),det] + + + if R has Field then + + VR ==> Vector R + IMATLIN ==> InnerMatrixLinearAlgebraFunctions(R,Row,Col,M) + MMATLIN ==> InnerMatrixLinearAlgebraFunctions(R,VR,VR,Matrix R) + FLA2 ==> FiniteLinearAggregateFunctions2(R, VR, R, Col) + MAT2 ==> MatrixCategoryFunctions2(R,Row,Col,M,R,VR,VR,Matrix R) + + rowEchelon y == rowEchelon(y)$IMATLIN + rank y == rank(y)$IMATLIN + nullity y == nullity(y)$IMATLIN + determinant y == determinant(y)$IMATLIN + inverse y == inverse(y)$IMATLIN + if Col has shallowlyMutable then + nullSpace y == nullSpace(y)$IMATLIN + else + nullSpace y == + [map(#1, v)$FLA2 for v in nullSpace(map(#1, y)$MAT2)$MMATLIN] + + else if R has IntegralDomain then + QF ==> Fraction R + Row2 ==> Vector QF + Col2 ==> Vector QF + M2 ==> Matrix QF + IMATQF ==> InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2) + + nullSpace m == nullSpace(m)$IMATQF + + determinant y == + (nrows y) ^= (ncols y) => error "determinant: matrix must be square" + fm:=fractionFreeGauss!(copy y) + fm(maxRowIndex fm,maxColIndex fm) + + rank x == + y := + (rk := nrows x) > (rh := ncols x) => + rk := rh + transpose x + copy x + y := fractionFreeGauss! y + i := maxRowIndex y + while rk > 0 and rowAllZeroes?(y,i) repeat + i := i - 1 + rk := (rk - 1) :: NonNegativeInteger + rk :: NonNegativeInteger + + nullity x == (ncols x - rank x) :: NonNegativeInteger + + if R has EuclideanDomain then + + if R has IntegerNumberSystem then + normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == + qr := divide(n, d) + qr.remainder >= 0 => qr + d > 0 => + qr.remainder := qr.remainder + d + qr.quotient := qr.quotient - 1 + qr + qr.remainder := qr.remainder - d + qr.quotient := qr.quotient + 1 + qr + else + normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == + divide(n, d) + + rowEchelon y == + x := copy y + minR := minRowIndex x; maxR := maxRowIndex x + minC := minColIndex x; maxC := maxColIndex x + n := minR - 1 + i := minR + for j in minC..maxC repeat + if i > maxR then leave x + n := minR - 1 + xnj: R + for k in i..maxR repeat + if not zero?(xkj:=qelt(x,k,j)) and ((n = minR - 1) _ + or sizeLess?(xkj,xnj)) then + n := k + xnj := xkj + n = minR - 1 => "next j" + swapRows_!(x,i,n) + for k in (i+1)..maxR repeat + qelt(x,k,j) = 0 => "next k" + aa := extendedEuclidean(qelt(x,i,j),qelt(x,k,j)) + (a,b,d) := (aa.coef1,aa.coef2,aa.generator) + b1 := (qelt(x,i,j) exquo d) :: R + a1 := (qelt(x,k,j) exquo d) :: R + -- a*b1+a1*b = 1 + for k1 in (j+1)..maxC repeat + val1 := a * qelt(x,i,k1) + b * qelt(x,k,k1) + val2 := -a1 * qelt(x,i,k1) + b1 * qelt(x,k,k1) + qsetelt_!(x,i,k1,val1); qsetelt_!(x,k,k1,val2) + qsetelt_!(x,i,j,d); qsetelt_!(x,k,j,0) + + un := unitNormal qelt(x,i,j) + qsetelt_!(x,i,j,un.canonical) + if un.associate ^= 1 then for jj in (j+1)..maxC repeat + qsetelt_!(x,i,jj,un.associate * qelt(x,i,jj)) + + xij := qelt(x,i,j) + for k in minR..(i-1) repeat + qelt(x,k,j) = 0 => "next k" + qr := normalizedDivide(qelt(x,k,j), xij) + qsetelt_!(x,k,j,qr.remainder) + for k1 in (j+1)..maxC repeat + qsetelt_!(x,k,k1,qelt(x,k,k1) - qr.quotient * qelt(x,i,k1)) + i := i + 1 + x + + else determinant x == minordet x + +@ +<>= +"MATLIN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MATLIN"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MATLIN" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MTHING MergeThing} \pagehead{MergeThing}{MTHING} \pagepic{ps/v104mergething.ps}{MTHING}{1.00} @@ -37284,6 +42724,398 @@ MergeThing(S:OrderedSet): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MESH MeshCreationRoutinesForThreeDimensions} +\pagehead{MeshCreationRoutinesForThreeDimensions}{MESH} +\pagepic{ps/v104meshcreationroutinesforthreedimensions.ps}{MESH}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MESH MeshCreationRoutinesForThreeDimensions +++ +++ Author: Jim Wen +++ Date Created: ?? +++ Date Last Updated: October 1991 by Jon Steinbach +++ Keywords: +++ Examples: +++ References: +MeshCreationRoutinesForThreeDimensions():Exports == Implementation where + + I ==> Integer + PI ==> PositiveInteger + SF ==> DoubleFloat + L ==> List + SEG ==> Segment + S ==> String + Fn1 ==> SF -> SF + Fn2 ==> (SF,SF) -> SF + Fn3 ==> (SF,SF,SF) -> SF + FnPt ==> (SF,SF) -> Point(SF) + FnU ==> Union(Fn3,"undefined") + EX ==> Expression + DROP ==> DrawOption + POINT ==> Point(SF) + SPACE3 ==> ThreeSpace(SF) + COMPPROP ==> SubSpaceComponentProperty + TUBE ==> TubePlot + + Exports ==> with + meshPar2Var: (Fn2,Fn2,Fn2,FnU,SEG SF,SEG SF,L DROP) -> SPACE3 + ++ meshPar2Var(f,g,h,j,s1,s2,l) \undocumented + meshPar2Var: (FnPt,SEG SF,SEG SF,L DROP) -> SPACE3 + ++ meshPar2Var(f,s1,s2,l) \undocumented + meshPar2Var: (SPACE3,FnPt,SEG SF,SEG SF,L DROP) -> SPACE3 + ++ meshPar2Var(sp,f,s1,s2,l) \undocumented + meshFun2Var: (Fn2,FnU,SEG SF,SEG SF,L DROP) -> SPACE3 + ++ meshFun2Var(f,g,s1,s2,l) \undocumented + meshPar1Var: (EX I,EX I,EX I,Fn1,SEG SF,L DROP) -> SPACE3 + ++ meshPar1Var(s,t,u,f,s1,l) \undocumented + ptFunc: (Fn2,Fn2,Fn2,Fn3) -> ((SF,SF) -> POINT) + ++ ptFunc(a,b,c,d) is an internal function exported in + ++ order to compile packages. + + Implementation ==> add + import ViewDefaultsPackage() + import SubSpaceComponentProperty() + import DrawOptionFunctions0 + import SPACE3 + --import TUBE() + + -- local functions + numberCheck(nums:Point SF):Void == + -- this function checks to see that the small floats are + -- actually just that - rather than complex numbers or + -- whatever (the whatever includes nothing presently + -- since NaN, Not a Number, is not necessarily supported + -- by common lisp). note that this function is dependent + -- upon the fact that Common Lisp supports complex numbers. + for i in minIndex(nums)..maxIndex(nums) repeat + COMPLEXP(nums.(i::PositiveInteger))$Lisp => + error "An unexpected complex number was encountered in the calculations." + + makePt:(SF,SF,SF,SF) -> POINT + makePt(x,y,z,c) == point(l : List SF := [x,y,z,c]) + ptFunc(f,g,h,c) == + x := f(#1,#2); y := g(#1,#2); z := h(#1,#2) + makePt(x,y,z,c(x,y,z)) + + -- parameterized equations of two variables + meshPar2Var(sp,ptFun,uSeg,vSeg,opts) == + -- the issue of open and closed needs to be addressed, here, we are + -- defaulting to open (which is probably the correct default) + -- the user should be able to override that (optional argument?) + llp : L L POINT := nil() + uNum : PI := var1Steps(opts,var1StepsDefault()) + vNum : PI := var2Steps(opts,var2StepsDefault()) + ustep := (lo uSeg - hi uSeg)/uNum + vstep := (lo vSeg - hi vSeg)/vNum + someV := hi vSeg + for iv in vNum..0 by -1 repeat + if zero? iv then someV := lo vSeg + -- hack: get last number in segment within segment + lp : L POINT := nil() + someU := hi uSeg + for iu in uNum..0 by -1 repeat + if zero? iu then someU := lo uSeg + -- hack: get last number in segment within segment + pt := ptFun(someU,someV) + numberCheck pt + lp := concat(pt,lp) + someU := someU + ustep + llp := concat(lp,llp) + someV := someV + vstep + -- now llp contains a list of lists of points + -- for a surface that is a result of a function of 2 variables, + -- the main component is open and each sublist is open as well + lProp : L COMPPROP := [ new() for l in llp ] + for aProp in lProp repeat + close(aProp,false) + solid(aProp,false) + aProp : COMPPROP:= new() + close(aProp,false) + solid(aProp,false) + space := sp +-- space := create3Space() + mesh(space,llp,lProp,aProp) + space + + meshPar2Var(ptFun,uSeg,vSeg,opts) == + sp := create3Space() + meshPar2Var(sp,ptFun,uSeg,vSeg,opts) + + zCoord: (SF,SF,SF) -> SF + zCoord(x,y,z) == z + + meshPar2Var(xFun,yFun,zFun,colorFun,uSeg,vSeg,opts) == + -- the color function should be parameterized by (u,v) as well, + -- not (x,y,z) but we also want some sort of consistency and so + -- changing this over would mean possibly changing the explicit + -- stuff over and there, we probably do want the color function + -- to be parameterized by (x,y,z) - not just (x,y) (this being + -- for convinience only since z is also defined in terms of (x,y)). + (colorFun case Fn3) => + meshPar2Var(ptFunc(xFun,yFun,zFun,colorFun :: Fn3),uSeg,vSeg,opts) + meshPar2Var(ptFunc(xFun,yFun,zFun,zCoord),uSeg,vSeg,opts) + + -- explicit equations of two variables + meshFun2Var(zFun,colorFun,xSeg,ySeg,opts) == + -- here, we construct the data for a function of two variables + meshPar2Var(#1,#2,zFun,colorFun,xSeg,ySeg,opts) + +@ +<>= +"MESH" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MESH"] +"FIELD" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FIELD"] +"RADCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RADCAT"] +"MESH" -> "FIELD" +"MESH" -> "RADCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MDDFACT ModularDistinctDegreeFactorizer} +\pagehead{ModularDistinctDegreeFactorizer}{MDDFACT} +\pagepic{ps/v104modulardistinctdegreefactorizer.ps}{MDDFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MDDFACT ModularDistinctDegreeFactorizer +++ Author: Barry Trager +++ Date Created: +++ Date Last Updated: 20.9.95 (JHD) +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package supports factorization and gcds +++ of univariate polynomials over the integers modulo different +++ primes. The inputs are given as polynomials over the integers +++ with the prime passed explicitly as an extra argument. + +ModularDistinctDegreeFactorizer(U):C == T where + U : UnivariatePolynomialCategory(Integer) + I ==> Integer + NNI ==> NonNegativeInteger + PI ==> PositiveInteger + V ==> Vector + L ==> List + DDRecord ==> Record(factor:EMR,degree:I) + UDDRecord ==> Record(factor:U,degree:I) + DDList ==> L DDRecord + UDDList ==> L UDDRecord + + + C == with + gcd:(U,U,I) -> U + ++ gcd(f1,f2,p) computes the gcd of the univariate polynomials + ++ f1 and f2 modulo the integer prime p. + linears: (U,I) -> U + ++ linears(f,p) returns the product of all the linear factors + ++ of f modulo p. Potentially incorrect result if f is not + ++ square-free modulo p. + factor:(U,I) -> L U + ++ factor(f1,p) returns the list of factors of the univariate + ++ polynomial f1 modulo the integer prime p. + ++ Error: if f1 is not square-free modulo p. + ddFact:(U,I) -> UDDList + ++ ddFact(f,p) computes a distinct degree factorization of the + ++ polynomial f modulo the prime p, i.e. such that each factor + ++ is a product of irreducibles of the same degrees. The input + ++ polynomial f is assumed to be square-free modulo p. + separateFactors:(UDDList,I) -> L U + ++ separateFactors(ddl, p) refines the distinct degree factorization + ++ produced by \spadfunFrom{ddFact}{ModularDistinctDegreeFactorizer} + ++ to give a complete list of factors. + exptMod:(U,I,U,I) -> U + ++ exptMod(f,n,g,p) raises the univariate polynomial f to the nth + ++ power modulo the polynomial g and the prime p. + + T == add + reduction(u:U,p:I):U == + zero? p => u + map(positiveRemainder(#1,p),u) + merge(p:I,q:I):Union(I,"failed") == + p = q => p + p = 0 => q + q = 0 => p + "failed" + modInverse(c:I,p:I):I == + (extendedEuclidean(c,p,1)::Record(coef1:I,coef2:I)).coef1 + exactquo(u:U,v:U,p:I):Union(U,"failed") == + invlcv:=modInverse(leadingCoefficient v,p) + r:=monicDivide(u,reduction(invlcv*v,p)) + reduction(r.remainder,p) ^=0 => "failed" + reduction(invlcv*r.quotient,p) + EMR := EuclideanModularRing(Integer,U,Integer, + reduction,merge,exactquo) + + probSplit2:(EMR,EMR,I) -> Union(List EMR,"failed") + trace:(EMR,I,EMR) -> EMR + ddfactor:EMR -> L EMR + ddfact:EMR -> DDList + sepFact1:DDRecord -> L EMR + sepfact:DDList -> L EMR + probSplit:(EMR,EMR,I) -> Union(L EMR,"failed") + makeMonic:EMR -> EMR + exptmod:(EMR,I,EMR) -> EMR + + lc(u:EMR):I == leadingCoefficient(u::U) + degree(u:EMR):I == degree(u::U) + makeMonic(u) == modInverse(lc(u),modulus(u)) * u + + i:I + + exptmod(u1,i,u2) == + i < 0 => error("negative exponentiation not allowed for exptMod") + ans:= 1$EMR + while i > 0 repeat + if odd?(i) then ans:= (ans * u1) rem u2 + i:= i quo 2 + u1:= (u1 * u1) rem u2 + ans + + exptMod(a,i,b,q) == + ans:= exptmod(reduce(a,q),i,reduce(b,q)) + ans::U + + ddfactor(u) == + if (c:= lc(u)) ^= 1$I then u:= makeMonic(u) + ans:= sepfact(ddfact(u)) + cons(c::EMR,[makeMonic(f) for f in ans | degree(f) > 0]) + + gcd(u,v,q) == gcd(reduce(u,q),reduce(v,q))::U + + factor(u,q) == + v:= reduce(u,q) + dv:= reduce(differentiate(u),q) + degree gcd(v,dv) > 0 => + error("Modular factor: polynomial must be squarefree") + ans:= ddfactor v + [f::U for f in ans] + + ddfact(u) == + p:=modulus u + w:= reduce(monomial(1,1)$U,p) + m:= w + d:I:= 1 + if (c:= lc(u)) ^= 1$I then u:= makeMonic u + ans:DDList:= [] + repeat + w:= exptmod(w,p,u) + g:= gcd(w - m,u) + if degree g > 0 then + g:= makeMonic(g) + ans:= [[g,d],:ans] + u:= (u quo g) + degree(u) = 0 => return [[c::EMR,0$I],:ans] + d:= d+1 + d > (degree(u):I quo 2) => + return [[c::EMR,0$I],[u,degree(u)],:ans] + + ddFact(u,q) == + ans:= ddfact(reduce(u,q)) + [[(dd.factor)::U,dd.degree]$UDDRecord for dd in ans]$UDDList + + linears(u,q) == + uu:=reduce(u,q) + m:= reduce(monomial(1,1)$U,q) + gcd(exptmod(m,q,uu)-m,uu)::U + + sepfact(factList) == + "append"/[sepFact1(f) for f in factList] + + separateFactors(uddList,q) == + ans:= sepfact [[reduce(udd.factor,q),udd.degree]$DDRecord for + udd in uddList]$DDList + [f::U for f in ans] + + decode(s:Integer, p:Integer, x:U):U == + s

s::U + qr := divide(s,p) + qr.remainder :: U + x*decode(qr.quotient, p, x) + + sepFact1(f) == + u:= f.factor + p:=modulus u + (d := f.degree) = 0 => [u] + if (c:= lc(u)) ^= 1$I then u:= makeMonic(u) + d = (du := degree(u)) => [u] + ans:L EMR:= [] + x:U:= monomial(1,1) + -- for small primes find linear factors by exhaustion + d=1 and p < 1000 => + for i in 0.. while du > 0 repeat + if u(i::U) = 0 then + ans := cons(reduce(x-(i::U),p),ans) + du := du-1 + ans + y:= x + s:I:= 0 + ss:I := 1 + stack:L EMR:= [u] + until null stack repeat + t:= reduce(((s::U)+x),p) + if not ((flist:= probSplit(first stack,t,d)) case "failed") then + stack:= rest stack + for fact in flist repeat + f1:= makeMonic(fact) + (df1:= degree(f1)) = 0 => nil + df1 > d => stack:= [f1,:stack] + ans:= [f1,:ans] + p = 2 => + ss:= ss + 1 + x := y * decode(ss, p, y) + s:= s+1 + s = p => + s:= 0 + ss := ss + 1 + x:= y * decode(ss, p, y) +-- not one? leadingCoefficient(x) => + not (leadingCoefficient(x) = 1) => + ss := p ** degree x + x:= y ** (degree(x) + 1) + [c * first(ans),:rest(ans)] + + probSplit(u,t,d) == + (p:=modulus(u)) = 2 => probSplit2(u,t,d) + f1:= gcd(u,t) + r:= ((p**(d:NNI)-1) quo 2):NNI + n:= exptmod(t,r,u) + f2:= gcd(u,n + 1) + (g:= f1 * f2) = 1 => "failed" + g = u => "failed" + [f1,f2,(u quo g)] + + probSplit2(u,t,d) == + f:= gcd(u,trace(t,d,u)) + f = 1 => "failed" + degree u = degree f => "failed" + [1,f,u quo f] + + trace(t,d,u) == + p:=modulus(t) + d:= d - 1 + tt:=t + while d > 0 repeat + tt:= (tt + (t:=exptmod(t,p,u))) rem u + d:= d - 1 + tt + +@ +<>= +"MDDFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MDDFACT"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MDDFACT" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MHROWRED ModularHermitianRowReduction} \pagehead{ModularHermitianRowReduction}{MHROWRED} \pagepic{ps/v104modularhermitianrowreduction.ps}{MHROWRED}{1.00} @@ -37540,6 +43372,54 @@ ModularHermitianRowReduction(R): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MRF2 MonoidRingFunctions2} +\pagehead{MonoidRingFunctions2}{MRF2} +\pagepic{ps/v104monoidringfunctions2.ps}{MRF2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MRF2 MonoidRingFunctions2 +++ Author: Johannes Grabmeier +++ Date Created: 14 May 1991 +++ Date Last Updated: 14 May 1991 +++ Basic Operations: map +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: monoid ring, group ring, change of coefficient domain +++ References: +++ Description: +++ MonoidRingFunctions2 implements functions between +++ two monoid rings defined with the same monoid over different rings. +MonoidRingFunctions2(R,S,M) : Exports == Implementation where + R : Ring + S : Ring + M : Monoid + Exports ==> with + map: (R -> S, MonoidRing(R,M)) -> MonoidRing(S,M) + ++ map(f,u) maps f onto the coefficients f the element + ++ u of the monoid ring to create an element of a monoid + ++ ring with the same monoid b. + Implementation ==> add + map(fn, u) == + res : MonoidRing(S,M) := 0 + for te in terms u repeat + res := res + monomial(fn(te.coef), te.monom) + res + +@ +<>= +"MRF2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MRF2"] +"LMODULE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=LMODULE"] +"SGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=SGROUP"] +"MRF2" -> "LMODULE" +"MRF2" -> "SGROUP" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MONOTOOL MonomialExtensionTools} \pagehead{MonomialExtensionTools}{MONOTOOL} \pagepic{ps/v104monomialextensiontools.ps}{MONOTOOL}{1.00} @@ -37931,6 +43811,513 @@ MRationalFactorize(E,OV,R,P) : C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MFINFACT MultFiniteFactorize} +\pagehead{MultFiniteFactorize}{MFINFACT} +\pagepic{ps/v104multfinitefactorize.ps}{MFINFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MFINFACT MultFiniteFactorize +++ Author: P. Gianni +++ Date Created: Summer 1990 +++ Date Last Updated: 19 March 1992 +++ Basic Functions: +++ Related Constructors: PrimeField, FiniteField, Polynomial +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: Package for factorization of multivariate polynomials +++ over finite fields. + + +MultFiniteFactorize(OV,E,F,PG) : C == T + where + F : FiniteFieldCategory + OV : OrderedSet + E : OrderedAbelianMonoidSup + PG : PolynomialCategory(F,E,OV) + SUP ==> SparseUnivariatePolynomial + R ==> SUP F + P ==> SparseMultivariatePolynomial(R,OV) + Z ==> Integer + FFPOLY ==> FiniteFieldPolynomialPackage(F) + MParFact ==> Record(irr:P,pow:Z) + MFinalFact ==> Record(contp:R,factors:List MParFact) + SUParFact ==> Record(irr:SUP P,pow:Z) + SUPFinalFact ==> Record(contp:R,factors:List SUParFact) + + -- contp = content, + -- factors = List of irreducible factors with exponent + + C == with + + factor : PG -> Factored PG + ++ factor(p) produces the complete factorization of the multivariate + ++ polynomial p over a finite field. + factor : SUP PG -> Factored SUP PG + ++ factor(p) produces the complete factorization of the multivariate + ++ polynomial p over a finite field. p is represented as a univariate + ++ polynomial with multivariate coefficients over a finite field. + + T == add + + import LeadingCoefDetermination(OV,IndexedExponents OV,R,P) + import MultivariateLifting(IndexedExponents OV,OV,R,P) + import FactoringUtilities(IndexedExponents OV,OV,R,P) + import FactoringUtilities(E,OV,F,PG) + import GenExEuclid(R,SUP R) + + NNI ==> NonNegativeInteger + L ==> List + UPCF2 ==> UnivariatePolynomialCategoryFunctions2 + LeadFact ==> Record(polfac:L P,correct:R,corrfact:L SUP R) + ContPrim ==> Record(cont:P,prim:P) + ParFact ==> Record(irr:SUP R,pow:Z) + FinalFact ==> Record(contp:R,factors:L ParFact) + NewOrd ==> Record(npol:SUP P,nvar:L OV,newdeg:L NNI) + Valuf ==> Record(inval:L L R,unvfact:L SUP R,lu:R,complead:L R) + + ---- Local Functions ---- + ran : Z -> R + mFactor : (P,Z) -> MFinalFact + supFactor : (SUP P,Z) -> SUPFinalFact + mfconst : (SUP P,Z,L OV,L NNI) -> L SUP P + mfpol : (SUP P,Z,L OV,L NNI) -> L SUP P + varChoose : (P,L OV,L NNI) -> NewOrd + simplify : (P,Z,L OV,L NNI) -> MFinalFact + intChoose : (SUP P,L OV,R,L P,L L R) -> Valuf + pretest : (P,NNI,L OV,L R) -> FinalFact + checkzero : (SUP P,SUP R) -> Boolean + pushdcoef : PG -> P + pushdown : (PG,OV) -> P + pushupconst : (R,OV) -> PG + pushup : (P,OV) -> PG + norm : L SUP R -> Integer + constantCase : (P,L MParFact) -> MFinalFact + pM : L SUP R -> R + intfact : (SUP P,L OV,L NNI,MFinalFact,L L R) -> L SUP P + + basicVar:OV:=NIL$Lisp pretend OV -- variable for the basic step + + + convertPUP(lfg:MFinalFact): SUPFinalFact == + [lfg.contp,[[lff.irr ::SUP P,lff.pow]$SUParFact + for lff in lfg.factors]]$SUPFinalFact + + supFactor(um:SUP P,dx:Z) : SUPFinalFact == + degree(um)=0 => convertPUP(mFactor(ground um,dx)) + lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um] + lcont:SUP P + lf:L SUP P + + flead : SUPFinalFact:=[0,empty()]$SUPFinalFact + factorlist:L SUParFact :=empty() + + mdeg :=minimumDegree um ---- is the Mindeg > 0? ---- + if mdeg>0 then + f1:SUP P:=monomial(1,mdeg) + um:=(um exquo f1)::SUP P + factorlist:=cons([monomial(1,1),mdeg],factorlist) + if degree um=0 then return + lfg:=convertPUP mFactor(ground um, dx) + [lfg.contp,append(factorlist,lfg.factors)] + + + om:=map(pushup(#1,basicVar),um)$UPCF2(P,SUP P,PG,SUP PG) + sqfacs:=squareFree(om) + lcont:=map(pushdown(#1,basicVar),unit sqfacs)$UPCF2(PG,SUP PG,P,SUP P) + + ---- Factorize the content ---- + if ground? lcont then + flead:=convertPUP constantCase(ground lcont,empty()) + else + flead:=supFactor(lcont,dx) + + factorlist:=flead.factors + + ---- Make the polynomial square-free ---- + sqqfact:=[[map(pushdown(#1,basicVar),ff.factor),ff.exponent] + for ff in factors sqfacs] + + --- Factorize the primitive square-free terms --- + for fact in sqqfact repeat + ffactor:SUP P:=fact.irr + ffexp:=fact.pow + ffcont:=content ffactor + coefs := coefficients ffactor + ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar] + if ground?(leadingCoefficient ffactor) then + lf:= mfconst(ffactor,dx,lvar,ldeg) + else lf:=mfpol(ffactor,dx,lvar,ldeg) + auxfl:=[[lfp,ffexp]$SUParFact for lfp in lf] + factorlist:=append(factorlist,auxfl) + lcfacs := */[leadingCoefficient leadingCoefficient(f.irr)**((f.pow)::NNI) + for f in factorlist] + [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R, + factorlist]$SUPFinalFact + + factor(um:SUP PG):Factored SUP PG == + lv:List OV:=variables um + ld:=degree(um,lv) + dx:="min"/ld + basicVar:=lv.position(dx,ld) + cm:=map(pushdown(#1,basicVar),um)$UPCF2(PG,SUP PG,P,SUP P) + flist := supFactor(cm,dx) + pushupconst(flist.contp,basicVar)::SUP(PG) * + (*/[primeFactor(map(pushup(#1,basicVar),u.irr)$UPCF2(P,SUP P,PG,SUP PG), + u.pow) for u in flist.factors]) + + + + mFactor(m:P,dx:Z) : MFinalFact == + ground?(m) => constantCase(m,empty()) + lvar:L OV:= variables m + lcont:P + lf:L SUP P + flead : MFinalFact:=[1,empty()]$MFinalFact + factorlist:L MParFact :=empty() + ---- is the Mindeg > 0? ---- + lmdeg :=minimumDegree(m,lvar) + or/[n>0 for n in lmdeg] => simplify(m,dx,lvar,lmdeg) + ---- Make the polynomial square-free ---- + om:=pushup(m,basicVar) + sqfacs:=squareFree(om) + lcont := pushdown(unit sqfacs,basicVar) + + ---- Factorize the content ---- + if ground? lcont then + flead:=constantCase(lcont,empty()) + else + flead:=mFactor(lcont,dx) + factorlist:=flead.factors + sqqfact:List Record(factor:P,exponent:Integer) + sqqfact:=[[pushdown(ff.factor,basicVar),ff.exponent] + for ff in factors sqfacs] + --- Factorize the primitive square-free terms --- + for fact in sqqfact repeat + ffactor:P:=fact.factor + ffexp := fact.exponent + ground? ffactor => + for lterm in constantCase(ffactor,empty()).factors repeat + factorlist:=cons([lterm.irr,lterm.pow * ffexp], factorlist) + lvar := variables ffactor + x:OV:=lvar.1 + ldeg:=degree(ffactor,lvar) + --- Is the polynomial linear in one of the variables ? --- + member?(1,ldeg) => + x:OV:=lvar.position(1,ldeg) + lcont:= gcd coefficients(univariate(ffactor,x)) + ffactor:=(ffactor exquo lcont)::P + factorlist:=cons([ffactor,ffexp]$MParFact,factorlist) + for lcterm in mFactor(lcont,dx).factors repeat + factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist) + + varch:=varChoose(ffactor,lvar,ldeg) + um:=varch.npol + + + ldeg:=ldeg.rest + lvar:=lvar.rest + if varch.nvar.1 ^= x then + lvar:= varch.nvar + x := lvar.1 + lvar:=lvar.rest + pc:= gcd coefficients um + if pc^=1 then + um:=(um exquo pc)::SUP P + ffactor:=multivariate(um,x) + for lcterm in mFactor(pc,dx).factors repeat + factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist) + ldeg:= degree(ffactor,lvar) + + -- should be unitNormal if unified, but for now it is easier + lcum:F:= leadingCoefficient leadingCoefficient + leadingCoefficient um + if lcum ^=1 then + um:=((inv lcum)::R::P) * um + flead.contp := (lcum::R) *flead.contp + + if ground?(leadingCoefficient um) + then lf:= mfconst(um,dx,lvar,ldeg) + else lf:=mfpol(um,dx,lvar,ldeg) + auxfl:=[[multivariate(lfp,x),ffexp]$MParFact for lfp in lf] + factorlist:=append(factorlist,auxfl) + flead.factors:= factorlist + flead + + + pM(lum:L SUP R) : R == + x := monomial(1,1)$R + for i in 1..size()$F repeat + p := x + (index(i::PositiveInteger)$F) ::R + testModulus(p,lum) => return p + for e in 2.. repeat + p := (createIrreduciblePoly(e::PositiveInteger))$FFPOLY + testModulus(p,lum) => return p + while not((q := nextIrreduciblePoly(p)$FFPOLY) case "failed") repeat + p := q::SUP F + if testModulus(p, lum)$GenExEuclid(R, SUP R) then return p + + ---- push x in the coefficient domain for a term ---- + pushdcoef(t:PG):P == + map(coerce(#1)$R,t)$MPolyCatFunctions2(OV,E, + IndexedExponents OV,F,R,PG,P) + + + ---- internal function, for testing bad cases ---- + intfact(um:SUP P,lvar: L OV,ldeg:L NNI, + tleadpol:MFinalFact,ltry:L L R): L SUP P == + polcase:Boolean:=(not empty? tleadpol.factors ) + vfchoo:Valuf:= + polcase => + leadpol:L P:=[ff.irr for ff in tleadpol.factors] + intChoose(um,lvar,tleadpol.contp,leadpol,ltry) + intChoose(um,lvar,1,empty(),empty()) + unifact:List SUP R := vfchoo.unvfact + nfact:NNI := #unifact + nfact=1 => [um] + ltry:L L R:= vfchoo.inval + lval:L R:=first ltry + dd:= vfchoo.lu + lpol:List P:=empty() + leadval:List R:=empty() + if polcase then + leadval := vfchoo.complead + distf := distFact(vfchoo.lu,unifact,tleadpol,leadval,lvar,lval) + distf case "failed" => + return intfact(um,lvar,ldeg,tleadpol,ltry) + dist := distf :: LeadFact + -- check the factorization of leading coefficient + lpol:= dist.polfac + dd := dist.correct + unifact:=dist.corrfact + if dd^=1 then + unifact := [dd*unifact.i for i in 1..nfact] + um := ((dd**(nfact-1)::NNI)::P)*um + (ffin:= lifting(um,lvar,unifact,lval,lpol,ldeg,pM(unifact))) + case "failed" => intfact(um,lvar,ldeg,tleadpol,ltry) + factfin: L SUP P:=ffin :: L SUP P + if dd^=1 then + factfin:=[primitivePart ff for ff in factfin] + factfin + +-- the following functions are used to "push" x in the coefficient ring - + ---- push back the variable ---- + pushup(f:P,x:OV) :PG == + ground? f => pushupconst((retract f)@R,x) + rr:PG:=0 + while f^=0 repeat + lf:=leadingMonomial f + cf:=pushupconst(leadingCoefficient f,x) + lvf:=variables lf + rr:=rr+monomial(cf,lvf, degree(lf,lvf))$PG + f:=reductum f + rr + + ---- push x in the coefficient domain for a polynomial ---- + pushdown(g:PG,x:OV) : P == + ground? g => ((retract g)@F)::R::P + rf:P:=0$P + ug:=univariate(g,x) + while ug^=0 repeat + cf:=monomial(1,degree ug)$R + rf:=rf+cf*pushdcoef(leadingCoefficient ug) + ug := reductum ug + rf + + ---- push x back from the coefficient domain ---- + pushupconst(r:R,x:OV):PG == + ground? r => (retract r)@F ::PG + rr:PG:=0 + while r^=0 repeat + rr:=rr+monomial((leadingCoefficient r)::PG,x,degree r)$PG + r:=reductum r + rr + + -- This function has to be added to Eucliden domain + ran(k1:Z) : R == + --if R case Integer then random()$R rem (2*k1)-k1 + --else + +/[monomial(random()$F,i)$R for i in 0..k1] + + checkzero(u:SUP P,um:SUP R) : Boolean == + u=0 => um =0 + um = 0 => false + degree u = degree um => checkzero(reductum u, reductum um) + false + + --- Choose the variable of least degree --- + varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd == + k:="min"/[d for d in ldeg] + k=degree(m,first lvar) => + [univariate(m,first lvar),lvar,ldeg]$NewOrd + i:=position(k,ldeg) + x:OV:=lvar.i + ldeg:=cons(k,delete(ldeg,i)) + lvar:=cons(x,delete(lvar,i)) + [univariate(m,x),lvar,ldeg]$NewOrd + + + norm(lum: L SUP R): Integer == "max"/[degree lup for lup in lum] + + --- Choose the values to reduce to the univariate case --- + intChoose(um:SUP P,lvar:L OV,clc:R,plist:L P,ltry:L L R) : Valuf == + -- declarations + degum:NNI := degree um + nvar1:=#lvar + range:NNI:=0 + unifact:L SUP R + ctf1 : R := 1 + testp:Boolean := -- polynomial leading coefficient + plist = empty() => false + true + leadcomp,leadcomp1 : L R + leadcomp:=leadcomp1:=empty() + nfatt:NNI := degum+1 + lffc:R:=1 + lffc1:=lffc + newunifact : L SUP R:=empty() + leadtest:=true --- the lc test with polCase has to be performed + int:L R:=empty() + + -- New sets of values are chosen until we find twice the + -- same number of "univariate" factors:the set smaller in modulo is + -- is chosen. + while true repeat + lval := [ ran(range) for i in 1..nvar1] + member?(lval,ltry) => range:=1+range + ltry := cons(lval,ltry) + leadcomp1:=[retract eval(pol,lvar,lval) for pol in plist] + testp and or/[unit? epl for epl in leadcomp1] => range:=range+1 + newm:SUP R:=completeEval(um,lvar,lval) + degum ^= degree newm or minimumDegree newm ^=0 => range:=range+1 + lffc1:=content newm + newm:=(newm exquo lffc1)::SUP R + testp and leadtest and ^ polCase(lffc1*clc,#plist,leadcomp1) + => range:=range+1 + Dnewm := differentiate newm + D2newm := map(differentiate, newm) + degree(gcd [newm,Dnewm,D2newm])^=0 => range:=range+1 + -- if R has Integer then luniv:=henselFact(newm,false)$ + -- else + lcnm:F:=1 + -- should be unitNormal if unified, but for now it is easier + if (lcnm:=leadingCoefficient leadingCoefficient newm)^=1 then + newm:=((inv lcnm)::R)*newm + dx:="max"/[degree uc for uc in coefficients newm] + luniv:=generalTwoFactor(newm)$TwoFactorize(F) + lunivf:= factors luniv + nf:= #lunivf + + nf=0 or nf>nfatt => "next values" --- pretest failed --- + + --- the univariate polynomial is irreducible --- + if nf=1 then leave (unifact:=[newm]) + + lffc1:=lcnm * retract(unit luniv)@R * lffc1 + + -- the new integer give the same number of factors + nfatt = nf => + -- if this is the first univariate factorization with polCase=true + -- or if the last factorization has smaller norm and satisfies + -- polCase + if leadtest or + ((norm unifact > norm [ff.factor for ff in lunivf]) and + (^testp or polCase(lffc1*clc,#plist,leadcomp1))) then + unifact:=[uf.factor for uf in lunivf] + int:=lval + lffc:=lffc1 + if testp then leadcomp:=leadcomp1 + leave "foundit" + + -- the first univariate factorization, inizialize + nfatt > degum => + unifact:=[uf.factor for uf in lunivf] + lffc:=lffc1 + if testp then leadcomp:=leadcomp1 + int:=lval + leadtest := false + nfatt := nf + + nfatt>nf => -- for the previous values there were more factors + if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp) + else leadtest:= false + -- if polCase=true we can consider the univariate decomposition + if ^leadtest then + unifact:=[uf.factor for uf in lunivf] + lffc:=lffc1 + if testp then leadcomp:=leadcomp1 + int:=lval + nfatt := nf + [cons(int,ltry),unifact,lffc,leadcomp]$Valuf + + + constantCase(m:P,factorlist:List MParFact) : MFinalFact == + --if R case Integer then [const m,factorlist]$MFinalFact + --else + lunm:=distdfact((retract m)@R,false)$DistinctDegreeFactorize(F,R) + [(lunm.cont)::R, append(factorlist, + [[(pp.irr)::P,pp.pow] for pp in lunm.factors])]$MFinalFact + + ---- The polynomial has mindeg>0 ---- + + simplify(m:P,dm:Z,lvar:L OV,lmdeg:L NNI):MFinalFact == + factorlist:L MParFact:=empty() + pol1:P:= 1$P + for x in lvar repeat + i := lmdeg.(position(x,lvar)) + i=0 => "next value" + pol1:=pol1*monomial(1$P,x,i) + factorlist:=cons([x::P,i]$MParFact,factorlist) + m := (m exquo pol1)::P + ground? m => constantCase(m,factorlist) + flead:=mFactor(m,dm) + flead.factors:=append(factorlist,flead.factors) + flead + + ---- m square-free,primitive,lc constant ---- + mfconst(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P == + nsign:Boolean + factfin:L SUP P:=empty() + empty? lvar => + um1:SUP R:=map(ground, + um)$UPCF2(P,SUP P,R,SUP R) + lum:= generalTwoFactor(um1)$TwoFactorize(F) + [map(coerce,lumf.factor)$UPCF2(R,SUP R,P,SUP P) + for lumf in factors lum] + intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty()) + + --- m is square-free,primitive,lc is a polynomial --- + mfpol(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P == + dist : LeadFact + tleadpol:=mFactor(leadingCoefficient um,dm) + intfact(um,lvar,ldeg,tleadpol,empty()) + + factor(m:PG):Factored PG == + lv:=variables m + lv=empty() => makeFR(m,empty() ) + -- reduce to multivariate over SUP + ld:=[degree(m,x) for x in lv] + dx:="min"/ld + basicVar:=lv(position(dx,ld)) + cm:=pushdown(m,basicVar) + flist := mFactor(cm,dx) + pushupconst(flist.contp,basicVar) * + (*/[primeFactor(pushup(u.irr,basicVar),u.pow) + for u in flist.factors]) + +@ +<>= +"MFINFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MFINFACT"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MFINFACT" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MMAP MultipleMap} \pagehead{MultipleMap}{MMAP} \pagepic{ps/v104multiplemap.ps}{MMAP}{1.00} @@ -38157,6 +44544,661 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MULTFACT MultivariateFactorize} +\pagehead{MultivariateFactorize}{MULTFACT} +\pagepic{ps/v104multivariatefactorize.ps}{MULTFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MULTFACT MultivariateFactorize +++ Author: P. Gianni +++ Date Created: 1983 +++ Date Last Updated: Sept. 1990 +++ Basic Functions: +++ Related Constructors: MultFiniteFactorize, AlgebraicMultFact, UnivariateFactorize +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This is the top level package for doing multivariate factorization +++ over basic domains like \spadtype{Integer} or \spadtype{Fraction Integer}. + +MultivariateFactorize(OV,E,R,P) : C == T + where + R : Join(EuclideanDomain, CharacteristicZero) + -- with factor on R[x] + OV : OrderedSet + E : OrderedAbelianMonoidSup + P : PolynomialCategory(R,E,OV) + Z ==> Integer + MParFact ==> Record(irr:P,pow:Z) + USP ==> SparseUnivariatePolynomial P + SUParFact ==> Record(irr:USP,pow:Z) + SUPFinalFact ==> Record(contp:R,factors:List SUParFact) + MFinalFact ==> Record(contp:R,factors:List MParFact) + + -- contp = content, + -- factors = List of irreducible factors with exponent + L ==> List + + C == with + factor : P -> Factored P + ++ factor(p) factors the multivariate polynomial p over its coefficient + ++ domain + factor : USP -> Factored USP + ++ factor(p) factors the multivariate polynomial p over its coefficient + ++ domain where p is represented as a univariate polynomial with + ++ multivariate coefficients + T == add + factor(p:P) : Factored P == + R is Fraction Integer => + factor(p)$MRationalFactorize(E,OV,Integer,P) + R is Fraction Complex Integer => + factor(p)$MRationalFactorize(E,OV,Complex Integer,P) + R is Fraction Polynomial Integer and OV has convert: % -> Symbol => + factor(p)$MPolyCatRationalFunctionFactorizer(E,OV,Integer,P) + factor(p,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P) + + factor(up:USP) : Factored USP == + factor(up,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P) + +@ +<>= +"MULTFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MULTFACT"] +"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"] +"MULTFACT" -> "COMPCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MLIFT MultivariateLifting} +<>= +)abbrev package MLIFT MultivariateLifting +++ Author : P.Gianni. +++ Description: +++ This package provides the functions for the multivariate "lifting", using +++ an algorithm of Paul Wang. +++ This package will work for every euclidean domain R which has property +++ F, i.e. there exists a factor operation in \spad{R[x]}. + +MultivariateLifting(E,OV,R,P) : C == T + where + OV : OrderedSet + E : OrderedAbelianMonoidSup + R : EuclideanDomain -- with property "F" + Z ==> Integer + BP ==> SparseUnivariatePolynomial R + P : PolynomialCategory(R,E,OV) + SUP ==> SparseUnivariatePolynomial P + NNI ==> NonNegativeInteger + Term ==> Record(expt:NNI,pcoef:P) + VTerm ==> List Term + Table ==> Vector List BP + L ==> List + + C == with + corrPoly: (SUP,L OV,L R,L NNI,L SUP,Table,R) -> Union(L SUP,"failed") + ++ corrPoly(u,lv,lr,ln,lu,t,r) \undocumented + lifting: (SUP,L OV,L BP,L R,L P,L NNI,R) -> Union(L SUP,"failed") + ++ lifting(u,lv,lu,lr,lp,ln,r) \undocumented + lifting1: (SUP,L OV,L SUP,L R,L P,L VTerm,L NNI,Table,R) -> + Union(L SUP,"failed") + ++ lifting1(u,lv,lu,lr,lp,lt,ln,t,r) \undocumented + + T == add + GenExEuclid(R,BP) + NPCoef(BP,E,OV,R,P) + IntegerCombinatoricFunctions(Z) + + SUPF2 ==> SparseUnivariatePolynomialFunctions2 + + DetCoef ==> Record(deter:L SUP,dterm:L VTerm,nfacts:L BP, + nlead:L P) + + --- local functions --- + normalDerivM : (P,Z,OV) -> P + normalDeriv : (SUP,Z) -> SUP + subslead : (SUP,P) -> SUP + subscoef : (SUP,L Term) -> SUP + maxDegree : (SUP,OV) -> NonNegativeInteger + + + corrPoly(m:SUP,lvar:L OV,fval:L R,ld:L NNI,flist:L SUP, + table:Table,pmod:R):Union(L SUP,"failed") == + -- The correction coefficients are evaluated recursively. + -- Extended Euclidean algorithm for the multivariate case. + + -- the polynomial is univariate -- + #lvar=0 => + lp:=solveid(map(ground,m)$SUPF2(P,R),pmod,table) + if lp case "failed" then return "failed" + lcoef:= [map(coerce,mp)$SUPF2(R,P) for mp in lp::L BP] + + + diff,ddiff,pol,polc:SUP + listpolv,listcong:L SUP + deg1:NNI:= ld.first + np:NNI:= #flist + a:P:= fval.first ::P + y:OV:=lvar.first + lvar:=lvar.rest + listpolv:L SUP := [map(eval(#1,y,a),f1) for f1 in flist] + um:=map(eval(#1,y,a),m) + flcoef:=corrPoly(um,lvar,fval.rest,ld.rest,listpolv,table,pmod) + if flcoef case "failed" then return "failed" + else lcoef:=flcoef :: L SUP + listcong:=[*/[flist.i for i in 1..np | i^=l] for l in 1..np] + polc:SUP:= (monomial(1,y,1) - a)::SUP + pol := 1$SUP + diff:=m- +/[lcoef.i*listcong.i for i in 1..np] + for l in 1..deg1 repeat + if diff=0 then return lcoef + pol := pol*polc + (ddiff:= map(eval(normalDerivM(#1,l,y),y,a),diff)) = 0 => "next l" + fbeta := corrPoly(ddiff,lvar,fval.rest,ld.rest,listpolv,table,pmod) + if fbeta case "failed" then return "failed" + else beta:=fbeta :: L SUP + lcoef := [lcoef.i+beta.i*pol for i in 1..np] + diff:=diff- +/[listcong.i*beta.i for i in 1..np]*pol + lcoef + + + + lifting1(m:SUP,lvar:L OV,plist:L SUP,vlist:L R,tlist:L P,_ + coeflist:L VTerm,listdeg:L NNI,table:Table,pmod:R) :Union(L SUP,"failed") == + -- The factors of m (multivariate) are determined , + -- We suppose to know the true univariate factors + -- some coefficients are determined + conglist:L SUP:=empty() + nvar : NNI:= #lvar + pol,polc:P + mc,mj:SUP + testp:Boolean:= (not empty?(tlist)) + lalpha : L SUP := empty() + tlv:L P:=empty() + subsvar:L OV:=empty() + subsval:L R:=empty() + li:L OV := lvar + ldeg:L NNI:=empty() + clv:L VTerm:=empty() + --j =#variables, i=#factors + for j in 1..nvar repeat + x := li.first + li := rest li + conglist:= plist + v := vlist.first + vlist := rest vlist + degj := listdeg.j + ldeg := cons(degj,ldeg) + subsvar:=cons(x,subsvar) + subsval:=cons(v,subsval) + + --substitute the determined coefficients + if testp then + if j "next k" + flalpha:=corrPoly(mc,subsvar.rest,subsval.rest, + ldeg.rest,conglist,table,pmod) + if flalpha case "failed" then return "failed" + else lalpha:=flalpha :: L SUP + plist:=[term-alpha*pol for term in plist for alpha in lalpha] + -- PGCD may call with a smaller valure of degj + idegj:Integer:=maxDegree(m,x) + for term in plist repeat idegj:=idegj -maxDegree(term,x) + idegj < 0 => return "failed" + plist + --There are not extraneous factors + + maxDegree(um:SUP,x:OV):NonNegativeInteger == + ans:NonNegativeInteger:=0 + while um ^= 0 repeat + ans:=max(ans,degree(leadingCoefficient um,x)) + um:=reductum um + ans + + lifting(um:SUP,lvar:L OV,plist:L BP,vlist:L R, + tlist:L P,listdeg:L NNI,pmod:R):Union(L SUP,"failed") == + -- The factors of m (multivariate) are determined, when the + -- univariate true factors are known and some coefficient determined + nplist:List SUP:=[map(coerce,pp)$SUPF2(R,P) for pp in plist] + empty? tlist => + table:=tablePow(degree um,pmod,plist) + table case "failed" => error "Table construction failed in MLIFT" + lifting1(um,lvar,nplist,vlist,tlist,empty(),listdeg,table,pmod) + ldcoef:DetCoef:=npcoef(um,plist,tlist) + if not empty?(listdet:=ldcoef.deter) then + if #listdet = #plist then return listdet + plist:=ldcoef.nfacts + nplist:=[map(coerce,pp)$SUPF2(R,P) for pp in plist] + um:=(um exquo */[pol for pol in listdet])::SUP + tlist:=ldcoef.nlead + tab:=tablePow(degree um,pmod,plist.rest) + else tab:=tablePow(degree um,pmod,plist) + tab case "failed" => error "Table construction failed in MLIFT" + table:Table:=tab + ffl:=lifting1(um,lvar,nplist,vlist,tlist,ldcoef.dterm,listdeg,table,pmod) + if ffl case "failed" then return "failed" + append(listdet,ffl:: L SUP) + + -- normalDerivM(f,m,x) = the normalized (divided by m!) m-th + -- derivative with respect to x of the multivariate polynomial f + normalDerivM(g:P,m:Z,x:OV) : P == + multivariate(normalDeriv(univariate(g,x),m),x) + + normalDeriv(f:SUP,m:Z) : SUP == + (n1:Z:=degree f) < m => 0$SUP + n1=m => leadingCoefficient f :: SUP + k:=binomial(n1,m) + ris:SUP:=0$SUP + n:Z:=n1 + while n>= m repeat + while n1>n repeat + k:=(k*(n1-m)) quo n1 + n1:=n1-1 + ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI) + f:=reductum f + n:=degree f + ris + + subslead(m:SUP,pol:P):SUP == + dm:NNI:=degree m + monomial(pol,dm)+reductum m + + subscoef(um:SUP,lterm:L Term):SUP == + dm:NNI:=degree um + new:=monomial(leadingCoefficient um,dm) + for k in dm-1..0 by -1 repeat + i:NNI:=k::NNI + empty?(lterm) or lterm.first.expt^=i => + new:=new+monomial(coefficient(um,i),i) + new:=new+monomial(lterm.first.pcoef,i) + lterm:=lterm.rest + new + +@ +<>= +"MLIFT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MLIFT"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MLIFT" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MULTSQFR MultivariateSquareFree} +\pagehead{MultivariateSquareFree}{MULTSQFR} +\pagepic{ps/v104multivariatesquarefree.ps}{MULTSQFR}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MULTSQFR MultivariateSquareFree +++ Author : P.Gianni +++ This package provides the functions for the computation of the square +++ free decomposition of a multivariate polynomial. +++ It uses the package GenExEuclid for the resolution of +++ the equation \spad{Af + Bg = h} and its generalization to n polynomials +++ over an integral domain and the package \spad{MultivariateLifting} +++ for the "multivariate" lifting. + +MultivariateSquareFree (E,OV,R,P) : C == T where + Z ==> Integer + NNI ==> NonNegativeInteger + R : EuclideanDomain + OV : OrderedSet + E : OrderedAbelianMonoidSup + P : PolynomialCategory(R,E,OV) + SUP ==> SparseUnivariatePolynomial P + + BP ==> SparseUnivariatePolynomial(R) + fUnion ==> Union("nil","sqfr","irred","prime") + ffSUP ==> Record(flg:fUnion,fctr:SUP,xpnt:Integer) + ffP ==> Record(flg:fUnion,fctr:P,xpnt:Integer) + FFE ==> Record(factor:BP,exponent:Z) + FFEP ==> Record(factor:P,exponent:Z) + FFES ==> Record(factor:SUP,exponent:Z) + Choice ==> Record(upol:BP,Lval:List(R),Lfact:List FFE,ctpol:R) + squareForm ==> Record(unitPart:P,suPart:List FFES) + Twopol ==> Record(pol:SUP,polval:BP) + UPCF2 ==> UnivariatePolynomialCategoryFunctions2 + + + C == with + squareFree : P -> Factored P + ++ squareFree(p) computes the square free + ++ decomposition of a multivariate polynomial p. + squareFree : SUP -> Factored SUP + ++ squareFree(p) computes the square free + ++ decomposition of a multivariate polynomial p presented as + ++ a univariate polynomial with multivariate coefficients. + squareFreePrim : P -> Factored P + ++ squareFreePrim(p) compute the square free decomposition + ++ of a primitive multivariate polynomial p. + + + + ---- local functions ---- + compdegd : List FFE -> Z + ++ compdegd should be local + univcase : (P,OV) -> Factored(P) + ++ univcase should be local + consnewpol : (SUP,BP,Z) -> Twopol + ++ consnewpol should be local + nsqfree : (SUP,List(OV), List List R) -> squareForm + ++ nsqfree should be local + intChoose : (SUP,List(OV),List List R) -> Choice + ++ intChoose should be local + coefChoose : (Z,Factored P) -> P + ++ coefChoose should be local + check : (List(FFE),List(FFE)) -> Boolean + ++ check should be local + lift : (SUP,BP,BP,P,List(OV),List(NNI),List(R)) -> Union(List(SUP),"failed") + ++ lift should be local + myDegree : (SUP,List OV,NNI) -> List NNI + ++ myDegree should be local + normDeriv2 : (BP,Z) -> BP + ++ normDeriv2 should be local + + + + T == add + + pmod:R := (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R + + + import GenExEuclid() + import MultivariateLifting(E,OV,R,P) + import PolynomialGcdPackage(E,OV,R,P) + import FactoringUtilities(E,OV,R,P) + import IntegerCombinatoricFunctions(Z) + + + ---- Are the univariate square-free decompositions consistent? ---- + + ---- new square-free algorithm for primitive polynomial ---- + nsqfree(oldf:SUP,lvar:List(OV),ltry:List List R) : squareForm == + f:=oldf + univPol := intChoose(f,lvar,ltry) +-- debug msg +-- if not empty? ltry then output("ltry =", (ltry::OutputForm))$OutputPackage + f0:=univPol.upol + --the polynomial is square-free + f0=1$BP => [1$P,[[f,1]$FFES]]$squareForm + lfact:List(FFE):=univPol.Lfact + lval:=univPol.Lval + ctf:=univPol.ctpol + leadpol:Boolean:=false + sqdec:List FFES := empty() + exp0:Z:=0 + unitsq:P:=1 + lcf:P:=leadingCoefficient f + if ctf^=1 then + f0:=ctf*f0 + f:=(ctf::P)*f + lcf:=ctf*lcf + sqlead:List FFEP:= empty() + sqlc:Factored P:=1 + if lcf^=1$P then + leadpol:=true + sqlc:=squareFree lcf + unitsq:=unitsq*(unit sqlc) + sqlead:= factors sqlc + lfact:=sort(#1.exponent > #2.exponent,lfact) + while lfact^=[] repeat + pfact:=lfact.first + (g0,exp0):=(pfact.factor,pfact.exponent) + lfact:=lfact.rest + lfact=[] and exp0 =1 => + f := (f exquo (ctf::P))::SUP + gg := unitNormal leadingCoefficient f + sqdec:=cons([gg.associate*f,exp0],sqdec) + return [gg.unit, sqdec]$squareForm + if ctf^=1 then g0:=ctf*g0 + npol:=consnewpol(f,f0,exp0) + (d,d0):=(npol.pol,npol.polval) + if leadpol then lcoef:=coefChoose(exp0,sqlc) + else lcoef:=1$P + ldeg:=myDegree(f,lvar,exp0::NNI) + result:=lift(d,g0,(d0 exquo g0)::BP,lcoef,lvar,ldeg,lval) + result case "failed" => return nsqfree(oldf,lvar,ltry) + result0:SUP:= (result::List SUP).1 + r1:SUP:=result0**(exp0:NNI) + if (h:=f exquo r1) case "failed" then return nsqfree(oldf,lvar,empty()) + sqdec:=cons([result0,exp0],sqdec) + f:=h::SUP + f0:=completeEval(h,lvar,lval) + lcr:P:=leadingCoefficient result0 + if leadpol and lcr^=1$P then + for lpfact in sqlead while lcr^=1 repeat + ground? lcr => + unitsq:=(unitsq exquo lcr)::P + lcr:=1$P + (h1:=lcr exquo lpfact.factor) case "failed" => "next" + lcr:=h1::P + lpfact.exponent:=(lpfact.exponent)-exp0 + [((retract f) exquo ctf)::P,sqdec]$squareForm + + + squareFree(f:SUP) : Factored SUP == + degree f =0 => + fu:=squareFree retract f + makeFR((unit fu)::SUP,[["sqfr",ff.fctr::SUP,ff.xpnt] + for ff in factorList fu]) + lvar:= "setUnion"/[variables cf for cf in coefficients f] + empty? lvar => -- the polynomial is univariate + upol:=map(ground,f)$UPCF2(P,SUP,R,BP) + usqfr:=squareFree upol + makeFR(map(coerce,unit usqfr)$UPCF2(R,BP,P,SUP), + [["sqfr",map(coerce,ff.fctr)$UPCF2(R,BP,P,SUP),ff.xpnt] + for ff in factorList usqfr]) + + lcf:=content f + f:=(f exquo lcf) ::SUP + lcSq:=squareFree lcf + lfs:List ffSUP:=[["sqfr",ff.fctr ::SUP,ff.xpnt] + for ff in factorList lcSq] + partSq:=nsqfree(f,lvar,empty()) + + lfs:=append([["sqfr",fu.factor,fu.exponent]$ffSUP + for fu in partSq.suPart],lfs) + makeFR((unit lcSq * partSq.unitPart) ::SUP,lfs) + + squareFree(f:P) : Factored P == + ground? f => makeFR(f,[]) --- the polynomial is constant --- + + lvar:List(OV):=variables(f) + result1:List ffP:= empty() + + lmdeg :=minimumDegree(f,lvar) --- is the mindeg > 0 ? --- + p:P:=1$P + for im in 1..#lvar repeat + (n:=lmdeg.im)=0 => "next im" + y:=lvar.im + p:=p*monomial(1$P,y,n) + result1:=cons(["sqfr",y::P,n],result1) + if p^=1$P then + f := (f exquo p)::P + if ground? f then return makeFR(f, result1) + lvar:=variables(f) + + + #lvar=1 => --- the polynomial is univariate --- + result:=univcase(f,lvar.first) + makeFR(unit result,append(result1,factorList result)) + + ldeg:=degree(f,lvar) --- general case --- + m:="min"/[j for j in ldeg|j^=0] + i:Z:=1 + for j in ldeg while j>m repeat i:=i+1 + x:=lvar.i + lvar:=delete(lvar,i) + f0:=univariate (f,x) + lcont:P:= content f0 + nsqfftot:=nsqfree((f0 exquo lcont)::SUP,lvar,empty()) + nsqff:List ffP:=[["sqfr",multivariate(fu.factor,x),fu.exponent]$ffP + for fu in nsqfftot.suPart] + result1:=append(result1,nsqff) + ground? lcont => makeFR(lcont*nsqfftot.unitPart,result1) + sqlead:=squareFree(lcont) + makeFR(unit sqlead*nsqfftot.unitPart,append(result1,factorList sqlead)) + + -- Choose the integer for the evaluation. -- + -- If the polynomial is square-free the function returns upol=1. -- + + intChoose(f:SUP,lvar:List(OV),ltry:List List R):Choice == + degf:= degree f + try:NNI:=0 + nvr:=#lvar + range:Z:=10 + lfact1:List(FFE):=[] + lval1:List R := [] + lfact:List(FFE) + ctf1:R:=1 + f1:BP:=1$BP + d1:Z + while range<10000000000 repeat + range:=2*range + lval:= [ran(range) for i in 1..nvr] + member?(lval,ltry) => "new integer" + ltry:=cons(lval,ltry) + f0:=completeEval(f,lvar,lval) + degree f0 ^=degf => "new integer" + ctf:=content f0 + lfact:List(FFE):=factors(squareFree((f0 exquo (ctf:R)::BP)::BP)) + + ---- the univariate polynomial is square-free ---- + if #lfact=1 and (lfact.1).exponent=1 then + return [1$BP,lval,lfact,1$R]$Choice + + d0:=compdegd lfact + ---- inizialize lfact1 ---- + try=0 => + f1:=f0 + lfact1:=lfact + ctf1:=ctf + lval1:=lval + d1:=d0 + try:=1 + d0=d1 => + return [f1,lval1,lfact1,ctf1]$Choice + d0 < d1 => + try:=1 + f1:=f0 + lfact1:=lfact + ctf1:=ctf + lval1:=lval + d1:=d0 + + + ---- Choose the leading coefficient for the lifting ---- + coefChoose(exp:Z,sqlead:Factored(P)) : P == + lcoef:P:=unit(sqlead) + for term in factors(sqlead) repeat + texp:=term.exponent + texp "next term" + texp=exp => lcoef:=lcoef*term.factor + lcoef:=lcoef*(term.factor)**((texp quo exp)::NNI) + lcoef + + ---- Construction of the polynomials for the lifting ---- + consnewpol(g:SUP,g0:BP,deg:Z):Twopol == + deg=1 => [g,g0]$Twopol + deg:=deg-1 + [normalDeriv(g,deg),normDeriv2(g0,deg)]$Twopol + + ---- lift the univariate square-free factor ---- + lift(ud:SUP,g0:BP,g1:BP,lcoef:P,lvar:List(OV), + ldeg:List(NNI),lval:List(R)) : Union(List SUP,"failed") == + leadpol:Boolean:=false + lcd:P:=leadingCoefficient ud + leadlist:List(P):=empty() + + if ^ground?(leadingCoefficient ud) then + leadpol:=true + ud:=lcoef*ud + lcg0:R:=leadingCoefficient g0 + if ground? lcoef then g0:=retract(lcoef) quo lcg0 *g0 + else g0:=(retract(eval(lcoef,lvar,lval)) quo lcg0) * g0 + g1:=lcg0*g1 + leadlist:=[lcoef,lcd] + plist:=lifting(ud,lvar,[g0,g1],lval,leadlist,ldeg,pmod) + plist case "failed" => "failed" + (p0:SUP,p1:SUP):=((plist::List SUP).1,(plist::List SUP).2) + if completeEval(p0,lvar,lval) ^= g0 then (p0,p1):=(p1,p0) + [primitivePart p0,primitivePart p1] + + ---- the polynomial is univariate ---- + univcase(f:P,x:OV) : Factored(P) == + uf := univariate f + cf:=content uf + uf :=(uf exquo cf)::BP + result:Factored BP:=squareFree uf + makeFR(multivariate(cf*unit result,x), + [["sqfr",multivariate(term.factor,x),term.exponent] + for term in factors result]) + +-- squareFreePrim(p:P) : Factored P == +-- -- p is content free +-- ground? p => makeFR(p,[]) --- the polynomial is constant --- +-- +-- lvar:List(OV):=variables p +-- #lvar=1 => --- the polynomial is univariate --- +-- univcase(p,lvar.first) +-- nsqfree(p,lvar,1) + + compdegd(lfact:List(FFE)) : Z == + ris:Z:=0 + for pfact in lfact repeat + ris:=ris+(pfact.exponent -1)*degree pfact.factor + ris + + normDeriv2(f:BP,m:Z) : BP == + (n1:Z:=degree f) < m => 0$BP + n1=m => (leadingCoefficient f)::BP + k:=binomial(n1,m) + ris:BP:=0$BP + n:Z:=n1 + while n>= m repeat + while n1>n repeat + k:=(k*(n1-m)) quo n1 + n1:=n1-1 + ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI) + f:=reductum f + n:=degree f + ris + + myDegree(f:SUP,lvar:List OV,exp:NNI) : List NNI== + [n quo exp for n in degree(f,lvar)] + +@ +<>= +"MULTSQFR" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MULTSQFR"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MULTSQFR" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter N} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package NAGF02 NagEigenPackage} @@ -43607,6 +50649,47 @@ PolynomialAN2Expression():Target == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package POLY2 PolynomialFunctions2} +\pagehead{PolynomialFunctions2}{POLY2} +\pagepic{ps/v104polynomialfunctions2.ps}{POLY2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package POLY2 PolynomialFunctions2 +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package takes a mapping between coefficient rings, and lifts +++ it to a mapping between polynomials over those rings. + +PolynomialFunctions2(R:Ring, S:Ring): with + map: (R -> S, Polynomial R) -> Polynomial S + ++ map(f, p) produces a new polynomial as a result of applying + ++ the function f to every coefficient of the polynomial p. + == add + map(f, p) == map(#1::Polynomial(S), f(#1)::Polynomial(S), + p)$PolynomialCategoryLifting(IndexedExponents Symbol, + Symbol, R, Polynomial R, Polynomial S) + + +@ +<>= +"POLY2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=POLY2"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"POLY2" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package POLYROOT PolynomialRoots} \pagehead{PolynomialRoots}{POLYROOT} \pagepic{ps/v104polynomialroots.ps}{POLYROOT}{1.00} @@ -45576,6 +52659,80 @@ RealSolvePackage(): _ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package RMCAT2 RectangularMatrixCategoryFunctions2} +\pagehead{RectangularMatrixCategoryFunctions2}{RMCAT2} +\pagepic{ps/v104rectangularmatrixcategoryfunctions2.ps}{RMCAT2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package RMCAT2 RectangularMatrixCategoryFunctions2 +++ Author: Clifton J. Williamson +++ Date Created: 21 November 1989 +++ Date Last Updated: 12 June 1991 +++ Basic Operations: +++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), +++ RectangularMatrix(n,m,R), SquareMatrix(n,R) +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Keywords: matrix, map, reduce +++ Examples: +++ References: +++ Description: +++ \spadtype{RectangularMatrixCategoryFunctions2} provides functions between +++ two matrix domains. The functions provided are \spadfun{map} and \spadfun{reduce}. + +RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ + Exports == Implementation where + m,n : NonNegativeInteger + R1 : Ring + Row1 : DirectProductCategory(n, R1) + Col1 : DirectProductCategory(m, R1) + M1 : RectangularMatrixCategory(m,n,R1,Row1,Col1) + R2 : Ring + Row2 : DirectProductCategory(n, R2) + Col2 : DirectProductCategory(m, R2) + M2 : RectangularMatrixCategory(m,n,R2,Row2,Col2) + + Exports ==> with + map: (R1 -> R2,M1) -> M2 + ++ \spad{map(f,m)} applies the function \spad{f} to the elements of the + ++ matrix \spad{m}. + reduce: ((R1,R2) -> R2,M1,R2) -> R2 + ++ \spad{reduce(f,m,r)} returns a matrix \spad{n} where + ++ \spad{n[i,j] = f(m[i,j],r)} for all indices spad{i} and \spad{j}. + + Implementation ==> add + minr ==> minRowIndex + maxr ==> maxRowIndex + minc ==> minColIndex + maxc ==> maxColIndex + + map(f,mat) == + ans : M2 := new(m,n,0)$Matrix(R2) pretend M2 + for i in minr(mat)..maxr(mat) for k in minr(ans)..maxr(ans) repeat + for j in minc(mat)..maxc(mat) for l in minc(ans)..maxc(ans) repeat + qsetelt_!(ans pretend Matrix R2,k,l,f qelt(mat,i,j)) + ans + + reduce(f,mat,ident) == + s := ident + for i in minr(mat)..maxr(mat) repeat + for j in minc(mat)..maxc(mat) repeat + s := f(qelt(mat,i,j),s) + s + +@ +<>= +"RMCAT2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RMCAT2"] +"RMATCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RMATCAT"] +"RMCAT2" -> "RMATCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package REPDB RepeatedDoubling} \pagehead{RepeatedDoubling}{REPDB} \pagepic{ps/v104repeateddoubling.ps}{REPDB}{1.00} @@ -45925,6 +53082,212 @@ SortedCache(S:CachableSet): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MATSTOR StorageEfficientMatrixOperations} +\pagehead{StorageEfficientMatrixOperations}{MATSTOR} +\pagepic{ps/v104storageefficientmatrixoperations.ps}{MATSTOR}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MATSTOR StorageEfficientMatrixOperations +++ Author: Clifton J. Williamson +++ Date Created: 18 July 1990 +++ Date Last Updated: 18 July 1990 +++ Basic Operations: +++ Related Domains: Matrix(R) +++ Also See: +++ AMS Classifications: +++ Keywords: matrix, linear algebra +++ Examples: +++ References: +++ Description: +++ This package provides standard arithmetic operations on matrices. +++ The functions in this package store the results of computations +++ in existing matrices, rather than creating new matrices. This +++ package works only for matrices of type Matrix and uses the +++ internal representation of this type. +StorageEfficientMatrixOperations(R): Exports == Implementation where + R : Ring + M ==> Matrix R + NNI ==> NonNegativeInteger + ARR ==> PrimitiveArray R + REP ==> PrimitiveArray PrimitiveArray R + + Exports ==> with + copy_! : (M,M) -> M + ++ \spad{copy!(c,a)} copies the matrix \spad{a} into the matrix c. + ++ Error: if \spad{a} and c do not have the same + ++ dimensions. + plus_! : (M,M,M) -> M + ++ \spad{plus!(c,a,b)} computes the matrix sum \spad{a + b} and stores the + ++ result in the matrix c. + ++ Error: if \spad{a}, b, and c do not have the same dimensions. + minus_! : (M,M) -> M + ++ \spad{minus!(c,a)} computes \spad{-a} and stores the result in the + ++ matrix c. + ++ Error: if a and c do not have the same dimensions. + minus_! : (M,M,M) -> M + ++ \spad{!minus!(c,a,b)} computes the matrix difference \spad{a - b} + ++ and stores the result in the matrix c. + ++ Error: if \spad{a}, b, and c do not have the same dimensions. + leftScalarTimes_! : (M,R,M) -> M + ++ \spad{leftScalarTimes!(c,r,a)} computes the scalar product + ++ \spad{r * a} and stores the result in the matrix c. + ++ Error: if \spad{a} and c do not have the same dimensions. + rightScalarTimes_! : (M,M,R) -> M + ++ \spad{rightScalarTimes!(c,a,r)} computes the scalar product + ++ \spad{a * r} and stores the result in the matrix c. + ++ Error: if \spad{a} and c do not have the same dimensions. + times_! : (M,M,M) -> M + ++ \spad{times!(c,a,b)} computes the matrix product \spad{a * b} + ++ and stores the result in the matrix c. + ++ Error: if \spad{a}, b, and c do not have + ++ compatible dimensions. + power_! : (M,M,M,M,NNI) -> M + ++ \spad{power!(a,b,c,m,n)} computes m ** n and stores the result in + ++ \spad{a}. The matrices b and c are used to store intermediate results. + ++ Error: if \spad{a}, b, c, and m are not square + ++ and of the same dimensions. + "**" : (M,NNI) -> M + ++ \spad{x ** n} computes the n-th power + ++ of a square matrix. The power n is assumed greater than 1. + + Implementation ==> add + + rep : M -> REP + rep m == m pretend REP + + copy_!(c,a) == + m := nrows a; n := ncols a + not((nrows c) = m and (ncols c) = n) => + error "copy!: matrices of incompatible dimensions" + aa := rep a; cc := rep c + for i in 0..(m-1) repeat + aRow := qelt(aa,i); cRow := qelt(cc,i) + for j in 0..(n-1) repeat + qsetelt_!(cRow,j,qelt(aRow,j)) + c + + plus_!(c,a,b) == + m := nrows a; n := ncols a + not((nrows b) = m and (ncols b) = n) => + error "plus!: matrices of incompatible dimensions" + not((nrows c) = m and (ncols c) = n) => + error "plus!: matrices of incompatible dimensions" + aa := rep a; bb := rep b; cc := rep c + for i in 0..(m-1) repeat + aRow := qelt(aa,i); bRow := qelt(bb,i); cRow := qelt(cc,i) + for j in 0..(n-1) repeat + qsetelt_!(cRow,j,qelt(aRow,j) + qelt(bRow,j)) + c + + minus_!(c,a) == + m := nrows a; n := ncols a + not((nrows c) = m and (ncols c) = n) => + error "minus!: matrices of incompatible dimensions" + aa := rep a; cc := rep c + for i in 0..(m-1) repeat + aRow := qelt(aa,i); cRow := qelt(cc,i) + for j in 0..(n-1) repeat + qsetelt_!(cRow,j,-qelt(aRow,j)) + c + + minus_!(c,a,b) == + m := nrows a; n := ncols a + not((nrows b) = m and (ncols b) = n) => + error "minus!: matrices of incompatible dimensions" + not((nrows c) = m and (ncols c) = n) => + error "minus!: matrices of incompatible dimensions" + aa := rep a; bb := rep b; cc := rep c + for i in 0..(m-1) repeat + aRow := qelt(aa,i); bRow := qelt(bb,i); cRow := qelt(cc,i) + for j in 0..(n-1) repeat + qsetelt_!(cRow,j,qelt(aRow,j) - qelt(bRow,j)) + c + + leftScalarTimes_!(c,r,a) == + m := nrows a; n := ncols a + not((nrows c) = m and (ncols c) = n) => + error "leftScalarTimes!: matrices of incompatible dimensions" + aa := rep a; cc := rep c + for i in 0..(m-1) repeat + aRow := qelt(aa,i); cRow := qelt(cc,i) + for j in 0..(n-1) repeat + qsetelt_!(cRow,j,r * qelt(aRow,j)) + c + + rightScalarTimes_!(c,a,r) == + m := nrows a; n := ncols a + not((nrows c) = m and (ncols c) = n) => + error "rightScalarTimes!: matrices of incompatible dimensions" + aa := rep a; cc := rep c + for i in 0..(m-1) repeat + aRow := qelt(aa,i); cRow := qelt(cc,i) + for j in 0..(n-1) repeat + qsetelt_!(cRow,j,qelt(aRow,j) * r) + c + + copyCol_!: (ARR,REP,Integer,Integer) -> ARR + copyCol_!(bCol,bb,j,n1) == + for i in 0..n1 repeat qsetelt_!(bCol,i,qelt(qelt(bb,i),j)) + + times_!(c,a,b) == + m := nrows a; n := ncols a; p := ncols b + not((nrows b) = n and (nrows c) = m and (ncols c) = p) => + error "times!: matrices of incompatible dimensions" + aa := rep a; bb := rep b; cc := rep c + bCol : ARR := new(n,0) + m1 := (m :: Integer) - 1; n1 := (n :: Integer) - 1 + for j in 0..(p-1) repeat + copyCol_!(bCol,bb,j,n1) + for i in 0..m1 repeat + aRow := qelt(aa,i); cRow := qelt(cc,i) + sum : R := 0 + for k in 0..n1 repeat + sum := sum + qelt(aRow,k) * qelt(bCol,k) + qsetelt_!(cRow,j,sum) + c + + power_!(a,b,c,m,p) == + mm := nrows a; nn := ncols a + not(mm = nn) => + error "power!: matrix must be square" + not((nrows b) = mm and (ncols b) = nn) => + error "power!: matrices of incompatible dimensions" + not((nrows c) = mm and (ncols c) = nn) => + error "power!: matrices of incompatible dimensions" + not((nrows m) = mm and (ncols m) = nn) => + error "power!: matrices of incompatible dimensions" + flag := false + copy_!(b,m) + repeat + if odd? p then + flag => + times_!(c,b,a) + copy_!(a,c) + flag := true + copy_!(a,b) +-- one? p => return a + (p = 1) => return a + p := p quo 2 + times_!(c,b,b) + copy_!(b,c) + + m ** n == + not square? m => error "**: matrix must be square" + a := copy m; b := copy m; c := copy m + power_!(a,b,c,m,n) + +@ +<>= +"MATSTOR" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MATSTOR"] +"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"] +"MATSTOR" -> "A1AGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package STINPROD StreamInfiniteProduct} \pagehead{StreamInfiniteProduct}{STINPROD} \pagepic{ps/v104streaminfiniteproduct.ps}{STINPROD}{1.00} @@ -49540,6 +56903,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> @@ -49680,8 +57044,13 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> +<> +<> +<> <> <> +<> <> <> <> @@ -49711,15 +57080,37 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> <> +<> <> +<> +<> <> +<> <> <> <> <> +<> <> <> +<> +<> +<> <> <> @@ -49752,6 +57143,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> @@ -49767,6 +57159,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> @@ -49775,6 +57168,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where <> <> <> +<> <> <> <> diff --git a/books/ps/v104MappingPackage3.ps b/books/ps/v104MappingPackage3.ps new file mode 100644 index 0000000..9e0cc47 --- /dev/null +++ b/books/ps/v104MappingPackage3.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 212 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 176 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPPKG3 +gsave +[ /Rect [ 45 72 125 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPPKG3) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 125 108 moveto +45 108 lineto +45 72 lineto +125 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 125 108 moveto +45 108 lineto +45 72 lineto +125 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +52.5 85.9 moveto 65 (MAPPKG3) alignedtext +grestore +% BASTYPE +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BASTYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (BASTYPE) alignedtext +grestore +% MAPPKG3->BASTYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 61 54 55 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath stroke +grestore +% KOERCE +gsave +[ /Rect [ 96 0 168 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KOERCE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103.5 13.9 moveto 57 (KOERCE) alignedtext +grestore +% MAPPKG3->KOERCE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 97 72 moveto +102 64 109 54 115 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 212 152 +end +restore +%%EOF diff --git a/books/ps/v104MatrixCategoryFunctions2.ps b/books/ps/v104MatrixCategoryFunctions2.ps new file mode 100644 index 0000000..6a6b970 --- /dev/null +++ b/books/ps/v104MatrixCategoryFunctions2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 124 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 88 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MATCAT2 +gsave +[ /Rect [ 0 72 80 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MATCAT2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +80 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +80 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 64 (MATCAT2) alignedtext +grestore +% MATCAT +gsave +[ /Rect [ 4 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=MATCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +4 36 lineto +4 1.06581e-14 lineto +76 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +4 36 lineto +4 1.06581e-14 lineto +76 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11.5 13.9 moveto 57 (MATCAT) alignedtext +grestore +% MATCAT2->MATCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 40 72 moveto +40 64 40 55 40 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.5001 46 moveto +40 36 lineto +36.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.5001 46 moveto +40 36 lineto +36.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 124 152 +end +restore +%%EOF diff --git a/books/ps/v104algebraicmultfact.ps b/books/ps/v104algebraicmultfact.ps new file mode 100644 index 0000000..998b8ca --- /dev/null +++ b/books/ps/v104algebraicmultfact.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 136 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 100 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% ALGMFACT +gsave +[ /Rect [ 0 72 92 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ALGMFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 92 108 moveto +2.76723e-14 108 lineto +6.58501e-15 72 lineto +92 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 92 108 moveto +2.76723e-14 108 lineto +6.58501e-15 72 lineto +92 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 77 (ALGMFACT) alignedtext +grestore +% ACF +gsave +[ /Rect [ 19 0 73 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 73 36 moveto +19 36 lineto +19 1.06581e-14 lineto +73 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 73 36 moveto +19 36 lineto +19 1.06581e-14 lineto +73 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +32.5 13.9 moveto 27 (ACF) alignedtext +grestore +% ALGMFACT->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 46 72 moveto +46 64 46 55 46 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 49.5001 46 moveto +46 36 lineto +42.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 49.5001 46 moveto +46 36 lineto +42.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 136 152 +end +restore +%%EOF diff --git a/books/ps/v104innermatrixlinearalgebrafunctions.ps b/books/ps/v104innermatrixlinearalgebrafunctions.ps new file mode 100644 index 0000000..a61f243 --- /dev/null +++ b/books/ps/v104innermatrixlinearalgebrafunctions.ps @@ -0,0 +1,316 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 224 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 188 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% IMATLIN +gsave +[ /Rect [ 3 144 75 180 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IMATLIN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 75 180 moveto +3 180 lineto +3 144 lineto +75 144 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 75 180 moveto +3 180 lineto +3 144 lineto +75 144 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10.5 157.9 moveto 57 (IMATLIN) alignedtext +grestore +% PFECAT +gsave +0.000 0.000 1.000 nodecolor +newpath 72 108 moveto +6 108 lineto +6 72 lineto +72 72 lineto +closepath fill +1 setlinewidth +filled +0.000 0.000 1.000 nodecolor +newpath 72 108 moveto +6 108 lineto +6 72 lineto +72 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 85.9 moveto 51 (PFECAT) alignedtext +grestore +% IMATLIN->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 144 moveto +39 136 39 127 39 118 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 118 moveto +39 108 lineto +35.5001 118 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 118 moveto +39 108 lineto +35.5001 118 lineto +closepath stroke +grestore +% IVECTOR +gsave +0.000 0.000 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.000 0.000 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (IVECTOR) alignedtext +grestore +% PFECAT->IVECTOR +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 224 +end +restore +%%EOF diff --git a/books/ps/v104innermatrixquotientfieldfunctions.ps b/books/ps/v104innermatrixquotientfieldfunctions.ps new file mode 100644 index 0000000..1d3366f --- /dev/null +++ b/books/ps/v104innermatrixquotientfieldfunctions.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 112 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 76 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% IMATQF +gsave +[ /Rect [ 0 72 68 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IMATQF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 53 (IMATQF) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 1 0 67 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +1 36 lineto +1 1.06581e-14 lineto +67 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +1 36 lineto +1 1.06581e-14 lineto +67 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% IMATQF->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 34 72 moveto +34 64 34 55 34 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 37.5001 46 moveto +34 36 lineto +30.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 37.5001 46 moveto +34 36 lineto +30.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 112 152 +end +restore +%%EOF diff --git a/books/ps/v104innermodulargcd.ps b/books/ps/v104innermodulargcd.ps new file mode 100644 index 0000000..ed8cd17 --- /dev/null +++ b/books/ps/v104innermodulargcd.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 136 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 100 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INMODGCD +gsave +[ /Rect [ 0 72 92 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INMODGCD) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 92 108 moveto +2.76723e-14 108 lineto +6.58501e-15 72 lineto +92 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 92 108 moveto +2.76723e-14 108 lineto +6.58501e-15 72 lineto +92 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 77 (INMODGCD) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 13 0 79 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 79 36 moveto +13 36 lineto +13 1.06581e-14 lineto +79 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 79 36 moveto +13 36 lineto +13 1.06581e-14 lineto +79 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +20.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% INMODGCD->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 46 72 moveto +46 64 46 55 46 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 49.5001 46 moveto +46 36 lineto +42.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 49.5001 46 moveto +46 36 lineto +42.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 136 152 +end +restore +%%EOF diff --git a/books/ps/v104innermultfact.ps b/books/ps/v104innermultfact.ps new file mode 100644 index 0000000..32363f6 --- /dev/null +++ b/books/ps/v104innermultfact.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 132 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 96 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INNMFACT +gsave +[ /Rect [ 0 72 88 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INNMFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 88 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +88 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 88 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +88 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 72 (INNMFACT) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 11 0 77 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 77 36 moveto +11 36 lineto +11 1.06581e-14 lineto +77 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 77 36 moveto +11 36 lineto +11 1.06581e-14 lineto +77 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +18.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% INNMFACT->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 44 72 moveto +44 64 44 55 44 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 132 152 +end +restore +%%EOF diff --git a/books/ps/v104inputformfunctions1.ps b/books/ps/v104inputformfunctions1.ps new file mode 100644 index 0000000..21372dd --- /dev/null +++ b/books/ps/v104inputformfunctions1.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 120 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 84 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INFORM1 +gsave +[ /Rect [ 0 72 76 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INFORM1) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 76 108 moveto +2.82205e-14 108 lineto +7.17829e-15 72 lineto +76 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 76 108 moveto +2.82205e-14 108 lineto +7.17829e-15 72 lineto +76 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 61 (INFORM1) alignedtext +grestore +% ALIST +gsave +[ /Rect [ 11 0 65 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ALIST) >> + /Subtype /Link +/ANN pdfmark +0.273 0.733 1.000 nodecolor +newpath 65 36 moveto +11 36 lineto +11 1.06581e-14 lineto +65 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 65 36 moveto +11 36 lineto +11 1.06581e-14 lineto +65 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +18.5 13.9 moveto 39 (ALIST) alignedtext +grestore +% INFORM1->ALIST +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 38 72 moveto +38 64 38 55 38 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 41.5001 46 moveto +38 36 lineto +34.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 41.5001 46 moveto +38 36 lineto +34.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 120 152 +end +restore +%%EOF diff --git a/books/ps/v104makebinarycompiledfunction.ps b/books/ps/v104makebinarycompiledfunction.ps new file mode 100644 index 0000000..a394080 --- /dev/null +++ b/books/ps/v104makebinarycompiledfunction.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 198 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 162 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MKBCFUNC +gsave +[ /Rect [ 37 72 131 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MKBCFUNC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +37 108 lineto +37 72 lineto +131 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +37 108 lineto +37 72 lineto +131 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +44.5 85.9 moveto 79 (MKBCFUNC) alignedtext +grestore +% KONVERT +gsave +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KONVERT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 66 (KONVERT) alignedtext +grestore +% MKBCFUNC->KONVERT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 62 54 57 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 59.916 43.0418 moveto +52 36 lineto +53.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 59.916 43.0418 moveto +52 36 lineto +53.7969 46.4414 lineto +closepath stroke +grestore +% TYPE +gsave +[ /Rect [ 100 0 154 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=TYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 154 36 moveto +100 36 lineto +100 1.06581e-14 lineto +154 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 154 36 moveto +100 36 lineto +100 1.06581e-14 lineto +154 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +109.5 13.9 moveto 35 (TYPE) alignedtext +grestore +% MKBCFUNC->TYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 95 72 moveto +100 64 106 54 111 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 114.203 46.4414 moveto +116 36 lineto +108.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 114.203 46.4414 moveto +116 36 lineto +108.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 198 152 +end +restore +%%EOF diff --git a/books/ps/v104makefloatcompiledfunction.ps b/books/ps/v104makefloatcompiledfunction.ps new file mode 100644 index 0000000..c5a5467 --- /dev/null +++ b/books/ps/v104makefloatcompiledfunction.ps @@ -0,0 +1,301 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 221 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 185 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MKFLCFN +gsave +[ /Rect [ 0 72 80 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MKFLCFN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +3.02917e-14 108 lineto +9.23914e-15 72 lineto +80 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +3.02917e-14 108 lineto +9.23914e-15 72 lineto +80 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 65 (MKFLCFN) alignedtext +grestore +% KONVERT +gsave +[ /Rect [ 95 0 177 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KONVERT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 177 36 moveto +95 36 lineto +95 1.06581e-14 lineto +177 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 177 36 moveto +95 36 lineto +95 1.06581e-14 lineto +177 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103 13.9 moveto 66 (KONVERT) alignedtext +grestore +% MKFUNC +gsave +0.000 0.000 1.000 nodecolor +newpath 174 108 moveto +98 108 lineto +98 72 lineto +174 72 lineto +closepath fill +1 setlinewidth +filled +0.000 0.000 1.000 nodecolor +newpath 174 108 moveto +98 108 lineto +98 72 lineto +174 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +106 85.9 moveto 60 (MKFUNC) alignedtext +grestore +% MKFUNC->KONVERT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 136 72 moveto +136 64 136 55 136 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 139.5 46 moveto +136 36 lineto +132.5 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 139.5 46 moveto +136 36 lineto +132.5 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 221 152 +end +restore +%%EOF diff --git a/books/ps/v104makefunction.ps b/books/ps/v104makefunction.ps new file mode 100644 index 0000000..63f77bf --- /dev/null +++ b/books/ps/v104makefunction.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MKFUNC +gsave +[ /Rect [ 3 72 79 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MKFUNC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 79 108 moveto +3 108 lineto +3 72 lineto +79 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 79 108 moveto +3 108 lineto +3 72 lineto +79 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 85.9 moveto 60 (MKFUNC) alignedtext +grestore +% KONVERT +gsave +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KONVERT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 66 (KONVERT) alignedtext +grestore +% MKFUNC->KONVERT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/books/ps/v104makerecord.ps b/books/ps/v104makerecord.ps new file mode 100644 index 0000000..144d617 --- /dev/null +++ b/books/ps/v104makerecord.ps @@ -0,0 +1,346 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 276 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 240 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MKRECORD +gsave +[ /Rect [ 0 72 96 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MKRECORD) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 96 108 moveto +2.13163e-14 108 lineto +0 72 lineto +96 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 96 108 moveto +2.13163e-14 108 lineto +0 72 lineto +96 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 80 (MKRECORD) alignedtext +grestore +% KONVERT +gsave +[ /Rect [ 78 0 160 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KONVERT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 160 36 moveto +78 36 lineto +78 1.06581e-14 lineto +160 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 160 36 moveto +78 36 lineto +78 1.06581e-14 lineto +160 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +86 13.9 moveto 66 (KONVERT) alignedtext +grestore +% TYPE +gsave +[ /Rect [ 178 0 232 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=TYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 232 36 moveto +178 36 lineto +178 1.06581e-14 lineto +232 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 232 36 moveto +178 36 lineto +178 1.06581e-14 lineto +232 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +187.5 13.9 moveto 35 (TYPE) alignedtext +grestore +% MKUCFUNC +gsave +0.000 0.000 1.000 nodecolor +newpath 210 108 moveto +114 108 lineto +114 72 lineto +210 72 lineto +closepath fill +1 setlinewidth +filled +0.000 0.000 1.000 nodecolor +newpath 210 108 moveto +114 108 lineto +114 72 lineto +210 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +122 85.9 moveto 80 (MKUCFUNC) alignedtext +grestore +% MKUCFUNC->KONVERT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 151 72 moveto +146 64 140 54 135 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 137.916 43.0418 moveto +130 36 lineto +131.797 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 137.916 43.0418 moveto +130 36 lineto +131.797 46.4414 lineto +closepath stroke +grestore +% MKUCFUNC->TYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 173 72 moveto +178 64 184 54 189 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 192.203 46.4414 moveto +194 36 lineto +186.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 192.203 46.4414 moveto +194 36 lineto +186.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 276 152 +end +restore +%%EOF diff --git a/books/ps/v104makeunarycompiledfunction.ps b/books/ps/v104makeunarycompiledfunction.ps new file mode 100644 index 0000000..7fd8f85 --- /dev/null +++ b/books/ps/v104makeunarycompiledfunction.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 198 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 162 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MKUCFUNC +gsave +[ /Rect [ 36 72 132 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MKUCFUNC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 132 108 moveto +36 108 lineto +36 72 lineto +132 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 132 108 moveto +36 108 lineto +36 72 lineto +132 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +44 85.9 moveto 80 (MKUCFUNC) alignedtext +grestore +% KONVERT +gsave +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KONVERT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 66 (KONVERT) alignedtext +grestore +% MKUCFUNC->KONVERT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 62 54 57 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 59.916 43.0418 moveto +52 36 lineto +53.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 59.916 43.0418 moveto +52 36 lineto +53.7969 46.4414 lineto +closepath stroke +grestore +% TYPE +gsave +[ /Rect [ 100 0 154 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=TYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 154 36 moveto +100 36 lineto +100 1.06581e-14 lineto +154 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 154 36 moveto +100 36 lineto +100 1.06581e-14 lineto +154 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +109.5 13.9 moveto 35 (TYPE) alignedtext +grestore +% MKUCFUNC->TYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 95 72 moveto +100 64 106 54 111 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 114.203 46.4414 moveto +116 36 lineto +108.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 114.203 46.4414 moveto +116 36 lineto +108.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 198 152 +end +restore +%%EOF diff --git a/books/ps/v104mappingpackage1.ps b/books/ps/v104mappingpackage1.ps new file mode 100644 index 0000000..273a149 --- /dev/null +++ b/books/ps/v104mappingpackage1.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 212 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 176 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPPKG1 +gsave +[ /Rect [ 45 72 125 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPPKG1) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 125 108 moveto +45 108 lineto +45 72 lineto +125 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 125 108 moveto +45 108 lineto +45 72 lineto +125 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +52.5 85.9 moveto 65 (MAPPKG1) alignedtext +grestore +% BASTYPE +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BASTYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (BASTYPE) alignedtext +grestore +% MAPPKG1->BASTYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 61 54 55 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath stroke +grestore +% KOERCE +gsave +[ /Rect [ 96 0 168 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KOERCE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103.5 13.9 moveto 57 (KOERCE) alignedtext +grestore +% MAPPKG1->KOERCE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 97 72 moveto +102 64 109 54 115 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 212 152 +end +restore +%%EOF diff --git a/books/ps/v104mappingpackage2.ps b/books/ps/v104mappingpackage2.ps new file mode 100644 index 0000000..c7ba74f --- /dev/null +++ b/books/ps/v104mappingpackage2.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 212 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 176 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPPKG2 +gsave +[ /Rect [ 45 72 125 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPPKG2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 125 108 moveto +45 108 lineto +45 72 lineto +125 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 125 108 moveto +45 108 lineto +45 72 lineto +125 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +52.5 85.9 moveto 65 (MAPPKG2) alignedtext +grestore +% BASTYPE +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BASTYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (BASTYPE) alignedtext +grestore +% MAPPKG2->BASTYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 61 54 55 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath stroke +grestore +% KOERCE +gsave +[ /Rect [ 96 0 168 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KOERCE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103.5 13.9 moveto 57 (KOERCE) alignedtext +grestore +% MAPPKG2->KOERCE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 97 72 moveto +102 64 109 54 115 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 212 152 +end +restore +%%EOF diff --git a/books/ps/v104mappingpackage4.ps b/books/ps/v104mappingpackage4.ps new file mode 100644 index 0000000..b994823 --- /dev/null +++ b/books/ps/v104mappingpackage4.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 200 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 164 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPPKG4 +gsave +[ /Rect [ 29 72 111 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPPKG4) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 111 108 moveto +29 108 lineto +29 72 lineto +111 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 111 108 moveto +29 108 lineto +29 72 lineto +111 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +37 85.9 moveto 66 (MAPPKG4) alignedtext +grestore +% PID +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PID) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16 13.9 moveto 22 (PID) alignedtext +grestore +% MAPPKG4->PID +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 59 72 moveto +54 64 48 54 43 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.916 43.0418 moveto +38 36 lineto +39.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.916 43.0418 moveto +38 36 lineto +39.7969 46.4414 lineto +closepath stroke +grestore +% OAGROUP +gsave +[ /Rect [ 72 0 156 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=OAGROUP) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 156 36 moveto +72 36 lineto +72 1.06581e-14 lineto +156 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 156 36 moveto +72 36 lineto +72 1.06581e-14 lineto +156 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +80 13.9 moveto 68 (OAGROUP) alignedtext +grestore +% MAPPKG4->OAGROUP +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 81 72 moveto +86 64 92 54 98 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 101.203 46.4414 moveto +103 36 lineto +95.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 101.203 46.4414 moveto +103 36 lineto +95.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 200 152 +end +restore +%%EOF diff --git a/books/ps/v104mappingpackageinternalhacks1.ps b/books/ps/v104mappingpackageinternalhacks1.ps new file mode 100644 index 0000000..a127d39 --- /dev/null +++ b/books/ps/v104mappingpackageinternalhacks1.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 212 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 176 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPHACK1 +gsave +[ /Rect [ 39 72 131 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPHACK1) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +39 108 lineto +39 72 lineto +131 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +39 108 lineto +39 72 lineto +131 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +47 85.9 moveto 76 (MAPHACK1) alignedtext +grestore +% BASTYPE +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BASTYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (BASTYPE) alignedtext +grestore +% MAPHACK1->BASTYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 61 54 55 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath stroke +grestore +% KOERCE +gsave +[ /Rect [ 96 0 168 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KOERCE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103.5 13.9 moveto 57 (KOERCE) alignedtext +grestore +% MAPHACK1->KOERCE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 97 72 moveto +102 64 109 54 115 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 212 152 +end +restore +%%EOF diff --git a/books/ps/v104mappingpackageinternalhacks2.ps b/books/ps/v104mappingpackageinternalhacks2.ps new file mode 100644 index 0000000..2d05096 --- /dev/null +++ b/books/ps/v104mappingpackageinternalhacks2.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 212 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 176 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPHACK2 +gsave +[ /Rect [ 39 72 131 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPHACK2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +39 108 lineto +39 72 lineto +131 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +39 108 lineto +39 72 lineto +131 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +47 85.9 moveto 76 (MAPHACK2) alignedtext +grestore +% BASTYPE +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BASTYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (BASTYPE) alignedtext +grestore +% MAPHACK2->BASTYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 61 54 55 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath stroke +grestore +% KOERCE +gsave +[ /Rect [ 96 0 168 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KOERCE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103.5 13.9 moveto 57 (KOERCE) alignedtext +grestore +% MAPHACK2->KOERCE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 97 72 moveto +102 64 109 54 115 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 212 152 +end +restore +%%EOF diff --git a/books/ps/v104mappingpackageinternalhacks3.ps b/books/ps/v104mappingpackageinternalhacks3.ps new file mode 100644 index 0000000..d66f463 --- /dev/null +++ b/books/ps/v104mappingpackageinternalhacks3.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 212 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 176 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MAPHACK3 +gsave +[ /Rect [ 39 72 131 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MAPHACK3) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +39 108 lineto +39 72 lineto +131 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 131 108 moveto +39 108 lineto +39 72 lineto +131 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +47 85.9 moveto 76 (MAPHACK3) alignedtext +grestore +% BASTYPE +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BASTYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (BASTYPE) alignedtext +grestore +% MAPHACK3->BASTYPE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 73 72 moveto +68 64 61 54 55 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 58.268 42.625 moveto +50 36 lineto +52.332 46.335 lineto +closepath stroke +grestore +% KOERCE +gsave +[ /Rect [ 96 0 168 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=KOERCE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 168 36 moveto +96 36 lineto +96 1.06581e-14 lineto +168 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +103.5 13.9 moveto 57 (KOERCE) alignedtext +grestore +% MAPHACK3->KOERCE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 97 72 moveto +102 64 109 54 115 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 117.668 46.335 moveto +120 36 lineto +111.732 42.625 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 212 152 +end +restore +%%EOF diff --git a/books/ps/v104mathmlform.ps b/books/ps/v104mathmlform.ps new file mode 100644 index 0000000..505c59c --- /dev/null +++ b/books/ps/v104mathmlform.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 134 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 98 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MMLFORM +gsave +[ /Rect [ 0 72 90 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MMLFORM) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 90 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +90 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 90 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +90 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 74 (MMLFORM) alignedtext +grestore +% FSAGG +gsave +[ /Rect [ 14 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FSAGG) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +14 36 lineto +14 1.06581e-14 lineto +76 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +14 36 lineto +14 1.06581e-14 lineto +76 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +22 13.9 moveto 46 (FSAGG) alignedtext +grestore +% MMLFORM->FSAGG +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 45 72 moveto +45 64 45 55 45 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 48.5001 46 moveto +45 36 lineto +41.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 48.5001 46 moveto +45 36 lineto +41.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 134 152 +end +restore +%%EOF diff --git a/books/ps/v104matrixlinearalgebrafunctions.ps b/books/ps/v104matrixlinearalgebrafunctions.ps new file mode 100644 index 0000000..922db49 --- /dev/null +++ b/books/ps/v104matrixlinearalgebrafunctions.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 112 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 76 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MATLIN +gsave +[ /Rect [ 0 72 68 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MATLIN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 53 (MATLIN) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 1 0 67 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +1 36 lineto +1 1.06581e-14 lineto +67 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +1 36 lineto +1 1.06581e-14 lineto +67 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% MATLIN->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 34 72 moveto +34 64 34 55 34 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 37.5001 46 moveto +34 36 lineto +30.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 37.5001 46 moveto +34 36 lineto +30.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 112 152 +end +restore +%%EOF diff --git a/books/ps/v104meshcreationroutinesforthreedimensions.ps b/books/ps/v104meshcreationroutinesforthreedimensions.ps new file mode 100644 index 0000000..324c160 --- /dev/null +++ b/books/ps/v104meshcreationroutinesforthreedimensions.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 188 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 152 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MESH +gsave +[ /Rect [ 40 72 94 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MESH) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 94 108 moveto +40 108 lineto +40 72 lineto +94 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 94 108 moveto +40 108 lineto +40 72 lineto +94 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +47.5 85.9 moveto 39 (MESH) alignedtext +grestore +% FIELD +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FIELD) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +1.41189e-14 36 lineto +3.65506e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +1.41189e-14 36 lineto +3.65506e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 39 (FIELD) alignedtext +grestore +% MESH->FIELD +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 57 72 moveto +53 64 47 54 42 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.916 43.0418 moveto +37 36 lineto +38.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.916 43.0418 moveto +37 36 lineto +38.7969 46.4414 lineto +closepath stroke +grestore +% RADCAT +gsave +[ /Rect [ 72 0 144 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=RADCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 144 36 moveto +72 36 lineto +72 1.06581e-14 lineto +144 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 144 36 moveto +72 36 lineto +72 1.06581e-14 lineto +144 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +80 13.9 moveto 56 (RADCAT) alignedtext +grestore +% MESH->RADCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 77 72 moveto +82 64 87 54 93 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 96.2031 46.4414 moveto +98 36 lineto +90.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 96.2031 46.4414 moveto +98 36 lineto +90.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 188 152 +end +restore +%%EOF diff --git a/books/ps/v104modulardistinctdegreefactorizer.ps b/books/ps/v104modulardistinctdegreefactorizer.ps new file mode 100644 index 0000000..00c3d84 --- /dev/null +++ b/books/ps/v104modulardistinctdegreefactorizer.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 128 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 92 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MDDFACT +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MDDFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 68 (MDDFACT) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 9 0 75 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% MDDFACT->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 42 72 moveto +42 64 42 55 42 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 128 152 +end +restore +%%EOF diff --git a/books/ps/v104monoidringfunctions2.ps b/books/ps/v104monoidringfunctions2.ps new file mode 100644 index 0000000..b202286 --- /dev/null +++ b/books/ps/v104monoidringfunctions2.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 218 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 182 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MRF2 +gsave +[ /Rect [ 63 72 117 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MRF2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 117 108 moveto +63 108 lineto +63 72 lineto +117 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 117 108 moveto +63 108 lineto +63 72 lineto +117 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +72 85.9 moveto 36 (MRF2) alignedtext +grestore +% LMODULE +gsave +[ /Rect [ 0 0 84 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=LMODULE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 84 36 moveto +2.63123e-14 36 lineto +5.2458e-15 1.06581e-14 lineto +84 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 84 36 moveto +2.63123e-14 36 lineto +5.2458e-15 1.06581e-14 lineto +84 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 69 (LMODULE) alignedtext +grestore +% MRF2->LMODULE +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 78 72 moveto +73 64 66 54 60 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 62.8 41.9 moveto +54 36 lineto +57.2 46.1 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 62.8 41.9 moveto +54 36 lineto +57.2 46.1 lineto +closepath stroke +grestore +% SGROUP +gsave +[ /Rect [ 102 0 174 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=SGROUP) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 174 36 moveto +102 36 lineto +102 1.06581e-14 lineto +174 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 174 36 moveto +102 36 lineto +102 1.06581e-14 lineto +174 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +110 13.9 moveto 56 (SGROUP) alignedtext +grestore +% MRF2->SGROUP +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 102 72 moveto +107 64 114 54 120 44 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 122.8 46.1 moveto +126 36 lineto +117.2 41.9 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 122.8 46.1 moveto +126 36 lineto +117.2 41.9 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 218 152 +end +restore +%%EOF diff --git a/books/ps/v104multfinitefactorize.ps b/books/ps/v104multfinitefactorize.ps new file mode 100644 index 0000000..5d619a0 --- /dev/null +++ b/books/ps/v104multfinitefactorize.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 130 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 94 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MFINFACT +gsave +[ /Rect [ 0 72 86 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MFINFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +86 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +86 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 70 (MFINFACT) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 10 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +10 36 lineto +10 1.06581e-14 lineto +76 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +10 36 lineto +10 1.06581e-14 lineto +76 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +17.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% MFINFACT->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 43 72 moveto +43 64 43 55 43 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 46.5001 46 moveto +43 36 lineto +39.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 130 152 +end +restore +%%EOF diff --git a/books/ps/v104multivariatefactorize.ps b/books/ps/v104multivariatefactorize.ps new file mode 100644 index 0000000..596004f --- /dev/null +++ b/books/ps/v104multivariatefactorize.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 134 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 98 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MULTFACT +gsave +[ /Rect [ 0 72 90 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MULTFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 90 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +90 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 90 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +90 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 74 (MULTFACT) alignedtext +grestore +% COMPCAT +gsave +[ /Rect [ 3 0 87 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=COMPCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 87 36 moveto +3 36 lineto +3 1.06581e-14 lineto +87 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 87 36 moveto +3 36 lineto +3 1.06581e-14 lineto +87 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 13.9 moveto 68 (COMPCAT) alignedtext +grestore +% MULTFACT->COMPCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 45 72 moveto +45 64 45 55 45 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 48.5001 46 moveto +45 36 lineto +41.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 48.5001 46 moveto +45 36 lineto +41.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 134 152 +end +restore +%%EOF diff --git a/books/ps/v104multivariatelifting.ps b/books/ps/v104multivariatelifting.ps new file mode 100644 index 0000000..f0668eb --- /dev/null +++ b/books/ps/v104multivariatelifting.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MLIFT +gsave +[ /Rect [ 4 72 62 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MLIFT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 62 108 moveto +4 108 lineto +4 72 lineto +62 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 62 108 moveto +4 108 lineto +4 72 lineto +62 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12 85.9 moveto 42 (MLIFT) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% MLIFT->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104multivariatesquarefree.ps b/books/ps/v104multivariatesquarefree.ps new file mode 100644 index 0000000..7f46498 --- /dev/null +++ b/books/ps/v104multivariatesquarefree.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 134 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 98 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MULTSQFR +gsave +[ /Rect [ 0 72 90 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MULTSQFR) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 90 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +90 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 90 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +90 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 74 (MULTSQFR) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 12 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +12 36 lineto +12 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 78 36 moveto +12 36 lineto +12 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +19.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% MULTSQFR->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 45 72 moveto +45 64 45 55 45 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 48.5001 46 moveto +45 36 lineto +41.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 48.5001 46 moveto +45 36 lineto +41.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 134 152 +end +restore +%%EOF diff --git a/books/ps/v104polynomialfunctions2.ps b/books/ps/v104polynomialfunctions2.ps new file mode 100644 index 0000000..f8176b8 --- /dev/null +++ b/books/ps/v104polynomialfunctions2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 74 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% POLY2 +gsave +[ /Rect [ 5 72 61 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=POLY2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +5 108 lineto +5 72 lineto +61 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +5 108 lineto +5 72 lineto +61 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12.5 85.9 moveto 41 (POLY2) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +2.24404e-14 36 lineto +8.44116e-15 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% POLY2->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 33 72 moveto +33 64 33 55 33 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 36.5001 46 moveto +33 36 lineto +29.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 110 152 +end +restore +%%EOF diff --git a/books/ps/v104rectangularmatrixcategoryfunctions2.ps b/books/ps/v104rectangularmatrixcategoryfunctions2.ps new file mode 100644 index 0000000..9dba3ae --- /dev/null +++ b/books/ps/v104rectangularmatrixcategoryfunctions2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% RMCAT2 +gsave +[ /Rect [ 5 72 77 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=RMCAT2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 77 108 moveto +5 108 lineto +5 72 lineto +77 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 77 108 moveto +5 108 lineto +5 72 lineto +77 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13 85.9 moveto 56 (RMCAT2) alignedtext +grestore +% RMATCAT +gsave +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=RMATCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +82 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 66 (RMATCAT) alignedtext +grestore +% RMCAT2->RMATCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/books/ps/v104storageefficientmatrixoperations.ps b/books/ps/v104storageefficientmatrixoperations.ps new file mode 100644 index 0000000..6d78e3f --- /dev/null +++ b/books/ps/v104storageefficientmatrixoperations.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% MATSTOR +gsave +[ /Rect [ 0 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MATSTOR) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 66 (MATSTOR) alignedtext +grestore +% A1AGG +gsave +[ /Rect [ 10 0 72 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=A1AGG) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 72 36 moveto +10 36 lineto +10 1.06581e-14 lineto +72 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 72 36 moveto +10 36 lineto +10 1.06581e-14 lineto +72 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +17.5 13.9 moveto 47 (A1AGG) alignedtext +grestore +% MATSTOR->A1AGG +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/changelog b/changelog index 59be0cc..37371db 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,52 @@ +20090203 tpd src/axiom-website/patches.html 20090203.01.tpd.patch +20090203 tpd books/bookvol10.4.pamphlet add packages +20090203 tpd src/algebra/Makefile remove spad files +20090203 tpd src/algebra/multsqfr.spad removed +20090203 tpd books/ps/v104multivariatesquarefree.ps added +20090203 tpd src/algebra/multpoly.spad removed +20090203 tpd books/ps/v104polynomialfunctions2.ps added +20090203 tpd src/algebra/multfact.spad removed +20090203 tpd books/ps/v104algebraicmultfact.ps added +20090203 tpd books/ps/v104multivariatefactorize.ps added +20090203 tpd books/ps/v104innermultfact.ps added +20090203 tpd src/algebra/mring.spad removed +20090203 tpd books/ps/v104monoidringfunctions2.ps added +20090203 tpd src/algebra/modgcd.spad removed +20090203 tpd books/ps/v104innermodulargcd.ps added +20090203 tpd src/algebra/moddfact.spad removed +20090203 tpd books/ps/v104modulardistinctdegreefactorizer.ps added +20090203 tpd src/algebra/mlift.spad removed +20090203 tpd books/ps/v104multivariatelifting.ps added +20090203 tpd src/algebra/mkrecord.spad removed +20090203 tpd books/ps/v104makerecord.ps added +20090203 tpd src/algebra/mkfunc.spad removed +20090203 tpd books/ps/v104makefloatcompiledfunction.ps added +20090203 tpd books/ps/v104makebinarycompiledfunction.ps added +20090203 tpd books/ps/v104makeunarycompiledfunction.ps added +20090203 tpd books/ps/v104makefunction.ps added +20090203 tpd books/ps/v104inputformfunctions1.ps added +20090203 tpd src/algebra/mfinfact.spad removed +20090203 tpd books/ps/v104multfinitefactorize.ps added +20090203 tpd src/algebra/mesh.spad removed +20090203 tpd books/ps/v104meshcreationroutinesforthreedimensions.ps added +20090203 tpd src/algebra/matstor.spad removed +20090203 tpd books/ps/v104storageefficientmatrixoperations.ps added +20090203 tpd src/algebra/mathml.spad removed +20090203 tpd books/ps/v104mathmlform.ps added +20090203 tpd src/algebra/matfuns.spad removed +20090203 tpd books/ps/v104matrixlinearalgebrafunctions.ps added +20090203 tpd books/ps/v104innermatrixquotientfieldfunctions.ps added +20090203 tpd books/ps/v104rectangularmatrixcategoryfunctions2.ps added +20090203 tpd books/ps/v104MatrixCategoryFunctions2.ps added +20090203 tpd books/ps/v104innermatrixlinearalgebrafunctions.ps added +20090203 tpd src/algebra/mappkg.spad removed +20090203 tpd books/ps/v104mappingpackage4.ps added +20090203 tpd books/ps/v104MappingPackage3.ps added +20090203 tpd books/ps/v104mappingpackage2.ps added +20090203 tpd books/ps/v104mappingpackage1.ps added +20090203 tpd books/ps/v104mappingpackageinternalhacks3.ps added +20090203 tpd books/ps/v104mappingpackageinternalhacks2.ps added +20090203 tpd books/ps/v104mappingpackageinternalhacks1.ps added 20090201 tpd src/axiom-website/patches.html 20090201.02.tpd.patch 20090201 tpd src/algebra/Makefile remove spad files 20090201 tpd src/algebra/mantepse.spad removed diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index df7d88f..3882e11 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -15771,14 +15771,6 @@ We need to figure out which mlift.spad to keep. <>= SPADFILES= \ - ${OUTSRC}/mappkg.spad \ - ${OUTSRC}/matfuns.spad ${OUTSRC}/mathml.spad \ - ${OUTSRC}/matstor.spad \ - ${OUTSRC}/mesh.spad ${OUTSRC}/mfinfact.spad \ - ${OUTSRC}/mkfunc.spad ${OUTSRC}/mkrecord.spad \ - ${OUTSRC}/mlift.spad ${OUTSRC}/moddfact.spad ${OUTSRC}/modgcd.spad \ - ${OUTSRC}/multfact.spad ${OUTSRC}/multpoly.spad \ - ${OUTSRC}/multsqfr.spad \ ${OUTSRC}/naalg.spad \ ${OUTSRC}/newdata.spad ${OUTSRC}/newpoint.spad \ ${OUTSRC}/newpoly.spad ${OUTSRC}/nlinsol.spad ${OUTSRC}/nlode.spad \ @@ -15864,14 +15856,6 @@ DOCFILES= \ ${DOC}/invnode.as.dvi ${DOC}/invrender.as.dvi \ ${DOC}/invtypes.as.dvi ${DOC}/invutils.as.dvi \ ${DOC}/iviews.as.dvi \ - ${DOC}/mappkg.spad.dvi \ - ${DOC}/matfuns.spad.dvi ${DOC}/mathml.spad.dvi \ - ${DOC}/matstor.spad.dvi \ - ${DOC}/mesh.spad.dvi ${DOC}/mfinfact.spad.dvi \ - ${DOC}/mkfunc.spad.dvi ${DOC}/mkrecord.spad.dvi ${DOC}/mlift.spad.jhd.dvi \ - ${DOC}/mlift.spad.dvi ${DOC}/moddfact.spad.dvi ${DOC}/modgcd.spad.dvi \ - ${DOC}/multfact.spad.dvi ${DOC}/multpoly.spad.dvi \ - ${DOC}/multsqfr.spad.dvi \ ${DOC}/naalg.spad.dvi ${DOC}/ndftip.as.dvi \ ${DOC}/nepip.as.dvi ${DOC}/newdata.spad.dvi ${DOC}/newpoint.spad.dvi \ ${DOC}/newpoly.spad.dvi ${DOC}/nlinsol.spad.dvi ${DOC}/nlode.spad.dvi \ @@ -17213,39 +17197,42 @@ ${HELP}/Magma.help: ${BOOKS}/bookvol10.3.pamphlet >${INPUT}/Magma.input @echo "Magma (MAGMA)" >>${HELPFILE} -${HELP}/MakeFunction.help: ${IN}/mkfunc.spad.pamphlet - @echo 7048 create MakeFunction.help from ${IN}/mkfunc.spad.pamphlet - @${TANGLE} -R"MakeFunction.help" ${IN}/mkfunc.spad.pamphlet \ +${HELP}/MakeFunction.help: ${BOOKS}/bookvol10.4.pamphlet + @echo 7048 create MakeFunction.help from ${BOOKS}/bookvol10.4.pamphlet + @${TANGLE} -R"MakeFunction.help" ${BOOKS}/bookvol10.4.pamphlet \ >${HELP}/MakeFunction.help @cp ${HELP}/MakeFunction.help ${HELP}/MKFUNC.help - @${TANGLE} -R"MakeFunction.input" ${IN}/mkfunc.spad.pamphlet \ + @${TANGLE} -R"MakeFunction.input" ${BOOKS}/bookvol10.4.pamphlet \ >${INPUT}/MakeFunction.input @echo "MakeFunction (MKFUNC)" >>${HELPFILE} -${HELP}/MappingPackage1.help: ${IN}/mappkg.spad.pamphlet - @echo 7049 create MappingPackage1.help from ${IN}/mappkg.spad.pamphlet - @${TANGLE} -R"MappingPackage1.help" ${IN}/mappkg.spad.pamphlet \ +${HELP}/MappingPackage1.help: ${BOOKS}/bookvol10.4.pamphlet + @echo 7049 create MappingPackage1.help from \ + ${BOOKS}/bookvol10.4.pamphlet + @${TANGLE} -R"MappingPackage1.help" ${BOOKS}/bookvol10.4.pamphlet \ >${HELP}/MappingPackage1.help @cp ${HELP}/MappingPackage1.help ${HELP}/MAPPKG1.help - @${TANGLE} -R"MappingPackage1.input" ${IN}/mappkg.spad.pamphlet \ + @${TANGLE} -R"MappingPackage1.input" ${BOOKS}/bookvol10.4.pamphlet \ >${INPUT}/MappingPackage1.input @echo "MappingPackage1 (MAPPKG1)" >>${HELPFILE} -${HELP}/MappingPackage2.help: ${IN}/mappkg.spad.pamphlet - @echo 7050 create MappingPackage2.help from ${IN}/mappkg.spad.pamphlet - @${TANGLE} -R"MappingPackage2.help" ${IN}/mappkg.spad.pamphlet \ +${HELP}/MappingPackage2.help: ${BOOKS}/bookvol10.4.pamphlet + @echo 7050 create MappingPackage2.help from \ + ${BOOKS}/bookvol10.4.pamphlet + @${TANGLE} -R"MappingPackage2.help" ${BOOKS}/bookvol10.4.pamphlet \ >${HELP}/MappingPackage2.help @cp ${HELP}/MappingPackage2.help ${HELP}/MAPPKG2.help - @${TANGLE} -R"MappingPackage2.input" ${IN}/mappkg.spad.pamphlet \ + @${TANGLE} -R"MappingPackage2.input" ${BOOKS}/bookvol10.4.pamphlet \ >${INPUT}/MappingPackage2.input @echo "MappingPackage2 (MAPPKG2)" >>${HELPFILE} -${HELP}/MappingPackage3.help: ${IN}/mappkg.spad.pamphlet - @echo 7051 create MappingPackage3.help from ${IN}/mappkg.spad.pamphlet - @${TANGLE} -R"MappingPackage3.help" ${IN}/mappkg.spad.pamphlet \ +${HELP}/MappingPackage3.help: ${BOOKS}/bookvol10.4.pamphlet + @echo 7051 create MappingPackage3.help from \ + ${BOOKS}/bookvol10.4.pamphlet + @${TANGLE} -R"MappingPackage3.help" ${BOOKS}/bookvol10.4.pamphlet \ >${HELP}/MappingPackage3.help @cp ${HELP}/MappingPackage3.help ${HELP}/MAPPKG3.help - @${TANGLE} -R"MappingPackage3.input" ${IN}/mappkg.spad.pamphlet \ + @${TANGLE} -R"MappingPackage3.input" ${BOOKS}/bookvol10.4.pamphlet \ >${INPUT}/MappingPackage3.input @echo "MappingPackage3 (MAPPKG3)" >>${HELPFILE} diff --git a/src/algebra/mappkg.spad.pamphlet b/src/algebra/mappkg.spad.pamphlet deleted file mode 100644 index ce3616e..0000000 --- a/src/algebra/mappkg.spad.pamphlet +++ /dev/null @@ -1,1862 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mappkg.spad} -\author{Stephen M. Watt, William Burge, Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MAPHACK1 MappingPackageInternalHacks1} -<>= -)abbrev package MAPHACK1 MappingPackageInternalHacks1 -++ Author: S.M.Watt and W.H.Burge -++ Date Created:Jan 87 -++ Date Last Updated:Feb 92 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: various Currying operations. -MappingPackageInternalHacks1(A: SetCategory): MPcat == MPdef where - NNI ==> NonNegativeInteger - - MPcat == with - iter: ((A -> A), NNI, A) -> A - ++\spad{iter(f,n,x)} applies \spad{f n} times to \spad{x}. - recur: ((NNI, A)->A, NNI, A) -> A - ++\spad{recur(n,g,x)} is \spad{g(n,g(n-1,..g(1,x)..))}. - - MPdef == add - iter(g,n,x) == - for i in 1..n repeat x := g x -- g(g(..(x)..)) - x - recur(g,n,x) == - for i in 1..n repeat x := g(i,x) -- g(n,g(n-1,..g(1,x)..)) - x - -@ -\section{package MAPHACK2 MappingPackageInternalHacks2} -<>= -)abbrev package MAPHACK2 MappingPackageInternalHacks2 -++ Description: various Currying operations. -MappingPackageInternalHacks2(A: SetCategory, C: SetCategory):_ - MPcat == MPdef where - NNI ==> NonNegativeInteger - - MPcat == with - arg1: (A, C) -> A - ++\spad{arg1(a,c)} selects its first argument. - arg2: (A, C) -> C - ++\spad{arg2(a,c)} selects its second argument. - - MPdef == add - arg1(a, c) == a - arg2(a, c) == c - -@ -\section{package MAPHACK3 MappingPackageInternalHacks3} -<>= -)abbrev package MAPHACK3 MappingPackageInternalHacks3 -++ Description: various Currying operations. -MappingPackageInternalHacks3(A: SetCategory, B: SetCategory, C: SetCategory):_ - MPcat == MPdef where - NNI ==> NonNegativeInteger - - MPcat == with - comp: (B->C, A->B, A) -> C - ++\spad{comp(f,g,x)} is \spad{f(g x)}. - - MPdef == add - comp(g,h,x) == g h x - -@ -\section{package MAPPKG1 MappingPackage1} -<>= --- mappkg.spad.pamphlet MappingPackage1.input -)spool MappingPackage1.output -)set message test on -)set message auto off -)clear all - ---S 1 of 26 -power(q: FRAC INT, n: INT): FRAC INT == q**n ---R ---R Function declaration power : (Fraction Integer,Integer) -> Fraction ---R Integer has been added to workspace. ---R Type: Void ---E 1 - ---S 2 of 26 -power(2,3) ---R ---R Compiling function power with type (Fraction Integer,Integer) -> ---R Fraction Integer ---R ---R (2) 8 ---R Type: Fraction Integer ---E 2 - ---S 3 of 26 -rewop := twist power ---R ---R ---I (3) theMap(MAPPKG3;twist;MM;5!0) ---R Type: ((Integer,Fraction Integer) -> Fraction Integer) ---E 3 - ---S 4 of 26 -rewop(3, 2) ---R ---R ---R (4) 8 ---R Type: Fraction Integer ---E 4 - ---S 5 of 26 -square: FRAC INT -> FRAC INT ---R ---R Type: Void ---E 5 - ---S 6 of 26 -square:= curryRight(power, 2) ---R ---R ---I (6) theMap(MAPPKG3;curryRight;MBM;1!0,0) ---R Type: (Fraction Integer -> Fraction Integer) ---E 6 - ---S 7 of 26 -square 4 ---R ---R ---R (7) 16 ---R Type: Fraction Integer ---E 7 - ---S 8 of 26 -squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) ---R ---R ---I (8) theMap(MAPPKG3;constantRight;MM;3!0) ---R Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) ---E 8 - ---S 9 of 26 -squirrel(1/2, 1/3) ---R ---R ---R 1 ---R (9) - ---R 4 ---R Type: Fraction Integer ---E 9 - ---S 10 of 26 -sixteen := curry(square, 4/1) ---R ---R ---I (10) theMap(MAPPKG2;curry;MAM;2!0,0) ---R Type: (() -> Fraction Integer) ---E 10 - ---S 11 of 26 -sixteen() ---R ---R ---R (11) 16 ---R Type: Fraction Integer ---E 11 - ---S 12 of 26 -square2:=square*square ---R ---R ---I (12) theMap(MAPPKG3;*;MMM;6!0,0) ---R Type: (Fraction Integer -> Fraction Integer) ---E 12 - ---S 13 of 26 -square2 3 ---R ---R ---R (13) 81 ---R Type: Fraction Integer ---E 13 - ---S 14 of 26 -sc(x: FRAC INT): FRAC INT == x + 1 ---R ---R Function declaration sc : Fraction Integer -> Fraction Integer has ---R been added to workspace. ---R Type: Void ---E 14 - ---S 15 of 26 -incfns := [sc**i for i in 0..10] ---R ---R Compiling function sc with type Fraction Integer -> Fraction Integer ---R ---R ---R (15) ---I [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0)] ---R Type: List (Fraction Integer -> Fraction Integer) ---E 15 - ---S 16 of 26 -[f 4 for f in incfns] ---R ---R ---R (16) [4,5,6,7,8,9,10,11,12,13,14] ---R Type: List Fraction Integer ---E 16 - ---S 17 of 26 -times(n:NNI, i:INT):INT == n*i ---R ---R Function declaration times : (NonNegativeInteger,Integer) -> Integer ---R has been added to workspace. ---R Type: Void ---E 17 - ---S 18 of 26 -r := recur(times) ---R ---R Compiling function times with type (NonNegativeInteger,Integer) -> ---R Integer ---R ---I (18) theMap(MAPPKG1;recur;2M;7!0,0) ---R Type: ((NonNegativeInteger,Integer) -> Integer) ---E 18 - ---S 19 of 26 -fact := curryRight(r, 1) ---R ---R ---I (19) theMap(MAPPKG3;curryRight;MBM;1!0,0) ---R Type: (NonNegativeInteger -> Integer) ---E 19 - ---S 20 of 26 -fact 4 ---R ---R ---R (20) 24 ---R Type: PositiveInteger ---E 20 - ---S 21 of 26 -mto2ton(m, n) == - raiser := square^n - raiser m ---R ---R Type: Void ---E 21 - ---S 22 of 26 -mto2ton(3, 3) ---R ---R Compiling function mto2ton with type (PositiveInteger, ---R PositiveInteger) -> Fraction Integer ---R ---R (22) 6561 ---R Type: Fraction Integer ---E 22 - ---S 23 of 26 -shiftfib(r: List INT) : INT == - t := r.1 - r.1 := r.2 - r.2 := r.2 + t - t ---R ---R Function declaration shiftfib : List Integer -> Integer has been ---R added to workspace. ---R Type: Void ---E 23 - ---S 24 of 26 -fibinit: List INT := [0, 1] ---R ---R ---R (24) [0,1] ---R Type: List Integer ---E 24 - ---S 25 of 26 -fibs := curry(shiftfib, fibinit) ---R ---R Compiling function shiftfib with type List Integer -> Integer ---R ---I (25) theMap(MAPPKG2;curry;MAM;2!0,0) ---R Type: (() -> Integer) ---E 25 - ---S 26 of 26 -[fibs() for i in 0..30] ---R ---R ---R (26) ---R [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, ---R 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, ---R 317811, 514229, 832040] ---R Type: List Integer ---E 26 - -)spool -)lisp (bye) - -@ -<>= -==================================================================== -MappingPackage examples -==================================================================== - -Function are objects of type Mapping. In this section we demonstrate -some library operations from the packages MappingPackage1, MappingPackage2, -and MappingPackage3 that manipulate and create functions. Some terminology: -a nullary function takes no arguments, a unary function takes one argument, -and a binary function takes two arguments. - -We begin by creating an example function that raises a rational number -to an integer exponent. - - power(q: FRAC INT, n: INT): FRAC INT == q**n - Type: Void - - power(2,3) - 8 - Type: Fraction Integer - -The twist operation transposes the arguments of a binary function. -Here rewop(a, b) is power(b, a). - - rewop := twist power - theMap(MAPPKG3;twist;MM;5!0) - Type: ((Integer,Fraction Integer) -> Fraction Integer) - -This is 2^3. - - rewop(3, 2) - 8 - Type: Fraction Integer - -Now we define square in terms of power. - - square: FRAC INT -> FRAC INT - Type: Void -The curryRight operation creates a unary function from a binary one by -providing a constant argument on the right. - - square:= curryRight(power, 2) - theMap(MAPPKG3;curryRight;MBM;1!0,0) - Type: (Fraction Integer -> Fraction Integer) - -Likewise, the curryLeft operation provides a constant argument on the -left. - - square 4 - 16 - Type: Fraction Integer - -The constantRight operation creates (in a trivial way) a binary -function from a unary one: constantRight(f) is the function g such -that g(a,b)= f(a). - - squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) - theMap(MAPPKG3;constantRight;MM;3!0) - Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) - -Likewise, constantLeft(f) is the function g such that g(a,b)= f(b). - - squirrel(1/2, 1/3) - 1 - - - 4 - Type: Fraction Integer - -The curry operation makes a unary function nullary. - - sixteen := curry(square, 4/1) - theMap(MAPPKG2;curry;MAM;2!0,0) - Type: (() -> Fraction Integer) - - sixteen() - 16 - Type: Fraction Integer - -The * operation constructs composed functions. - - square2:=square*square - theMap(MAPPKG3;*;MMM;6!0,0) - Type: (Fraction Integer -> Fraction Integer) - - square2 3 - 81 - Type: Fraction Integer - -Use the ** operation to create functions that are n-fold iterations of -other functions. - - sc(x: FRAC INT): FRAC INT == x + 1 - Type: Void - -This is a list of Mapping objects. - - incfns := [sc**i for i in 0..10] - [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0)] - Type: List (Fraction Integer -> Fraction Integer) - -This is a list of applications of those functions. - - [f 4 for f in incfns] - [4,5,6,7,8,9,10,11,12,13,14] - Type: List Fraction Integer - -Use the recur operation for recursion: - - g := recur f means g(n,x) == f(n,f(n-1,...f(1,x))). - - times(n:NNI, i:INT):INT == n*i - Type: Void - - r := recur(times) - theMap(MAPPKG1;recur;2M;7!0,0) - Type: ((NonNegativeInteger,Integer) -> Integer) - -This is a factorial function. - - fact := curryRight(r, 1) - theMap(MAPPKG3;curryRight;MBM;1!0,0) - Type: (NonNegativeInteger -> Integer) - - fact 4 - 24 - Type: PositiveInteger - -Constructed functions can be used within other functions. - - mto2ton(m, n) == - raiser := square^n - raiser m - Type: Void - -This is 3^(2^3). - - mto2ton(3, 3) - 6561 - Type: Fraction Integer - -Here shiftfib is a unary function that modifies its argument. - - shiftfib(r: List INT) : INT == - t := r.1 - r.1 := r.2 - r.2 := r.2 + t - t - Type: Void - -By currying over the argument we get a function with private state. - - fibinit: List INT := [0, 1] - [0,1] - Type: List Integer - - fibs := curry(shiftfib, fibinit) - theMap(MAPPKG2;curry;MAM;2!0,0) - Type: (() -> Integer) - - [fibs() for i in 0..30] - [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, - 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, - 317811, 514229, 832040] - Type: List Integer - -See Also: -o )show MappingPackage1 -o )help MappingPackage2 -o )help MappingPackage3 -o )help MappingPackage4 -o $AXIOM/doc/src/algebra/mappkg.spad.dvi - -@ -<>= -)abbrev package MAPPKG1 MappingPackage1 -++ Author: S.M.Watt and W.H.Burge -++ Date Created:Jan 87 -++ Date Last Updated:Feb 92 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: various Currying operations. -MappingPackage1(A:SetCategory): MPcat == MPdef where - NNI ==> NonNegativeInteger - - MPcat == with - nullary: A -> (()->A) - ++\spad{nullary A} changes its argument into a - ++ nullary function. - coerce: A -> (()->A) - ++\spad{coerce A} changes its argument into a - ++ nullary function. - - fixedPoint: (A->A) -> A - ++\spad{fixedPoint f} is the fixed point of function \spad{f}. - ++ i.e. such that \spad{fixedPoint f = f(fixedPoint f)}. - fixedPoint: (List A->List A, Integer) -> List A - ++\spad{fixedPoint(f,n)} is the fixed point of function - ++ \spad{f} which is assumed to transform a list of length - ++ \spad{n}. - - - id: A -> A - ++\spad{id x} is \spad{x}. - "**": (A->A, NNI) -> (A->A) - ++\spad{f**n} is the function which is the n-fold application - ++ of \spad{f}. - - recur: ((NNI, A)->A) -> ((NNI, A)->A) - ++\spad{recur(g)} is the function \spad{h} such that - ++ \spad{h(n,x)= g(n,g(n-1,..g(1,x)..))}. - - - MPdef == add - - MappingPackageInternalHacks1(A) - - a: A - faa: A -> A - f0a: ()-> A - - nullary a == a - coerce a == nullary a - fixedPoint faa == - g0 := GENSYM()$Lisp - g1 := faa g0 - EQ(g0, g1)$Lisp => error "All points are fixed points" - GEQNSUBSTLIST([g0]$Lisp, [g1]$Lisp, g1)$Lisp - - fixedPoint(fll, n) == - g0 := [(GENSYM()$Lisp):A for i in 1..n] - g1 := fll g0 - or/[EQ(e0,e1)$Lisp for e0 in g0 for e1 in g1] => - error "All points are fixed points" - GEQNSUBSTLIST(g0, g1, g1)$Lisp - - -- Composition and recursion. - id a == a - g**n == iter(g, n, #1) - - recur fnaa == recur(fnaa, #1, #2) - -@ -\section{package MAPPKG2 MappingPackage2} -<>= --- mappkg.spad.pamphlet MappingPackage2.input -)spool MappingPackage2.output -)set message test on -)set message auto off -)clear all ---S 1 -power(q: FRAC INT, n: INT): FRAC INT == q**n ---R ---R Function declaration power : (Fraction Integer,Integer) -> Fraction ---R Integer has been added to workspace. ---R Type: Void ---E 1 - ---S 2 -power(2,3) ---R ---R Compiling function power with type (Fraction Integer,Integer) -> ---R Fraction Integer ---R ---R (2) 8 ---R Type: Fraction Integer ---E 2 - ---S 3 -rewop := twist power ---R ---R ---I (3) theMap(MAPPKG3;twist;MM;5!0) ---R Type: ((Integer,Fraction Integer) -> Fraction Integer) ---E 3 - ---S 4 -rewop(3, 2) ---R ---R ---R (4) 8 ---R Type: Fraction Integer ---E 4 - ---S 5 -square: FRAC INT -> FRAC INT ---R ---R Type: Void ---E 5 - ---S 6 -square:= curryRight(power, 2) ---R ---R ---I (6) theMap(MAPPKG3;curryRight;MBM;1!0,0) ---R Type: (Fraction Integer -> Fraction Integer) ---E 6 - ---S 7 -square 4 ---R ---R ---R (7) 16 ---R Type: Fraction Integer ---E 7 - ---S 8 -squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) ---R ---R ---I (8) theMap(MAPPKG3;constantRight;MM;3!0) ---R Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) ---E 8 - ---S 9 -squirrel(1/2, 1/3) ---R ---R ---R 1 ---R (9) - ---R 4 ---R Type: Fraction Integer ---E 9 - ---S 10 -sixteen := curry(square, 4/1) ---R ---R ---I (10) theMap(MAPPKG2;curry;MAM;2!0,0) ---R Type: (() -> Fraction Integer) ---E 10 - ---S 11 -sixteen() ---R ---R ---R (11) 16 ---R Type: Fraction Integer ---E 11 - ---S 12 -square2:=square*square ---R ---R ---I (12) theMap(MAPPKG3;*;MMM;6!0,0) ---R Type: (Fraction Integer -> Fraction Integer) ---E 12 - ---S 13 -square2 3 ---R ---R ---R (13) 81 ---R Type: Fraction Integer ---E 13 - ---S 14 -sc(x: FRAC INT): FRAC INT == x + 1 ---R ---R Function declaration sc : Fraction Integer -> Fraction Integer has ---R been added to workspace. ---R Type: Void ---E 14 - ---S 15 -incfns := [sc**i for i in 0..10] ---R ---R Compiling function sc with type Fraction Integer -> Fraction Integer ---R ---R ---R (15) ---I [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0)] ---R Type: List (Fraction Integer -> Fraction Integer) ---E 15 - ---S 16 -[f 4 for f in incfns] ---R ---R ---R (16) [4,5,6,7,8,9,10,11,12,13,14] ---R Type: List Fraction Integer ---E 16 - ---S 17 -times(n:NNI, i:INT):INT == n*i ---R ---R Function declaration times : (NonNegativeInteger,Integer) -> Integer ---R has been added to workspace. ---R Type: Void ---E 17 - ---S 18 -r := recur(times) ---R ---R Compiling function times with type (NonNegativeInteger,Integer) -> ---R Integer ---R ---I (18) theMap(MAPPKG1;recur;2M;7!0,0) ---R Type: ((NonNegativeInteger,Integer) -> Integer) ---E 18 - ---S 19 -fact := curryRight(r, 1) ---R ---R ---I (19) theMap(MAPPKG3;curryRight;MBM;1!0,0) ---R Type: (NonNegativeInteger -> Integer) ---E 19 - ---S 20 -fact 4 ---R ---R ---R (20) 24 ---R Type: PositiveInteger ---E 20 - ---S 21 -mto2ton(m, n) == - raiser := square^n - raiser m ---R ---R Type: Void ---E 21 - ---S 22 -mto2ton(3, 3) ---R ---R Compiling function mto2ton with type (PositiveInteger, ---R PositiveInteger) -> Fraction Integer ---R ---R (22) 6561 ---R Type: Fraction Integer ---E 22 - ---S 23 -shiftfib(r: List INT) : INT == - t := r.1 - r.1 := r.2 - r.2 := r.2 + t - t ---R ---R Function declaration shiftfib : List Integer -> Integer has been ---R added to workspace. ---R Type: Void ---E 23 - ---S 24 -fibinit: List INT := [0, 1] ---R ---R ---R (24) [0,1] ---R Type: List Integer ---E 24 - ---S 25 -fibs := curry(shiftfib, fibinit) ---R ---R Compiling function shiftfib with type List Integer -> Integer ---R ---I (25) theMap(MAPPKG2;curry;MAM;2!0,0) ---R Type: (() -> Integer) ---E 25 - ---S 26 -[fibs() for i in 0..30] ---R ---R ---R (26) ---R [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, ---R 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, ---R 317811, 514229, 832040] ---R Type: List Integer ---E 26 -)spool -)lisp (bye) -@ -<>= -==================================================================== -MappingPackage examples -==================================================================== - -Function are objects of type Mapping. In this section we demonstrate -some library operations from the packages MappingPackage1, MappingPackage2, -and MappingPackage3 that manipulate and create functions. Some terminology: -a nullary function takes no arguments, a unary function takes one argument, -and a binary function takes two arguments. - -We begin by creating an example function that raises a rational number -to an integer exponent. - - power(q: FRAC INT, n: INT): FRAC INT == q**n - Type: Void - - power(2,3) - 8 - Type: Fraction Integer - -The twist operation transposes the arguments of a binary function. -Here rewop(a, b) is power(b, a). - - rewop := twist power - theMap(MAPPKG3;twist;MM;5!0) - Type: ((Integer,Fraction Integer) -> Fraction Integer) - -This is 2^3. - - rewop(3, 2) - 8 - Type: Fraction Integer - -Now we define square in terms of power. - - square: FRAC INT -> FRAC INT - Type: Void -The curryRight operation creates a unary function from a binary one by -providing a constant argument on the right. - - square:= curryRight(power, 2) - theMap(MAPPKG3;curryRight;MBM;1!0,0) - Type: (Fraction Integer -> Fraction Integer) - -Likewise, the curryLeft operation provides a constant argument on the -left. - - square 4 - 16 - Type: Fraction Integer - -The constantRight operation creates (in a trivial way) a binary -function from a unary one: constantRight(f) is the function g such -that g(a,b)= f(a). - - squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) - theMap(MAPPKG3;constantRight;MM;3!0) - Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) - -Likewise, constantLeft(f) is the function g such that g(a,b)= f(b). - - squirrel(1/2, 1/3) - 1 - - - 4 - Type: Fraction Integer - -The curry operation makes a unary function nullary. - - sixteen := curry(square, 4/1) - theMap(MAPPKG2;curry;MAM;2!0,0) - Type: (() -> Fraction Integer) - - sixteen() - 16 - Type: Fraction Integer - -The * operation constructs composed functions. - - square2:=square*square - theMap(MAPPKG3;*;MMM;6!0,0) - Type: (Fraction Integer -> Fraction Integer) - - square2 3 - 81 - Type: Fraction Integer - -Use the ** operation to create functions that are n-fold iterations of -other functions. - - sc(x: FRAC INT): FRAC INT == x + 1 - Type: Void - -This is a list of Mapping objects. - - incfns := [sc**i for i in 0..10] - [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0)] - Type: List (Fraction Integer -> Fraction Integer) - -This is a list of applications of those functions. - - [f 4 for f in incfns] - [4,5,6,7,8,9,10,11,12,13,14] - Type: List Fraction Integer - -Use the recur operation for recursion: - - g := recur f means g(n,x) == f(n,f(n-1,...f(1,x))). - - times(n:NNI, i:INT):INT == n*i - Type: Void - - r := recur(times) - theMap(MAPPKG1;recur;2M;7!0,0) - Type: ((NonNegativeInteger,Integer) -> Integer) - -This is a factorial function. - - fact := curryRight(r, 1) - theMap(MAPPKG3;curryRight;MBM;1!0,0) - Type: (NonNegativeInteger -> Integer) - - fact 4 - 24 - Type: PositiveInteger - -Constructed functions can be used within other functions. - - mto2ton(m, n) == - raiser := square^n - raiser m - Type: Void - -This is 3^(2^3). - - mto2ton(3, 3) - 6561 - Type: Fraction Integer - -Here shiftfib is a unary function that modifies its argument. - - shiftfib(r: List INT) : INT == - t := r.1 - r.1 := r.2 - r.2 := r.2 + t - t - Type: Void - -By currying over the argument we get a function with private state. - - fibinit: List INT := [0, 1] - [0,1] - Type: List Integer - - fibs := curry(shiftfib, fibinit) - theMap(MAPPKG2;curry;MAM;2!0,0) - Type: (() -> Integer) - - [fibs() for i in 0..30] - [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, - 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, - 317811, 514229, 832040] - Type: List Integer - -See Also: -o )help MappingPackage1 -o )show MappingPackage2 -o )help MappingPackage3 -o )help MappingPackage4 -o $AXIOM/doc/src/algebra/mappkg.spad.dvi - -@ -<>= -)abbrev package MAPPKG2 MappingPackage2 -++ Description: various Currying operations. -MappingPackage2(A:SetCategory, C:SetCategory): MPcat == MPdef where - NNI ==> NonNegativeInteger - - MPcat == with - const: C -> (A ->C) - ++\spad{const c} is a function which produces \spad{c} when - ++ applied to its argument. - - curry: (A ->C, A) -> (()->C) - ++\spad{cu(f,a)} is the function \spad{g} - ++ such that \spad{g ()= f a}. - constant: (()->C) -> (A ->C) - ++\spad{vu(f)} is the function \spad{g} - ++ such that \spad{g a= f ()}. - - diag: ((A,A)->C) -> (A->C) - ++\spad{diag(f)} is the function \spad{g} - ++ such that \spad{g a = f(a,a)}. - - - MPdef == add - - MappingPackageInternalHacks2(A, C) - - a: A - c: C - faa: A -> A - f0c: ()-> C - fac: A -> C - faac: (A,A)->C - - const c == arg2(#1, c) - curry(fac, a) == fac a - constant f0c == arg2(#1, f0c()) - - diag faac == faac(#1, #1) - -@ -\section{package MAPPKG3 MappingPackage3} -<>= --- mappkg.spad.pamphlet MappingPackage3.input -)spool MappingPackage3.output -)set message test on -)set message auto off -)clear all ---S 1 -power(q: FRAC INT, n: INT): FRAC INT == q**n ---R ---R Function declaration power : (Fraction Integer,Integer) -> Fraction ---R Integer has been added to workspace. ---R Type: Void ---E 1 - ---S 2 -power(2,3) ---R ---R Compiling function power with type (Fraction Integer,Integer) -> ---R Fraction Integer ---R ---R (2) 8 ---R Type: Fraction Integer ---E 2 - ---S 3 -rewop := twist power ---R ---R ---I (3) theMap(MAPPKG3;twist;MM;5!0) ---R Type: ((Integer,Fraction Integer) -> Fraction Integer) ---E 3 - ---S 4 -rewop(3, 2) ---R ---R ---R (4) 8 ---R Type: Fraction Integer ---E 4 - ---S 5 -square: FRAC INT -> FRAC INT ---R ---R Type: Void ---E 5 - ---S 6 -square:= curryRight(power, 2) ---R ---R ---I (6) theMap(MAPPKG3;curryRight;MBM;1!0,0) ---R Type: (Fraction Integer -> Fraction Integer) ---E 6 - ---S 7 -square 4 ---R ---R ---R (7) 16 ---R Type: Fraction Integer ---E 7 - ---S 8 -squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) ---R ---R ---I (8) theMap(MAPPKG3;constantRight;MM;3!0) ---R Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) ---E 8 - ---S 9 -squirrel(1/2, 1/3) ---R ---R ---R 1 ---R (9) - ---R 4 ---R Type: Fraction Integer ---E 9 - ---S 10 -sixteen := curry(square, 4/1) ---R ---R ---I (10) theMap(MAPPKG2;curry;MAM;2!0,0) ---R Type: (() -> Fraction Integer) ---E 10 - ---S 11 -sixteen() ---R ---R ---R (11) 16 ---R Type: Fraction Integer ---E 11 - ---S 12 -square2:=square*square ---R ---R ---I (12) theMap(MAPPKG3;*;MMM;6!0,0) ---R Type: (Fraction Integer -> Fraction Integer) ---E 12 - ---S 13 -square2 3 ---R ---R ---R (13) 81 ---R Type: Fraction Integer ---E 13 - ---S 14 -sc(x: FRAC INT): FRAC INT == x + 1 ---R ---R Function declaration sc : Fraction Integer -> Fraction Integer has ---R been added to workspace. ---R Type: Void ---E 14 - ---S 15 -incfns := [sc**i for i in 0..10] ---R ---R Compiling function sc with type Fraction Integer -> Fraction Integer ---R ---R ---R (15) ---I [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), ---I theMap(MAPPKG1;**;MNniM;6!0,0)] ---R Type: List (Fraction Integer -> Fraction Integer) ---E 15 - ---S 16 -[f 4 for f in incfns] ---R ---R ---R (16) [4,5,6,7,8,9,10,11,12,13,14] ---R Type: List Fraction Integer ---E 16 - ---S 17 -times(n:NNI, i:INT):INT == n*i ---R ---R Function declaration times : (NonNegativeInteger,Integer) -> Integer ---R has been added to workspace. ---R Type: Void ---E 17 - ---S 18 -r := recur(times) ---R ---R Compiling function times with type (NonNegativeInteger,Integer) -> ---R Integer ---R ---I (18) theMap(MAPPKG1;recur;2M;7!0,0) ---R Type: ((NonNegativeInteger,Integer) -> Integer) ---E 18 - ---S 19 -fact := curryRight(r, 1) ---R ---R ---I (19) theMap(MAPPKG3;curryRight;MBM;1!0,0) ---R Type: (NonNegativeInteger -> Integer) ---E 19 - ---S 20 -fact 4 ---R ---R ---R (20) 24 ---R Type: PositiveInteger ---E 20 - ---S 21 -mto2ton(m, n) == - raiser := square^n - raiser m ---R ---R Type: Void ---E 21 - ---S 22 -mto2ton(3, 3) ---R ---R Compiling function mto2ton with type (PositiveInteger, ---R PositiveInteger) -> Fraction Integer ---R ---R (22) 6561 ---R Type: Fraction Integer ---E 22 - ---S 23 -shiftfib(r: List INT) : INT == - t := r.1 - r.1 := r.2 - r.2 := r.2 + t - t ---R ---R Function declaration shiftfib : List Integer -> Integer has been ---R added to workspace. ---R Type: Void ---E 23 - ---S 24 -fibinit: List INT := [0, 1] ---R ---R ---R (24) [0,1] ---R Type: List Integer ---E 24 - ---S 25 -fibs := curry(shiftfib, fibinit) ---R ---R Compiling function shiftfib with type List Integer -> Integer ---R ---I (25) theMap(MAPPKG2;curry;MAM;2!0,0) ---R Type: (() -> Integer) ---E 25 - ---S 26 -[fibs() for i in 0..30] ---R ---R ---R (26) ---R [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, ---R 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, ---R 317811, 514229, 832040] ---R Type: List Integer ---E 26 -)spool -)lisp (bye) -@ -<>= -==================================================================== -MappingPackage examples -==================================================================== - -Function are objects of type Mapping. In this section we demonstrate -some library operations from the packages MappingPackage1, MappingPackage2, -and MappingPackage3 that manipulate and create functions. Some terminology: -a nullary function takes no arguments, a unary function takes one argument, -and a binary function takes two arguments. - -We begin by creating an example function that raises a rational number -to an integer exponent. - - power(q: FRAC INT, n: INT): FRAC INT == q**n - Type: Void - - power(2,3) - 8 - Type: Fraction Integer - -The twist operation transposes the arguments of a binary function. -Here rewop(a, b) is power(b, a). - - rewop := twist power - theMap(MAPPKG3;twist;MM;5!0) - Type: ((Integer,Fraction Integer) -> Fraction Integer) - -This is 2^3. - - rewop(3, 2) - 8 - Type: Fraction Integer - -Now we define square in terms of power. - - square: FRAC INT -> FRAC INT - Type: Void -The curryRight operation creates a unary function from a binary one by -providing a constant argument on the right. - - square:= curryRight(power, 2) - theMap(MAPPKG3;curryRight;MBM;1!0,0) - Type: (Fraction Integer -> Fraction Integer) - -Likewise, the curryLeft operation provides a constant argument on the -left. - - square 4 - 16 - Type: Fraction Integer - -The constantRight operation creates (in a trivial way) a binary -function from a unary one: constantRight(f) is the function g such -that g(a,b)= f(a). - - squirrel:= constantRight(square)$MAPPKG3(FRAC INT,FRAC INT,FRAC INT) - theMap(MAPPKG3;constantRight;MM;3!0) - Type: ((Fraction Integer,Fraction Integer) -> Fraction Integer) - -Likewise, constantLeft(f) is the function g such that g(a,b)= f(b). - - squirrel(1/2, 1/3) - 1 - - - 4 - Type: Fraction Integer - -The curry operation makes a unary function nullary. - - sixteen := curry(square, 4/1) - theMap(MAPPKG2;curry;MAM;2!0,0) - Type: (() -> Fraction Integer) - - sixteen() - 16 - Type: Fraction Integer - -The * operation constructs composed functions. - - square2:=square*square - theMap(MAPPKG3;*;MMM;6!0,0) - Type: (Fraction Integer -> Fraction Integer) - - square2 3 - 81 - Type: Fraction Integer - -Use the ** operation to create functions that are n-fold iterations of -other functions. - - sc(x: FRAC INT): FRAC INT == x + 1 - Type: Void - -This is a list of Mapping objects. - - incfns := [sc**i for i in 0..10] - [theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0), theMap(MAPPKG1;**;MNniM;6!0,0), - theMap(MAPPKG1;**;MNniM;6!0,0)] - Type: List (Fraction Integer -> Fraction Integer) - -This is a list of applications of those functions. - - [f 4 for f in incfns] - [4,5,6,7,8,9,10,11,12,13,14] - Type: List Fraction Integer - -Use the recur operation for recursion: - - g := recur f means g(n,x) == f(n,f(n-1,...f(1,x))). - - times(n:NNI, i:INT):INT == n*i - Type: Void - - r := recur(times) - theMap(MAPPKG1;recur;2M;7!0,0) - Type: ((NonNegativeInteger,Integer) -> Integer) - -This is a factorial function. - - fact := curryRight(r, 1) - theMap(MAPPKG3;curryRight;MBM;1!0,0) - Type: (NonNegativeInteger -> Integer) - - fact 4 - 24 - Type: PositiveInteger - -Constructed functions can be used within other functions. - - mto2ton(m, n) == - raiser := square^n - raiser m - Type: Void - -This is 3^(2^3). - - mto2ton(3, 3) - 6561 - Type: Fraction Integer - -Here shiftfib is a unary function that modifies its argument. - - shiftfib(r: List INT) : INT == - t := r.1 - r.1 := r.2 - r.2 := r.2 + t - t - Type: Void - -By currying over the argument we get a function with private state. - - fibinit: List INT := [0, 1] - [0,1] - Type: List Integer - - fibs := curry(shiftfib, fibinit) - theMap(MAPPKG2;curry;MAM;2!0,0) - Type: (() -> Integer) - - [fibs() for i in 0..30] - [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, - 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, - 317811, 514229, 832040] - Type: List Integer - -See Also: -o )help MappingPackage1 -o )help MappingPackage2 -o )show MappingPackage3 -o )help MappingPackage4 -o $AXIOM/doc/src/algebra/mappkg.spad.dvi - -@ -<>= -)abbrev package MAPPKG3 MappingPackage3 -++ Description: various Currying operations. -MappingPackage3(A:SetCategory, B:SetCategory, C:SetCategory):_ - MPcat == MPdef where - NNI ==> NonNegativeInteger - - MPcat == with - curryRight: ((A,B)->C, B) -> (A ->C) - ++\spad{curryRight(f,b)} is the function \spad{g} such that - ++ \spad{g a = f(a,b)}. - curryLeft: ((A,B)->C, A) -> (B ->C) - ++\spad{curryLeft(f,a)} is the function \spad{g} - ++ such that \spad{g b = f(a,b)}. - - constantRight: (A -> C) -> ((A,B)->C) - ++\spad{constantRight(f)} is the function \spad{g} - ++ such that \spad{g (a,b)= f a}. - constantLeft: (B -> C) -> ((A,B)->C) - ++\spad{constantLeft(f)} is the function \spad{g} - ++ such that \spad{g (a,b)= f b}. - - twist: ((A,B)->C) -> ((B,A)->C) - ++\spad{twist(f)} is the function \spad{g} - ++ such that \spad{g (a,b)= f(b,a)}. - - "*": (B->C, A->B) -> (A->C) - ++\spad{f*g} is the function \spad{h} - ++ such that \spad{h x= f(g x)}. - - - MPdef == add - - MappingPackageInternalHacks3(A, B, C) - - a: A - b: B - c: C - faa: A -> A - f0c: ()-> C - fac: A -> C - fbc: B -> C - fab: A -> B - fabc: (A,B)->C - faac: (A,A)->C - - -- Fix left and right arguments as constants. - curryRight(fabc,b) == fabc(#1,b) - curryLeft(fabc,a) == fabc(a, #1) - - -- Add left and right arguments which are ignored. - constantRight fac == fac #1 - constantLeft fbc == fbc #2 - - -- Combinators to rearrange arguments. - twist fabc == fabc(#2, #1) - -- Functional composition - fbc*fab == comp(fbc,fab,#1) - -@ -\section{package MAPPKG4 MappingPackage4} -<>= --- mappkg.spad.pamphlet MappingPackage4.input -)spool MappingPackage4.output -)set message test on -)set message auto off -)clear all - ---S 1 of 21 -p:=(x:EXPR(INT)):EXPR(INT)+->3*x ---R ---R ---R (1) theMap(Closure) ---R Type: (Expression Integer -> Expression Integer) ---E 1 - ---S 2 of 21 -q:=(x:EXPR(INT)):EXPR(INT)+->2*x+3 ---R ---R ---R (2) theMap(Closure) ---R Type: (Expression Integer -> Expression Integer) ---E 2 - ---S 3 of 21 -(p+q)(4)-(p(4)+q(4)) ---R ---R ---R (3) 0 ---R Type: Expression Integer ---E 3 - ---S 4 of 21 -(p+q)(x)-(p(x)+q(x)) ---R ---R ---R (4) 0 ---R Type: Expression Integer ---E 4 - ---S 5 of 21 -(p-q)(4)-(p(4)-q(4)) ---R ---R ---R (5) 0 ---R Type: Expression Integer ---E 5 - ---S 6 of 21 -(p-q)(x)-(p(x)-q(x)) ---R ---R ---R (6) 0 ---R Type: Expression Integer ---E 6 - ---S 7 of 21 -(p*q)(4)-(p(4)*q(4)) ---R ---R ---R (7) 0 ---R Type: Expression Integer ---E 7 - ---S 8 of 21 -(p*q)(x)-(p(x)*q(x)) ---R ---R ---R (8) 0 ---R Type: Expression Integer ---E 8 - ---S 9 of 21 -(p/q)(4)-(p(4)/q(4)) ---R ---R ---R (9) 0 ---R Type: Expression Integer ---E 9 - ---S 10 of 21 -(p/q)(x)-(p(x)/q(x)) ---R ---R ---R (10) 0 ---R Type: Expression Integer ---E 10 - ---S 11 of 21 -r:=(x:INT):INT+-> (x*x*x) ---R ---R ---R (11) theMap(Closure) ---R Type: (Integer -> Integer) ---E 11 - ---S 12 of 21 -s:=(y:INT):INT+-> (y*y+3) ---R ---R ---R (12) theMap(Closure) ---R Type: (Integer -> Integer) ---E 12 - ---S 13 of 21 -(r+s)(4)-(r(4)+s(4)) ---R ---R ---R (13) 0 ---R Type: NonNegativeInteger ---E 13 - ---S 14 of 21 -(r-s)(4)-(r(4)-s(4)) ---R ---R ---R (14) 0 ---R Type: NonNegativeInteger ---E 14 - ---S 15 of 21 -(r*s)(4)-(r(4)*s(4)) ---R ---R ---R (15) 0 ---R Type: NonNegativeInteger ---E 15 - ---S 16 of 21 -t:=(x:INT):EXPR(INT)+-> (x*x*x) ---R ---R ---R (16) theMap(Closure) ---R Type: (Integer -> Expression Integer) ---E 16 - ---S 17 of 21 -u:=(y:INT):EXPR(INT)+-> (y*y+3) ---R ---R ---R (17) theMap(Closure) ---R Type: (Integer -> Expression Integer) ---E 17 - ---S 18 of 21 -(t/u)(4)-(t(4)/u(4)) ---R ---R ---R (18) 0 ---R Type: Expression Integer ---E 18 - ---S 19 of 21 -h:=(x:EXPR(INT)):EXPR(INT)+->1 ---R ---R (19) theMap(Closure) ---R Type: (Expression Integer -> Expression Integer) ---E 19 - ---S 20 of 21 -(p/h)(x) ---R ---R (20) 3x ---R Type: Expression Integer ---E 20 - ---S 21 of 21 -(q/h)(x) ---R ---R (21) 2x + 3 ---R Type: Expression Integer ---E 21 - -)spool -)lisp (bye) - -@ -<>= -==================================================================== -MappingPackage examples -==================================================================== - -We can construct some simple maps that take a variable x -into an equation: - - p:=(x:EXPR(INT)):EXPR(INT)+->3*x - q:=(x:EXPR(INT)):EXPR(INT)+->2*x+3 - -Now we can do the four arithmetic operations, +, -, *, / on these -newly constructed mappings. Since the maps are from the domain -Expression Integer to the same domain we can also use symbolic -values for the argument. All of the following will return 0, -showing that function composition is equivalent to the result -of doing the operations individually. - - (p+q)(4)-(p(4)+q(4)) - (p+q)(x)-(p(x)+q(x)) - - (p-q)(4)-(p(4)-q(4)) - (p-q)(x)-(p(x)-q(x)) - - (p*q)(4)-(p(4)*q(4)) - (p*q)(x)-(p(x)*q(x)) - - (p/q)(4)-(p(4)/q(4)) - (p/q)(x)-(p(x)/q(x)) - -We can construct simple maps from Integer to Integer but this -limits our ability to do division. - - r:=(x:INT):INT+-> (x*x*x) - s:=(y:INT):INT+-> (y*y+3) - -Again, all of these will return 0: - - (r+s)(4)-(r(4)+s(4)) - (r-s)(4)-(r(4)-s(4)) - (r*s)(4)-(r(4)*s(4)) - -If we want to do division with Integer inputs we create the -appropriate map: - - t:=(x:INT):EXPR(INT)+-> (x*x*x) - u:=(y:INT):EXPR(INT)+-> (y*y+3) - - (t/u)(4)-(t(4)/u(4)) - -We can even recover the original functions if we make a map -that always returns the constant 1: - - h:=(x:EXPR(INT)):EXPR(INT)+->1 - - theMap(Closure) - Type: (Expression Integer -> Expression Integer) - - (p/h)(x) - - 3x - Type: Expression Integer - (q/h)(x) - - 2x + 3 - Type: Expression Integer - -See Also: -o )show MappingPackage1 -o )help MappingPackage2 -o )help MappingPackage3 -o )help MappingPackage4 -o $AXIOM/doc/src/algebra/mappkg.spad.dvi - -@ -<>= -)abbrev package MAPPKG4 MappingPackage4 -++ Author: Timothy Daly -++ Description: Functional Composition -++ Given functions f and g, returns the applicable closure -MappingPackage4(A:SetCategory, B:Ring): - with - "+": (A->B, A->B) -> (A->B) - ++ \spad(+) does functional addition - ++ - ++X f:=(x:INT):INT +-> 3*x - ++X g:=(x:INT):INT +-> 2*x+3 - ++X (f+g)(4) - "-": (A->B, A->B) -> (A->B) - ++ \spad(+) does functional addition - ++ - ++X f:=(x:INT):INT +-> 3*x - ++X g:=(x:INT):INT +-> 2*x+3 - ++X (f-g)(4) - "*": (A->B, A->B) -> (A->B) - ++ \spad(+) does functional addition - ++ - ++X f:=(x:INT):INT +-> 3*x - ++X g:=(x:INT):INT +-> 2*x+3 - ++X (f*g)(4) - "/": (A->Expression(Integer), A->Expression(Integer)) -> (A->Expression(Integer)) - ++ \spad(+) does functional addition - ++ - ++X p:=(x:EXPR(INT)):EXPR(INT)+->3*x - ++X q:=(x:EXPR(INT)):EXPR(INT)+->2*x+3 - ++X (p/q)(4) - ++X (p/q)(x) - == add - fab ==> (A -> B) - faei ==> (A -> Expression(Integer)) - - funcAdd(g:fab,h:fab,x:A):B == ((g x) + (h x))$B - - (a:fab)+(b:fab) == funcAdd(a,b,#1) - - funcSub(g:fab,h:fab,x:A):B == ((g x) - (h x))$B - - (a:fab)-(b:fab) == funcSub(a,b,#1) - - funcMul(g:fab,h:fab,x:A):B == ((g x) * (h x))$B - - (a:fab)*(b:fab) == funcMul(a,b,#1) - - funcDiv(g:faei,h:faei,x:A):Expression(Integer) - == ((g x) / (h x))$Expression(Integer) - - (a:faei)/(b:faei) == funcDiv(a,b,#1) - -@ -\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/matfuns.spad.pamphlet b/src/algebra/matfuns.spad.pamphlet deleted file mode 100644 index 59d0874..0000000 --- a/src/algebra/matfuns.spad.pamphlet +++ /dev/null @@ -1,803 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra matfuns.spad} -\author{Clifton J. Williamson, Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package IMATLIN InnerMatrixLinearAlgebraFunctions} -<>= -)abbrev package IMATLIN InnerMatrixLinearAlgebraFunctions -++ Author: Clifton J. Williamson, P.Gianni -++ Date Created: 13 November 1989 -++ Date Last Updated: September 1993 -++ Basic Operations: -++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), -++ RectangularMatrix(n,m,R), SquareMatrix(n,R) -++ Also See: -++ AMS Classifications: -++ Keywords: matrix, canonical forms, linear algebra -++ Examples: -++ References: -++ Description: -++ \spadtype{InnerMatrixLinearAlgebraFunctions} is an internal package -++ which provides standard linear algebra functions on domains in -++ \spad{MatrixCategory} -InnerMatrixLinearAlgebraFunctions(R,Row,Col,M):_ - Exports == Implementation where - R : Field - Row : FiniteLinearAggregate R - Col : FiniteLinearAggregate R - M : MatrixCategory(R,Row,Col) - I ==> Integer - - Exports ==> with - rowEchelon: M -> M - ++ \spad{rowEchelon(m)} returns the row echelon form of the matrix m. - rank: M -> NonNegativeInteger - ++ \spad{rank(m)} returns the rank of the matrix m. - nullity: M -> NonNegativeInteger - ++ \spad{nullity(m)} returns the mullity of the matrix m. This is the - ++ dimension of the null space of the matrix m. - if Col has shallowlyMutable then - nullSpace: M -> List Col - ++ \spad{nullSpace(m)} returns a basis for the null space of the - ++ matrix m. - determinant: M -> R - ++ \spad{determinant(m)} returns the determinant of the matrix m. - ++ an error message is returned if the matrix is not square. - generalizedInverse: M -> M - ++ \spad{generalizedInverse(m)} returns the generalized (Moore--Penrose) - ++ inverse of the matrix m, i.e. the matrix h such that - ++ m*h*m=h, h*m*h=m, m*h and h*m are both symmetric matrices. - inverse: M -> Union(M,"failed") - ++ \spad{inverse(m)} returns the inverse of the matrix m. - ++ If the matrix is not invertible, "failed" is returned. - ++ Error: if the matrix is not square. - - Implementation ==> add - - rowAllZeroes?: (M,I) -> Boolean - rowAllZeroes?(x,i) == - -- determines if the ith row of x consists only of zeroes - -- internal function: no check on index i - for j in minColIndex(x)..maxColIndex(x) repeat - qelt(x,i,j) ^= 0 => return false - true - - colAllZeroes?: (M,I) -> Boolean - colAllZeroes?(x,j) == - -- determines if the ith column of x consists only of zeroes - -- internal function: no check on index j - for i in minRowIndex(x)..maxRowIndex(x) repeat - qelt(x,i,j) ^= 0 => return false - true - - rowEchelon y == - -- row echelon form via Gaussian elimination - x := copy y - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := maxColIndex x - i := minR - n: I := minR - 1 - for j in minC..maxC repeat - i > maxR => return x - n := minR - 1 - -- n = smallest k such that k >= i and x(k,j) ^= 0 - for k in i..maxR repeat - if qelt(x,k,j) ^= 0 then leave (n := k) - n = minR - 1 => "no non-zeroes" - -- put nth row in ith position - if i ^= n then swapRows_!(x,i,n) - -- divide ith row by its first non-zero entry - b := inv qelt(x,i,j) - qsetelt_!(x,i,j,1) - for k in (j+1)..maxC repeat qsetelt_!(x,i,k,b * qelt(x,i,k)) - -- perform row operations so that jth column has only one 1 - for k in minR..maxR repeat - if k ^= i and qelt(x,k,j) ^= 0 then - for k1 in (j+1)..maxC repeat - qsetelt_!(x,k,k1,qelt(x,k,k1) - qelt(x,k,j) * qelt(x,i,k1)) - qsetelt_!(x,k,j,0) - -- increment i - i := i + 1 - x - - rank x == - y := - (rk := nrows x) > (rh := ncols x) => - rk := rh - transpose x - copy x - y := rowEchelon y; i := maxRowIndex y - while rk > 0 and rowAllZeroes?(y,i) repeat - i := i - 1 - rk := (rk - 1) :: NonNegativeInteger - rk :: NonNegativeInteger - - nullity x == (ncols x - rank x) :: NonNegativeInteger - - if Col has shallowlyMutable then - - nullSpace y == - x := rowEchelon y - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := maxColIndex x - nrow := nrows x; ncol := ncols x - basis : List Col := nil() - rk := nrow; row := maxR - -- compute rank = # rows - # rows of all zeroes - while rk > 0 and rowAllZeroes?(x,row) repeat - rk := (rk - 1) :: NonNegativeInteger - row := (row - 1) :: NonNegativeInteger - -- if maximal rank, return zero vector - ncol <= nrow and rk = ncol => [new(ncol,0)] - -- if rank = 0, return standard basis vectors - rk = 0 => - for j in minC..maxC repeat - w : Col := new(ncol,0) - qsetelt_!(w,j,1) - basis := cons(w,basis) - basis - -- v contains information about initial 1's in the rows of x - -- if the ith row has an initial 1 in the jth column, then - -- v.j = i; v.j = minR - 1, otherwise - v : IndexedOneDimensionalArray(I,minC) := new(ncol,minR - 1) - for i in minR..(minR + rk - 1) repeat - for j in minC.. while qelt(x,i,j) = 0 repeat j - qsetelt_!(v,j,i) - j := maxC; l := minR + ncol - 1 - while j >= minC repeat - w : Col := new(ncol,0) - -- if there is no row with an initial 1 in the jth column, - -- create a basis vector with a 1 in the jth row - if qelt(v,j) = minR - 1 then - colAllZeroes?(x,j) => - qsetelt_!(w,l,1) - basis := cons(w,basis) - for k in minC..(j-1) for ll in minR..(l-1) repeat - if qelt(v,k) ^= minR - 1 then - qsetelt_!(w,ll,-qelt(x,qelt(v,k),j)) - qsetelt_!(w,l,1) - basis := cons(w,basis) - j := j - 1; l := l - 1 - basis - - determinant y == - (ndim := nrows y) ^= (ncols y) => - error "determinant: matrix must be square" - -- Gaussian Elimination - ndim = 1 => qelt(y,minRowIndex y,minColIndex y) - x := copy y - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := maxColIndex x - ans : R := 1 - for i in minR..(maxR - 1) for j in minC..(maxC - 1) repeat - if qelt(x,i,j) = 0 then - rown := minR - 1 - for k in (i+1)..maxR repeat - qelt(x,k,j) ^= 0 => leave (rown := k) - if rown = minR - 1 then return 0 - swapRows_!(x,i,rown); ans := -ans - ans := qelt(x,i,j) * ans; b := -inv qelt(x,i,j) - for l in (j+1)..maxC repeat qsetelt_!(x,i,l,b * qelt(x,i,l)) - for k in (i+1)..maxR repeat - if (b := qelt(x,k,j)) ^= 0 then - for l in (j+1)..maxC repeat - qsetelt_!(x,k,l,qelt(x,k,l) + b * qelt(x,i,l)) - qelt(x,maxR,maxC) * ans - - generalizedInverse(x) == - SUP:=SparseUnivariatePolynomial R - FSUP := Fraction SUP - VFSUP := Vector FSUP - MATCAT2 := MatrixCategoryFunctions2(R, Row, Col, M, - FSUP, VFSUP, VFSUP, Matrix FSUP) - MATCAT22 := MatrixCategoryFunctions2(FSUP, VFSUP, VFSUP, Matrix FSUP, - R, Row, Col, M) - y:= map(coerce(coerce(#1)$SUP)$(Fraction SUP),x)$MATCAT2 - ty:=transpose y - yy:=ty*y - nc:=ncols yy - var:=monomial(1,1)$SUP ::(Fraction SUP) - yy:=inverse(yy+scalarMatrix(ncols yy,var))::Matrix(FSUP)*ty - map(elt(#1,0),yy)$MATCAT22 - - inverse x == - (ndim := nrows x) ^= (ncols x) => - error "inverse: matrix must be square" - ndim = 2 => - ans2 : M := zero(ndim, ndim) - zero?(det := x(1,1)*x(2,2)-x(1,2)*x(2,1)) => "failed" - detinv := inv det - ans2(1,1) := x(2,2)*detinv - ans2(1,2) := -x(1,2)*detinv - ans2(2,1) := -x(2,1)*detinv - ans2(2,2) := x(1,1)*detinv - ans2 - AB : M := zero(ndim,ndim + ndim) - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := maxColIndex x - kmin := minRowIndex AB; kmax := kmin + ndim - 1 - lmin := minColIndex AB; lmax := lmin + ndim - 1 - for i in minR..maxR for k in kmin..kmax repeat - for j in minC..maxC for l in lmin..lmax repeat - qsetelt_!(AB,k,l,qelt(x,i,j)) - qsetelt_!(AB,k,lmin + ndim + k - kmin,1) - AB := rowEchelon AB - elt(AB,kmax,lmax) = 0 => "failed" - subMatrix(AB,kmin,kmax,lmin + ndim,lmax + ndim) - -@ -\section{package MATCAT2 MatrixCategoryFunctions2} -<>= -)abbrev package MATCAT2 MatrixCategoryFunctions2 -++ Author: Clifton J. Williamson -++ Date Created: 21 November 1989 -++ Date Last Updated: 21 March 1994 -++ Basic Operations: -++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), -++ RectangularMatrix(n,m,R), SquareMatrix(n,R) -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Keywords: matrix, map, reduce -++ Examples: -++ References: -++ Description: -++ \spadtype{MatrixCategoryFunctions2} provides functions between two matrix -++ domains. The functions provided are \spadfun{map} and \spadfun{reduce}. -MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ - Exports == Implementation where - R1 : Ring - Row1 : FiniteLinearAggregate R1 - Col1 : FiniteLinearAggregate R1 - M1 : MatrixCategory(R1,Row1,Col1) - R2 : Ring - Row2 : FiniteLinearAggregate R2 - Col2 : FiniteLinearAggregate R2 - M2 : MatrixCategory(R2,Row2,Col2) - - Exports ==> with - map: (R1 -> R2,M1) -> M2 - ++ \spad{map(f,m)} applies the function f to the elements of the matrix m. - map: (R1 -> Union(R2,"failed"),M1) -> Union(M2,"failed") - ++ \spad{map(f,m)} applies the function f to the elements of the matrix m. - reduce: ((R1,R2) -> R2,M1,R2) -> R2 - ++ \spad{reduce(f,m,r)} returns a matrix n where - ++ \spad{n[i,j] = f(m[i,j],r)} for all indices i and j. - - Implementation ==> add - minr ==> minRowIndex - maxr ==> maxRowIndex - minc ==> minColIndex - maxc ==> maxColIndex - - map(f:(R1->R2),m:M1):M2 == - ans : M2 := new(nrows m,ncols m,0) - for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat - for j in minc(m)..maxc(m) for l in minc(ans)..maxc(ans) repeat - qsetelt_!(ans,k,l,f qelt(m,i,j)) - ans - - map(f:(R1 -> (Union(R2,"failed"))),m:M1):Union(M2,"failed") == - ans : M2 := new(nrows m,ncols m,0) - for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat - for j in minc(m)..maxc(m) for l in minc(ans)..maxc(ans) repeat - (r := f qelt(m,i,j)) = "failed" => return "failed" - qsetelt_!(ans,k,l,r::R2) - ans - - reduce(f,m,ident) == - s := ident - for i in minr(m)..maxr(m) repeat - for j in minc(m)..maxc(m) repeat - s := f(qelt(m,i,j),s) - s - -@ -\section{package RMCAT2 RectangularMatrixCategoryFunctions2} -<>= -)abbrev package RMCAT2 RectangularMatrixCategoryFunctions2 -++ Author: Clifton J. Williamson -++ Date Created: 21 November 1989 -++ Date Last Updated: 12 June 1991 -++ Basic Operations: -++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), -++ RectangularMatrix(n,m,R), SquareMatrix(n,R) -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Keywords: matrix, map, reduce -++ Examples: -++ References: -++ Description: -++ \spadtype{RectangularMatrixCategoryFunctions2} provides functions between -++ two matrix domains. The functions provided are \spadfun{map} and \spadfun{reduce}. - -RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_ - Exports == Implementation where - m,n : NonNegativeInteger - R1 : Ring - Row1 : DirectProductCategory(n, R1) - Col1 : DirectProductCategory(m, R1) - M1 : RectangularMatrixCategory(m,n,R1,Row1,Col1) - R2 : Ring - Row2 : DirectProductCategory(n, R2) - Col2 : DirectProductCategory(m, R2) - M2 : RectangularMatrixCategory(m,n,R2,Row2,Col2) - - Exports ==> with - map: (R1 -> R2,M1) -> M2 - ++ \spad{map(f,m)} applies the function \spad{f} to the elements of the - ++ matrix \spad{m}. - reduce: ((R1,R2) -> R2,M1,R2) -> R2 - ++ \spad{reduce(f,m,r)} returns a matrix \spad{n} where - ++ \spad{n[i,j] = f(m[i,j],r)} for all indices spad{i} and \spad{j}. - - Implementation ==> add - minr ==> minRowIndex - maxr ==> maxRowIndex - minc ==> minColIndex - maxc ==> maxColIndex - - map(f,mat) == - ans : M2 := new(m,n,0)$Matrix(R2) pretend M2 - for i in minr(mat)..maxr(mat) for k in minr(ans)..maxr(ans) repeat - for j in minc(mat)..maxc(mat) for l in minc(ans)..maxc(ans) repeat - qsetelt_!(ans pretend Matrix R2,k,l,f qelt(mat,i,j)) - ans - - reduce(f,mat,ident) == - s := ident - for i in minr(mat)..maxr(mat) repeat - for j in minc(mat)..maxc(mat) repeat - s := f(qelt(mat,i,j),s) - s - -@ -\section{package IMATQF InnerMatrixQuotientFieldFunctions} -<>= -)abbrev package IMATQF InnerMatrixQuotientFieldFunctions -++ Author: Clifton J. Williamson -++ Date Created: 22 November 1989 -++ Date Last Updated: 22 November 1989 -++ Basic Operations: -++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), RectangularMatrix(n,m,R), SquareMatrix(n,R) -++ Also See: -++ AMS Classifications: -++ Keywords: matrix, inverse, integral domain -++ Examples: -++ References: -++ Description: -++ \spadtype{InnerMatrixQuotientFieldFunctions} provides functions on matrices -++ over an integral domain which involve the quotient field of that integral -++ domain. The functions rowEchelon and inverse return matrices with -++ entries in the quotient field. -InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2):_ - Exports == Implementation where - R : IntegralDomain - Row : FiniteLinearAggregate R - Col : FiniteLinearAggregate R - M : MatrixCategory(R,Row,Col) - QF : QuotientFieldCategory R - Row2 : FiniteLinearAggregate QF - Col2 : FiniteLinearAggregate QF - M2 : MatrixCategory(QF,Row2,Col2) - IMATLIN ==> InnerMatrixLinearAlgebraFunctions(QF,Row2,Col2,M2) - MATCAT2 ==> MatrixCategoryFunctions2(R,Row,Col,M,QF,Row2,Col2,M2) - CDEN ==> InnerCommonDenominator(R,QF,Col,Col2) - - Exports ==> with - rowEchelon: M -> M2 - ++ \spad{rowEchelon(m)} returns the row echelon form of the matrix m. - ++ the result will have entries in the quotient field. - inverse: M -> Union(M2,"failed") - ++ \spad{inverse(m)} returns the inverse of the matrix m. - ++ If the matrix is not invertible, "failed" is returned. - ++ Error: if the matrix is not square. - ++ Note: the result will have entries in the quotient field. - if Col2 has shallowlyMutable then - nullSpace : M -> List Col - ++ \spad{nullSpace(m)} returns a basis for the null space of the - ++ matrix m. - Implementation ==> add - - qfMat: M -> M2 - qfMat m == map(#1 :: QF,m)$MATCAT2 - - rowEchelon m == rowEchelon(qfMat m)$IMATLIN - inverse m == - (inv := inverse(qfMat m)$IMATLIN) case "failed" => "failed" - inv :: M2 - - if Col2 has shallowlyMutable then - nullSpace m == - [clearDenominator(v)$CDEN for v in nullSpace(qfMat m)$IMATLIN] - -@ -\section{package MATLIN MatrixLinearAlgebraFunctions} -<>= -)abbrev package MATLIN MatrixLinearAlgebraFunctions -++ Author: Clifton J. Williamson, P.Gianni -++ Date Created: 13 November 1989 -++ Date Last Updated: December 1992 -++ Basic Operations: -++ Related Domains: IndexedMatrix(R,minRow,minCol), Matrix(R), -++ RectangularMatrix(n,m,R), SquareMatrix(n,R) -++ Also See: -++ AMS Classifications: -++ Keywords: matrix, canonical forms, linear algebra -++ Examples: -++ References: -++ Description: -++ \spadtype{MatrixLinearAlgebraFunctions} provides functions to compute -++ inverses and canonical forms. -MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where - R : CommutativeRing - Row : FiniteLinearAggregate R - Col : FiniteLinearAggregate R - M : MatrixCategory(R,Row,Col) - I ==> Integer - - Exports ==> with - - determinant: M -> R - ++ \spad{determinant(m)} returns the determinant of the matrix m. - ++ an error message is returned if the matrix is not square. - minordet: M -> R - ++ \spad{minordet(m)} computes the determinant of the matrix m using - ++ minors. Error: if the matrix is not square. - elRow1! : (M,I,I) -> M - ++ elRow1!(m,i,j) swaps rows i and j of matrix m : elementary operation - ++ of first kind - elRow2! : (M,R,I,I) -> M - ++ elRow2!(m,a,i,j) adds to row i a*row(m,j) : elementary operation of - ++ second kind. (i ^=j) - elColumn2! : (M,R,I,I) -> M - ++ elColumn2!(m,a,i,j) adds to column i a*column(m,j) : elementary - ++ operation of second kind. (i ^=j) - - if R has IntegralDomain then - rank: M -> NonNegativeInteger - ++ \spad{rank(m)} returns the rank of the matrix m. - nullity: M -> NonNegativeInteger - ++ \spad{nullity(m)} returns the mullity of the matrix m. This is - ++ the dimension of the null space of the matrix m. - nullSpace: M -> List Col - ++ \spad{nullSpace(m)} returns a basis for the null space of the - ++ matrix m. - fractionFreeGauss! : M -> M - ++ \spad{fractionFreeGauss(m)} performs the fraction - ++ free gaussian elimination on the matrix m. - invertIfCan : M -> Union(M,"failed") - ++ \spad{invertIfCan(m)} returns the inverse of m over R - adjoint : M -> Record(adjMat:M, detMat:R) - ++ \spad{adjoint(m)} returns the ajoint matrix of m (i.e. the matrix - ++ n such that m*n = determinant(m)*id) and the detrminant of m. - - if R has EuclideanDomain then - rowEchelon: M -> M - ++ \spad{rowEchelon(m)} returns the row echelon form of the matrix m. - - normalizedDivide: (R, R) -> Record(quotient:R, remainder:R) - ++ normalizedDivide(n,d) returns a normalized quotient and - ++ remainder such that consistently unique representatives - ++ for the residue class are chosen, e.g. positive remainders - - if R has Field then - inverse: M -> Union(M,"failed") - ++ \spad{inverse(m)} returns the inverse of the matrix. - ++ If the matrix is not invertible, "failed" is returned. - ++ Error: if the matrix is not square. - - Implementation ==> add - - rowAllZeroes?: (M,I) -> Boolean - rowAllZeroes?(x,i) == - -- determines if the ith row of x consists only of zeroes - -- internal function: no check on index i - for j in minColIndex(x)..maxColIndex(x) repeat - qelt(x,i,j) ^= 0 => return false - true - - colAllZeroes?: (M,I) -> Boolean - colAllZeroes?(x,j) == - -- determines if the ith column of x consists only of zeroes - -- internal function: no check on index j - for i in minRowIndex(x)..maxRowIndex(x) repeat - qelt(x,i,j) ^= 0 => return false - true - - minorDet:(M,I,List I,I,PrimitiveArray(Union(R,"uncomputed")))-> R - minorDet(x,m,l,i,v) == - z := v.m - z case R => z - ans : R := 0; rl : List I := nil() - j := first l; l := rest l; pos := true - minR := minRowIndex x; minC := minColIndex x; - repeat - if qelt(x,j + minR,i + minC) ^= 0 then - ans := - md := minorDet(x,m - 2**(j :: NonNegativeInteger),_ - concat_!(reverse rl,l),i + 1,v) *_ - qelt(x,j + minR,i + minC) - pos => ans + md - ans - md - null l => - v.m := ans - return ans - pos := not pos; rl := cons(j,rl); j := first l; l := rest l - - minordet x == - (ndim := nrows x) ^= (ncols x) => - error "determinant: matrix must be square" - -- minor expansion with (s---loads of) memory - n1 : I := ndim - 1 - v : PrimitiveArray(Union(R,"uncomputed")) := - new((2**ndim - 1) :: NonNegativeInteger,"uncomputed") - minR := minRowIndex x; maxC := maxColIndex x - for i in 0..n1 repeat - qsetelt_!(v,(2**i - 1),qelt(x,i + minR,maxC)) - minorDet(x, 2**ndim - 2, [i for i in 0..n1], 0, v) - - -- elementary operation of first kind: exchange two rows -- - elRow1!(m:M,i:I,j:I) : M == - vec:=row(m,i) - setRow!(m,i,row(m,j)) - setRow!(m,j,vec) - m - - -- elementary operation of second kind: add to row i-- - -- a*row j (i^=j) -- - elRow2!(m : M,a:R,i:I,j:I) : M == - vec:= map(a*#1,row(m,j)) - vec:=map("+",row(m,i),vec) - setRow!(m,i,vec) - m - -- elementary operation of second kind: add to column i -- - -- a*column j (i^=j) -- - elColumn2!(m : M,a:R,i:I,j:I) : M == - vec:= map(a*#1,column(m,j)) - vec:=map("+",column(m,i),vec) - setColumn!(m,i,vec) - m - - if R has IntegralDomain then - -- Fraction-Free Gaussian Elimination - fractionFreeGauss! x == - (ndim := nrows x) = 1 => x - ans := b := 1$R - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := maxColIndex x - i := minR - for j in minC..maxC repeat - if qelt(x,i,j) = 0 then -- candidate for pivot = 0 - rown := minR - 1 - for k in (i+1)..maxR repeat - if qelt(x,k,j) ^= 0 then - rown := k -- found a pivot - leave - if rown > minR - 1 then - swapRows_!(x,i,rown) - ans := -ans - (c := qelt(x,i,j)) = 0 => "next j" -- try next column - for k in (i+1)..maxR repeat - if qelt(x,k,j) = 0 then - for l in (j+1)..maxC repeat - qsetelt_!(x,k,l,(c * qelt(x,k,l) exquo b) :: R) - else - pv := qelt(x,k,j) - qsetelt_!(x,k,j,0) - for l in (j+1)..maxC repeat - val := c * qelt(x,k,l) - pv * qelt(x,i,l) - qsetelt_!(x,k,l,(val exquo b) :: R) - b := c - (i := i+1)>maxR => leave - if ans=-1 then - lasti := i-1 - for j in 1..maxC repeat x(lasti, j) := -x(lasti,j) - x - - -- - lastStep(x:M) : M == - ndim := nrows x - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := minC+ndim -1 - exCol:=maxColIndex x - det:=x(maxR,maxC) - maxR1:=maxR-1 - maxC1:=maxC+1 - minC1:=minC+1 - iRow:=maxR - iCol:=maxC-1 - for i in maxR1..1 by -1 repeat - for j in maxC1..exCol repeat - ss:=+/[x(i,iCol+k)*x(i+k,j) for k in 1..(maxR-i)] - x(i,j) := _exquo((det * x(i,j) - ss),x(i,iCol))::R - iCol:=iCol-1 - subMatrix(x,minR,maxR,maxC1,exCol) - - invertIfCan(y) == - (nr:=nrows y) ^= (ncols y) => - error "invertIfCan: matrix must be square" - adjRec := adjoint y - (den:=recip(adjRec.detMat)) case "failed" => "failed" - den::R * adjRec.adjMat - - adjoint(y) == - (nr:=nrows y) ^= (ncols y) => error "adjoint: matrix must be square" - maxR := maxRowIndex y - maxC := maxColIndex y - x := horizConcat(copy y,scalarMatrix(nr,1$R)) - ffr:= fractionFreeGauss!(x) - det:=ffr(maxR,maxC) - [lastStep(ffr),det] - - - if R has Field then - - VR ==> Vector R - IMATLIN ==> InnerMatrixLinearAlgebraFunctions(R,Row,Col,M) - MMATLIN ==> InnerMatrixLinearAlgebraFunctions(R,VR,VR,Matrix R) - FLA2 ==> FiniteLinearAggregateFunctions2(R, VR, R, Col) - MAT2 ==> MatrixCategoryFunctions2(R,Row,Col,M,R,VR,VR,Matrix R) - - rowEchelon y == rowEchelon(y)$IMATLIN - rank y == rank(y)$IMATLIN - nullity y == nullity(y)$IMATLIN - determinant y == determinant(y)$IMATLIN - inverse y == inverse(y)$IMATLIN - if Col has shallowlyMutable then - nullSpace y == nullSpace(y)$IMATLIN - else - nullSpace y == - [map(#1, v)$FLA2 for v in nullSpace(map(#1, y)$MAT2)$MMATLIN] - - else if R has IntegralDomain then - QF ==> Fraction R - Row2 ==> Vector QF - Col2 ==> Vector QF - M2 ==> Matrix QF - IMATQF ==> InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2) - - nullSpace m == nullSpace(m)$IMATQF - - determinant y == - (nrows y) ^= (ncols y) => error "determinant: matrix must be square" - fm:=fractionFreeGauss!(copy y) - fm(maxRowIndex fm,maxColIndex fm) - - rank x == - y := - (rk := nrows x) > (rh := ncols x) => - rk := rh - transpose x - copy x - y := fractionFreeGauss! y - i := maxRowIndex y - while rk > 0 and rowAllZeroes?(y,i) repeat - i := i - 1 - rk := (rk - 1) :: NonNegativeInteger - rk :: NonNegativeInteger - - nullity x == (ncols x - rank x) :: NonNegativeInteger - - if R has EuclideanDomain then - - if R has IntegerNumberSystem then - normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == - qr := divide(n, d) - qr.remainder >= 0 => qr - d > 0 => - qr.remainder := qr.remainder + d - qr.quotient := qr.quotient - 1 - qr - qr.remainder := qr.remainder - d - qr.quotient := qr.quotient + 1 - qr - else - normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) == - divide(n, d) - - rowEchelon y == - x := copy y - minR := minRowIndex x; maxR := maxRowIndex x - minC := minColIndex x; maxC := maxColIndex x - n := minR - 1 - i := minR - for j in minC..maxC repeat - if i > maxR then leave x - n := minR - 1 - xnj: R - for k in i..maxR repeat - if not zero?(xkj:=qelt(x,k,j)) and ((n = minR - 1) _ - or sizeLess?(xkj,xnj)) then - n := k - xnj := xkj - n = minR - 1 => "next j" - swapRows_!(x,i,n) - for k in (i+1)..maxR repeat - qelt(x,k,j) = 0 => "next k" - aa := extendedEuclidean(qelt(x,i,j),qelt(x,k,j)) - (a,b,d) := (aa.coef1,aa.coef2,aa.generator) - b1 := (qelt(x,i,j) exquo d) :: R - a1 := (qelt(x,k,j) exquo d) :: R - -- a*b1+a1*b = 1 - for k1 in (j+1)..maxC repeat - val1 := a * qelt(x,i,k1) + b * qelt(x,k,k1) - val2 := -a1 * qelt(x,i,k1) + b1 * qelt(x,k,k1) - qsetelt_!(x,i,k1,val1); qsetelt_!(x,k,k1,val2) - qsetelt_!(x,i,j,d); qsetelt_!(x,k,j,0) - - un := unitNormal qelt(x,i,j) - qsetelt_!(x,i,j,un.canonical) - if un.associate ^= 1 then for jj in (j+1)..maxC repeat - qsetelt_!(x,i,jj,un.associate * qelt(x,i,jj)) - - xij := qelt(x,i,j) - for k in minR..(i-1) repeat - qelt(x,k,j) = 0 => "next k" - qr := normalizedDivide(qelt(x,k,j), xij) - qsetelt_!(x,k,j,qr.remainder) - for k1 in (j+1)..maxC repeat - qsetelt_!(x,k,k1,qelt(x,k,k1) - qr.quotient * qelt(x,i,k1)) - i := i + 1 - x - - else determinant x == minordet x - -@ -\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. -@ -<<*>>= -<> - --- This file and MATRIX SPAD must be compiled in bootstrap mode. - -<> -<> -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/mathml.spad.pamphlet b/src/algebra/mathml.spad.pamphlet deleted file mode 100644 index 124c18f..0000000 --- a/src/algebra/mathml.spad.pamphlet +++ /dev/null @@ -1,1466 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mathml.spad} -\author{Arthur C. Ralfs} -\maketitle -\begin{abstract} -MathMLFormat is a package to produce presentation mathematical -markup language from OutputForm. -\end{abstract} -\eject -\tableofcontents -\eject -\section{Preface} - -Both this code and documentation are still under development and -I don't pretend they are anywhere close to perfect or even finished. -However the code does work and I hope it might be useful to somebody -both for it's ability to output MathML from Axiom and as an example -of how to write a new output form. - -\section{Introduction to Mathematical Markup Language} - -MathML exists in two forms: presentation and content. -At this time (2007-02-11) the package only has a presentation -package. A content package is in the -works however it is more difficult. Unfortunately Axiom does -not make its semantics easily available. The \spadtype{OutputForm} -domain mediates between the individual Axiom domains and the -user visible output but \spadtype{OutputForm} does not provide full -semantic information. From my currently incomplete understanding -of Axiom it appears that remedying this would entail going back -to the individual domains and rewriting a lot of code. -However some semantics are conveyed directly by \spadtype{OutputForm} and other -things can be deduced from \spadtype{OutputForm} or from the original -user command. - -\section{Displaying MathML} - -The MathML string produced by ")set output mathml on" can be pasted -directly into an appropriate xhtml page and then viewed in Firefox -or some other MathML aware browser. The boiler plate code needed for -a test page, testmathml.xml, is: - -\begin{verbatim} - - - -]> - - - - - - MathML Test - - - - - - -\end{verbatim} - - -Paste the MathML string into the body element and it should display -nicely in Firefox. - -\section{Test Cases} - -Here's a list of test cases that currently format correctly: - -1. (x+y)**2 - -2. integrate(x**x,x) - -3. integral(x**x,x) - -4. (5 + sqrt 63 + sqrt 847)**(1/3) - -5. set $[$1,2,3$]$ - -6. multiset $[$x rem 5 for x in primes(2,1000)$]$ - -7. series(sin(a*x),x=0) - -8. matrix $[$ $[$x**i + y**j for i in 1..10$]$ for j in 1..10$]$ - -9. y := operator 'y - a. D(y(x,z),$[$x,x,z,x$]$) - b. D(y x,x,2) - -10. x := series 'x - a. sin(1+x) - -11. series(1/log(y),y=1) - -12. y:UTS(FLOAT,'z,0) := exp(z) - -13. a. c := continuedFraction(314159/100000) - b. c := continuedFraction(314159/100000) - -The \spadtype{TexFormat} domain has the capability to format an object with -subscripts, superscripts, presubscripts and presuperscripts however -I don't know of any Axiom command that produces such an object. In -fact at present I see the case of "SUPERSUB" being used for putting -primes in the superscript position to denote ordinary differentiation. -I also only see the "SUB" case being used to denote partial -derivatives. - -\section{)set output mathml on} - - -Making mathml appear as output during a normal Axiom session -by invoking ")set output mathml on" proved to be a bit tedious -and seems to be undocumented. I document my experience here -in case it proves useful to somebody else trying to get a new -output format from Axiom. - -In \spadtype{MathMLFormat} the functions -\spadfun{coerce(expr : OutputForm) : String} and -\spadfun{display(s : String) : Void} provide the desired mathml output. -Note that this package was constructed by close examination of -Robert Sutor's \spadtype{TexFormat} domain and much remains from that source. -To have mathml displayed as output we need to get Axiom to -call display(coerce(expr)) at the appropriate place. Here's what -I did to get that to happen. Note that my starting point here was -an attempt by Andrey Grozin to do the same. To figure things out -I searched through files for "tex" to see what was done for the -\spadtype{TexFormat} domain, and used grep to find which files had mention of -\spadtype{TexFormat}. - -\subsection{File src/interp/setvars.boot.pamphlet} - - - Create an output mathml section by analogy to the tex section. -Remember to add the code chunk "outputmathmlCode" at the end. - -setvars.boot is a bootstrap file which means that it has to be -precompiled into lisp code and then that code has to be inserted -back into setvars.boot. To do this extract the boot code by running -"notangle" on it. I did this from the "tmp" directory. -From inside axiom run ")lisp (boottran::boottocl "tmp/setvars.boot") -which put "setvars.clisp" into "int/interp/setvars.clisp". Then -replace the lisp in "setvars.boot.pamphlet" with that in the newly -generated "setvars.clisp". - -The relevant code chunks appearing in "setvars.boot.pamphlet" are: -\begin{verbatim} - outputmathmlCode - setOutputMathml - describeSetOutputMathml -\end{verbatim} -and the relevant variables are: -\begin{verbatim} - setOutputMathml - $mathmlOutputStream - $mathmlOutputFile - $mathmlFormat - describeSetOutputMathml -\end{verbatim} - -\subsection{File setvart.boot.pamphlet} - - -Create an output mathml section in "setvart.boot.pamphlet" again -patterned after the tex section. I changed the default file -extension from ".stex" to ".smml". - -To the "section{output}" table I added the line -\begin{verbatim} - mathml created output in MathML style Off:CONSOLE -\end{verbatim} -Added the code chunk "outputmathml" to the code chunk "output" -in "section{output}". - -Relevant code chunks: -\begin{verbatim} - outputmathml -\end{verbatim} -Relevant variables: -\begin{verbatim} - setOutputMathml - $mathmlFormat - $mathmlOutputFile -\end{verbatim} - -Note when copying the tex stuff I changed occurrences of "tex" -to "mathml", "Tex" to "Mathml" and "TeX" to "MathML". - -\subsection{File src/algebra/Makefile.pamphlet} - - -The file "src/algebra/tex.spad.pamphlet" contains -the domain \spadtype{TexFormat} (TEX) and the package -\spadtype{TexFormat1} (TEX1). -However the sole function of \spadtype{TexFormat1} is to \spadfun{coerce} -objects from a domain into \spadtype{OutputForm} and then apply -\spadtype{TexFormat} -to them. It is to save programmers the trouble of doing -the coercion themselves from inside spad code. It does -not appear to be used for the main purpose of delivering -Axiom output in TeX format. In order to keep the mathml -package as simple as possible, and because I didn't see much -use for this, I didn't copy the \spadtype{TexFormat1} package. So -no analog of the TEX1 entries in "Makefile.pamphlet" were -needed. One curiosity I don't understand is why TEX1 -appears in layer 4 when it seems to depend on TEX which -appears in layer 14. - -Initially I added "\${OUT}/MMLFORM.o" to layer 14 and -"mathml.spad.pamphlet" to completed spad files in layer 14. -When trying to compile the build failed at MMLFORM. It left -"MMLFORM.erlib" in "int/algebra" instead of "MMLFORM.NRLIB" -which confused me at first because mathml.spad compiled -under a running axiom. By examining the file "obj/tmp/trace" -I saw that a new dependency had been introduced, compared -to TexFormat, with the function eltName depending on the -domain FSAGG in layer 16. So the lines had to be moved -from layer 14 to layer 17. - -Added appropriate lines to "SPADFILES" and "DOCFILES". - -\subsection{File src/algebra/exposed.lsp.pamphlet} - -Add the line "($\vert{}$MathMLFormat$\vert$ . MMLFORM)" - -\subsection{File src/algebra/Lattice.pamphlet} - -I don't see that this file is used anywhere but I made -the appropriate changes anyway by searching for "TEX" and -mimicing everything for MMLFORM. - -\subsection{File src/doc/axiom.bib.pamphlet} - -Added mathml.spad subsection to "src/doc/axiom.bib.pamphlet". - -\subsection{File interp/i-output.boot.pamphlet} - - -This is where the \spadfun{coerce} and \spadfun{display} functions -from MathMLFormat -actually get called. The following was added: - -\begin{verbatim} -mathmlFormat expr == - mml := '(MathMLFormat) - mmlrep := '(String) - formatFn := getFunctionFromDomain("coerce",mml,[$OutputForm]) - displayFn := getFunctionFromDomain("display",mml,[mmlrep]) - SPADCALL(SPADCALL(expr,formatFn),displayFn) - TERPRI $mathmlOutputStream - FORCE_-OUTPUT $mathmlOutputStream - NIL -\end{verbatim} - -Note that compared to the texFormat function there are a couple -of differences. Since \spadtype{MathMLFormat} is currently a package rather -than a domain there is the "mmlrep" variable whereas in texFormat -the argument of the "display" function is an instance of the -domain. Also the \spadfun{coerce} function here only has one argument, -namely "\$OutputForm". - -Also for the function "output(expr,domain)" add lines for mathml, -e.g. "if \$mathmlFormat then mathmlFormat expr". - -After these changes Axiom compiled with mathml enabled under -)set output. - -\section{package MMLFORM MathMLFormat} - -\subsection{Public Declarations} - -The declarations -\begin{verbatim} - E ==> OutputForm - I ==> Integer - L ==> List - S ==> String - US ==> UniversalSegment(Integer) -\end{verbatim} -provide abbreviations for domains used heavily in the code. -The publicly exposed functions are: - - \spadfun{coerce: E -$>$ S} This function is the main one for converting -an expression in domain OutputForm into a MathML string. - - \spadfun{coerceS: E -$>$ S} This function is for use from the command line. -It converts an OutputForm expression into a MathML string and does -some formatting so that the output is not one long line. If you take -the output from this function, stick it in an emacs buffer in -nxml-mode and then indent according to mode, you'll get something that's -nicer to look at than what comes from coerce. Note that coerceS returns -the same value as coerce but invokes a display function as well so that -the result will be printed twice in different formats. The need for this -is that the output from coerce is automatically formatted with line breaks -by Axiom's output routine that are not in the right place. - - \spadfun{coerceL: E -$>$ S} Similar to coerceS except that the displayed result -is the MathML string in one long line. These functions can be used, -for instance, to get the MathML for the previous result by typing -coerceL(%)\$MMLFORM. - - \spadfun{exprex: E -$>$ S} Converts \spadtype{OutputForm} to -\spadtype{String} with -the structure preserved with braces. This is useful in developing this -package. Actually this is not quite accurate. The function -\spadfun{precondition} is first applied to the \spadtype{OutputForm} -expression before \spadfun{exprex}. Raw \spadtype{OutputForm} and the nature -of the \spadfun{precondition} function is still obscure to me at the time of -this writing (2007-02-14), however I probably need to understand it to make -sure I'm not missing any semantics. The spad function \spadfun{precondition} -is just a wrapper for the lisp function outputTran\$Lisp, which I guess is -compiled from boot. - - \spadfun{display: S -$>$ Void} This one prints the string returned by coerce as one -long line, adding "math" tags: $<$math ...$>$ ... $<$/math$>$. Thus the output -from this can be stuck directly into an appropriate html/xhtml page and will -be displayed nicely by a MathML aware browser. - - \spadfun{displayF: S -$>$ Void} This function doesn't exist -yet but it would be nice -to have a humanly readable formatted output as well. The basics do exist in -the coerceS function however the formatting still needs some work to be -really good. - -<>= -)abbrev domain MMLFORM MathMLFormat -++ Author: Arthur C. Ralfs -++ Date: January 2007 -++ This package is based on the TeXFormat domain by Robert S. Sutor -++ without which I wouldn't have known where to start. -++ Basic Operations: coerce, coerceS, coerceL, exprex, display -++ Description: -++ \spadtype{MathMLFormat} provides a coercion from \spadtype{OutputForm} -++ to MathML format. - -MathMLFormat(): public == private where - E ==> OutputForm - I ==> Integer - L ==> List - S ==> String - US ==> UniversalSegment(Integer) - - public == SetCategory with - coerce: E -> S - ++ coerceS(o) changes o in the standard output format to MathML - ++ format. - coerceS: E -> S - ++ coerceS(o) changes o in the standard output format to MathML - ++ format and displays formatted result. - coerceL: E -> S - ++ coerceS(o) changes o in the standard output format to MathML - ++ format and displays result as one long string. - exprex: E -> S - ++ coverts \spadtype{OutputForm} to \spadtype{String} with the - ++ structure preserved with braces. Actually this is not quite - ++ accurate. The function \spadfun{precondition} is first - ++ applied to the - ++ \spadtype{OutputForm} expression before \spadfun{exprex}. - ++ The raw \spadtype{OutputForm} and - ++ the nature of the \spadfun{precondition} function is - ++ still obscure to me - ++ at the time of this writing (2007-02-14). - display: S -> Void - ++ prints the string returned by coerce, adding tags. - -@ -\subsection{Private Constant Declarations} -<>= - private == add - import OutputForm - import Character - import Integer - import List OutputForm - import List String - - -- local variable declarations and definitions - - expr: E - prec,opPrec: I - str: S - blank : S := " \ " - - maxPrec : I := 1000000 - minPrec : I := 0 - - unaryOps : L S := ["-","^"]$(L S) - unaryPrecs : L I := [700,260]$(L I) - - -- the precedence of / in the following is relatively low because - -- the bar obviates the need for parentheses. - binaryOps : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S) - binaryPrecs : L I := [0,0,900, 700,400,400,400, 700]$(L I) - - naryOps : L S := ["-","+","*",blank,",",";"," ","ROW","", - " \cr ","&",""]$(L S) - naryPrecs : L I := [700,700,800, 800,110,110, 0, 0, 0, - 0, 0, 0]$(L I) - naryNGOps : L S := ["ROW","&"]$(L S) - - plexOps : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"]$(L S) - plexPrecs : L I := [ 700, 800, 700, 800 , 700, 700]$(L I) - - specialOps : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT", _ - "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG", _ - "SUPERSUB","ZAG","AGGSET","SC","PAREN", _ - "SEGMENT","QUOTE","theMap" ] - - -- the next two lists provide translations for some strings for - -- which MML provides special macros. - - specialStrings : L S := - ["cos", "cot", "csc", "log", "sec", "sin", "tan", - "cosh", "coth", "csch", "sech", "sinh", "tanh", - "acos","asin","atan","erf","...","$","infinity"] - specialStringsInMML : L S := - ["cos","cot","csc","log","sec","sin","tan", - "cosh","coth","csch","sech","sinh","tanh", - "arccos","arcsin","arctan","erf","…","$","∞"] - -@ -\subsection{Private Function Declarations} - -These are the local functions: - - addBraces:S -$>$ S - - addBrackets:S -$>$ S - - atomize:E -$>$ L E - - displayElt:S -$>$ Void - function for recursively displaying mathml nicely formatted - - eltLimit:(S,I,S) -$>$ I - demarcates end postion of mathml element with name:S starting at - position i:I in mathml string s:S and returns end of end tag as - i:I position in mathml string, i.e. find start and end of - substring: $<$name ...$>$...$<$/name$>$ - - eltName:(I,S) -$>$ S - find name of mathml element starting at position i:I in string s:S - - group:S -$>$ S - - formatBinary:(S,L E, I) -$>$ S - - formatFunction:(S,L E, I) -$>$ S - - formatMatrix:L E -$>$ S - - formatNary:(S,L E, I) -$>$ S - - formatNaryNoGroup:(S,L E, I) -$>$ S - - formatNullary:S -$>$ S - - formatPlex:(S,L E, I) -$>$ S - - formatSpecial:(S,L E, I) -$>$ S - - formatUnary:(S, E, I) -$>$ S - - formatMml:(E,I) -$>$ S - - newWithNum:I -$>$ \$ - this is a relic from tex.spad and is not used here so far. I'll - probably remove it. - - parenthesize:S -$>$ S - - precondition:E -$>$ E - this function is applied to the OutputForm expression before - doing anything else. - - postcondition:S -$>$ S - this function is applied after all other OutputForm -$>$ MathML - transformations. In the TexFormat domain the ungroup function - first peels off the outermost set of braces however I have - replaced braces with $<$mrow$>$s here and sometimes the outermost set - of $<$mrow$>$s is necessary to get proper display in Firefox. - For instance with getting the correct size of brackets on a matrix - the whole expression needs to be enclosed in a mrow element. - It also checks for $+-$ and removes the $+$. - - stringify:E -$>$ S - - tagEnd:(S,I,S) -$>$ I - finds closing "$>$" of start or end tag for mathML element for formatting - MathML string for human readability. No analog in TexFormat. - - ungroup:S -$>$ S - -<>= - -- local function signatures - - addBraces: S -> S - addBrackets: S -> S - atomize: E -> L E - displayElt: S -> Void - ++ function for recursively displaying mathml nicely formatted - eltLimit: (S,I,S) -> I - ++ demarcates end postion of mathml element with name:S starting at - ++ position i:I in mathml string s:S and returns end of end tag as - ++ i:I position in mathml string, i.e. find start and end of - ++ substring: ... - eltName: (I,S) -> S - ++ find name of mathml element starting at position i:I in string s:S - group: S -> S - formatBinary: (S,L E, I) -> S - formatFunction: (S,L E, I) -> S - formatIntSign: (L E, I) -> S - formatMatrix: L E -> S - formatNary: (S,L E, I) -> S - formatNaryNoGroup: (S,L E, I) -> S - formatNullary: S -> S - formatPlex: (S,L E, I) -> S - formatSpecial: (S,L E, I) -> S - formatSub: (E, L E, I) -> S - formatSuperSub: (E, L E, I) -> S - formatSuperSub1: (E, L E, I) -> S - formatUnary: (S, E, I) -> S - formatMml: (E,I) -> S - formatZag: L E -> S - formatZag1: L E -> S - newWithNum: I -> $ - parenthesize: S -> S - precondition: E -> E - postcondition: S -> S - stringify: E -> S - tagEnd: (S,I,S) -> I - ++ finds closing ">" of start or end tag for mathML element - ungroup: S -> S - -@ -\subsection{Public Function Definitions} - -Note that I use the function sayTeX\$Lisp much as I would printf in a -C program. I've noticed in grepping the code that there are other "say" -functions, sayBrightly and sayMessage for instance, but I have no idea -what the difference is between them at this point. sayTeX\$Lisp does the -job so for the time being I'll use that until I learn more. - -The functions coerceS and coerceL should probably be changed to display -functions, {\it i.e.}\/ \spadfun{displayS} and \spadfun{display L}, -returning Void. I really only need the one coerce function. - -<>= - -- public function definitions - - coerce(expr : E): S == - s : S := postcondition formatMml(precondition expr, minPrec) - s - - coerceS(expr : E): S == - s : S := postcondition formatMml(precondition expr, minPrec) - sayTeX$Lisp "" - displayElt(s) - sayTeX$Lisp "" - s - - coerceL(expr : E): S == - s : S := postcondition formatMml(precondition expr, minPrec) - sayTeX$Lisp "" - sayTeX$Lisp s - sayTeX$Lisp "" - s - - display(mathml : S): Void == - sayTeX$Lisp "" - sayTeX$Lisp mathml - sayTeX$Lisp "" - void()$Void - - - - exprex(expr : E): S == - -- This breaks down an expression into atoms and returns it as - -- a string. It's for developmental purposes to help understand - -- the expressions. - a : E - expr := precondition expr --- sayTeX$Lisp "0: "stringify expr - (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") => - concat ["{",stringify expr,"}"] - le : L E := (expr pretend L E) - op := first le - sop : S := exprex op - args : L E := rest le - nargs : I := #args --- sayTeX$Lisp concat ["1: ",stringify first le," : ",string(nargs)$S] - s : S := concat ["{",sop] - if nargs > 0 then - for a in args repeat --- sayTeX$Lisp concat ["2: ",stringify a] - s1 : S := exprex a - s := concat [s,s1] - s := concat [s,"}"] - -@ -\subsection{Private Function Definitions} - -\subsubsection{Display Functions} - - displayElt(mathml:S):Void - - eltName(pos:I,mathml:S):S - - eltLimit(name:S,pos:I,mathml:S):I - - tagEnd(name:S,pos:I,mathml:S):I - -<>= - - displayElt(mathML:S): Void == - -- Takes a string of syntactically complete mathML - -- and formats it for display. --- sayTeX$Lisp "****displayElt1****" --- sayTeX$Lisp mathML - enT:I -- marks end of tag, e.g. "" - enE:I -- marks end of element, e.g. " ... " - end:I -- marks end of mathML string - u:US - end := #mathML - length:I := 60 --- sayTeX$Lisp "****displayElt1.1****" - name:S := eltName(1,mathML) --- sayTeX$Lisp name --- sayTeX$Lisp concat("****displayElt1.2****",name) - enE := eltLimit(name,2+#name,mathML) --- sayTeX$Lisp "****displayElt2****" - if enE < length then --- sayTeX$Lisp "****displayElt3****" - u := segment(1,enE)$US - sayTeX$Lisp mathML.u - else --- sayTeX$Lisp "****displayElt4****" - enT := tagEnd(name,1,mathML) - u := segment(1,enT)$US - sayTeX$Lisp mathML.u - u := segment(enT+1,enE-#name-3)$US - displayElt(mathML.u) - u := segment(enE-#name-2,enE)$US - sayTeX$Lisp mathML.u - if end > enE then --- sayTeX$Lisp "****displayElt5****" - u := segment(enE+1,end)$US - displayElt(mathML.u) - - void()$Void - - eltName(pos:I,mathML:S): S == - -- Assuming pos is the position of "<" for a start tag of a mathML - -- element finds and returns the element's name. - i:I := pos+1 - --sayTeX$Lisp "eltName:mathmML string: "mathML - while member?(mathML.i,lowerCase()$CharacterClass)$CharacterClass repeat - i := i+1 - u:US := segment(pos+1,i-1) - name:S := mathML.u - - eltLimit(name:S,pos:I,mathML:S): I == - -- Finds the end of a mathML element like " ... " - -- where pos is the position of the space after name in the start tag - -- although it could point to the closing ">". Returns the position - -- of the ">" in the end tag. - pI:I := pos - startI:I - endI:I - startS:S := concat ["<",name] - endS:S := concat [""] - level:I := 1 - --sayTeX$Lisp "eltLimit: element name: "name - while (level > 0) repeat - startI := position(startS,mathML,pI)$String - - endI := position(endS,mathML,pI)$String - - if (startI = 0) then - level := level-1 - --sayTeX$Lisp "****eltLimit 1******" - pI := tagEnd(name,endI,mathML) - else - if (startI < endI) then - level := level+1 - pI := tagEnd(name,startI,mathML) - else - level := level-1 - pI := tagEnd(name,endI,mathML) - pI - - - tagEnd(name:S,pos:I,mathML:S):I == - -- Finds the closing ">" for either a start or end tag of a mathML - -- element, so the return value is the position of ">" in mathML. - pI:I := pos - while (mathML.pI ^= char ">") repeat - pI := pI+1 - u:US := segment(pos,pI)$US - --sayTeX$Lisp "tagEnd: "mathML.u - pI - -@ -\subsubsection{Formatting Functions} - -Still need to format \verb+\zag+ in formatSpecial! - -In formatPlex the case op = "INTSIGN" is now passed off to -formatIntSign which is a change from the TexFormat domain. -This is done here for presentation mark up to replace the -ugly bound variable that Axiom delivers. For content mark up -this has to be done anyway. - -The formatPlex function also allows for op = "INDEFINTEGRAL". -However I don't know what Axiom command gives rise to this case. -The INTSIGN case already allows for both definite and indefinite -integrals. - -In the function formatSpecial various cases are handled including -SUB and SUPERSUB. These cases are now caught in formatMml and so -the code in formatSpecial doesn't get executed. The only cases -I know of using these are partial derivatives for SUB and ordinary -derivatives or SUPERSUB however in TexFormat the capability is there -to handle multiscripts, i.e. an object with subscripts, superscripts, -pre-subscripts and pre-superscripts but I am so far unaware of any -Axiom command that produces such a multiscripted object. - -Another question is how to represent derivatives. At present I have -differential notation for partials and prime notation for ordinary -derivatives, -but it would be nice to allow for different derivative notations in -different circumstances, maybe some options to )set output mathml on. - -Ordinary derivatives are formatted in formatSuperSub and there are -2 versions, formatSuperSub and formatSuperSub1, which at this point -have to be switched by swapping names. - -<>= - - atomize(expr : E): L E == - -- This breaks down an expression into a flat list of atomic expressions. - -- expr should be preconditioned. - le : L E := nil() - a : E - letmp : L E - (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") => - le := append(le,list(expr)) - letmp := expr pretend L E - for a in letmp repeat - le := append(le,atomize a) - le - - - ungroup(str: S): S == - len : I := #str - len < 14 => str - lrow : S := "" - rrow : S := "" - -- drop leading and trailing mrows - u1 : US := segment(1,6)$US - u2 : US := segment(len-6,len)$US - if (str.u1 =$S lrow) and (str.u2 =$S rrow) then - u : US := segment(7,len-7)$US - str := str.u - str - - postcondition(str: S): S == --- str := ungroup str - len : I := #str - plusminus : S := "+-" - pos : I := position(plusminus,str,1) - if pos > 0 then - ustart:US := segment(1,pos-1)$US - uend:US := segment(pos+20,len)$US - str := concat [str.ustart,"-",str.uend] - if pos < len-18 then - str := postcondition(str) - str - - stringify expr == (mathObject2String$Lisp expr)@S - - group str == - concat ["",str,""] - - addBraces str == - concat ["{",str,"}"] - - addBrackets str == - concat ["[",str,"]"] - - parenthesize str == - concat ["(",str,")"] - - precondition expr == - outputTran$Lisp expr - - formatSpecial(op : S, args : L E, prec : I) : S == - arg : E - prescript : Boolean := false - op = "theMap" => "theMap(...)" - op = "AGGLST" => - formatNary(",",args,prec) - op = "AGGSET" => - formatNary(";",args,prec) - op = "TAG" => - group concat [formatMml(first args,prec), - "→", - formatMml(second args,prec)] - --RightArrow - op = "VCONCAT" => - group concat("", - concat(concat([concat("",concat(formatMml(u, minPrec),"")) - for u in args]::L S), - "")) - op = "CONCATB" => - formatNary(" ",args,prec) - op = "CONCAT" => - formatNary("",args,minPrec) - op = "QUOTE" => - group concat("'",formatMml(first args, minPrec)) - op = "BRACKET" => - group addBrackets ungroup formatMml(first args, minPrec) - op = "BRACE" => - group addBraces ungroup formatMml(first args, minPrec) - op = "PAREN" => - group parenthesize ungroup formatMml(first args, minPrec) - op = "OVERBAR" => - null args => "" - group concat ["",formatMml(first args,minPrec),"¯"] - --OverBar - op = "ROOT" => - null args => "" - tmp : S := group formatMml(first args, minPrec) - null rest args => concat ["",tmp,""] - group concat - ["",tmp,"",formatMml(first rest args, minPrec),""] - op = "SEGMENT" => - tmp : S := concat [formatMml(first args, minPrec),".."] - group - null rest args => tmp - concat [tmp,formatMml(first rest args, minPrec)] - -- SUB should now be diverted in formatMml although I'll leave - -- the code here for now. - op = "SUB" => - group concat ["",formatMml(first args, minPrec), - formatSpecial("AGGLST",rest args,minPrec),""] - -- SUPERSUB should now be diverted in formatMml although I'll leave - -- the code here for now. - op = "SUPERSUB" => - base:S := formatMml(first args, minPrec) - args := rest args - if #args = 1 then - ""base""formatMml(first args, minPrec)"" - else if #args = 2 then - -- it would be nice to substitue ′ for , in the case of - -- an ordinary derivative, it looks a lot better. - ""base""formatMml(first args,minPrec)""formatMml(first rest args, minPrec)"" - else if #args = 3 then - ""base""formatMml(first args,minPrec)""formatMml(first rest args,minPrec)""formatMml(first rest rest args,minPrec)"" - else if #args = 4 then - ""base""formatMml(first args,minPrec)""formatMml(first rest args,minPrec)""formatMml(first rest rest args,minPrec)""formatMml(first rest rest rest args,minPrec)"" - else - "Problem with multiscript object" - op = "SC" => - -- need to handle indentation someday - null args => "" - tmp := formatNaryNoGroup("", args, minPrec) - group concat ["",tmp,""] - op = "MATRIX" => formatMatrix rest args - op = "ZAG" => --- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} --- to format continued fraction traditionally need to intercept it at the --- formatNary of the "+" - concat [" \zag{",formatMml(first args, minPrec),"}{", - formatMml(first rest args,minPrec),"}"] - concat ["not done yet for: ",op,""] - - formatSub(expr : E, args : L E, opPrec : I) : S == - -- This one produces differential notation partial derivatives. - -- It doesn't work in all cases and may not be workable, use - -- formatSub1 below for now. - -- At this time this is only to handle partial derivatives. - -- If the SUB case handles anything else I'm not aware of it. - -- This an example of the 4th partial of y(x,z) w.r.t. x,x,z,x - -- {{{SUB}{y}{{CONCAT}{{CONCAT}{{CONCAT}{{CONCAT}{,}{1}}{{CONCAT}{,}{1}}}{{CONCAT}{,}{2}}}{{CONCAT}{,}{1}}}}{x}{z}} - atomE : L E := atomize(expr) - op : S := stringify first atomE - op ^= "SUB" => "Mistake in formatSub: no SUB" - stringify first rest rest atomE ^= "CONCAT" => "Mistake in formatSub: no CONCAT" - -- expecting form for atomE like - --[{SUB}{func}{CONCAT}...{CONCAT}{,}{n}{CONCAT}{,}{n}...{CONCAT}{,}{n}], - --counting the first CONCATs before the comma gives the number of - --derivatives - ndiffs : I := 0 - tmpLE : L E := rest rest atomE - while stringify first tmpLE = "CONCAT" repeat - ndiffs := ndiffs+1 - tmpLE := rest tmpLE - numLS : L S := nil - i : I := 1 - while i < ndiffs repeat - numLS := append(numLS,list(stringify first rest tmpLE)) - tmpLE := rest rest rest tmpLE - i := i+1 - numLS := append(numLS,list(stringify first rest tmpLE)) - -- numLS contains the numbers of the bound variables as strings - -- for the differentiations, thus for the differentiation [x,x,z,x] - -- for y(x,z) numLS = ["1","1","2","1"] - posLS : L S := nil - i := 0 - -- sayTeX$Lisp "formatSub: nargs = "string(#args) - while i < #args repeat - posLS := append(posLS,list(string(i+1))) - i := i+1 - -- posLS contains the positions of the bound variables in args - -- as a list of strings, e.g. for the above example ["1","2"] - tmpS: S := stringify atomE.2 - if ndiffs = 1 then - s : S := "∂"tmpS"" - else - s : S := "∂"string(ndiffs)""tmpS"" - -- need to find the order of the differentiation w.r.t. the i-th - -- variable - i := 1 - j : I - k : I - tmpS: S - while i < #posLS+1 repeat - j := 0 - k := 1 - while k < #numLS + 1 repeat - if numLS.k = string i then j := j + 1 - k := k+1 - if j > 0 then - tmpS := stringify args.i - if j = 1 then - s := s"∂"tmpS"" - else - s := s"∂"tmpS""string(j)"" - i := i + 1 - s := s"(" - i := 1 - while i < #posLS+1 repeat - tmpS := stringify args.i - s := s""tmpS"" - if i < #posLS then s := s"," - i := i+1 - s := s")" - - formatSub1(expr : E, args : L E, opPrec : I) : S == - -- This one produces partial derivatives notated by ",n" as - -- subscripts. - -- At this time this is only to handle partial derivatives. - -- If the SUB case handles anything else I'm not aware of it. - -- This an example of the 4th partial of y(x,z) w.r.t. x,x,z,x - -- {{{SUB}{y}{{CONCAT}{{CONCAT}{{CONCAT}{{CONCAT}{,}{1}} - -- {{CONCAT}{,}{1}}}{{CONCAT}{,}{2}}}{{CONCAT}{,}{1}}}}{x}{z}}, - -- here expr is everything in the first set of braces and - -- args is {{x}{z}} - atomE : L E := atomize(expr) - op : S := stringify first atomE - op ^= "SUB" => "Mistake in formatSub: no SUB" - stringify first rest rest atomE ^= "CONCAT" => "Mistake in formatSub: no CONCAT" - -- expecting form for atomE like - --[{SUB}{func}{CONCAT}...{CONCAT}{,}{n}{CONCAT}{,}{n}...{CONCAT}{,}{n}], - --counting the first CONCATs before the comma gives the number of - --derivatives - ndiffs : I := 0 - tmpLE : L E := rest rest atomE - while stringify first tmpLE = "CONCAT" repeat - ndiffs := ndiffs+1 - tmpLE := rest tmpLE - numLS : L S := nil - i : I := 1 - while i < ndiffs repeat - numLS := append(numLS,list(stringify first rest tmpLE)) - tmpLE := rest rest rest tmpLE - i := i+1 - numLS := append(numLS,list(stringify first rest tmpLE)) - -- numLS contains the numbers of the bound variables as strings - -- for the differentiations, thus for the differentiation [x,x,z,x] - -- for y(x,z) numLS = ["1","1","2","1"] - posLS : L S := nil - i := 0 - -- sayTeX$Lisp "formatSub: nargs = "string(#args) - while i < #args repeat - posLS := append(posLS,list(string(i+1))) - i := i+1 - -- posLS contains the positions of the bound variables in args - -- as a list of strings, e.g. for the above example ["1","2"] - funcS: S := stringify atomE.2 - s : S := ""funcS"" - i := 1 - while i < #numLS+1 repeat - s := s","numLS.i"" - i := i + 1 - s := s"(" - i := 1 - while i < #posLS+1 repeat --- tmpS := stringify args.i - tmpS := formatMml(first args,minPrec) - args := rest args - s := s""tmpS"" - if i < #posLS then s := s"," - i := i+1 - s := s")" - - formatSuperSub(expr : E, args : L E, opPrec : I) : S == - -- this produces prime notation ordinary derivatives. - -- first have to divine the semantics, add cases as needed --- WriteLine$Lisp "SuperSub1 begin" - atomE : L E := atomize(expr) - op : S := stringify first atomE --- WriteLine$Lisp "op: "op - op ^= "SUPERSUB" => _ - "Mistake in formatSuperSub: no SUPERSUB1" - #args ^= 1 => "Mistake in SuperSub1: #args <> 1" - var : E := first args - -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}} for - -- example here's the second derivative of y w.r.t. x - -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the - -- {x} - funcS : S := stringify first rest atomE --- WriteLine$Lisp "funcS: "funcS - bvarS : S := stringify first args --- WriteLine$Lisp "bvarS: "bvarS - -- count the number of commas - commaS : S := stringify first rest rest rest atomE - commaTest : S := "," - i : I := 0 - while position(commaTest,commaS,1) > 0 repeat - i := i+1 - commaTest := commaTest"," - s : S := ""funcS"" --- WriteLine$Lisp "s: "s - j : I := 0 - while j < i repeat - s := s"′" - j := j + 1 - s := s"⁡("formatMml(first args,minPrec)")" - - formatSuperSub1(expr : E, args : L E, opPrec : I) : S == - -- This one produces ordinary derivatives with differential notation, - -- it needs a little more work yet. - -- first have to divine the semantics, add cases as needed --- WriteLine$Lisp "SuperSub begin" - atomE : L E := atomize(expr) - op : S := stringify first atomE - op ^= "SUPERSUB" => _ - "Mistake in formatSuperSub: no SUPERSUB" - #args ^= 1 => "Mistake in SuperSub: #args <> 1" - var : E := first args - -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}} for - -- example here's the second derivative of y w.r.t. x - -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the - -- {x} - funcS : S := stringify first rest atomE - bvarS : S := stringify first args - -- count the number of commas - commaS : S := stringify first rest rest rest atomE - commaTest : S := "," - ndiffs : I := 0 - while position(commaTest,commaS,1) > 0 repeat - ndiffs := ndiffs+1 - commaTest := commaTest"," - s : S := "ⅆ"string(ndiffs)""funcS"ⅆ"formatMml(first args,minPrec)""string(ndiffs)"⁡("formatMml(first args,minPrec)")" - - formatPlex(op : S, args : L E, prec : I) : S == - checkarg:Boolean := false - hold : S - p : I := position(op,plexOps) - p < 1 => error "unknown plex op" - op = "INTSIGN" => formatIntSign(args,minPrec) - opPrec := plexPrecs.p - n : I := #args - (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex" - s : S := - op = "SIGMA" => - checkarg := true - "∑" - -- Sum - op = "SIGMA2" => - checkarg := true - "∑" - -- Sum - op = "PI" => - checkarg := true - "∏" - -- Product - op = "PI2" => - checkarg := true - "∏" - -- Product --- op = "INTSIGN" => "∫" - -- Integral, int - op = "INDEFINTEGRAL" => "∫" - -- Integral, int - "????" - hold := formatMml(first args,minPrec) - args := rest args - if op ^= "INDEFINTEGRAL" then - if hold ^= "" then - s := concat ["",s,group hold] - else - s := concat ["",s,group " "] - if not null rest args then - hold := formatMml(first args,minPrec) - if hold ^= "" then - s := concat [s,group hold,""] - else - s := concat [s,group " ",""] - args := rest args - -- if checkarg true need to test op arg for "+" at least - -- and wrap parentheses if so - if checkarg then - la : L E := (first args pretend L E) - opa : S := stringify first la - if opa = "+" then - s := concat [s,"(",formatMml(first args,minPrec),")"] - else s := concat [s,formatMml(first args,minPrec)] - else s := concat [s,formatMml(first args,minPrec)] - else - hold := group concat [hold,formatMml(first args,minPrec)] - s := concat [s,hold] --- if opPrec < prec then s := parenthesize s --- getting ugly parentheses on fractions - group s - - formatIntSign(args : L E, opPrec : I) : S == - -- the original OutputForm expression looks something like this: - -- {{INTSIGN}{NOTHING or lower limit?} - -- {bvar or upper limit?}{{*}{integrand}{{CONCAT}{d}{axiom var}}}} - -- the args list passed here consists of the rest of this list, i.e. - -- starting at the NOTHING or ... - (stringify first args) = "NOTHING" => - -- the bound variable is the second one in the argument list - bvar : E := first rest args - bvarS : S := stringify bvar - tmpS : S - i : I := 0 - u1 : US - u2 : US - -- this next one atomizes the integrand plus differential - atomE : L E := atomize(first rest rest args) - -- pick out the bound variable used by axiom - varRS : S := stringify last(atomE) - tmpLE : L E := ((first rest rest args) pretend L E) - integrand : S := formatMml(first rest tmpLE,minPrec) - -- replace the bound variable, i.e. axiom uses someting of the form - -- %A for the bound variable and puts the original variable used - -- in the input command as a superscript on the integral sign. - -- I'm assuming that the axiom variable is 2 characters. - while (i := position(varRS,integrand,i+1)) > 0 repeat - u1 := segment(1,i-1)$US - u2 := segment(i+2,#integrand)$US - integrand := concat [integrand.u1,bvarS,integrand.u2] - concat ["∫" integrand "ⅆ" bvarS ""] - - lowlim : S := stringify first args - highlim : S := stringify first rest args - bvar : E := last atomize(first rest rest args) - bvarS : S := stringify bvar - tmpLE : L E := ((first rest rest args) pretend L E) - integrand : S := formatMml(first rest tmpLE,minPrec) - concat ["∫" lowlim "" highlim "" integrand "ⅆ" bvarS ""] - - - formatMatrix(args : L E) : S == - -- format for args is [[ROW ...],[ROW ...],[ROW ...]] - -- generate string for formatting columns (centered) - group addBrackets concat - ["",formatNaryNoGroup("",args,minPrec), - ""] - - formatFunction(op : S, args : L E, prec : I) : S == - group concat ["",op,"",parenthesize formatNary(",",args,minPrec)] - - formatNullary(op : S) == - op = "NOTHING" => "" - group concat ["",op,"()"] - - formatUnary(op : S, arg : E, prec : I) == - p : I := position(op,unaryOps) - p < 1 => error "unknown unary op" - opPrec := unaryPrecs.p - s : S := concat ["",op,"",formatMml(arg,opPrec)] - opPrec < prec => group parenthesize s - op = "-" => s - group s - - formatBinary(op : S, args : L E, prec : I) : S == - p : I := position(op,binaryOps) - p < 1 => error "unknown binary op" - opPrec := binaryPrecs.p - -- if base op is product or sum need to add parentheses - if ATOM(first args)$Lisp@Boolean then - opa:S := stringify first args - else - la : L E := (first args pretend L E) - opa : S := stringify first la - if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2") _ - and op = "**" then - s1:S:=concat ["(",formatMml(first args, opPrec),")"] - else - s1 : S := formatMml(first args, opPrec) - s2 : S := formatMml(first rest args, opPrec) - op := - op = "|" => s := concat ["",s1,"",op,"",s2,""] - op = "**" => s := concat ["",s1,"",s2,""] - op = "/" => s := concat ["",s1,"",s2,""] - op = "OVER" => s := concat ["",s1,"",s2,""] - op = "+->" => s := concat ["",s1,"",op,"",s2,""] - s := concat ["",s1,"",op,"",s2,""] - group - op = "OVER" => s --- opPrec < prec => parenthesize s --- ugly parentheses? - s - - formatNary(op : S, args : L E, prec : I) : S == - group formatNaryNoGroup(op, args, prec) - - formatNaryNoGroup(op : S, args : L E, prec : I) : S == - checkargs:Boolean := false - null args => "" - p : I := position(op,naryOps) - p < 1 => error "unknown nary op" - -- need to test for "ZAG" case and divert it here - -- ex 1. continuedFraction(314159/100000) - -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}} - -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} - -- this is the preconditioned output form - -- including "op", the args list would be the rest of this - -- i.e op = '+' and args = {{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}} - -- {{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} - -- ex 2. continuedFraction(14159/100000) - -- this one doesn't have the leading integer - -- {{+}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}} - -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}} - -- - -- ex 3. continuedFraction(3,repeating [1], repeating [3,6]) - -- {{+}{3}{{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}} - -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}} - -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{...}} - -- In each of these examples the args list consists of the terms - -- following the '+' op - -- so the first arg could be a "ZAG" or something - -- else, but the second arg looks like it has to be "ZAG", so maybe - -- test for #args > 1 and args.2 contains "ZAG". - -- Note that since the resulting MathML s are nested we need - -- to handle the whole continued fraction at once, i.e. we can't - -- just look for, e.g., {{ZAG}{1}{6}} - (#args > 1) and (position("ZAG",stringify first rest args,1) > 0) => - tmpS : S := stringify first args - position("ZAG",tmpS,1) > 0 => formatZag(args) --- position("ZAG",tmpS,1) > 0 => formatZag1(args) - concat [formatMml(first args,minPrec) "+" formatZag(rest args)] - -- At least for the ops "*","+","-" we need to test to see if a sigma - -- or pi is one of their arguments because we might need parentheses - -- as indicated by the problem with - -- summation(operator(f)(i),i=1..n)+1 versus - -- summation(operator(f)(i)+1,i=1..n) having identical displays as - -- of 2007-21-21 - op := - op = "," => "," --originally , \: - op = ";" => ";" --originally ; \: should figure these out - op = "*" => "" - -- InvisibleTimes - op = " " => "" - op = "ROW" => "" - op = "+" => - checkargs := true - "+" - op = "-" => - checkargs := true - "-" - op - l : L S := nil - opPrec := naryPrecs.p - -- if checkargs is true check each arg except last one to see if it's - -- a sigma or pi and if so add parentheses. Other op's may have to be - -- checked for in future - count:I := 1 - for a in args repeat --- WriteLine$Lisp "checking args" - if checkargs then - if count < #args then - -- check here for sum or product - if ATOM(a)$Lisp@Boolean then - opa:S := stringify a - else - la : L E := (a pretend L E) - opa : S := stringify first la - if opa = "SIGMA" or opa = "SIGMA2" or _ - opa = "PI" or opa = "PI2" then - l := concat(op,concat(_ - concat ["(",formatMml(a,opPrec),_ - ")"],l)$L(S))$L(S) - else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) - else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) - else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) - count := count + 1 - s : S := concat reverse rest l - opPrec < prec => parenthesize s - s - - formatZag(args : L E) : S == - -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG - -- must be there, the '1' and '7' could conceivably be more complex - -- expressions - tmpZag : L E := first args pretend L E - -- may want to test that tmpZag contains 'ZAG' - #args > 1 => ""formatMml(first rest tmpZag,minPrec)""formatMml(first rest rest tmpZag,minPrec)"+"formatZag(rest args)"" - -- EQUAL(tmpZag, "...")$Lisp => "…" - (first args = "..."::E)@Boolean => "…" - position("ZAG",stringify first args,1) > 0 => - ""formatMml(first rest tmpZag,minPrec)formatMml(first rest rest tmpZag,minPrec)"" - "formatZag: Unexpected kind of ZAG" - - - formatZag1(args : L E) : S == - -- make alternative ZAG format without diminishing fonts, maybe - -- use a table - -- {{ZAG}{1}{7}} - tmpZag : L E := first args pretend L E - #args > 1 => ""formatMml(first rest tmpZag,minPrec)""formatMml(first rest rest tmpZag,minPrec)"+"formatZag(rest args)"" - (first args = "...":: E)@Boolean => "…" - error "formatZag1: Unexpected kind of ZAG" - - - formatMml(expr : E,prec : I) == - i,len : Integer - intSplitLen : Integer := 20 - ATOM(expr)$Lisp@Boolean => - str := stringify expr - len := #str - -- this bit seems to deal with integers - FIXP$Lisp expr => - i := expr pretend Integer - if (i < 0) or (i > 9) - then - group - nstr : String := "" - -- insert some blanks into the string, if too long - while ((len := #str) > intSplitLen) repeat - nstr := concat [nstr," ", - elt(str,segment(1,intSplitLen)$US)] - str := elt(str,segment(intSplitLen+1)$US) - empty? nstr => concat ["",str,""] - nstr := - empty? str => nstr - concat [nstr," ",str] - concat ["",elt(nstr,segment(2)$US),""] - else str := concat ["",str,""] - str = "%pi" => "π" - -- pi - str = "%e" => "ⅇ" - -- ExponentialE - str = "%i" => "ⅈ" - -- ImaginaryI - len > 0 and str.1 = char "%" => concat(concat("",str),"") - len > 1 and digit? str.1 => concat ["",str,""] -- should handle floats - -- presumably this is a literal string - len > 0 and str.1 = char "_"" => - concat(concat("",str),"") - len = 1 and str.1 = char " " => " " - (i := position(str,specialStrings)) > 0 => - specialStringsInMML.i - (i := position(char " ",str)) > 0 => - -- We want to preserve spacing, so use a roman font. - -- What's this for? Leave the \rm in for now so I can see - -- where it arises. Removed 2007-02-14 - concat(concat("",str),"") - -- if we get to here does that mean it's a variable? - concat ["",str,""] - l : L E := (expr pretend L E) - null l => blank - op : S := stringify first l - args : L E := rest l - nargs : I := #args - -- need to test here in case first l is SUPERSUB case and then - -- pass first l and args to formatSuperSub. - position("SUPERSUB",op,1) > 0 => - formatSuperSub(first l,args,minPrec) - -- now test for SUB - position("SUB",op,1) > 0 => - formatSub1(first l,args,minPrec) - - -- special cases - member?(op, specialOps) => formatSpecial(op,args,prec) - member?(op, plexOps) => formatPlex(op,args,prec) - - -- nullary case - 0 = nargs => formatNullary op - - -- unary case - (1 = nargs) and member?(op, unaryOps) => - formatUnary(op, first args, prec) - - -- binary case - (2 = nargs) and member?(op, binaryOps) => - formatBinary(op, args, prec) - - -- nary case - member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) - member?(op,naryOps) => formatNary(op,args, prec) - - op := formatMml(first l,minPrec) - formatFunction(op,args,prec) - -@ -\section{Mathematical Markup Language Form} -<>= -<> -<> -<> -<> -<> -<> - -@ -\section{License} -<>= ---Copyright (c) 2007, Arthur C. Ralfs ---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. --- --- - The name of Arthur C. Ralfs may not 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/matstor.spad.pamphlet b/src/algebra/matstor.spad.pamphlet deleted file mode 100644 index f34f9e2..0000000 --- a/src/algebra/matstor.spad.pamphlet +++ /dev/null @@ -1,246 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra matstor.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MATSTOR StorageEfficientMatrixOperations} -<>= -)abbrev package MATSTOR StorageEfficientMatrixOperations -++ Author: Clifton J. Williamson -++ Date Created: 18 July 1990 -++ Date Last Updated: 18 July 1990 -++ Basic Operations: -++ Related Domains: Matrix(R) -++ Also See: -++ AMS Classifications: -++ Keywords: matrix, linear algebra -++ Examples: -++ References: -++ Description: -++ This package provides standard arithmetic operations on matrices. -++ The functions in this package store the results of computations -++ in existing matrices, rather than creating new matrices. This -++ package works only for matrices of type Matrix and uses the -++ internal representation of this type. -StorageEfficientMatrixOperations(R): Exports == Implementation where - R : Ring - M ==> Matrix R - NNI ==> NonNegativeInteger - ARR ==> PrimitiveArray R - REP ==> PrimitiveArray PrimitiveArray R - - Exports ==> with - copy_! : (M,M) -> M - ++ \spad{copy!(c,a)} copies the matrix \spad{a} into the matrix c. - ++ Error: if \spad{a} and c do not have the same - ++ dimensions. - plus_! : (M,M,M) -> M - ++ \spad{plus!(c,a,b)} computes the matrix sum \spad{a + b} and stores the - ++ result in the matrix c. - ++ Error: if \spad{a}, b, and c do not have the same dimensions. - minus_! : (M,M) -> M - ++ \spad{minus!(c,a)} computes \spad{-a} and stores the result in the - ++ matrix c. - ++ Error: if a and c do not have the same dimensions. - minus_! : (M,M,M) -> M - ++ \spad{!minus!(c,a,b)} computes the matrix difference \spad{a - b} - ++ and stores the result in the matrix c. - ++ Error: if \spad{a}, b, and c do not have the same dimensions. - leftScalarTimes_! : (M,R,M) -> M - ++ \spad{leftScalarTimes!(c,r,a)} computes the scalar product - ++ \spad{r * a} and stores the result in the matrix c. - ++ Error: if \spad{a} and c do not have the same dimensions. - rightScalarTimes_! : (M,M,R) -> M - ++ \spad{rightScalarTimes!(c,a,r)} computes the scalar product - ++ \spad{a * r} and stores the result in the matrix c. - ++ Error: if \spad{a} and c do not have the same dimensions. - times_! : (M,M,M) -> M - ++ \spad{times!(c,a,b)} computes the matrix product \spad{a * b} - ++ and stores the result in the matrix c. - ++ Error: if \spad{a}, b, and c do not have - ++ compatible dimensions. - power_! : (M,M,M,M,NNI) -> M - ++ \spad{power!(a,b,c,m,n)} computes m ** n and stores the result in - ++ \spad{a}. The matrices b and c are used to store intermediate results. - ++ Error: if \spad{a}, b, c, and m are not square - ++ and of the same dimensions. - "**" : (M,NNI) -> M - ++ \spad{x ** n} computes the n-th power - ++ of a square matrix. The power n is assumed greater than 1. - - Implementation ==> add - - rep : M -> REP - rep m == m pretend REP - - copy_!(c,a) == - m := nrows a; n := ncols a - not((nrows c) = m and (ncols c) = n) => - error "copy!: matrices of incompatible dimensions" - aa := rep a; cc := rep c - for i in 0..(m-1) repeat - aRow := qelt(aa,i); cRow := qelt(cc,i) - for j in 0..(n-1) repeat - qsetelt_!(cRow,j,qelt(aRow,j)) - c - - plus_!(c,a,b) == - m := nrows a; n := ncols a - not((nrows b) = m and (ncols b) = n) => - error "plus!: matrices of incompatible dimensions" - not((nrows c) = m and (ncols c) = n) => - error "plus!: matrices of incompatible dimensions" - aa := rep a; bb := rep b; cc := rep c - for i in 0..(m-1) repeat - aRow := qelt(aa,i); bRow := qelt(bb,i); cRow := qelt(cc,i) - for j in 0..(n-1) repeat - qsetelt_!(cRow,j,qelt(aRow,j) + qelt(bRow,j)) - c - - minus_!(c,a) == - m := nrows a; n := ncols a - not((nrows c) = m and (ncols c) = n) => - error "minus!: matrices of incompatible dimensions" - aa := rep a; cc := rep c - for i in 0..(m-1) repeat - aRow := qelt(aa,i); cRow := qelt(cc,i) - for j in 0..(n-1) repeat - qsetelt_!(cRow,j,-qelt(aRow,j)) - c - - minus_!(c,a,b) == - m := nrows a; n := ncols a - not((nrows b) = m and (ncols b) = n) => - error "minus!: matrices of incompatible dimensions" - not((nrows c) = m and (ncols c) = n) => - error "minus!: matrices of incompatible dimensions" - aa := rep a; bb := rep b; cc := rep c - for i in 0..(m-1) repeat - aRow := qelt(aa,i); bRow := qelt(bb,i); cRow := qelt(cc,i) - for j in 0..(n-1) repeat - qsetelt_!(cRow,j,qelt(aRow,j) - qelt(bRow,j)) - c - - leftScalarTimes_!(c,r,a) == - m := nrows a; n := ncols a - not((nrows c) = m and (ncols c) = n) => - error "leftScalarTimes!: matrices of incompatible dimensions" - aa := rep a; cc := rep c - for i in 0..(m-1) repeat - aRow := qelt(aa,i); cRow := qelt(cc,i) - for j in 0..(n-1) repeat - qsetelt_!(cRow,j,r * qelt(aRow,j)) - c - - rightScalarTimes_!(c,a,r) == - m := nrows a; n := ncols a - not((nrows c) = m and (ncols c) = n) => - error "rightScalarTimes!: matrices of incompatible dimensions" - aa := rep a; cc := rep c - for i in 0..(m-1) repeat - aRow := qelt(aa,i); cRow := qelt(cc,i) - for j in 0..(n-1) repeat - qsetelt_!(cRow,j,qelt(aRow,j) * r) - c - - copyCol_!: (ARR,REP,Integer,Integer) -> ARR - copyCol_!(bCol,bb,j,n1) == - for i in 0..n1 repeat qsetelt_!(bCol,i,qelt(qelt(bb,i),j)) - - times_!(c,a,b) == - m := nrows a; n := ncols a; p := ncols b - not((nrows b) = n and (nrows c) = m and (ncols c) = p) => - error "times!: matrices of incompatible dimensions" - aa := rep a; bb := rep b; cc := rep c - bCol : ARR := new(n,0) - m1 := (m :: Integer) - 1; n1 := (n :: Integer) - 1 - for j in 0..(p-1) repeat - copyCol_!(bCol,bb,j,n1) - for i in 0..m1 repeat - aRow := qelt(aa,i); cRow := qelt(cc,i) - sum : R := 0 - for k in 0..n1 repeat - sum := sum + qelt(aRow,k) * qelt(bCol,k) - qsetelt_!(cRow,j,sum) - c - - power_!(a,b,c,m,p) == - mm := nrows a; nn := ncols a - not(mm = nn) => - error "power!: matrix must be square" - not((nrows b) = mm and (ncols b) = nn) => - error "power!: matrices of incompatible dimensions" - not((nrows c) = mm and (ncols c) = nn) => - error "power!: matrices of incompatible dimensions" - not((nrows m) = mm and (ncols m) = nn) => - error "power!: matrices of incompatible dimensions" - flag := false - copy_!(b,m) - repeat - if odd? p then - flag => - times_!(c,b,a) - copy_!(a,c) - flag := true - copy_!(a,b) --- one? p => return a - (p = 1) => return a - p := p quo 2 - times_!(c,b,b) - copy_!(b,c) - - m ** n == - not square? m => error "**: matrix must be square" - a := copy m; b := copy m; c := copy m - power_!(a,b,c,m,n) - -@ -\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/mesh.spad.pamphlet b/src/algebra/mesh.spad.pamphlet deleted file mode 100644 index 8cc1c8e..0000000 --- a/src/algebra/mesh.spad.pamphlet +++ /dev/null @@ -1,188 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mesh.spad} -\author{James Wen, Jon Steinbach} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MESH MeshCreationRoutinesForThreeDimensions} -<>= -)abbrev package MESH MeshCreationRoutinesForThreeDimensions -++ -++ Author: Jim Wen -++ Date Created: ?? -++ Date Last Updated: October 1991 by Jon Steinbach -++ Keywords: -++ Examples: -++ References: -MeshCreationRoutinesForThreeDimensions():Exports == Implementation where - - I ==> Integer - PI ==> PositiveInteger - SF ==> DoubleFloat - L ==> List - SEG ==> Segment - S ==> String - Fn1 ==> SF -> SF - Fn2 ==> (SF,SF) -> SF - Fn3 ==> (SF,SF,SF) -> SF - FnPt ==> (SF,SF) -> Point(SF) - FnU ==> Union(Fn3,"undefined") - EX ==> Expression - DROP ==> DrawOption - POINT ==> Point(SF) - SPACE3 ==> ThreeSpace(SF) - COMPPROP ==> SubSpaceComponentProperty - TUBE ==> TubePlot - - Exports ==> with - meshPar2Var: (Fn2,Fn2,Fn2,FnU,SEG SF,SEG SF,L DROP) -> SPACE3 - ++ meshPar2Var(f,g,h,j,s1,s2,l) \undocumented - meshPar2Var: (FnPt,SEG SF,SEG SF,L DROP) -> SPACE3 - ++ meshPar2Var(f,s1,s2,l) \undocumented - meshPar2Var: (SPACE3,FnPt,SEG SF,SEG SF,L DROP) -> SPACE3 - ++ meshPar2Var(sp,f,s1,s2,l) \undocumented - meshFun2Var: (Fn2,FnU,SEG SF,SEG SF,L DROP) -> SPACE3 - ++ meshFun2Var(f,g,s1,s2,l) \undocumented - meshPar1Var: (EX I,EX I,EX I,Fn1,SEG SF,L DROP) -> SPACE3 - ++ meshPar1Var(s,t,u,f,s1,l) \undocumented - ptFunc: (Fn2,Fn2,Fn2,Fn3) -> ((SF,SF) -> POINT) - ++ ptFunc(a,b,c,d) is an internal function exported in - ++ order to compile packages. - - Implementation ==> add - import ViewDefaultsPackage() - import SubSpaceComponentProperty() - import DrawOptionFunctions0 - import SPACE3 - --import TUBE() - - -- local functions - numberCheck(nums:Point SF):Void == - -- this function checks to see that the small floats are - -- actually just that - rather than complex numbers or - -- whatever (the whatever includes nothing presently - -- since NaN, Not a Number, is not necessarily supported - -- by common lisp). note that this function is dependent - -- upon the fact that Common Lisp supports complex numbers. - for i in minIndex(nums)..maxIndex(nums) repeat - COMPLEXP(nums.(i::PositiveInteger))$Lisp => - error "An unexpected complex number was encountered in the calculations." - - makePt:(SF,SF,SF,SF) -> POINT - makePt(x,y,z,c) == point(l : List SF := [x,y,z,c]) - ptFunc(f,g,h,c) == - x := f(#1,#2); y := g(#1,#2); z := h(#1,#2) - makePt(x,y,z,c(x,y,z)) - - -- parameterized equations of two variables - meshPar2Var(sp,ptFun,uSeg,vSeg,opts) == - -- the issue of open and closed needs to be addressed, here, we are - -- defaulting to open (which is probably the correct default) - -- the user should be able to override that (optional argument?) - llp : L L POINT := nil() - uNum : PI := var1Steps(opts,var1StepsDefault()) - vNum : PI := var2Steps(opts,var2StepsDefault()) - ustep := (lo uSeg - hi uSeg)/uNum - vstep := (lo vSeg - hi vSeg)/vNum - someV := hi vSeg - for iv in vNum..0 by -1 repeat - if zero? iv then someV := lo vSeg - -- hack: get last number in segment within segment - lp : L POINT := nil() - someU := hi uSeg - for iu in uNum..0 by -1 repeat - if zero? iu then someU := lo uSeg - -- hack: get last number in segment within segment - pt := ptFun(someU,someV) - numberCheck pt - lp := concat(pt,lp) - someU := someU + ustep - llp := concat(lp,llp) - someV := someV + vstep - -- now llp contains a list of lists of points - -- for a surface that is a result of a function of 2 variables, - -- the main component is open and each sublist is open as well - lProp : L COMPPROP := [ new() for l in llp ] - for aProp in lProp repeat - close(aProp,false) - solid(aProp,false) - aProp : COMPPROP:= new() - close(aProp,false) - solid(aProp,false) - space := sp --- space := create3Space() - mesh(space,llp,lProp,aProp) - space - - meshPar2Var(ptFun,uSeg,vSeg,opts) == - sp := create3Space() - meshPar2Var(sp,ptFun,uSeg,vSeg,opts) - - zCoord: (SF,SF,SF) -> SF - zCoord(x,y,z) == z - - meshPar2Var(xFun,yFun,zFun,colorFun,uSeg,vSeg,opts) == - -- the color function should be parameterized by (u,v) as well, - -- not (x,y,z) but we also want some sort of consistency and so - -- changing this over would mean possibly changing the explicit - -- stuff over and there, we probably do want the color function - -- to be parameterized by (x,y,z) - not just (x,y) (this being - -- for convinience only since z is also defined in terms of (x,y)). - (colorFun case Fn3) => - meshPar2Var(ptFunc(xFun,yFun,zFun,colorFun :: Fn3),uSeg,vSeg,opts) - meshPar2Var(ptFunc(xFun,yFun,zFun,zCoord),uSeg,vSeg,opts) - - -- explicit equations of two variables - meshFun2Var(zFun,colorFun,xSeg,ySeg,opts) == - -- here, we construct the data for a function of two variables - meshPar2Var(#1,#2,zFun,colorFun,xSeg,ySeg,opts) - -@ -\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/mfinfact.spad.pamphlet b/src/algebra/mfinfact.spad.pamphlet deleted file mode 100644 index 685afc5..0000000 --- a/src/algebra/mfinfact.spad.pamphlet +++ /dev/null @@ -1,547 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mfinfact.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MFINFACT MultFiniteFactorize} -<>= -)abbrev package MFINFACT MultFiniteFactorize -++ Author: P. Gianni -++ Date Created: Summer 1990 -++ Date Last Updated: 19 March 1992 -++ Basic Functions: -++ Related Constructors: PrimeField, FiniteField, Polynomial -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: Package for factorization of multivariate polynomials -++ over finite fields. - - -MultFiniteFactorize(OV,E,F,PG) : C == T - where - F : FiniteFieldCategory - OV : OrderedSet - E : OrderedAbelianMonoidSup - PG : PolynomialCategory(F,E,OV) - SUP ==> SparseUnivariatePolynomial - R ==> SUP F - P ==> SparseMultivariatePolynomial(R,OV) - Z ==> Integer - FFPOLY ==> FiniteFieldPolynomialPackage(F) - MParFact ==> Record(irr:P,pow:Z) - MFinalFact ==> Record(contp:R,factors:List MParFact) - SUParFact ==> Record(irr:SUP P,pow:Z) - SUPFinalFact ==> Record(contp:R,factors:List SUParFact) - - -- contp = content, - -- factors = List of irreducible factors with exponent - - C == with - - factor : PG -> Factored PG - ++ factor(p) produces the complete factorization of the multivariate - ++ polynomial p over a finite field. - factor : SUP PG -> Factored SUP PG - ++ factor(p) produces the complete factorization of the multivariate - ++ polynomial p over a finite field. p is represented as a univariate - ++ polynomial with multivariate coefficients over a finite field. - - T == add - - import LeadingCoefDetermination(OV,IndexedExponents OV,R,P) - import MultivariateLifting(IndexedExponents OV,OV,R,P) - import FactoringUtilities(IndexedExponents OV,OV,R,P) - import FactoringUtilities(E,OV,F,PG) - import GenExEuclid(R,SUP R) - - NNI ==> NonNegativeInteger - L ==> List - UPCF2 ==> UnivariatePolynomialCategoryFunctions2 - LeadFact ==> Record(polfac:L P,correct:R,corrfact:L SUP R) - ContPrim ==> Record(cont:P,prim:P) - ParFact ==> Record(irr:SUP R,pow:Z) - FinalFact ==> Record(contp:R,factors:L ParFact) - NewOrd ==> Record(npol:SUP P,nvar:L OV,newdeg:L NNI) - Valuf ==> Record(inval:L L R,unvfact:L SUP R,lu:R,complead:L R) - - ---- Local Functions ---- - ran : Z -> R - mFactor : (P,Z) -> MFinalFact - supFactor : (SUP P,Z) -> SUPFinalFact - mfconst : (SUP P,Z,L OV,L NNI) -> L SUP P - mfpol : (SUP P,Z,L OV,L NNI) -> L SUP P - varChoose : (P,L OV,L NNI) -> NewOrd - simplify : (P,Z,L OV,L NNI) -> MFinalFact - intChoose : (SUP P,L OV,R,L P,L L R) -> Valuf - pretest : (P,NNI,L OV,L R) -> FinalFact - checkzero : (SUP P,SUP R) -> Boolean - pushdcoef : PG -> P - pushdown : (PG,OV) -> P - pushupconst : (R,OV) -> PG - pushup : (P,OV) -> PG - norm : L SUP R -> Integer - constantCase : (P,L MParFact) -> MFinalFact - pM : L SUP R -> R - intfact : (SUP P,L OV,L NNI,MFinalFact,L L R) -> L SUP P - - basicVar:OV:=NIL$Lisp pretend OV -- variable for the basic step - - - convertPUP(lfg:MFinalFact): SUPFinalFact == - [lfg.contp,[[lff.irr ::SUP P,lff.pow]$SUParFact - for lff in lfg.factors]]$SUPFinalFact - - supFactor(um:SUP P,dx:Z) : SUPFinalFact == - degree(um)=0 => convertPUP(mFactor(ground um,dx)) - lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um] - lcont:SUP P - lf:L SUP P - - flead : SUPFinalFact:=[0,empty()]$SUPFinalFact - factorlist:L SUParFact :=empty() - - mdeg :=minimumDegree um ---- is the Mindeg > 0? ---- - if mdeg>0 then - f1:SUP P:=monomial(1,mdeg) - um:=(um exquo f1)::SUP P - factorlist:=cons([monomial(1,1),mdeg],factorlist) - if degree um=0 then return - lfg:=convertPUP mFactor(ground um, dx) - [lfg.contp,append(factorlist,lfg.factors)] - - - om:=map(pushup(#1,basicVar),um)$UPCF2(P,SUP P,PG,SUP PG) - sqfacs:=squareFree(om) - lcont:=map(pushdown(#1,basicVar),unit sqfacs)$UPCF2(PG,SUP PG,P,SUP P) - - ---- Factorize the content ---- - if ground? lcont then - flead:=convertPUP constantCase(ground lcont,empty()) - else - flead:=supFactor(lcont,dx) - - factorlist:=flead.factors - - ---- Make the polynomial square-free ---- - sqqfact:=[[map(pushdown(#1,basicVar),ff.factor),ff.exponent] - for ff in factors sqfacs] - - --- Factorize the primitive square-free terms --- - for fact in sqqfact repeat - ffactor:SUP P:=fact.irr - ffexp:=fact.pow - ffcont:=content ffactor - coefs := coefficients ffactor - ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar] - if ground?(leadingCoefficient ffactor) then - lf:= mfconst(ffactor,dx,lvar,ldeg) - else lf:=mfpol(ffactor,dx,lvar,ldeg) - auxfl:=[[lfp,ffexp]$SUParFact for lfp in lf] - factorlist:=append(factorlist,auxfl) - lcfacs := */[leadingCoefficient leadingCoefficient(f.irr)**((f.pow)::NNI) - for f in factorlist] - [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R, - factorlist]$SUPFinalFact - - factor(um:SUP PG):Factored SUP PG == - lv:List OV:=variables um - ld:=degree(um,lv) - dx:="min"/ld - basicVar:=lv.position(dx,ld) - cm:=map(pushdown(#1,basicVar),um)$UPCF2(PG,SUP PG,P,SUP P) - flist := supFactor(cm,dx) - pushupconst(flist.contp,basicVar)::SUP(PG) * - (*/[primeFactor(map(pushup(#1,basicVar),u.irr)$UPCF2(P,SUP P,PG,SUP PG), - u.pow) for u in flist.factors]) - - - - mFactor(m:P,dx:Z) : MFinalFact == - ground?(m) => constantCase(m,empty()) - lvar:L OV:= variables m - lcont:P - lf:L SUP P - flead : MFinalFact:=[1,empty()]$MFinalFact - factorlist:L MParFact :=empty() - ---- is the Mindeg > 0? ---- - lmdeg :=minimumDegree(m,lvar) - or/[n>0 for n in lmdeg] => simplify(m,dx,lvar,lmdeg) - ---- Make the polynomial square-free ---- - om:=pushup(m,basicVar) - sqfacs:=squareFree(om) - lcont := pushdown(unit sqfacs,basicVar) - - ---- Factorize the content ---- - if ground? lcont then - flead:=constantCase(lcont,empty()) - else - flead:=mFactor(lcont,dx) - factorlist:=flead.factors - sqqfact:List Record(factor:P,exponent:Integer) - sqqfact:=[[pushdown(ff.factor,basicVar),ff.exponent] - for ff in factors sqfacs] - --- Factorize the primitive square-free terms --- - for fact in sqqfact repeat - ffactor:P:=fact.factor - ffexp := fact.exponent - ground? ffactor => - for lterm in constantCase(ffactor,empty()).factors repeat - factorlist:=cons([lterm.irr,lterm.pow * ffexp], factorlist) - lvar := variables ffactor - x:OV:=lvar.1 - ldeg:=degree(ffactor,lvar) - --- Is the polynomial linear in one of the variables ? --- - member?(1,ldeg) => - x:OV:=lvar.position(1,ldeg) - lcont:= gcd coefficients(univariate(ffactor,x)) - ffactor:=(ffactor exquo lcont)::P - factorlist:=cons([ffactor,ffexp]$MParFact,factorlist) - for lcterm in mFactor(lcont,dx).factors repeat - factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist) - - varch:=varChoose(ffactor,lvar,ldeg) - um:=varch.npol - - - ldeg:=ldeg.rest - lvar:=lvar.rest - if varch.nvar.1 ^= x then - lvar:= varch.nvar - x := lvar.1 - lvar:=lvar.rest - pc:= gcd coefficients um - if pc^=1 then - um:=(um exquo pc)::SUP P - ffactor:=multivariate(um,x) - for lcterm in mFactor(pc,dx).factors repeat - factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist) - ldeg:= degree(ffactor,lvar) - - -- should be unitNormal if unified, but for now it is easier - lcum:F:= leadingCoefficient leadingCoefficient - leadingCoefficient um - if lcum ^=1 then - um:=((inv lcum)::R::P) * um - flead.contp := (lcum::R) *flead.contp - - if ground?(leadingCoefficient um) - then lf:= mfconst(um,dx,lvar,ldeg) - else lf:=mfpol(um,dx,lvar,ldeg) - auxfl:=[[multivariate(lfp,x),ffexp]$MParFact for lfp in lf] - factorlist:=append(factorlist,auxfl) - flead.factors:= factorlist - flead - - - pM(lum:L SUP R) : R == - x := monomial(1,1)$R - for i in 1..size()$F repeat - p := x + (index(i::PositiveInteger)$F) ::R - testModulus(p,lum) => return p - for e in 2.. repeat - p := (createIrreduciblePoly(e::PositiveInteger))$FFPOLY - testModulus(p,lum) => return p - while not((q := nextIrreduciblePoly(p)$FFPOLY) case "failed") repeat - p := q::SUP F - if testModulus(p, lum)$GenExEuclid(R, SUP R) then return p - - ---- push x in the coefficient domain for a term ---- - pushdcoef(t:PG):P == - map(coerce(#1)$R,t)$MPolyCatFunctions2(OV,E, - IndexedExponents OV,F,R,PG,P) - - - ---- internal function, for testing bad cases ---- - intfact(um:SUP P,lvar: L OV,ldeg:L NNI, - tleadpol:MFinalFact,ltry:L L R): L SUP P == - polcase:Boolean:=(not empty? tleadpol.factors ) - vfchoo:Valuf:= - polcase => - leadpol:L P:=[ff.irr for ff in tleadpol.factors] - intChoose(um,lvar,tleadpol.contp,leadpol,ltry) - intChoose(um,lvar,1,empty(),empty()) - unifact:List SUP R := vfchoo.unvfact - nfact:NNI := #unifact - nfact=1 => [um] - ltry:L L R:= vfchoo.inval - lval:L R:=first ltry - dd:= vfchoo.lu - lpol:List P:=empty() - leadval:List R:=empty() - if polcase then - leadval := vfchoo.complead - distf := distFact(vfchoo.lu,unifact,tleadpol,leadval,lvar,lval) - distf case "failed" => - return intfact(um,lvar,ldeg,tleadpol,ltry) - dist := distf :: LeadFact - -- check the factorization of leading coefficient - lpol:= dist.polfac - dd := dist.correct - unifact:=dist.corrfact - if dd^=1 then - unifact := [dd*unifact.i for i in 1..nfact] - um := ((dd**(nfact-1)::NNI)::P)*um - (ffin:= lifting(um,lvar,unifact,lval,lpol,ldeg,pM(unifact))) - case "failed" => intfact(um,lvar,ldeg,tleadpol,ltry) - factfin: L SUP P:=ffin :: L SUP P - if dd^=1 then - factfin:=[primitivePart ff for ff in factfin] - factfin - --- the following functions are used to "push" x in the coefficient ring - - ---- push back the variable ---- - pushup(f:P,x:OV) :PG == - ground? f => pushupconst((retract f)@R,x) - rr:PG:=0 - while f^=0 repeat - lf:=leadingMonomial f - cf:=pushupconst(leadingCoefficient f,x) - lvf:=variables lf - rr:=rr+monomial(cf,lvf, degree(lf,lvf))$PG - f:=reductum f - rr - - ---- push x in the coefficient domain for a polynomial ---- - pushdown(g:PG,x:OV) : P == - ground? g => ((retract g)@F)::R::P - rf:P:=0$P - ug:=univariate(g,x) - while ug^=0 repeat - cf:=monomial(1,degree ug)$R - rf:=rf+cf*pushdcoef(leadingCoefficient ug) - ug := reductum ug - rf - - ---- push x back from the coefficient domain ---- - pushupconst(r:R,x:OV):PG == - ground? r => (retract r)@F ::PG - rr:PG:=0 - while r^=0 repeat - rr:=rr+monomial((leadingCoefficient r)::PG,x,degree r)$PG - r:=reductum r - rr - - -- This function has to be added to Eucliden domain - ran(k1:Z) : R == - --if R case Integer then random()$R rem (2*k1)-k1 - --else - +/[monomial(random()$F,i)$R for i in 0..k1] - - checkzero(u:SUP P,um:SUP R) : Boolean == - u=0 => um =0 - um = 0 => false - degree u = degree um => checkzero(reductum u, reductum um) - false - - --- Choose the variable of least degree --- - varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd == - k:="min"/[d for d in ldeg] - k=degree(m,first lvar) => - [univariate(m,first lvar),lvar,ldeg]$NewOrd - i:=position(k,ldeg) - x:OV:=lvar.i - ldeg:=cons(k,delete(ldeg,i)) - lvar:=cons(x,delete(lvar,i)) - [univariate(m,x),lvar,ldeg]$NewOrd - - - norm(lum: L SUP R): Integer == "max"/[degree lup for lup in lum] - - --- Choose the values to reduce to the univariate case --- - intChoose(um:SUP P,lvar:L OV,clc:R,plist:L P,ltry:L L R) : Valuf == - -- declarations - degum:NNI := degree um - nvar1:=#lvar - range:NNI:=0 - unifact:L SUP R - ctf1 : R := 1 - testp:Boolean := -- polynomial leading coefficient - plist = empty() => false - true - leadcomp,leadcomp1 : L R - leadcomp:=leadcomp1:=empty() - nfatt:NNI := degum+1 - lffc:R:=1 - lffc1:=lffc - newunifact : L SUP R:=empty() - leadtest:=true --- the lc test with polCase has to be performed - int:L R:=empty() - - -- New sets of values are chosen until we find twice the - -- same number of "univariate" factors:the set smaller in modulo is - -- is chosen. - while true repeat - lval := [ ran(range) for i in 1..nvar1] - member?(lval,ltry) => range:=1+range - ltry := cons(lval,ltry) - leadcomp1:=[retract eval(pol,lvar,lval) for pol in plist] - testp and or/[unit? epl for epl in leadcomp1] => range:=range+1 - newm:SUP R:=completeEval(um,lvar,lval) - degum ^= degree newm or minimumDegree newm ^=0 => range:=range+1 - lffc1:=content newm - newm:=(newm exquo lffc1)::SUP R - testp and leadtest and ^ polCase(lffc1*clc,#plist,leadcomp1) - => range:=range+1 - Dnewm := differentiate newm - D2newm := map(differentiate, newm) - degree(gcd [newm,Dnewm,D2newm])^=0 => range:=range+1 - -- if R has Integer then luniv:=henselFact(newm,false)$ - -- else - lcnm:F:=1 - -- should be unitNormal if unified, but for now it is easier - if (lcnm:=leadingCoefficient leadingCoefficient newm)^=1 then - newm:=((inv lcnm)::R)*newm - dx:="max"/[degree uc for uc in coefficients newm] - luniv:=generalTwoFactor(newm)$TwoFactorize(F) - lunivf:= factors luniv - nf:= #lunivf - - nf=0 or nf>nfatt => "next values" --- pretest failed --- - - --- the univariate polynomial is irreducible --- - if nf=1 then leave (unifact:=[newm]) - - lffc1:=lcnm * retract(unit luniv)@R * lffc1 - - -- the new integer give the same number of factors - nfatt = nf => - -- if this is the first univariate factorization with polCase=true - -- or if the last factorization has smaller norm and satisfies - -- polCase - if leadtest or - ((norm unifact > norm [ff.factor for ff in lunivf]) and - (^testp or polCase(lffc1*clc,#plist,leadcomp1))) then - unifact:=[uf.factor for uf in lunivf] - int:=lval - lffc:=lffc1 - if testp then leadcomp:=leadcomp1 - leave "foundit" - - -- the first univariate factorization, inizialize - nfatt > degum => - unifact:=[uf.factor for uf in lunivf] - lffc:=lffc1 - if testp then leadcomp:=leadcomp1 - int:=lval - leadtest := false - nfatt := nf - - nfatt>nf => -- for the previous values there were more factors - if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp) - else leadtest:= false - -- if polCase=true we can consider the univariate decomposition - if ^leadtest then - unifact:=[uf.factor for uf in lunivf] - lffc:=lffc1 - if testp then leadcomp:=leadcomp1 - int:=lval - nfatt := nf - [cons(int,ltry),unifact,lffc,leadcomp]$Valuf - - - constantCase(m:P,factorlist:List MParFact) : MFinalFact == - --if R case Integer then [const m,factorlist]$MFinalFact - --else - lunm:=distdfact((retract m)@R,false)$DistinctDegreeFactorize(F,R) - [(lunm.cont)::R, append(factorlist, - [[(pp.irr)::P,pp.pow] for pp in lunm.factors])]$MFinalFact - - ---- The polynomial has mindeg>0 ---- - - simplify(m:P,dm:Z,lvar:L OV,lmdeg:L NNI):MFinalFact == - factorlist:L MParFact:=empty() - pol1:P:= 1$P - for x in lvar repeat - i := lmdeg.(position(x,lvar)) - i=0 => "next value" - pol1:=pol1*monomial(1$P,x,i) - factorlist:=cons([x::P,i]$MParFact,factorlist) - m := (m exquo pol1)::P - ground? m => constantCase(m,factorlist) - flead:=mFactor(m,dm) - flead.factors:=append(factorlist,flead.factors) - flead - - ---- m square-free,primitive,lc constant ---- - mfconst(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P == - nsign:Boolean - factfin:L SUP P:=empty() - empty? lvar => - um1:SUP R:=map(ground, - um)$UPCF2(P,SUP P,R,SUP R) - lum:= generalTwoFactor(um1)$TwoFactorize(F) - [map(coerce,lumf.factor)$UPCF2(R,SUP R,P,SUP P) - for lumf in factors lum] - intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty()) - - --- m is square-free,primitive,lc is a polynomial --- - mfpol(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P == - dist : LeadFact - tleadpol:=mFactor(leadingCoefficient um,dm) - intfact(um,lvar,ldeg,tleadpol,empty()) - - factor(m:PG):Factored PG == - lv:=variables m - lv=empty() => makeFR(m,empty() ) - -- reduce to multivariate over SUP - ld:=[degree(m,x) for x in lv] - dx:="min"/ld - basicVar:=lv(position(dx,ld)) - cm:=pushdown(m,basicVar) - flist := mFactor(cm,dx) - pushupconst(flist.contp,basicVar) * - (*/[primeFactor(pushup(u.irr,basicVar),u.pow) - for u in flist.factors]) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/mkfunc.spad.pamphlet b/src/algebra/mkfunc.spad.pamphlet deleted file mode 100644 index 08e2838..0000000 --- a/src/algebra/mkfunc.spad.pamphlet +++ /dev/null @@ -1,523 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mkfunc.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INFORM1 InputFormFunctions1} -<>= -)abbrev package INFORM1 InputFormFunctions1 ---)boot $noSubsumption := false - -++ Tools for manipulating input forms -++ Author: Manuel Bronstein -++ Date Created: ??? -++ Date Last Updated: 19 April 1991 -++ Description: Tools for manipulating input forms. - -InputFormFunctions1(R:Type):with - packageCall: Symbol -> InputForm - ++ packageCall(f) returns the input form corresponding to f$R. - interpret : InputForm -> R - ++ interpret(f) passes f to the interpreter, and transforms - ++ the result into an object of type R. - == add - Rname := devaluate(R)$Lisp :: InputForm - - packageCall name == - convert([convert("$elt"::Symbol), Rname, - convert name]$List(InputForm))@InputForm - - interpret form == - retract(interpret(convert([convert("@"::Symbol), form, - Rname]$List(InputForm))@InputForm)$InputForm)$AnyFunctions1(R) - -@ -\section{package MKFUNC MakeFunction} -<>= --- mkfunc.spad.pamphlet MakeFunction.input -)spool MakeFunction.output -)set message test on -)set message auto off -)clear all ---S 1 of 9 -expr := (x - exp x + 1)^2 * (sin(x^2) * x + 1)^3 ---R ---R ---R (1) ---R 3 x 2 4 3 x 5 4 3 2 3 ---R (x (%e ) + (- 2x - 2x )%e + x + 2x + x )sin(x ) ---R + ---R 2 x 2 3 2 x 4 3 2 2 2 ---R (3x (%e ) + (- 6x - 6x )%e + 3x + 6x + 3x )sin(x ) ---R + ---R x 2 2 x 3 2 2 x 2 ---R (3x (%e ) + (- 6x - 6x)%e + 3x + 6x + 3x)sin(x ) + (%e ) ---R + ---R x 2 ---R (- 2x - 2)%e + x + 2x + 1 ---R Type: Expression Integer ---E 1 - ---S 2 of 9 -function(expr, f, x) ---R ---R ---R (2) f ---R Type: Symbol ---E 2 - ---S 3 of 9 -tbl := [f(0.1 * i - 1) for i in 0..20] ---R ---R Compiling function f with type Float -> Float ---R ---R (3) ---R [0.0005391844 0362701574, 0.0039657551 1844206653, ---R 0.0088545187 4833983689 2, 0.0116524883 0907069695, ---R 0.0108618220 9245751364 5, 0.0076366823 2120869965 06, ---R 0.0040584985 7597822062 55, 0.0015349542 8910500836 48, ---R 0.0003424903 1549879905 716, 0.0000233304 8276098819 6001, 0.0, ---R 0.0000268186 8782862599 4229, 0.0004691571 3720051642 621, ---R 0.0026924576 5968519586 08, 0.0101486881 7369135148 8, ---R 0.0313833725 8543810564 3, 0.0876991144 5154615297 9, ---R 0.2313019789 3439968362, 0.5843743955 958098772, 1.4114930171 992819197, ---R 3.2216948276 75164252] ---R Type: List Float ---E 3 - ---S 4 of 9 -e := (x - y + 1)^2 * (x^2 * y + 1)^2 ---R ---R ---R (4) ---R 4 4 5 4 2 3 6 5 4 3 2 2 ---R x y + (- 2x - 2x + 2x )y + (x + 2x + x - 4x - 4x + 1)y ---R + ---R 4 3 2 2 ---R (2x + 4x + 2x - 2x - 2)y + x + 2x + 1 ---R Type: Polynomial Integer ---E 4 - ---S 5 of 9 -function(e, g, [x, y]) ---R ---R ---R (5) g ---R Type: Symbol ---E 5 - ---S 6 of 9 -function(e, h, x, y) ---R ---R ---R (6) h ---R Type: Symbol ---E 6 - ---S 7 of 9 -m1 := squareMatrix [ [1, 2], [3, 4] ] ---R ---R ---R +1 2+ ---R (7) | | ---R +3 4+ ---R Type: SquareMatrix(2,Integer) ---E 7 - ---S 8 of 9 -m2 := squareMatrix [ [1, 0], [-1, 1] ] ---R ---R ---R + 1 0+ ---R (8) | | ---R +- 1 1+ ---R Type: SquareMatrix(2,Integer) ---E 8 - ---S 9 of 9 -h(m1, m2) ---R ---R Compiling function h with type (SquareMatrix(2,Integer),SquareMatrix ---R (2,Integer)) -> SquareMatrix(2,Integer) ---R ---R +- 7836 8960 + ---R (9) | | ---R +- 17132 19588+ ---R Type: SquareMatrix(2,Integer) ---E 9 -)spool -)lisp (bye) -@ -<>= -==================================================================== -MakeFunction examples -==================================================================== - -It is sometimes useful to be able to define a function given by -the result of a calculation. - -Suppose that you have obtained the following expression after several -computations and that you now want to tabulate the numerical values of -f for x between -1 and +1 with increment 0.1. - - expr := (x - exp x + 1)^2 * (sin(x^2) * x + 1)^3 - 3 x 2 4 3 x 5 4 3 2 3 - (x (%e ) + (- 2x - 2x )%e + x + 2x + x )sin(x ) - + - 2 x 2 3 2 x 4 3 2 2 2 - (3x (%e ) + (- 6x - 6x )%e + 3x + 6x + 3x )sin(x ) - + - x 2 2 x 3 2 2 x 2 - (3x (%e ) + (- 6x - 6x)%e + 3x + 6x + 3x)sin(x ) + (%e ) - + - x 2 - (- 2x - 2)%e + x + 2x + 1 - Type: Expression Integer - -You could, of course, use the function eval within a loop and evaluate -expr twenty-one times, but this would be quite slow. A better way is -to create a numerical function f such that f(x) is defined by the -expression expr above, but without retyping expr! The package -MakeFunction provides the operation function which does exactly this. - -Issue this to create the function f(x) given by expr. - - function(expr, f, x) - f - Type: Symbol - -To tabulate expr, we can now quickly evaluate f 21 times. - - tbl := [f(0.1 * i - 1) for i in 0..20]; - Type: List Float - -Use the list [x1,...,xn] as the third argument to function to create a -multivariate function f(x1,...,xn). - - e := (x - y + 1)^2 * (x^2 * y + 1)^2 - 4 4 5 4 2 3 6 5 4 3 2 2 - x y + (- 2x - 2x + 2x )y + (x + 2x + x - 4x - 4x + 1)y - + - 4 3 2 2 - (2x + 4x + 2x - 2x - 2)y + x + 2x + 1 - Type: Polynomial Integer - - function(e, g, [x, y]) - g - Type: Symbol - -In the case of just two variables, they can be given as arguments -without making them into a list. - - function(e, h, x, y) - h - Type: Symbol - -Note that the functions created by function are not limited to -floating point numbers, but can be applied to any type for which they -are defined. - - m1 := squareMatrix [ [1, 2], [3, 4] ] - +1 2+ - | | - +3 4+ - Type: SquareMatrix(2,Integer) - - m2 := squareMatrix [ [1, 0], [-1, 1] ] - + 1 0+ - | | - +- 1 1+ - Type: SquareMatrix(2,Integer) - - h(m1, m2) - +- 7836 8960 + - | | - +- 17132 19588+ - Type: SquareMatrix(2,Integer) - -See Also: -o )show MakeFunction -o $AXIOM/doc/src/algebra/mkfunc.spad.dvi - -@ -<>= -)abbrev package MKFUNC MakeFunction -++ Tools for making interpreter functions from top-level expressions -++ Author: Manuel Bronstein -++ Date Created: 22 Nov 1988 -++ Date Last Updated: 8 Jan 1990 -++ Description: transforms top-level objects into interpreter functions. -MakeFunction(S:ConvertibleTo InputForm): Exports == Implementation where - SY ==> Symbol - - Exports ==> with - function: (S, SY ) -> SY - ++ function(e, foo) creates a function \spad{foo() == e}. - function: (S, SY, SY) -> SY - ++ function(e, foo, x) creates a function \spad{foo(x) == e}. - function: (S, SY, SY, SY) -> SY - ++ function(e, foo, x, y) creates a function \spad{foo(x, y) = e}. - function: (S, SY, List SY) -> SY - ++ \spad{function(e, foo, [x1,...,xn])} creates a function - ++ \spad{foo(x1,...,xn) == e}. - - Implementation ==> add - function(s, name) == function(s, name, nil()) - function(s:S, name:SY, x:SY) == function(s, name, [x]) - function(s, name, x, y) == function(s, name, [x, y]) - - function(s:S, name:SY, args:List SY) == - interpret function(convert s, args, name)$InputForm - name - -@ -\section{package MKUCFUNC MakeUnaryCompiledFunction} -<>= -)abbrev package MKUCFUNC MakeUnaryCompiledFunction -++ Tools for making compiled functions from top-level expressions -++ Author: Manuel Bronstein -++ Date Created: 1 Dec 1988 -++ Date Last Updated: 5 Mar 1990 -++ Description: transforms top-level objects into compiled functions. -MakeUnaryCompiledFunction(S, D, I): Exports == Implementation where - S: ConvertibleTo InputForm - D, I: Type - - SY ==> Symbol - DI ==> devaluate(D -> I)$Lisp - - Exports ==> with - unaryFunction : SY -> (D -> I) - ++ unaryFunction(a) is a local function - compiledFunction: (S, SY) -> (D -> I) - ++ compiledFunction(expr, x) returns a function \spad{f: D -> I} - ++ defined by \spad{f(x) == expr}. - ++ Function f is compiled and directly - ++ applicable to objects of type D. - - Implementation ==> add - import MakeFunction(S) - - func: (SY, D) -> I - - func(name, x) == FUNCALL(name, x, NIL$Lisp)$Lisp - unaryFunction name == func(name, #1) - - compiledFunction(e:S, x:SY) == - t := [convert([devaluate(D)$Lisp]$List(InputForm)) - ]$List(InputForm) - unaryFunction compile(function(e, declare DI, x), t) - -@ -\section{package MKBCFUNC MakeBinaryCompiledFunction} -<>= -)abbrev package MKBCFUNC MakeBinaryCompiledFunction -++ Tools for making compiled functions from top-level expressions -++ Author: Manuel Bronstein -++ Date Created: 1 Dec 1988 -++ Date Last Updated: 5 Mar 1990 -++ Description: transforms top-level objects into compiled functions. -MakeBinaryCompiledFunction(S, D1, D2, I):Exports == Implementation where - S: ConvertibleTo InputForm - D1, D2, I: Type - - SY ==> Symbol - DI ==> devaluate((D1, D2) -> I)$Lisp - - Exports ==> with - binaryFunction : SY -> ((D1, D2) -> I) - ++ binaryFunction(s) is a local function - compiledFunction: (S, SY, SY) -> ((D1, D2) -> I) - ++ compiledFunction(expr,x,y) returns a function \spad{f: (D1, D2) -> I} - ++ defined by \spad{f(x, y) == expr}. - ++ Function f is compiled and directly - ++ applicable to objects of type \spad{(D1, D2)} - - Implementation ==> add - import MakeFunction(S) - - func: (SY, D1, D2) -> I - - func(name, x, y) == FUNCALL(name, x, y, NIL$Lisp)$Lisp - binaryFunction name == func(name, #1, #2) - - compiledFunction(e, x, y) == - t := [devaluate(D1)$Lisp, devaluate(D2)$Lisp]$List(InputForm) - binaryFunction compile(function(e, declare DI, x, y), t) - -@ -\section{package MKFLCFN MakeFloatCompiledFunction} -<>= -)abbrev package MKFLCFN MakeFloatCompiledFunction -++ Tools for making compiled functions from top-level expressions -++ Author: Manuel Bronstein -++ Date Created: 2 Mar 1990 -++ Date Last Updated: 2 Dec 1996 (MCD) -++ Description: -++ MakeFloatCompiledFunction transforms top-level objects into -++ compiled Lisp functions whose arguments are Lisp floats. -++ This by-passes the \Language{} compiler and interpreter, -++ thereby gaining several orders of magnitude. -MakeFloatCompiledFunction(S): Exports == Implementation where - S: ConvertibleTo InputForm - - INF ==> InputForm - SF ==> DoubleFloat - DI1 ==> devaluate(SF -> SF)$Lisp - DI2 ==> devaluate((SF, SF) -> SF)$Lisp - - Exports ==> with - makeFloatFunction: (S, Symbol) -> (SF -> SF) - ++ makeFloatFunction(expr, x) returns a Lisp function - ++ \spad{f: \axiomType{DoubleFloat} -> \axiomType{DoubleFloat}} - ++ defined by \spad{f(x) == expr}. - ++ Function f is compiled and directly - ++ applicable to objects of type \axiomType{DoubleFloat}. - makeFloatFunction: (S, Symbol, Symbol) -> ((SF, SF) -> SF) - ++ makeFloatFunction(expr, x, y) returns a Lisp function - ++ \spad{f: (\axiomType{DoubleFloat}, \axiomType{DoubleFloat}) -> \axiomType{DoubleFloat}} - ++ defined by \spad{f(x, y) == expr}. - ++ Function f is compiled and directly - ++ applicable to objects of type \spad{(\axiomType{DoubleFloat}, \axiomType{DoubleFloat})}. - - Implementation ==> add - import MakeUnaryCompiledFunction(S, SF, SF) - import MakeBinaryCompiledFunction(S, SF, SF, SF) - - streq? : (INF, String) -> Boolean - streqlist?: (INF, List String) -> Boolean - gencode : (String, List INF) -> INF - mkLisp : INF -> Union(INF, "failed") - mkLispList: List INF -> Union(List INF, "failed") - mkDefun : (INF, List INF) -> INF - mkLispCall: INF -> INF - mkPretend : INF -> INF - mkCTOR : INF -> INF - - lsf := convert([convert("DoubleFloat"::Symbol)@INF]$List(INF))@INF - - streq?(s, st) == s = convert(st::Symbol)@INF - gencode(s, l) == convert(concat(convert(s::Symbol)@INF, l))@INF - streqlist?(s, l) == member?(string symbol s, l) - - mkPretend form == - convert([convert("pretend"::Symbol), form, lsf]$List(INF))@INF - - mkCTOR form == - convert([convert("C-TO-R"::Symbol), form]$List(INF))@INF - - - mkLispCall name == - convert([convert("$elt"::Symbol), - convert("Lisp"::Symbol), name]$List(INF))@INF - - mkDefun(s, lv) == - name := convert(new()$Symbol)@INF - fun := convert([convert("DEFUN"::Symbol), name, convert lv, - gencode("DECLARE",[gencode("FLOAT",lv)]),mkCTOR s]$List(INF))@INF - EVAL(fun)$Lisp - if _$compileDontDefineFunctions$Lisp then COMPILE(name)$Lisp - name - - makeFloatFunction(f, x, y) == - (u := mkLisp(convert(f)@INF)) case "failed" => - compiledFunction(f, x, y) - name := mkDefun(u::INF, [ix := convert x, iy := convert y]) - t := [lsf, lsf]$List(INF) - spadname := declare DI2 - spadform:=mkPretend convert([mkLispCall name,ix,iy]$List(INF))@INF - interpret function(spadform, [x, y], spadname) - binaryFunction compile(spadname, t) - - makeFloatFunction(f, var) == - (u := mkLisp(convert(f)@INF)) case "failed" => - compiledFunction(f, var) - name := mkDefun(u::INF, [ivar := convert var]) - t := [lsf]$List(INF) - spadname := declare DI1 - spadform:= mkPretend convert([mkLispCall name,ivar]$List(INF))@INF - interpret function(spadform, [var], spadname) - unaryFunction compile(spadname, t) - - mkLispList l == - ans := nil()$List(INF) - for s in l repeat - (u := mkLisp s) case "failed" => return "failed" - ans := concat(u::INF, ans) - reverse_! ans - - - mkLisp s == - atom? s => s - op := first(l := destruct s) - (u := mkLispList rest l) case "failed" => "failed" - ll := u::List(INF) - streqlist?(op, ["+","*","/","-"]) => convert(concat(op, ll))@INF - streq?(op, "**") => gencode("EXPT", ll) - streqlist?(op, ["exp","sin","cos","tan","atan", - "log", "sinh","cosh","tanh","asinh","acosh","atanh","sqrt"]) => - gencode(upperCase string symbol op, ll) - streq?(op, "nthRoot") => - second ll = convert(2::Integer)@INF =>gencode("SQRT",[first ll]) - gencode("EXPT", concat(first ll, [1$INF / second ll])) - streq?(op, "float") => - a := ll.1 - e := ll.2 - b := ll.3 - _*(a, EXPT(b, e)$Lisp)$Lisp pretend INF - "failed" - -@ -\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/mkrecord.spad.pamphlet b/src/algebra/mkrecord.spad.pamphlet deleted file mode 100644 index 2fe1585..0000000 --- a/src/algebra/mkrecord.spad.pamphlet +++ /dev/null @@ -1,70 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mkrecord.spad} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MKRECORD MakeRecord} -<>= -)abbrev package MKRECORD MakeRecord -++ Description: -++ MakeRecord is used internally by the interpreter to create record -++ types which are used for doing parallel iterations on streams. -MakeRecord(S: Type, T: Type): public == private where - public == with - makeRecord: (S,T) -> Record(part1: S, part2: T) - ++ makeRecord(a,b) creates a record object with type - ++ Record(part1:S, part2:R), where part1 is \spad{a} and part2 is \spad{b}. - private == add - makeRecord(s: S, t: T) == - [s,t]$Record(part1: S, part2: T) - -@ -\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/mlift.spad.pamphlet b/src/algebra/mlift.spad.pamphlet deleted file mode 100644 index 4ec8d14..0000000 --- a/src/algebra/mlift.spad.pamphlet +++ /dev/null @@ -1,277 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mlift.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MLIFT MultivariateLifting} -<>= -)abbrev package MLIFT MultivariateLifting -++ Author : P.Gianni. -++ Description: -++ This package provides the functions for the multivariate "lifting", using -++ an algorithm of Paul Wang. -++ This package will work for every euclidean domain R which has property -++ F, i.e. there exists a factor operation in \spad{R[x]}. - -MultivariateLifting(E,OV,R,P) : C == T - where - OV : OrderedSet - E : OrderedAbelianMonoidSup - R : EuclideanDomain -- with property "F" - Z ==> Integer - BP ==> SparseUnivariatePolynomial R - P : PolynomialCategory(R,E,OV) - SUP ==> SparseUnivariatePolynomial P - NNI ==> NonNegativeInteger - Term ==> Record(expt:NNI,pcoef:P) - VTerm ==> List Term - Table ==> Vector List BP - L ==> List - - C == with - corrPoly: (SUP,L OV,L R,L NNI,L SUP,Table,R) -> Union(L SUP,"failed") - ++ corrPoly(u,lv,lr,ln,lu,t,r) \undocumented - lifting: (SUP,L OV,L BP,L R,L P,L NNI,R) -> Union(L SUP,"failed") - ++ lifting(u,lv,lu,lr,lp,ln,r) \undocumented - lifting1: (SUP,L OV,L SUP,L R,L P,L VTerm,L NNI,Table,R) -> - Union(L SUP,"failed") - ++ lifting1(u,lv,lu,lr,lp,lt,ln,t,r) \undocumented - - T == add - GenExEuclid(R,BP) - NPCoef(BP,E,OV,R,P) - IntegerCombinatoricFunctions(Z) - - SUPF2 ==> SparseUnivariatePolynomialFunctions2 - - DetCoef ==> Record(deter:L SUP,dterm:L VTerm,nfacts:L BP, - nlead:L P) - - --- local functions --- - normalDerivM : (P,Z,OV) -> P - normalDeriv : (SUP,Z) -> SUP - subslead : (SUP,P) -> SUP - subscoef : (SUP,L Term) -> SUP - maxDegree : (SUP,OV) -> NonNegativeInteger - - - corrPoly(m:SUP,lvar:L OV,fval:L R,ld:L NNI,flist:L SUP, - table:Table,pmod:R):Union(L SUP,"failed") == - -- The correction coefficients are evaluated recursively. - -- Extended Euclidean algorithm for the multivariate case. - - -- the polynomial is univariate -- - #lvar=0 => - lp:=solveid(map(ground,m)$SUPF2(P,R),pmod,table) - if lp case "failed" then return "failed" - lcoef:= [map(coerce,mp)$SUPF2(R,P) for mp in lp::L BP] - - - diff,ddiff,pol,polc:SUP - listpolv,listcong:L SUP - deg1:NNI:= ld.first - np:NNI:= #flist - a:P:= fval.first ::P - y:OV:=lvar.first - lvar:=lvar.rest - listpolv:L SUP := [map(eval(#1,y,a),f1) for f1 in flist] - um:=map(eval(#1,y,a),m) - flcoef:=corrPoly(um,lvar,fval.rest,ld.rest,listpolv,table,pmod) - if flcoef case "failed" then return "failed" - else lcoef:=flcoef :: L SUP - listcong:=[*/[flist.i for i in 1..np | i^=l] for l in 1..np] - polc:SUP:= (monomial(1,y,1) - a)::SUP - pol := 1$SUP - diff:=m- +/[lcoef.i*listcong.i for i in 1..np] - for l in 1..deg1 repeat - if diff=0 then return lcoef - pol := pol*polc - (ddiff:= map(eval(normalDerivM(#1,l,y),y,a),diff)) = 0 => "next l" - fbeta := corrPoly(ddiff,lvar,fval.rest,ld.rest,listpolv,table,pmod) - if fbeta case "failed" then return "failed" - else beta:=fbeta :: L SUP - lcoef := [lcoef.i+beta.i*pol for i in 1..np] - diff:=diff- +/[listcong.i*beta.i for i in 1..np]*pol - lcoef - - - - lifting1(m:SUP,lvar:L OV,plist:L SUP,vlist:L R,tlist:L P,_ - coeflist:L VTerm,listdeg:L NNI,table:Table,pmod:R) :Union(L SUP,"failed") == - -- The factors of m (multivariate) are determined , - -- We suppose to know the true univariate factors - -- some coefficients are determined - conglist:L SUP:=empty() - nvar : NNI:= #lvar - pol,polc:P - mc,mj:SUP - testp:Boolean:= (not empty?(tlist)) - lalpha : L SUP := empty() - tlv:L P:=empty() - subsvar:L OV:=empty() - subsval:L R:=empty() - li:L OV := lvar - ldeg:L NNI:=empty() - clv:L VTerm:=empty() - --j =#variables, i=#factors - for j in 1..nvar repeat - x := li.first - li := rest li - conglist:= plist - v := vlist.first - vlist := rest vlist - degj := listdeg.j - ldeg := cons(degj,ldeg) - subsvar:=cons(x,subsvar) - subsval:=cons(v,subsval) - - --substitute the determined coefficients - if testp then - if j "next k" - flalpha:=corrPoly(mc,subsvar.rest,subsval.rest, - ldeg.rest,conglist,table,pmod) - if flalpha case "failed" then return "failed" - else lalpha:=flalpha :: L SUP - plist:=[term-alpha*pol for term in plist for alpha in lalpha] - -- PGCD may call with a smaller valure of degj - idegj:Integer:=maxDegree(m,x) - for term in plist repeat idegj:=idegj -maxDegree(term,x) - idegj < 0 => return "failed" - plist - --There are not extraneous factors - - maxDegree(um:SUP,x:OV):NonNegativeInteger == - ans:NonNegativeInteger:=0 - while um ^= 0 repeat - ans:=max(ans,degree(leadingCoefficient um,x)) - um:=reductum um - ans - - lifting(um:SUP,lvar:L OV,plist:L BP,vlist:L R, - tlist:L P,listdeg:L NNI,pmod:R):Union(L SUP,"failed") == - -- The factors of m (multivariate) are determined, when the - -- univariate true factors are known and some coefficient determined - nplist:List SUP:=[map(coerce,pp)$SUPF2(R,P) for pp in plist] - empty? tlist => - table:=tablePow(degree um,pmod,plist) - table case "failed" => error "Table construction failed in MLIFT" - lifting1(um,lvar,nplist,vlist,tlist,empty(),listdeg,table,pmod) - ldcoef:DetCoef:=npcoef(um,plist,tlist) - if not empty?(listdet:=ldcoef.deter) then - if #listdet = #plist then return listdet - plist:=ldcoef.nfacts - nplist:=[map(coerce,pp)$SUPF2(R,P) for pp in plist] - um:=(um exquo */[pol for pol in listdet])::SUP - tlist:=ldcoef.nlead - tab:=tablePow(degree um,pmod,plist.rest) - else tab:=tablePow(degree um,pmod,plist) - tab case "failed" => error "Table construction failed in MLIFT" - table:Table:=tab - ffl:=lifting1(um,lvar,nplist,vlist,tlist,ldcoef.dterm,listdeg,table,pmod) - if ffl case "failed" then return "failed" - append(listdet,ffl:: L SUP) - - -- normalDerivM(f,m,x) = the normalized (divided by m!) m-th - -- derivative with respect to x of the multivariate polynomial f - normalDerivM(g:P,m:Z,x:OV) : P == - multivariate(normalDeriv(univariate(g,x),m),x) - - normalDeriv(f:SUP,m:Z) : SUP == - (n1:Z:=degree f) < m => 0$SUP - n1=m => leadingCoefficient f :: SUP - k:=binomial(n1,m) - ris:SUP:=0$SUP - n:Z:=n1 - while n>= m repeat - while n1>n repeat - k:=(k*(n1-m)) quo n1 - n1:=n1-1 - ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI) - f:=reductum f - n:=degree f - ris - - subslead(m:SUP,pol:P):SUP == - dm:NNI:=degree m - monomial(pol,dm)+reductum m - - subscoef(um:SUP,lterm:L Term):SUP == - dm:NNI:=degree um - new:=monomial(leadingCoefficient um,dm) - for k in dm-1..0 by -1 repeat - i:NNI:=k::NNI - empty?(lterm) or lterm.first.expt^=i => - new:=new+monomial(coefficient(um,i),i) - new:=new+monomial(lterm.first.pcoef,i) - lterm:=lterm.rest - new - -@ -\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/moddfact.spad.pamphlet b/src/algebra/moddfact.spad.pamphlet deleted file mode 100644 index 19692d4..0000000 --- a/src/algebra/moddfact.spad.pamphlet +++ /dev/null @@ -1,282 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra moddfact.spad} -\author{Barry Trager, James Davenport} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MDDFACT ModularDistinctDegreeFactorizer} -<>= -)abbrev package MDDFACT ModularDistinctDegreeFactorizer -++ Author: Barry Trager -++ Date Created: -++ Date Last Updated: 20.9.95 (JHD) -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package supports factorization and gcds -++ of univariate polynomials over the integers modulo different -++ primes. The inputs are given as polynomials over the integers -++ with the prime passed explicitly as an extra argument. - -ModularDistinctDegreeFactorizer(U):C == T where - U : UnivariatePolynomialCategory(Integer) - I ==> Integer - NNI ==> NonNegativeInteger - PI ==> PositiveInteger - V ==> Vector - L ==> List - DDRecord ==> Record(factor:EMR,degree:I) - UDDRecord ==> Record(factor:U,degree:I) - DDList ==> L DDRecord - UDDList ==> L UDDRecord - - - C == with - gcd:(U,U,I) -> U - ++ gcd(f1,f2,p) computes the gcd of the univariate polynomials - ++ f1 and f2 modulo the integer prime p. - linears: (U,I) -> U - ++ linears(f,p) returns the product of all the linear factors - ++ of f modulo p. Potentially incorrect result if f is not - ++ square-free modulo p. - factor:(U,I) -> L U - ++ factor(f1,p) returns the list of factors of the univariate - ++ polynomial f1 modulo the integer prime p. - ++ Error: if f1 is not square-free modulo p. - ddFact:(U,I) -> UDDList - ++ ddFact(f,p) computes a distinct degree factorization of the - ++ polynomial f modulo the prime p, i.e. such that each factor - ++ is a product of irreducibles of the same degrees. The input - ++ polynomial f is assumed to be square-free modulo p. - separateFactors:(UDDList,I) -> L U - ++ separateFactors(ddl, p) refines the distinct degree factorization - ++ produced by \spadfunFrom{ddFact}{ModularDistinctDegreeFactorizer} - ++ to give a complete list of factors. - exptMod:(U,I,U,I) -> U - ++ exptMod(f,n,g,p) raises the univariate polynomial f to the nth - ++ power modulo the polynomial g and the prime p. - - T == add - reduction(u:U,p:I):U == - zero? p => u - map(positiveRemainder(#1,p),u) - merge(p:I,q:I):Union(I,"failed") == - p = q => p - p = 0 => q - q = 0 => p - "failed" - modInverse(c:I,p:I):I == - (extendedEuclidean(c,p,1)::Record(coef1:I,coef2:I)).coef1 - exactquo(u:U,v:U,p:I):Union(U,"failed") == - invlcv:=modInverse(leadingCoefficient v,p) - r:=monicDivide(u,reduction(invlcv*v,p)) - reduction(r.remainder,p) ^=0 => "failed" - reduction(invlcv*r.quotient,p) - EMR := EuclideanModularRing(Integer,U,Integer, - reduction,merge,exactquo) - - probSplit2:(EMR,EMR,I) -> Union(List EMR,"failed") - trace:(EMR,I,EMR) -> EMR - ddfactor:EMR -> L EMR - ddfact:EMR -> DDList - sepFact1:DDRecord -> L EMR - sepfact:DDList -> L EMR - probSplit:(EMR,EMR,I) -> Union(L EMR,"failed") - makeMonic:EMR -> EMR - exptmod:(EMR,I,EMR) -> EMR - - lc(u:EMR):I == leadingCoefficient(u::U) - degree(u:EMR):I == degree(u::U) - makeMonic(u) == modInverse(lc(u),modulus(u)) * u - - i:I - - exptmod(u1,i,u2) == - i < 0 => error("negative exponentiation not allowed for exptMod") - ans:= 1$EMR - while i > 0 repeat - if odd?(i) then ans:= (ans * u1) rem u2 - i:= i quo 2 - u1:= (u1 * u1) rem u2 - ans - - exptMod(a,i,b,q) == - ans:= exptmod(reduce(a,q),i,reduce(b,q)) - ans::U - - ddfactor(u) == - if (c:= lc(u)) ^= 1$I then u:= makeMonic(u) - ans:= sepfact(ddfact(u)) - cons(c::EMR,[makeMonic(f) for f in ans | degree(f) > 0]) - - gcd(u,v,q) == gcd(reduce(u,q),reduce(v,q))::U - - factor(u,q) == - v:= reduce(u,q) - dv:= reduce(differentiate(u),q) - degree gcd(v,dv) > 0 => - error("Modular factor: polynomial must be squarefree") - ans:= ddfactor v - [f::U for f in ans] - - ddfact(u) == - p:=modulus u - w:= reduce(monomial(1,1)$U,p) - m:= w - d:I:= 1 - if (c:= lc(u)) ^= 1$I then u:= makeMonic u - ans:DDList:= [] - repeat - w:= exptmod(w,p,u) - g:= gcd(w - m,u) - if degree g > 0 then - g:= makeMonic(g) - ans:= [[g,d],:ans] - u:= (u quo g) - degree(u) = 0 => return [[c::EMR,0$I],:ans] - d:= d+1 - d > (degree(u):I quo 2) => - return [[c::EMR,0$I],[u,degree(u)],:ans] - - ddFact(u,q) == - ans:= ddfact(reduce(u,q)) - [[(dd.factor)::U,dd.degree]$UDDRecord for dd in ans]$UDDList - - linears(u,q) == - uu:=reduce(u,q) - m:= reduce(monomial(1,1)$U,q) - gcd(exptmod(m,q,uu)-m,uu)::U - - sepfact(factList) == - "append"/[sepFact1(f) for f in factList] - - separateFactors(uddList,q) == - ans:= sepfact [[reduce(udd.factor,q),udd.degree]$DDRecord for - udd in uddList]$DDList - [f::U for f in ans] - - decode(s:Integer, p:Integer, x:U):U == - s

s::U - qr := divide(s,p) - qr.remainder :: U + x*decode(qr.quotient, p, x) - - sepFact1(f) == - u:= f.factor - p:=modulus u - (d := f.degree) = 0 => [u] - if (c:= lc(u)) ^= 1$I then u:= makeMonic(u) - d = (du := degree(u)) => [u] - ans:L EMR:= [] - x:U:= monomial(1,1) - -- for small primes find linear factors by exhaustion - d=1 and p < 1000 => - for i in 0.. while du > 0 repeat - if u(i::U) = 0 then - ans := cons(reduce(x-(i::U),p),ans) - du := du-1 - ans - y:= x - s:I:= 0 - ss:I := 1 - stack:L EMR:= [u] - until null stack repeat - t:= reduce(((s::U)+x),p) - if not ((flist:= probSplit(first stack,t,d)) case "failed") then - stack:= rest stack - for fact in flist repeat - f1:= makeMonic(fact) - (df1:= degree(f1)) = 0 => nil - df1 > d => stack:= [f1,:stack] - ans:= [f1,:ans] - p = 2 => - ss:= ss + 1 - x := y * decode(ss, p, y) - s:= s+1 - s = p => - s:= 0 - ss := ss + 1 - x:= y * decode(ss, p, y) --- not one? leadingCoefficient(x) => - not (leadingCoefficient(x) = 1) => - ss := p ** degree x - x:= y ** (degree(x) + 1) - [c * first(ans),:rest(ans)] - - probSplit(u,t,d) == - (p:=modulus(u)) = 2 => probSplit2(u,t,d) - f1:= gcd(u,t) - r:= ((p**(d:NNI)-1) quo 2):NNI - n:= exptmod(t,r,u) - f2:= gcd(u,n + 1) - (g:= f1 * f2) = 1 => "failed" - g = u => "failed" - [f1,f2,(u quo g)] - - probSplit2(u,t,d) == - f:= gcd(u,trace(t,d,u)) - f = 1 => "failed" - degree u = degree f => "failed" - [1,f,u quo f] - - trace(t,d,u) == - p:=modulus(t) - d:= d - 1 - tt:=t - while d > 0 repeat - tt:= (tt + (t:=exptmod(t,p,u))) rem u - d:= d - 1 - tt - -@ -\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/modgcd.spad.pamphlet b/src/algebra/modgcd.spad.pamphlet deleted file mode 100644 index a2f056c..0000000 --- a/src/algebra/modgcd.spad.pamphlet +++ /dev/null @@ -1,315 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra modgcd.spad} -\author{James Davenport, Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INMODGCD InnerModularGcd} -<>= -)abbrev package INMODGCD InnerModularGcd -++ Author: J.H. Davenport and P. Gianni -++ Date Created: July 1990 -++ Date Last Updated: November 1991 -++ Description: -++ This file contains the functions for modular gcd algorithm -++ for univariate polynomials with coefficients in a -++ non-trivial euclidean domain (i.e. not a field). -++ The package parametrised by the coefficient domain, -++ the polynomial domain, a prime, -++ and a function for choosing the next prime - -Z ==> Integer -NNI ==> NonNegativeInteger - -InnerModularGcd(R,BP,pMod,nextMod):C == T - where - R : EuclideanDomain - BP : UnivariatePolynomialCategory(R) - pMod : R - nextMod : (R,NNI) -> R - - C == with - modularGcdPrimitive : List BP -> BP - ++ modularGcdPrimitive(f1,f2) computes the gcd of the two polynomials - ++ f1 and f2 by modular methods. - modularGcd : List BP -> BP - ++ modularGcd(listf) computes the gcd of the list of polynomials - ++ listf by modular methods. - reduction : (BP,R) -> BP - ++ reduction(f,p) reduces the coefficients of the polynomial f - ++ modulo the prime p. - - T == add - - -- local functions -- - height : BP -> NNI - mbound : (BP,BP) -> NNI - modGcdPrimitive : (BP,BP) -> BP - test : (BP,BP,BP) -> Boolean - merge : (R,R) -> Union(R,"failed") - modInverse : (R,R) -> R - exactquo : (BP,BP,R) -> Union(BP,"failed") - constNotZero : BP -> Boolean - constcase : (List NNI ,List BP ) -> BP - lincase : (List NNI ,List BP ) -> BP - - - if R has IntegerNumberSystem then - reduction(u:BP,p:R):BP == - p = 0 => u - map(symmetricRemainder(#1,p),u) - else - reduction(u:BP,p:R):BP == - p = 0 => u - map(#1 rem p,u) - - FP:=EuclideanModularRing(R,BP,R,reduction,merge,exactquo) - zeroChar : Boolean := R has CharacteristicZero - - -- exported functions -- - - -- modular Gcd for a list of primitive polynomials - modularGcdPrimitive(listf : List BP) :BP == - empty? listf => 0$BP - g := first listf - for f in rest listf | ^zero? f while degree g > 0 repeat - g:=modGcdPrimitive(g,f) - g - - -- gcd for univariate polynomials - modularGcd(listf : List BP): BP == - listf:=remove!(0$BP,listf) - empty? listf => 0$BP - # listf = 1 => first listf - minpol:=1$BP - -- extract a monomial gcd - mdeg:= "min"/[minimumDegree f for f in listf] - if mdeg>0 then - minpol1:= monomial(1,mdeg) - listf:= [(f exquo minpol1)::BP for f in listf] - minpol:=minpol*minpol1 - listdeg:=[degree f for f in listf ] - -- make the polynomials primitive - listCont := [content f for f in listf] - contgcd:= gcd listCont - -- make the polynomials primitive - listf :=[(f exquo cf)::BP for f in listf for cf in listCont] - minpol:=contgcd*minpol - ans:BP := - --one polynomial is constant - member?(1,listf) => 1 - --one polynomial is linear - member?(1,listdeg) => lincase(listdeg,listf) - modularGcdPrimitive listf - minpol*ans - - -- local functions -- - - --one polynomial is linear, remark that they are primitive - lincase(listdeg:List NNI ,listf:List BP ): BP == - n:= position(1,listdeg) - g:=listf.n - for f in listf repeat - if (f1:=f exquo g) case "failed" then return 1$BP - g - - -- test if d is the gcd - test(f:BP,g:BP,d:BP):Boolean == - d0:=coefficient(d,0) - coefficient(f,0) exquo d0 case "failed" => false - coefficient(g,0) exquo d0 case "failed" => false - f exquo d case "failed" => false - g exquo d case "failed" => false - true - - -- gcd and cofactors for PRIMITIVE univariate polynomials - -- also assumes that constant terms are non zero - modGcdPrimitive(f:BP,g:BP): BP == - df:=degree f - dg:=degree g - dp:FP - lcf:=leadingCoefficient f - lcg:=leadingCoefficient g - testdeg:NNI - lcd:R:=gcd(lcf,lcg) - prime:=pMod - bound:=mbound(f,g) - while zero? (lcd rem prime) repeat - prime := nextMod(prime,bound) - soFar:=gcd(reduce(f,prime),reduce(g,prime))::BP - testdeg:=degree soFar - zero? testdeg => return 1$BP - ldp:FP:= - ((lcdp:=leadingCoefficient(soFar::BP)) = 1) => - reduce(lcd::BP,prime) - reduce((modInverse(lcdp,prime)*lcd)::BP,prime) - soFar:=reduce(ldp::BP *soFar,prime)::BP - soFarModulus:=prime - -- choose the prime - while true repeat - prime := nextMod(prime,bound) - lcd rem prime =0 => "next prime" - fp:=reduce(f,prime) - gp:=reduce(g,prime) - dp:=gcd(fp,gp) - dgp :=euclideanSize dp - if dgp =0 then return 1$BP - if dgp=dg and ^(f exquo g case "failed") then return g - if dgp=df and ^(g exquo f case "failed") then return f - dgp > testdeg => "next prime" - ldp:FP:= - ((lcdp:=leadingCoefficient(dp::BP)) = 1) => - reduce(lcd::BP,prime) - reduce((modInverse(lcdp,prime)*lcd)::BP,prime) - dp:=ldp *dp - dgp=testdeg => - correction:=reduce(dp::BP-soFar,prime)::BP - zero? correction => - ans:=reduce(lcd::BP*soFar,soFarModulus)::BP - cont:=content ans - ans:=(ans exquo cont)::BP - test(f,g,ans) => return ans - soFarModulus:=soFarModulus*prime - correctionFactor:=modInverse(soFarModulus rem prime,prime) - -- the initial rem is just for efficiency - soFar:=soFar+soFarModulus*(correctionFactor*correction) - soFarModulus:=soFarModulus*prime - soFar:=reduce(soFar,soFarModulus)::BP - dgp - soFarModulus:=prime - soFar:=dp::BP - testdeg:=dgp - if ^zeroChar and euclideanSize(prime)>1 then - result:=dp::BP - test(f,g,result) => return result - -- this is based on the assumption that the caller of this package, - -- in non-zero characteristic, will use primes of the form - -- x-alpha as long as possible, but, if these are exhausted, - -- will switch to a prime of degree larger than the answer - -- so the result can be used directly. - - merge(p:R,q:R):Union(R,"failed") == - p = q => p - p = 0 => q - q = 0 => p - "failed" - - modInverse(c:R,p:R):R == - (extendedEuclidean(c,p,1)::Record(coef1:R,coef2:R)).coef1 - - exactquo(u:BP,v:BP,p:R):Union(BP,"failed") == - invlcv:=modInverse(leadingCoefficient v,p) - r:=monicDivide(u,reduction(invlcv*v,p)) - reduction(r.remainder,p) ^=0 => "failed" - reduction(invlcv*r.quotient,p) - - - -- compute the height of a polynomial -- - height(f:BP):NNI == - degf:=degree f - "max"/[euclideanSize cc for cc in coefficients f] - - -- compute the bound - mbound(f:BP,g:BP):NNI == - hf:=height f - hg:=height g - 2*min(hf,hg) - -\section{package FOMOGCD ForModularGcd} --- ForModularGcd(R,BP) : C == T --- where --- R : EuclideanDomain -- characteristic 0 --- BP : UnivariatePolynomialCategory(R) --- --- C == with --- nextMod : (R,NNI) -> R --- --- T == add --- nextMod(val:R,bound:NNI) : R == --- ival:Z:= val pretend Z --- (nextPrime(ival)$IntegerPrimesPackage(Z))::R --- --- ForTwoGcd(F) : C == T --- where --- F : Join(Finite,Field) --- SUP ==> SparseUnivariatePolynomial --- R ==> SUP F --- P ==> SUP R --- UPCF2 ==> UnivariatePolynomialCategoryFunctions2 --- --- C == with --- nextMod : (R,NNI) -> R --- --- T == add --- nextMod(val:R,bound:NNI) : R == --- ris:R:= nextItem(val) :: R --- euclideanSize ris < 2 => ris --- generateIrredPoly( --- (bound+1)::PositiveInteger)$IrredPolyOverFiniteField(F) --- --- --- ModularGcd(R,BP) == T --- where --- R : EuclideanDomain -- characteristic 0 --- BP : UnivariatePolynomialCategory(R) --- T ==> InnerModularGcd(R,BP,67108859::R,nextMod$ForModularGcd(R,BP)) --- --- TwoGcd(F) : C == T --- where --- F : Join(Finite,Field) --- SUP ==> SparseUnivariatePolynomial --- R ==> SUP F --- P ==> SUP R --- --- T ==> InnerModularGcd(R,P,nextMod(monomial(1,1)$R)$ForTwoGcd(F), --- nextMod$ForTwoGcd(F)) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/mring.spad.pamphlet b/src/algebra/mring.spad.pamphlet deleted file mode 100644 index ff6b9cf..0000000 --- a/src/algebra/mring.spad.pamphlet +++ /dev/null @@ -1,86 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra mring.spad} -\author{Stephen M. Watt, Johannes Grabmeier, Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MRF2 MonoidRingFunctions2} -<>= -)abbrev package MRF2 MonoidRingFunctions2 -++ Author: Johannes Grabmeier -++ Date Created: 14 May 1991 -++ Date Last Updated: 14 May 1991 -++ Basic Operations: map -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: monoid ring, group ring, change of coefficient domain -++ References: -++ Description: -++ MonoidRingFunctions2 implements functions between -++ two monoid rings defined with the same monoid over different rings. -MonoidRingFunctions2(R,S,M) : Exports == Implementation where - R : Ring - S : Ring - M : Monoid - Exports ==> with - map: (R -> S, MonoidRing(R,M)) -> MonoidRing(S,M) - ++ map(f,u) maps f onto the coefficients f the element - ++ u of the monoid ring to create an element of a monoid - ++ ring with the same monoid b. - Implementation ==> add - map(fn, u) == - res : MonoidRing(S,M) := 0 - for te in terms u repeat - res := res + monomial(fn(te.coef), te.monom) - res - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/multfact.spad.pamphlet b/src/algebra/multfact.spad.pamphlet deleted file mode 100644 index 6efcd46..0000000 --- a/src/algebra/multfact.spad.pamphlet +++ /dev/null @@ -1,604 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra multfact.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INNMFACT InnerMultFact} -<>= -)abbrev package INNMFACT InnerMultFact -++ Author: P. Gianni -++ Date Created: 1983 -++ Date Last Updated: Sept. 1990 -++ Additional Comments: JHD Aug 1997 -++ Basic Functions: -++ Related Constructors: MultivariateFactorize, AlgebraicMultFact -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This is an inner package for factoring multivariate polynomials -++ over various coefficient domains in characteristic 0. -++ The univariate factor operation is passed as a parameter. -++ Multivariate hensel lifting is used to lift the univariate -++ factorization - --- Both exposed functions call mFactor. This deals with issues such as --- monomial factors, contents, square-freeness etc., then calls intfact. --- This uses intChoose to find a "good" evaluation and factorise the --- corresponding univariate, and then uses MultivariateLifting to find --- the multivariate factors. - -InnerMultFact(OV,E,R,P) : C == T - where - R : Join(EuclideanDomain, CharacteristicZero) - -- with factor on R[x] - OV : OrderedSet - E : OrderedAbelianMonoidSup - P : PolynomialCategory(R,E,OV) - BP ==> SparseUnivariatePolynomial R - UFactor ==> (BP -> Factored BP) - Z ==> Integer - MParFact ==> Record(irr:P,pow:Z) - USP ==> SparseUnivariatePolynomial P - SUParFact ==> Record(irr:USP,pow:Z) - SUPFinalFact ==> Record(contp:R,factors:List SUParFact) - MFinalFact ==> Record(contp:R,factors:List MParFact) - - -- contp = content, - -- factors = List of irreducible factors with exponent - L ==> List - - C == with - factor : (P,UFactor) -> Factored P - ++ factor(p,ufact) factors the multivariate polynomial p - ++ by specializing variables and calling the univariate - ++ factorizer ufact. - factor : (USP,UFactor) -> Factored USP - ++ factor(p,ufact) factors the multivariate polynomial p - ++ by specializing variables and calling the univariate - ++ factorizer ufact. p is represented as a univariate - ++ polynomial with multivariate coefficients. - - T == add - - NNI ==> NonNegativeInteger - - LeadFact ==> Record(polfac:L P,correct:R,corrfact:L BP) - ContPrim ==> Record(cont:P,prim:P) - ParFact ==> Record(irr:BP,pow:Z) - FinalFact ==> Record(contp:R,factors:L ParFact) - NewOrd ==> Record(npol:USP,nvar:L OV,newdeg:L NNI) - pmod:R := (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R - - import GenExEuclid(R,BP) - import MultivariateLifting(E,OV,R,P) - import FactoringUtilities(E,OV,R,P) - import LeadingCoefDetermination(OV,E,R,P) - Valuf ==> Record(inval:L L R,unvfact:L BP,lu:R,complead:L R) - UPCF2 ==> UnivariatePolynomialCategoryFunctions2 - - ---- Local Functions ---- - mFactor : (P,UFactor) -> MFinalFact - supFactor : (USP,UFactor) -> SUPFinalFact - mfconst : (USP,L OV,L NNI,UFactor) -> L USP - mfpol : (USP,L OV,L NNI,UFactor) -> L USP - monicMfpol: (USP,L OV,L NNI,UFactor) -> L USP - varChoose : (P,L OV,L NNI) -> NewOrd - simplify : (P,L OV,L NNI,UFactor) -> MFinalFact - intChoose : (USP,L OV,R,L P,L L R,UFactor) -> Union(Valuf,"failed") - intfact : (USP,L OV,L NNI,MFinalFact,L L R,UFactor) -> L USP - pretest : (P,NNI,L OV,L R) -> FinalFact - checkzero : (USP,BP) -> Boolean - localNorm : L BP -> Z - - convertPUP(lfg:MFinalFact): SUPFinalFact == - [lfg.contp,[[lff.irr ::USP,lff.pow]$SUParFact - for lff in lfg.factors]]$SUPFinalFact - - -- intermediate routine if an SUP was passed in. - supFactor(um:USP,ufactor:UFactor) : SUPFinalFact == - ground?(um) => convertPUP(mFactor(ground um,ufactor)) - lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um] - empty? lvar => -- the polynomial is univariate - umv:= map(ground,um)$UPCF2(P,USP,R,BP) - lfact:=ufactor umv - [retract unit lfact,[[map(coerce,ff.factor)$UPCF2(R,BP,P,USP), - ff.exponent] for ff in factors lfact]]$SUPFinalFact - lcont:P - lf:L USP - flead : SUPFinalFact:=[0,empty()]$SUPFinalFact - factorlist:L SUParFact :=empty() - - mdeg :=minimumDegree um ---- is the Mindeg > 0? ---- - if mdeg>0 then - f1:USP:=monomial(1,mdeg) - um:=(um exquo f1)::USP - factorlist:=cons([monomial(1,1),mdeg],factorlist) - if degree um=0 then return - lfg:=convertPUP mFactor(ground um, ufactor) - [lfg.contp,append(factorlist,lfg.factors)] - uum:=unitNormal um - um :=uum.canonical - sqfacs := squareFree(um)$MultivariateSquareFree(E,OV,R,P) - lcont := ground(uum.unit * unit sqfacs) - ---- Factorize the content ---- - flead:=convertPUP mFactor(lcont,ufactor) - factorlist:=append(flead.factors,factorlist) - ---- Make the polynomial square-free ---- - sqqfact:=factors sqfacs - --- Factorize the primitive square-free terms --- - for fact in sqqfact repeat - ffactor:USP:=fact.factor - ffexp:=fact.exponent - zero? degree ffactor => - lfg:=mFactor(ground ffactor,ufactor) - lcont:=lfg.contp * lcont - factorlist := append(factorlist, - [[lff.irr ::USP,lff.pow * ffexp]$SUParFact - for lff in lfg.factors]) - coefs := coefficients ffactor - ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar] - lf := - ground?(leadingCoefficient ffactor) => - mfconst(ffactor,lvar,ldeg,ufactor) - mfpol(ffactor,lvar,ldeg,ufactor) - auxfl:=[[lfp,ffexp]$SUParFact for lfp in lf] - factorlist:=append(factorlist,auxfl) - lcfacs := */[leadingCoefficient leadingCoefficient(f.irr)**((f.pow)::NNI) - for f in factorlist] - [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R, - factorlist]$SUPFinalFact - - factor(um:USP,ufactor:UFactor):Factored USP == - flist := supFactor(um,ufactor) - (flist.contp):: P :: USP * - (*/[primeFactor(u.irr,u.pow) for u in flist.factors]) - - checkzero(u:USP,um:BP) : Boolean == - u=0 => um =0 - um = 0 => false - degree u = degree um => checkzero(reductum u, reductum um) - false - --- Choose the variable of less degree --- - varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd == - k:="min"/[d for d in ldeg] - k=degree(m,first lvar) => - [univariate(m,first lvar),lvar,ldeg]$NewOrd - i:=position(k,ldeg) - x:OV:=lvar.i - ldeg:=cons(k,delete(ldeg,i)) - lvar:=cons(x,delete(lvar,i)) - [univariate(m,x),lvar,ldeg]$NewOrd - - localNorm(lum: L BP): Z == - R is AlgebraicNumber => - "max"/[numberOfMonomials ff for ff in lum] - - "max"/[+/[euclideanSize cc for i in 0..degree ff| - (cc:= coefficient(ff,i))^=0] for ff in lum] - - --- Choose the integer to reduce to univariate case --- - intChoose(um:USP,lvar:L OV,clc:R,plist:L P,ltry:L L R, - ufactor:UFactor) : Union(Valuf,"failed") == - -- declarations - degum:NNI := degree um - nvar1:=#lvar - range:NNI:=5 - unifact:L BP - ctf1 : R := 1 - testp:Boolean := -- polynomial leading coefficient - empty? plist => false - true - leadcomp,leadcomp1 : L R - leadcomp:=leadcomp1:=empty() - nfatt:NNI := degum+1 - lffc:R:=1 - lffc1:=lffc - newunifact : L BP:=empty() - leadtest:=true --- the lc test with polCase has to be performed - int:L R:=empty() - - -- New sets of integers are chosen to reduce the multivariate problem to - -- a univariate one, until we find twice the - -- same (and minimal) number of "univariate" factors: - -- the set smaller in modulo is chosen. - -- Note that there is no guarantee that this is the truth: - -- merely the closest approximation we have found! - - while true repeat - testp and #ltry>10 => return "failed" - lval := [ ran(range) for i in 1..nvar1] - member?(lval,ltry) => range:=2*range - ltry := cons(lval,ltry) - leadcomp1:=[retract eval(pol,lvar,lval) for pol in plist] - testp and or/[unit? epl for epl in leadcomp1] => range:=2*range - newm:BP:=completeEval(um,lvar,lval) - degum ^= degree newm or minimumDegree newm ^=0 => range:=2*range - lffc1:=content newm - newm:=(newm exquo lffc1)::BP - testp and leadtest and ^ polCase(lffc1*clc,#plist,leadcomp1) - => range:=2*range - degree(gcd [newm,differentiate(newm)])^=0 => range:=2*range - luniv:=ufactor(newm) - lunivf:= factors luniv - lffc1:R:=retract(unit luniv)@R * lffc1 - nf:= #lunivf - - nf=0 or nf>nfatt => "next values" --- pretest failed --- - - --- the univariate polynomial is irreducible --- - if nf=1 then leave (unifact:=[newm]) - - -- the new integer give the same number of factors - nfatt = nf => - -- if this is the first univariate factorization with polCase=true - -- or if the last factorization has smaller norm and satisfies - -- polCase - if leadtest or - ((localNorm unifact > localNorm [ff.factor for ff in lunivf]) - and (^testp or polCase(lffc1*clc,#plist,leadcomp1))) then - unifact:=[uf.factor for uf in lunivf] - int:=lval - lffc:=lffc1 - if testp then leadcomp:=leadcomp1 - leave "foundit" - - -- the first univariate factorization, inizialize - nfatt > degum => - unifact:=[uf.factor for uf in lunivf] - lffc:=lffc1 - if testp then leadcomp:=leadcomp1 - int:=lval - leadtest := false - nfatt := nf - - nfatt>nf => -- for the previous values there were more factors - if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp) - else leadtest:= false - -- if polCase=true we can consider the univariate decomposition - if ^leadtest then - unifact:=[uf.factor for uf in lunivf] - lffc:=lffc1 - if testp then leadcomp:=leadcomp1 - int:=lval - nfatt := nf - [cons(int,ltry),unifact,lffc,leadcomp]$Valuf - - - ---- The polynomial has mindeg>0 ---- - - simplify(m:P,lvar:L OV,lmdeg:L NNI,ufactor:UFactor):MFinalFact == - factorlist:L MParFact:=[] - pol1:P:= 1$P - for x in lvar repeat - i := lmdeg.(position(x,lvar)) - i=0 => "next value" - pol1:=pol1*monomial(1$P,x,i) - factorlist:=cons([x::P,i]$MParFact,factorlist) - m := (m exquo pol1)::P - ground? m => [retract m,factorlist]$MFinalFact - flead:=mFactor(m,ufactor) - flead.factors:=append(factorlist,flead.factors) - flead - - -- This is the key internal function - -- We now know that the polynomial is square-free etc., - -- We use intChoose to find a set of integer values to reduce the - -- problem to univariate (and for efficiency, intChoose returns - -- the univariate factors). - -- In the case of a polynomial leading coefficient, we check that this - -- is consistent with leading coefficient determination (else try again) - -- We then lift the univariate factors to multivariate factors, and - -- return the result - intfact(um:USP,lvar: L OV,ldeg:L NNI,tleadpol:MFinalFact, - ltry:L L R,ufactor:UFactor) : L USP == - polcase:Boolean:=(not empty? tleadpol.factors) - vfchoo:Valuf:= - polcase => - leadpol:L P:=[ff.irr for ff in tleadpol.factors] - check:=intChoose(um,lvar,tleadpol.contp,leadpol,ltry,ufactor) - check case "failed" => return monicMfpol(um,lvar,ldeg,ufactor) - check::Valuf - intChoose(um,lvar,1,empty(),empty(),ufactor)::Valuf - unifact:List BP := vfchoo.unvfact - nfact:NNI := #unifact - nfact=1 => [um] - ltry:L L R:= vfchoo.inval - lval:L R:=first ltry - dd:= vfchoo.lu - leadval:L R:=empty() - lpol:List P:=empty() - if polcase then - leadval := vfchoo.complead - distf := distFact(vfchoo.lu,unifact,tleadpol,leadval,lvar,lval) - distf case "failed" => - return intfact(um,lvar,ldeg,tleadpol,ltry,ufactor) - dist := distf :: LeadFact - -- check the factorization of leading coefficient - lpol:= dist.polfac - dd := dist.correct - unifact:=dist.corrfact - if dd^=1 then --- if polcase then lpol := [unitCanonical lp for lp in lpol] --- dd:=unitCanonical(dd) - unifact := [dd * unif for unif in unifact] - umd := unitNormal(dd).unit * ((dd**(nfact-1)::NNI)::P)*um - else umd := um - (ffin:=lifting(umd,lvar,unifact,lval,lpol,ldeg,pmod)) - case "failed" => intfact(um,lvar,ldeg,tleadpol,ltry,ufactor) - factfin: L USP:=ffin :: L USP - if dd^=1 then - factfin:=[primitivePart ff for ff in factfin] - factfin - - ---- m square-free,primitive,lc constant ---- - mfconst(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP == - factfin:L USP:=empty() - empty? lvar => - lum:=factors ufactor(map(ground,um)$UPCF2(P,USP,R,BP)) - [map(coerce,uf.factor)$UPCF2(R,BP,P,USP) for uf in lum] - intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty(),ufactor) - - monicize(um:USP,c:P):USP == - n:=degree(um) - ans:USP := monomial(1,n) - n:=(n-1)::NonNegativeInteger - prod:P:=1 - while (um:=reductum(um)) ^= 0 repeat - i := degree um - lc := leadingCoefficient um - prod := prod * c ** (n-(n:=i))::NonNegativeInteger - ans := ans + monomial(prod*lc, i) - ans - - unmonicize(m:USP,c:P):USP == primitivePart m(monomial(c,1)) - - --- m is square-free,primitive,lc is a polynomial --- - monicMfpol(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP == - l := leadingCoefficient um - monpol := monicize(um,l) - nldeg := degree(monpol,lvar) - map(unmonicize(#1,l), - mfconst(monpol,lvar,nldeg,ufactor)) - - mfpol(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP == - R has Field => - monicMfpol(um,lvar,ldeg,ufactor) - tleadpol:=mFactor(leadingCoefficient um,ufactor) - intfact(um,lvar,ldeg,tleadpol,[],ufactor) - - mFactor(m:P,ufactor:UFactor) : MFinalFact == - ground?(m) => [retract(m),empty()]$MFinalFact - lvar:L OV:= variables m - lcont:P - lf:L USP - flead : MFinalFact:=[0,empty()]$MFinalFact - factorlist:L MParFact :=empty() - - lmdeg :=minimumDegree(m,lvar) ---- is the Mindeg > 0? ---- - or/[n>0 for n in lmdeg] => simplify(m,lvar,lmdeg,ufactor) - - sqfacs := squareFree m - lcont := unit sqfacs - - ---- Factorize the content ---- - if ground? lcont then flead.contp:=retract lcont - else flead:=mFactor(lcont,ufactor) - factorlist:=flead.factors - - - - ---- Make the polynomial square-free ---- - sqqfact:=factors sqfacs - - --- Factorize the primitive square-free terms --- - for fact in sqqfact repeat - ffactor:P:=fact.factor - ffexp := fact.exponent - lvar := variables ffactor - x:OV :=lvar.first - ldeg:=degree(ffactor,lvar) - --- Is the polynomial linear in one of the variables ? --- - member?(1,ldeg) => - x:OV:=lvar.position(1,ldeg) - lcont:= gcd coefficients(univariate(ffactor,x)) - ffactor:=(ffactor exquo lcont)::P - factorlist:=cons([ffactor,ffexp]$MParFact,factorlist) - for lcterm in mFactor(lcont,ufactor).factors repeat - factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist) - - varch:=varChoose(ffactor,lvar,ldeg) - um:=varch.npol - - x:=lvar.first - ldeg:=ldeg.rest - lvar := lvar.rest - if varch.nvar.first ^= x then - lvar:= varch.nvar - x := lvar.first - lvar := lvar.rest - pc:= gcd coefficients um - if pc^=1 then - um:=(um exquo pc)::USP - ffactor:=multivariate(um,x) - for lcterm in mFactor(pc,ufactor).factors repeat - factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist) - ldeg:=degree(ffactor,lvar) - um := unitCanonical um - if ground?(leadingCoefficient um) then - lf:= mfconst(um,lvar,ldeg,ufactor) - else lf:=mfpol(um,lvar,ldeg,ufactor) - auxfl:=[[unitCanonical multivariate(lfp,x),ffexp]$MParFact for lfp in lf] - factorlist:=append(factorlist,auxfl) - lcfacs := */[leadingCoefficient(f.irr)**((f.pow)::NNI) for f in factorlist] - [(leadingCoefficient(m) exquo lcfacs):: R,factorlist]$MFinalFact - - factor(m:P,ufactor:UFactor):Factored P == - flist := mFactor(m,ufactor) - (flist.contp):: P * - (*/[primeFactor(u.irr,u.pow) for u in flist.factors]) - -@ -\section{package MULTFACT MultivariateFactorize} -<>= -)abbrev package MULTFACT MultivariateFactorize -++ Author: P. Gianni -++ Date Created: 1983 -++ Date Last Updated: Sept. 1990 -++ Basic Functions: -++ Related Constructors: MultFiniteFactorize, AlgebraicMultFact, UnivariateFactorize -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This is the top level package for doing multivariate factorization -++ over basic domains like \spadtype{Integer} or \spadtype{Fraction Integer}. - -MultivariateFactorize(OV,E,R,P) : C == T - where - R : Join(EuclideanDomain, CharacteristicZero) - -- with factor on R[x] - OV : OrderedSet - E : OrderedAbelianMonoidSup - P : PolynomialCategory(R,E,OV) - Z ==> Integer - MParFact ==> Record(irr:P,pow:Z) - USP ==> SparseUnivariatePolynomial P - SUParFact ==> Record(irr:USP,pow:Z) - SUPFinalFact ==> Record(contp:R,factors:List SUParFact) - MFinalFact ==> Record(contp:R,factors:List MParFact) - - -- contp = content, - -- factors = List of irreducible factors with exponent - L ==> List - - C == with - factor : P -> Factored P - ++ factor(p) factors the multivariate polynomial p over its coefficient - ++ domain - factor : USP -> Factored USP - ++ factor(p) factors the multivariate polynomial p over its coefficient - ++ domain where p is represented as a univariate polynomial with - ++ multivariate coefficients - T == add - factor(p:P) : Factored P == - R is Fraction Integer => - factor(p)$MRationalFactorize(E,OV,Integer,P) - R is Fraction Complex Integer => - factor(p)$MRationalFactorize(E,OV,Complex Integer,P) - R is Fraction Polynomial Integer and OV has convert: % -> Symbol => - factor(p)$MPolyCatRationalFunctionFactorizer(E,OV,Integer,P) - factor(p,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P) - - factor(up:USP) : Factored USP == - factor(up,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P) - -@ -\section{package ALGMFACT AlgebraicMultFact} -<>= -)abbrev package ALGMFACT AlgebraicMultFact -++ Author: P. Gianni -++ Date Created: 1990 -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package factors multivariate polynomials over the -++ domain of \spadtype{AlgebraicNumber} by allowing the user -++ to specify a list of algebraic numbers generating the particular -++ extension to factor over. - -AlgebraicMultFact(OV,E,P) : C == T - where - AN ==> AlgebraicNumber - OV : OrderedSet - E : OrderedAbelianMonoidSup - P : PolynomialCategory(AN,E,OV) - BP ==> SparseUnivariatePolynomial AN - Z ==> Integer - MParFact ==> Record(irr:P,pow:Z) - USP ==> SparseUnivariatePolynomial P - SUParFact ==> Record(irr:USP,pow:Z) - SUPFinalFact ==> Record(contp:R,factors:List SUParFact) - MFinalFact ==> Record(contp:R,factors:List MParFact) - - -- contp = content, - -- factors = List of irreducible factors with exponent - L ==> List - - C == with - factor : (P,L AN) -> Factored P - ++ factor(p,lan) factors the polynomial p over the extension - ++ generated by the algebraic numbers given by the list lan. - factor : (USP,L AN) -> Factored USP - ++ factor(p,lan) factors the polynomial p over the extension - ++ generated by the algebraic numbers given by the list lan. - ++ p is presented as a univariate polynomial with multivariate - ++ coefficients. - T == add - AF := AlgFactor(BP) - - factor(p:P,lalg:L AN) : Factored P == - factor(p,factor(#1,lalg)$AF)$InnerMultFact(OV,E,AN,P) - - factor(up:USP,lalg:L AN) : Factored USP == - factor(up,factor(#1,lalg)$AF)$InnerMultFact(OV,E,AN,P) - -@ -\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/multpoly.spad.pamphlet b/src/algebra/multpoly.spad.pamphlet deleted file mode 100644 index 40ad269..0000000 --- a/src/algebra/multpoly.spad.pamphlet +++ /dev/null @@ -1,81 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra multpoly.spad} -\author{Dave Barton, Barry Trager, James Davenport} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package POLY2 PolynomialFunctions2} -<>= -)abbrev package POLY2 PolynomialFunctions2 -++ Author: -++ Date Created: -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package takes a mapping between coefficient rings, and lifts -++ it to a mapping between polynomials over those rings. - -PolynomialFunctions2(R:Ring, S:Ring): with - map: (R -> S, Polynomial R) -> Polynomial S - ++ map(f, p) produces a new polynomial as a result of applying - ++ the function f to every coefficient of the polynomial p. - == add - map(f, p) == map(#1::Polynomial(S), f(#1)::Polynomial(S), - p)$PolynomialCategoryLifting(IndexedExponents Symbol, - Symbol, R, Polynomial R, Polynomial S) - - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/multsqfr.spad.pamphlet b/src/algebra/multsqfr.spad.pamphlet deleted file mode 100644 index 271d61b..0000000 --- a/src/algebra/multsqfr.spad.pamphlet +++ /dev/null @@ -1,395 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra multsqfr.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MULTSQFR MultivariateSquareFree} -<>= -)abbrev package MULTSQFR MultivariateSquareFree -++ Author : P.Gianni -++ This package provides the functions for the computation of the square -++ free decomposition of a multivariate polynomial. -++ It uses the package GenExEuclid for the resolution of -++ the equation \spad{Af + Bg = h} and its generalization to n polynomials -++ over an integral domain and the package \spad{MultivariateLifting} -++ for the "multivariate" lifting. - -MultivariateSquareFree (E,OV,R,P) : C == T where - Z ==> Integer - NNI ==> NonNegativeInteger - R : EuclideanDomain - OV : OrderedSet - E : OrderedAbelianMonoidSup - P : PolynomialCategory(R,E,OV) - SUP ==> SparseUnivariatePolynomial P - - BP ==> SparseUnivariatePolynomial(R) - fUnion ==> Union("nil","sqfr","irred","prime") - ffSUP ==> Record(flg:fUnion,fctr:SUP,xpnt:Integer) - ffP ==> Record(flg:fUnion,fctr:P,xpnt:Integer) - FFE ==> Record(factor:BP,exponent:Z) - FFEP ==> Record(factor:P,exponent:Z) - FFES ==> Record(factor:SUP,exponent:Z) - Choice ==> Record(upol:BP,Lval:List(R),Lfact:List FFE,ctpol:R) - squareForm ==> Record(unitPart:P,suPart:List FFES) - Twopol ==> Record(pol:SUP,polval:BP) - UPCF2 ==> UnivariatePolynomialCategoryFunctions2 - - - C == with - squareFree : P -> Factored P - ++ squareFree(p) computes the square free - ++ decomposition of a multivariate polynomial p. - squareFree : SUP -> Factored SUP - ++ squareFree(p) computes the square free - ++ decomposition of a multivariate polynomial p presented as - ++ a univariate polynomial with multivariate coefficients. - squareFreePrim : P -> Factored P - ++ squareFreePrim(p) compute the square free decomposition - ++ of a primitive multivariate polynomial p. - - - - ---- local functions ---- - compdegd : List FFE -> Z - ++ compdegd should be local - univcase : (P,OV) -> Factored(P) - ++ univcase should be local - consnewpol : (SUP,BP,Z) -> Twopol - ++ consnewpol should be local - nsqfree : (SUP,List(OV), List List R) -> squareForm - ++ nsqfree should be local - intChoose : (SUP,List(OV),List List R) -> Choice - ++ intChoose should be local - coefChoose : (Z,Factored P) -> P - ++ coefChoose should be local - check : (List(FFE),List(FFE)) -> Boolean - ++ check should be local - lift : (SUP,BP,BP,P,List(OV),List(NNI),List(R)) -> Union(List(SUP),"failed") - ++ lift should be local - myDegree : (SUP,List OV,NNI) -> List NNI - ++ myDegree should be local - normDeriv2 : (BP,Z) -> BP - ++ normDeriv2 should be local - - - - T == add - - pmod:R := (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R - - - import GenExEuclid() - import MultivariateLifting(E,OV,R,P) - import PolynomialGcdPackage(E,OV,R,P) - import FactoringUtilities(E,OV,R,P) - import IntegerCombinatoricFunctions(Z) - - - ---- Are the univariate square-free decompositions consistent? ---- - - ---- new square-free algorithm for primitive polynomial ---- - nsqfree(oldf:SUP,lvar:List(OV),ltry:List List R) : squareForm == - f:=oldf - univPol := intChoose(f,lvar,ltry) --- debug msg --- if not empty? ltry then output("ltry =", (ltry::OutputForm))$OutputPackage - f0:=univPol.upol - --the polynomial is square-free - f0=1$BP => [1$P,[[f,1]$FFES]]$squareForm - lfact:List(FFE):=univPol.Lfact - lval:=univPol.Lval - ctf:=univPol.ctpol - leadpol:Boolean:=false - sqdec:List FFES := empty() - exp0:Z:=0 - unitsq:P:=1 - lcf:P:=leadingCoefficient f - if ctf^=1 then - f0:=ctf*f0 - f:=(ctf::P)*f - lcf:=ctf*lcf - sqlead:List FFEP:= empty() - sqlc:Factored P:=1 - if lcf^=1$P then - leadpol:=true - sqlc:=squareFree lcf - unitsq:=unitsq*(unit sqlc) - sqlead:= factors sqlc - lfact:=sort(#1.exponent > #2.exponent,lfact) - while lfact^=[] repeat - pfact:=lfact.first - (g0,exp0):=(pfact.factor,pfact.exponent) - lfact:=lfact.rest - lfact=[] and exp0 =1 => - f := (f exquo (ctf::P))::SUP - gg := unitNormal leadingCoefficient f - sqdec:=cons([gg.associate*f,exp0],sqdec) - return [gg.unit, sqdec]$squareForm - if ctf^=1 then g0:=ctf*g0 - npol:=consnewpol(f,f0,exp0) - (d,d0):=(npol.pol,npol.polval) - if leadpol then lcoef:=coefChoose(exp0,sqlc) - else lcoef:=1$P - ldeg:=myDegree(f,lvar,exp0::NNI) - result:=lift(d,g0,(d0 exquo g0)::BP,lcoef,lvar,ldeg,lval) - result case "failed" => return nsqfree(oldf,lvar,ltry) - result0:SUP:= (result::List SUP).1 - r1:SUP:=result0**(exp0:NNI) - if (h:=f exquo r1) case "failed" then return nsqfree(oldf,lvar,empty()) - sqdec:=cons([result0,exp0],sqdec) - f:=h::SUP - f0:=completeEval(h,lvar,lval) - lcr:P:=leadingCoefficient result0 - if leadpol and lcr^=1$P then - for lpfact in sqlead while lcr^=1 repeat - ground? lcr => - unitsq:=(unitsq exquo lcr)::P - lcr:=1$P - (h1:=lcr exquo lpfact.factor) case "failed" => "next" - lcr:=h1::P - lpfact.exponent:=(lpfact.exponent)-exp0 - [((retract f) exquo ctf)::P,sqdec]$squareForm - - - squareFree(f:SUP) : Factored SUP == - degree f =0 => - fu:=squareFree retract f - makeFR((unit fu)::SUP,[["sqfr",ff.fctr::SUP,ff.xpnt] - for ff in factorList fu]) - lvar:= "setUnion"/[variables cf for cf in coefficients f] - empty? lvar => -- the polynomial is univariate - upol:=map(ground,f)$UPCF2(P,SUP,R,BP) - usqfr:=squareFree upol - makeFR(map(coerce,unit usqfr)$UPCF2(R,BP,P,SUP), - [["sqfr",map(coerce,ff.fctr)$UPCF2(R,BP,P,SUP),ff.xpnt] - for ff in factorList usqfr]) - - lcf:=content f - f:=(f exquo lcf) ::SUP - lcSq:=squareFree lcf - lfs:List ffSUP:=[["sqfr",ff.fctr ::SUP,ff.xpnt] - for ff in factorList lcSq] - partSq:=nsqfree(f,lvar,empty()) - - lfs:=append([["sqfr",fu.factor,fu.exponent]$ffSUP - for fu in partSq.suPart],lfs) - makeFR((unit lcSq * partSq.unitPart) ::SUP,lfs) - - squareFree(f:P) : Factored P == - ground? f => makeFR(f,[]) --- the polynomial is constant --- - - lvar:List(OV):=variables(f) - result1:List ffP:= empty() - - lmdeg :=minimumDegree(f,lvar) --- is the mindeg > 0 ? --- - p:P:=1$P - for im in 1..#lvar repeat - (n:=lmdeg.im)=0 => "next im" - y:=lvar.im - p:=p*monomial(1$P,y,n) - result1:=cons(["sqfr",y::P,n],result1) - if p^=1$P then - f := (f exquo p)::P - if ground? f then return makeFR(f, result1) - lvar:=variables(f) - - - #lvar=1 => --- the polynomial is univariate --- - result:=univcase(f,lvar.first) - makeFR(unit result,append(result1,factorList result)) - - ldeg:=degree(f,lvar) --- general case --- - m:="min"/[j for j in ldeg|j^=0] - i:Z:=1 - for j in ldeg while j>m repeat i:=i+1 - x:=lvar.i - lvar:=delete(lvar,i) - f0:=univariate (f,x) - lcont:P:= content f0 - nsqfftot:=nsqfree((f0 exquo lcont)::SUP,lvar,empty()) - nsqff:List ffP:=[["sqfr",multivariate(fu.factor,x),fu.exponent]$ffP - for fu in nsqfftot.suPart] - result1:=append(result1,nsqff) - ground? lcont => makeFR(lcont*nsqfftot.unitPart,result1) - sqlead:=squareFree(lcont) - makeFR(unit sqlead*nsqfftot.unitPart,append(result1,factorList sqlead)) - - -- Choose the integer for the evaluation. -- - -- If the polynomial is square-free the function returns upol=1. -- - - intChoose(f:SUP,lvar:List(OV),ltry:List List R):Choice == - degf:= degree f - try:NNI:=0 - nvr:=#lvar - range:Z:=10 - lfact1:List(FFE):=[] - lval1:List R := [] - lfact:List(FFE) - ctf1:R:=1 - f1:BP:=1$BP - d1:Z - while range<10000000000 repeat - range:=2*range - lval:= [ran(range) for i in 1..nvr] - member?(lval,ltry) => "new integer" - ltry:=cons(lval,ltry) - f0:=completeEval(f,lvar,lval) - degree f0 ^=degf => "new integer" - ctf:=content f0 - lfact:List(FFE):=factors(squareFree((f0 exquo (ctf:R)::BP)::BP)) - - ---- the univariate polynomial is square-free ---- - if #lfact=1 and (lfact.1).exponent=1 then - return [1$BP,lval,lfact,1$R]$Choice - - d0:=compdegd lfact - ---- inizialize lfact1 ---- - try=0 => - f1:=f0 - lfact1:=lfact - ctf1:=ctf - lval1:=lval - d1:=d0 - try:=1 - d0=d1 => - return [f1,lval1,lfact1,ctf1]$Choice - d0 < d1 => - try:=1 - f1:=f0 - lfact1:=lfact - ctf1:=ctf - lval1:=lval - d1:=d0 - - - ---- Choose the leading coefficient for the lifting ---- - coefChoose(exp:Z,sqlead:Factored(P)) : P == - lcoef:P:=unit(sqlead) - for term in factors(sqlead) repeat - texp:=term.exponent - texp "next term" - texp=exp => lcoef:=lcoef*term.factor - lcoef:=lcoef*(term.factor)**((texp quo exp)::NNI) - lcoef - - ---- Construction of the polynomials for the lifting ---- - consnewpol(g:SUP,g0:BP,deg:Z):Twopol == - deg=1 => [g,g0]$Twopol - deg:=deg-1 - [normalDeriv(g,deg),normDeriv2(g0,deg)]$Twopol - - ---- lift the univariate square-free factor ---- - lift(ud:SUP,g0:BP,g1:BP,lcoef:P,lvar:List(OV), - ldeg:List(NNI),lval:List(R)) : Union(List SUP,"failed") == - leadpol:Boolean:=false - lcd:P:=leadingCoefficient ud - leadlist:List(P):=empty() - - if ^ground?(leadingCoefficient ud) then - leadpol:=true - ud:=lcoef*ud - lcg0:R:=leadingCoefficient g0 - if ground? lcoef then g0:=retract(lcoef) quo lcg0 *g0 - else g0:=(retract(eval(lcoef,lvar,lval)) quo lcg0) * g0 - g1:=lcg0*g1 - leadlist:=[lcoef,lcd] - plist:=lifting(ud,lvar,[g0,g1],lval,leadlist,ldeg,pmod) - plist case "failed" => "failed" - (p0:SUP,p1:SUP):=((plist::List SUP).1,(plist::List SUP).2) - if completeEval(p0,lvar,lval) ^= g0 then (p0,p1):=(p1,p0) - [primitivePart p0,primitivePart p1] - - ---- the polynomial is univariate ---- - univcase(f:P,x:OV) : Factored(P) == - uf := univariate f - cf:=content uf - uf :=(uf exquo cf)::BP - result:Factored BP:=squareFree uf - makeFR(multivariate(cf*unit result,x), - [["sqfr",multivariate(term.factor,x),term.exponent] - for term in factors result]) - --- squareFreePrim(p:P) : Factored P == --- -- p is content free --- ground? p => makeFR(p,[]) --- the polynomial is constant --- --- --- lvar:List(OV):=variables p --- #lvar=1 => --- the polynomial is univariate --- --- univcase(p,lvar.first) --- nsqfree(p,lvar,1) - - compdegd(lfact:List(FFE)) : Z == - ris:Z:=0 - for pfact in lfact repeat - ris:=ris+(pfact.exponent -1)*degree pfact.factor - ris - - normDeriv2(f:BP,m:Z) : BP == - (n1:Z:=degree f) < m => 0$BP - n1=m => (leadingCoefficient f)::BP - k:=binomial(n1,m) - ris:BP:=0$BP - n:Z:=n1 - while n>= m repeat - while n1>n repeat - k:=(k*(n1-m)) quo n1 - n1:=n1-1 - ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI) - f:=reductum f - n:=degree f - ris - - myDegree(f:SUP,lvar:List OV,exp:NNI) : List NNI== - [n quo exp for n in degree(f,lvar)] - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 0214d1b..b049c62 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -923,5 +923,7 @@ help documentation fixes and packages
bookvol10.4 add packages
20090201.02.tpd.patch bookvol10.4 add packages
+20090203.01.tpd.patch +bookvol10.4 add packages