diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index 22cd0cd..875dfd7 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -1689,6 +1689,201 @@ BrillhartTests(UP): Exports == Implementation where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter C} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CARTEN2 CartesianTensorFunctions2} +\pagehead{CartesianTensorFunctions2}{CARTEN2} +\pagepic{ps/v104cartesiantensorfunctions2.ps}{CARTEN2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CARTEN2 CartesianTensorFunctions2 +++ Author: Stephen M. Watt +++ Date Created: December 1986 +++ Date Last Updated: May 30, 1991 +++ Basic Operations: reshape, map +++ Related Domains: CartesianTensor +++ Also See: +++ AMS Classifications: +++ Keywords: tensor +++ Examples: +++ References: +++ Description: +++ This package provides functions to enable conversion of tensors +++ given conversion of the components. + +CartesianTensorFunctions2(minix, dim, S, T): CTPcat == CTPdef where + minix: Integer + dim: NonNegativeInteger + S, T: CommutativeRing + CS ==> CartesianTensor(minix, dim, S) + CT ==> CartesianTensor(minix, dim, T) + + CTPcat == with + reshape: (List T, CS) -> CT + ++ reshape(lt,ts) organizes the list of components lt into + ++ a tensor with the same shape as ts. + map: (S->T, CS) -> CT + ++ map(f,ts) does a componentwise conversion of the tensor ts + ++ to a tensor with components of type T. + CTPdef == add + reshape(l, s) == unravel l + map(f, s) == unravel [f e for e in ravel s] + +@ +<>= +"CARTEN2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CARTEN2"] +"BMODULE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BMODULE"] +"CARTEN2" -> "BMODULE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CHVAR ChangeOfVariable} +\pagehead{ChangeOfVariable}{CHVAR} +\pagepic{ps/v104changeofvariable.ps}{CHVAR}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CHVAR ChangeOfVariable +++ Sends a point to infinity +++ Author: Manuel Bronstein +++ Date Created: 1988 +++ Date Last Updated: 22 Feb 1990 +++ Description: +++ Tools to send a point to infinity on an algebraic curve. +ChangeOfVariable(F, UP, UPUP): Exports == Implementation where + F : UniqueFactorizationDomain + UP : UnivariatePolynomialCategory F + UPUP: UnivariatePolynomialCategory Fraction UP + + N ==> NonNegativeInteger + Z ==> Integer + Q ==> Fraction Z + RF ==> Fraction UP + + Exports ==> with + mkIntegral: UPUP -> Record(coef:RF, poly:UPUP) + ++ mkIntegral(p(x,y)) returns \spad{[c(x), q(x,z)]} such that + ++ \spad{z = c * y} is integral. + ++ The algebraic relation between x and y is \spad{p(x, y) = 0}. + ++ The algebraic relation between x and z is \spad{q(x, z) = 0}. + radPoly : UPUP -> Union(Record(radicand:RF, deg:N), "failed") + ++ radPoly(p(x, y)) returns \spad{[c(x), n]} if p is of the form + ++ \spad{y**n - c(x)}, "failed" otherwise. + rootPoly : (RF, N) -> Record(exponent: N, coef:RF, radicand:UP) + ++ rootPoly(g, n) returns \spad{[m, c, P]} such that + ++ \spad{c * g ** (1/n) = P ** (1/m)} + ++ thus if \spad{y**n = g}, then \spad{z**m = P} + ++ where \spad{z = c * y}. + goodPoint : (UPUP,UPUP) -> F + ++ goodPoint(p, q) returns an integer a such that a is neither + ++ a pole of \spad{p(x,y)} nor a branch point of \spad{q(x,y) = 0}. + eval : (UPUP, RF, RF) -> UPUP + ++ eval(p(x,y), f(x), g(x)) returns \spad{p(f(x), y * g(x))}. + chvar : (UPUP,UPUP) -> Record(func:UPUP,poly:UPUP,c1:RF,c2:RF,deg:N) + ++ chvar(f(x,y), p(x,y)) returns + ++ \spad{[g(z,t), q(z,t), c1(z), c2(z), n]} + ++ such that under the change of variable + ++ \spad{x = c1(z)}, \spad{y = t * c2(z)}, + ++ one gets \spad{f(x,y) = g(z,t)}. + ++ The algebraic relation between x and y is \spad{p(x, y) = 0}. + ++ The algebraic relation between z and t is \spad{q(z, t) = 0}. + + Implementation ==> add + import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) + + algPoly : UPUP -> Record(coef:RF, poly:UPUP) + RPrim : (UP, UP, UPUP) -> Record(coef:RF, poly:UPUP) + good? : (F, UP, UP) -> Boolean + infIntegral?: (UPUP, UPUP) -> Boolean + + eval(p, x, y) == map(#1 x, p) monomial(y, 1) + good?(a, p, q) == p(a) ^= 0 and q(a) ^= 0 + + algPoly p == + ground?(a:= retract(leadingCoefficient(q:=clearDenominator p))@UP) + => RPrim(1, a, q) + c := d := squareFreePart a + q := clearDenominator q monomial(inv(d::RF), 1) + while not ground?(a := retract(leadingCoefficient q)@UP) repeat + c := c * (d := gcd(a, d)) + q := clearDenominator q monomial(inv(d::RF), 1) + RPrim(c, a, q) + + RPrim(c, a, q) == +-- one? a => [c::RF, q] + (a = 1) => [c::RF, q] + [(a * c)::RF, clearDenominator q monomial(inv(a::RF), 1)] + +-- always makes the algebraic integral, but does not send a point to infinity +-- if the integrand does not have a pole there (in the case of an nth-root) + chvar(f, modulus) == + r1 := mkIntegral modulus + f1 := f monomial(r1inv := inv(r1.coef), 1) + infIntegral?(f1, r1.poly) => + [f1, r1.poly, monomial(1,1)$UP :: RF,r1inv,degree(retract(r1.coef)@UP)] + x := (a:= goodPoint(f1,r1.poly))::UP::RF + inv(monomial(1,1)::RF) + r2c:= retract((r2 := mkIntegral map(#1 x, r1.poly)).coef)@UP + t := inv((monomial(1, 1)$UP - a::UP)::RF) + [- inv(monomial(1, 2)$UP :: RF) * eval(f1, x, inv(r2.coef)), + r2.poly, t, r1.coef * r2c t, degree r2c] + +-- returns true if y is an n-th root, and it can be guaranteed that p(x,y)dx +-- is integral at infinity +-- expects y to be integral. + infIntegral?(p, modulus) == + (r := radPoly modulus) case "failed" => false + ninv := inv(r.deg::Q) + degy:Q := degree(retract(r.radicand)@UP) * ninv + degp:Q := 0 + while p ^= 0 repeat + c := leadingCoefficient p + degp := max(degp, + (2 + degree(numer c)::Z - degree(denom c)::Z)::Q + degree(p) * degy) + p := reductum p + degp <= ninv + + mkIntegral p == + (r := radPoly p) case "failed" => algPoly p + rp := rootPoly(r.radicand, r.deg) + [rp.coef, monomial(1, rp.exponent)$UPUP - rp.radicand::RF::UPUP] + + goodPoint(p, modulus) == + q := + (r := radPoly modulus) case "failed" => + retract(resultant(modulus, differentiate modulus))@UP + retract(r.radicand)@UP + d := commonDenominator p + for i in 0.. repeat + good?(a := i::F, q, d) => return a + good?(-a, q, d) => return -a + + radPoly p == + (r := retractIfCan(reductum p)@Union(RF, "failed")) case "failed" + => "failed" + [- (r::RF), degree p] + +-- we have y**m = g(x) = n(x)/d(x), so if we can write +-- (n(x) * d(x)**(m-1)) ** (1/m) = c(x) * P(x) ** (1/n) +-- then z**q = P(x) where z = (d(x) / c(x)) * y + rootPoly(g, m) == + zero? g => error "Should not happen" + pr := nthRoot(squareFree((numer g) * (d := denom g) ** (m-1)::N), + m)$FactoredFunctions(UP) + [pr.exponent, d / pr.coef, */(pr.radicand)] + +@ +<>= +"CHVAR" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CHVAR"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"CHVAR" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package CPIMA CharacteristicPolynomialInMonogenicalAlgebra} \pagehead{CharacteristicPolynomialInMonogenicalAlgebra}{CPIMA} \pagepic{ps/v104characteristicpolynomialinmonogenicalalgebra.ps}{CPIMA}{1.00} @@ -1735,14 +1930,3288 @@ CharacteristicPolynomialInMonogenicalAlgebra(R : CommutativeRing, @ <>= "CPIMA" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CPIMA"] +"MONOGEN" [color="#4488FF",href="bookvol10.2.pdf#nameddest=MONOGEN"] +"CPIMA" -> "MONOGEN" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package COMBF CombinatorialFunction} +\pagehead{CombinatorialFunction}{COMBF} +\pagepic{ps/v104combinatorialfunction.ps}{COMBF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package COMBF CombinatorialFunction +++ Provides the usual combinatorial functions +++ Author: Manuel Bronstein, Martin Rubey +++ Date Created: 2 Aug 1988 +++ Date Last Updated: 30 October 2005 +++ Description: +++ Provides combinatorial functions over an integral domain. +++ Keywords: combinatorial, function, factorial. +++ Examples: )r COMBF INPUT + +CombinatorialFunction(R, F): Exports == Implementation where + R: Join(OrderedSet, IntegralDomain) + F: FunctionSpace R + + OP ==> BasicOperator + K ==> Kernel F + SE ==> Symbol + O ==> OutputForm + SMP ==> SparseMultivariatePolynomial(R, K) + Z ==> Integer + + POWER ==> "%power"::Symbol + OPEXP ==> "exp"::Symbol + SPECIALDIFF ==> "%specialDiff" + SPECIALDISP ==> "%specialDisp" + SPECIALEQUAL ==> "%specialEqual" + + Exports ==> with + belong? : OP -> Boolean + ++ belong?(op) is true if op is a combinatorial operator; + operator : OP -> OP + ++ operator(op) returns a copy of op with the domain-dependent + ++ properties appropriate for F; + ++ error if op is not a combinatorial operator; + "**" : (F, F) -> F + ++ a ** b is the formal exponential a**b; + binomial : (F, F) -> F + ++ binomial(n, r) returns the number of subsets of r objects + ++ taken among n objects, i.e. n!/(r! * (n-r)!); +@ + +We currently simplify binomial coefficients only for non-negative integral +second argument, using the formula +$$ \binom{n}{k}=\frac{1}{k!}\prod_{i=0..k-1} (n-i),$$ +except if the second argument is symbolic: in this case [[binomial(n,n)]] is +simplified to one. + +Note that there are at least two different ways to define binomial coefficients +for negative integral second argument. One way, particular suitable for +combinatorics, is to set the binomial coefficient equal to zero for negative +second argument. This is, partially, also the approach taken in +[[combinat.spad]], where we find + +\begin{verbatim} + binomial(n, m) == + n < 0 or m < 0 or m > n => 0 + m = 0 => 1 +\end{verbatim} + +Of course, here [[n]] and [[m]] are integers. This definition agrees with the +recurrence + +$$\binom{n}{k}+\binom{n}{k+1}=\binom{n+1}{k+1}.$$ + +Alternatively, one can use the formula +$$ \binom{n}{k}=\frac{\Gamma(n+1)}{\Gamma(k+1)\Gamma(n-k+1)}, $$ +and leave the case where $k\in {\bf Z}$, $n\in {\bf Z}$ and $k \leq n < 0$ +undefined, since the limit does not exist in this case: + +Since we then have that $n-k+1\geq 1$, $\Gamma(n-k+1)$ is finite. So it is +sufficient to consider $\frac{\Gamma(n+1)}{\Gamma(k+1)}$. On the one hand, we +have +$$\lim_{n_0\to n} \lim_{k_0\to k}\frac{\Gamma(n_0+1)}{\Gamma(k_0+1)} = 0,$$ +since for any non-integral $n_0$, $\Gamma(n_0+1)$ is finite. On the other +hand, +$$\lim_{k_0\to k} \lim_{n_0\to n}\frac{\Gamma(n_0+1)}{\Gamma(k_0+1)}$$ +does not exist, since for non-integral $k_0$, $\Gamma(k_0+1)$ is finite while +$\Gamma(n_0+1)$ is unbounded. + +However, since for $k\in {\bf Z}$, $n\in {\bf Z}$ and $0 < k < n$ both +definitions agree, one could also combine them. This is what, for example, +Mathematica does. It seems that MuPAD sets [[binomial(n,n)=1]] for all +arguments [[n]], and returns [[binomial(-2, n)]] unevaluated. Provisos may help +here. + +<>= + permutation: (F, F) -> F + ++ permutation(n, r) returns the number of permutations of + ++ n objects taken r at a time, i.e. n!/(n-r)!; + factorial : F -> F + ++ factorial(n) returns the factorial of n, i.e. n!; + factorials : F -> F + ++ factorials(f) rewrites the permutations and binomials in f + ++ in terms of factorials; + factorials : (F, SE) -> F + ++ factorials(f, x) rewrites the permutations and binomials in f + ++ involving x in terms of factorials; + summation : (F, SE) -> F + ++ summation(f(n), n) returns the formal sum S(n) which verifies + ++ S(n+1) - S(n) = f(n); + summation : (F, SegmentBinding F) -> F + ++ summation(f(n), n = a..b) returns f(a) + ... + f(b) as a + ++ formal sum; + product : (F, SE) -> F + ++ product(f(n), n) returns the formal product P(n) which verifies + ++ P(n+1)/P(n) = f(n); + product : (F, SegmentBinding F) -> F + ++ product(f(n), n = a..b) returns f(a) * ... * f(b) as a + ++ formal product; + iifact : F -> F + ++ iifact(x) should be local but conditional; + iibinom : List F -> F + ++ iibinom(l) should be local but conditional; + iiperm : List F -> F + ++ iiperm(l) should be local but conditional; + iipow : List F -> F + ++ iipow(l) should be local but conditional; + iidsum : List F -> F + ++ iidsum(l) should be local but conditional; + iidprod : List F -> F + ++ iidprod(l) should be local but conditional; + ipow : List F -> F + ++ ipow(l) should be local but conditional; + + Implementation ==> add + ifact : F -> F + iiipow : List F -> F + iperm : List F -> F + ibinom : List F -> F + isum : List F -> F + idsum : List F -> F + iprod : List F -> F + idprod : List F -> F + dsum : List F -> O + ddsum : List F -> O + dprod : List F -> O + ddprod : List F -> O + equalsumprod : (K, K) -> Boolean + equaldsumprod : (K, K) -> Boolean + fourth : List F -> F + dvpow1 : List F -> F + dvpow2 : List F -> F + summand : List F -> F + dvsum : (List F, SE) -> F + dvdsum : (List F, SE) -> F + dvprod : (List F, SE) -> F + dvdprod : (List F, SE) -> F + facts : (F, List SE) -> F + K2fact : (K, List SE) -> F + smpfact : (SMP, List SE) -> F + + dummy == new()$SE :: F +@ +This macro will be used in [[product]] and [[summation]], both the $5$ and $3$ +argument forms. It is used to introduce a dummy variable in place of the +summation index within the summands. This in turn is necessary to keep the +indexing variable local, circumventing problems, for example, with +differentiation. + +This works if we don't accidently use such a symbol as a bound of summation or +product. + +Note that up to [[patch--25]] this used to read +\begin{verbatim} + dummy := new()$SE :: F +\end{verbatim} +thus introducing the same dummy variable for all products and summations, which +caused nested products and summations to fail. (Issue~\#72) + +<>= + opfact := operator("factorial"::Symbol)$CommonOperators + opperm := operator("permutation"::Symbol)$CommonOperators + opbinom := operator("binomial"::Symbol)$CommonOperators + opsum := operator("summation"::Symbol)$CommonOperators + opdsum := operator("%defsum"::Symbol)$CommonOperators + opprod := operator("product"::Symbol)$CommonOperators + opdprod := operator("%defprod"::Symbol)$CommonOperators + oppow := operator(POWER::Symbol)$CommonOperators + + factorial x == opfact x + binomial(x, y) == opbinom [x, y] + permutation(x, y) == opperm [x, y] + + import F + import Kernel F + + number?(x:F):Boolean == + if R has RetractableTo(Z) then + ground?(x) or + ((retractIfCan(x)@Union(Fraction(Z),"failed")) case Fraction(Z)) + else + ground?(x) + + x ** y == + -- Do some basic simplifications + is?(x,POWER) => + args : List F := argument first kernels x + not(#args = 2) => error "Too many arguments to **" + number?(first args) and number?(y) => + oppow [first(args)**y, second args] + oppow [first args, (second args)* y] + -- Generic case + exp : Union(Record(val:F,exponent:Z),"failed") := isPower x + exp case Record(val:F,exponent:Z) => + expr := exp::Record(val:F,exponent:Z) + oppow [expr.val, (expr.exponent)*y] + oppow [x, y] + + belong? op == has?(op, "comb") + fourth l == third rest l + dvpow1 l == second(l) * first(l) ** (second l - 1) + factorials x == facts(x, variables x) + factorials(x, v) == facts(x, [v]) + facts(x, l) == smpfact(numer x, l) / smpfact(denom x, l) + summand l == eval(first l, retract(second l)@K, third l) + + product(x:F, i:SE) == + dm := dummy + opprod [eval(x, k := kernel(i)$K, dm), dm, k::F] + + summation(x:F, i:SE) == + dm := dummy + opsum [eval(x, k := kernel(i)$K, dm), dm, k::F] + +@ +These two operations return the product or the sum as unevaluated operators. A +dummy variable is introduced to make the indexing variable \lq local\rq. + +<>= + dvsum(l, x) == + opsum [differentiate(first l, x), second l, third l] + + dvdsum(l, x) == + x = retract(y := third l)@SE => 0 + if member?(x, variables(h := third rest rest l)) or + member?(x, variables(g := third rest l)) then + error "a sum cannot be differentiated with respect to a bound" + else + opdsum [differentiate(first l, x), second l, y, g, h] + +@ +The above two operations implement differentiation of sums with and without +bounds. Note that the function +$$n\mapsto\sum_{k=1}^n f(k,n)$$ +is well defined only for integral values of $n$ greater than or equal to zero. +There is not even consensus how to define this function for $n<0$. Thus, it is +not differentiable. Therefore, we need to check whether we erroneously are +differentiating with respect to the upper bound or the lower bound, where the +same reasoning holds. + +Differentiating a sum with respect to its indexing variable correctly gives +zero. This is due to the introduction of dummy variables in the internal +representation of a sum: the operator [[%defsum]] takes 5 arguments, namely + +\begin{enumerate} +\item the summands, where each occurrence of the indexing variable is replaced + by +\item the dummy variable, +\item the indexing variable, +\item the lower bound, and +\item the upper bound. +\end{enumerate} + +Note that up to [[patch--40]] the following incorrect code was used, which +tried to parallel the known rules for integration: (Issue~\#180) + +\begin{verbatim} + dvdsum(l, x) == + x = retract(y := third l)@SE => 0 + k := retract(d := second l)@K + differentiate(h := third rest rest l,x) * eval(f := first l, k, h) + - differentiate(g := third rest l, x) * eval(f, k, g) + + opdsum [differentiate(f, x), d, y, g, h] +\end{verbatim} + +Up to [[patch--45]] a similar mistake could be found in the code for +differentiation of formal sums, which read +\begin{verbatim} + dvsum(l, x) == + k := retract(second l)@K + differentiate(third l, x) * summand l + + opsum [differentiate(first l, x), second l, third l] +\end{verbatim} + +<>= + dvprod(l, x) == + dm := retract(dummy)@SE + f := eval(first l, retract(second l)@K, dm::F) + p := product(f, dm) + + opsum [differentiate(first l, x)/first l * p, second l, third l] + + + dvdprod(l, x) == + x = retract(y := third l)@SE => 0 + if member?(x, variables(h := third rest rest l)) or + member?(x, variables(g := third rest l)) then + error "a product cannot be differentiated with respect to a bound" + else + opdsum cons(differentiate(first l, x)/first l, rest l) * opdprod l + +@ +The above two operations implement differentiation of products with and without +bounds. Note again, that we cannot even properly define products with bounds +that are not integral. + +To differentiate the product, we use Leibniz rule: +$$\frac{d}{dx}\prod_{i=a}^b f(i,x) = + \sum_{i=a}^b \frac{\frac{d}{dx} f(i,x)}{f(i,x)}\prod_{i=a}^b f(i,x) +$$ + +There is one situation where this definition might produce wrong results, +namely when the product is zero, but axiom failed to recognize it: in this +case, +$$ + \frac{d}{dx} f(i,x)/f(i,x) +$$ +is undefined for some $i$. However, I was not able to come up with an +example. The alternative definition +$$ + \frac{d}{dx}\prod_{i=a}^b f(i,x) = + \sum_{i=a}^b \left(\frac{d}{dx} f(i,x)\right)\prod_{j=a,j\neq i}^b f(j,x) +$$ +has the slight (display) problem that we would have to come up with a new index +variable, which looks very ugly. Furthermore, it seems to me that more +simplifications will occur with the first definition. + +<>= + f := operator 'f + D(product(f(i,x),i=1..m),x) +@ + +Note that up to [[patch--45]] these functions did not exist and products were +differentiated according to the usual chain rule, which gave incorrect +results. (Issue~\#211) + +<>= + dprod l == + prod(summand(l)::O, third(l)::O) + + ddprod l == + prod(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O) + + dsum l == + sum(summand(l)::O, third(l)::O) + + ddsum l == + sum(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O) + +@ +These four operations handle the conversion of sums and products to +[[OutputForm]]. Note that up to [[patch--45]] the definitions for sums and +products without bounds were missing and output was illegible. + +<>= + equalsumprod(s1, s2) == + l1 := argument s1 + l2 := argument s2 + + (eval(first l1, retract(second l1)@K, second l2) = first l2) + + equaldsumprod(s1, s2) == + l1 := argument s1 + l2 := argument s2 + + ((third rest l1 = third rest l2) and + (third rest rest l1 = third rest rest l2) and + (eval(first l1, retract(second l1)@K, second l2) = first l2)) + +@ +The preceding two operations handle the testing for equality of sums and +products. This functionality was missing up to [[patch--45]]. (Issue~\#213) The +corresponding property [[%specialEqual]] set below is checked in +[[Kernel]]. Note that we can assume that the operators are equal, since this is +checked in [[Kernel]] itself. +<>= + product(x:F, s:SegmentBinding F) == + k := kernel(variable s)$K + dm := dummy + opdprod [eval(x,k,dm), dm, k::F, lo segment s, hi segment s] + + summation(x:F, s:SegmentBinding F) == + k := kernel(variable s)$K + dm := dummy + opdsum [eval(x,k,dm), dm, k::F, lo segment s, hi segment s] + +@ +These two operations return the product or the sum as unevaluated operators. A +dummy variable is introduced to make the indexing variable \lq local\rq. + +<>= + smpfact(p, l) == + map(K2fact(#1, l), #1::F, p)$PolynomialCategoryLifting( + IndexedExponents K, K, R, SMP, F) + + K2fact(k, l) == + empty? [v for v in variables(kf := k::F) | member?(v, l)] => kf + empty?(args:List F := [facts(a, l) for a in argument k]) => kf + is?(k, opperm) => + factorial(n := first args) / factorial(n - second args) + is?(k, opbinom) => + n := first args + p := second args + factorial(n) / (factorial(p) * factorial(n-p)) + (operator k) args + + operator op == + is?(op, "factorial"::Symbol) => opfact + is?(op, "permutation"::Symbol) => opperm + is?(op, "binomial"::Symbol) => opbinom + is?(op, "summation"::Symbol) => opsum + is?(op, "%defsum"::Symbol) => opdsum + is?(op, "product"::Symbol) => opprod + is?(op, "%defprod"::Symbol) => opdprod + is?(op, POWER) => oppow + error "Not a combinatorial operator" + + iprod l == + zero? first l => 0 +-- one? first l => 1 + (first l = 1) => 1 + kernel(opprod, l) + + isum l == + zero? first l => 0 + kernel(opsum, l) + + idprod l == + member?(retract(second l)@SE, variables first l) => + kernel(opdprod, l) + first(l) ** (fourth rest l - fourth l + 1) + + idsum l == + member?(retract(second l)@SE, variables first l) => + kernel(opdsum, l) + first(l) * (fourth rest l - fourth l + 1) + + ifact x == +-- zero? x or one? x => 1 + zero? x or (x = 1) => 1 + kernel(opfact, x) + + ibinom l == + n := first l + ((p := second l) = 0) or (p = n) => 1 +-- one? p or (p = n - 1) => n + (p = 1) or (p = n - 1) => n + kernel(opbinom, l) + + iperm l == + zero? second l => 1 + kernel(opperm, l) + + if R has RetractableTo Z then + iidsum l == + (r1:=retractIfCan(fourth l)@Union(Z,"failed")) + case "failed" or + (r2:=retractIfCan(fourth rest l)@Union(Z,"failed")) + case "failed" or + (k:=retractIfCan(second l)@Union(K,"failed")) case "failed" + => idsum l + +/[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z] + + iidprod l == + (r1:=retractIfCan(fourth l)@Union(Z,"failed")) + case "failed" or + (r2:=retractIfCan(fourth rest l)@Union(Z,"failed")) + case "failed" or + (k:=retractIfCan(second l)@Union(K,"failed")) case "failed" + => idprod l + */[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z] + + iiipow l == + (u := isExpt(x := first l, OPEXP)) case "failed" => kernel(oppow, l) + rec := u::Record(var: K, exponent: Z) + y := first argument(rec.var) + (r := retractIfCan(y)@Union(Fraction Z, "failed")) case + "failed" => kernel(oppow, l) + (operator(rec.var)) (rec.exponent * y * second l) + + if F has RadicalCategory then + ipow l == + (r := retractIfCan(second l)@Union(Fraction Z,"failed")) + case "failed" => iiipow l + first(l) ** (r::Fraction(Z)) + else + ipow l == + (r := retractIfCan(second l)@Union(Z, "failed")) + case "failed" => iiipow l + first(l) ** (r::Z) + + else + ipow l == + zero?(x := first l) => + zero? second l => error "0 ** 0" + 0 +-- one? x or zero?(n := second l) => 1 + (x = 1) or zero?(n: F := second l) => 1 +-- one? n => x + (n = 1) => x + (u := isExpt(x, OPEXP)) case "failed" => kernel(oppow, l) + rec := u::Record(var: K, exponent: Z) +-- one?(y := first argument(rec.var)) or y = -1 => + ((y := first argument(rec.var))=1) or y = -1 => + (operator(rec.var)) (rec.exponent * y * n) + kernel(oppow, l) + + if R has CombinatorialFunctionCategory then + iifact x == + (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => ifact x + factorial(r::R)::F + + iiperm l == + (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or + (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" + => iperm l + permutation(r1::R, r2::R)::F + + if R has RetractableTo(Z) and F has Algebra(Fraction(Z)) then + iibinom l == + (s:=retractIfCan(second l)@Union(R,"failed")) case R and + (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 => + ans:=1::F + for i in 0..t-1 repeat + ans:=ans*(first l - i::R::F) + (1/factorial t) * ans + (s:=retractIfCan(first l-second l)@Union(R,"failed")) case R and + (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 => + ans:=1::F + for i in 1..t repeat + ans:=ans*(second l+i::R::F) + (1/factorial t) * ans + (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or + (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" + => ibinom l + binomial(r1::R, r2::R)::F + +@ + +[[iibinom]] checks those cases in which the binomial coefficient may be +evaluated explicitly. Note that up to [[patch--51]], the case where the second +argument is a positive integer was not checked.(Issue~\#336) Currently, the +naive iterative algorithm is used to calculate the coefficient, there is room +for improvement here. + +<>= + + else + iibinom l == + (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or + (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" + => ibinom l + binomial(r1::R, r2::R)::F + + else + iifact x == ifact x + iibinom l == ibinom l + iiperm l == iperm l + + if R has ElementaryFunctionCategory then + iipow l == + (r1:=retractIfCan(first l)@Union(R,"failed")) case "failed" or + (r2:=retractIfCan(second l)@Union(R,"failed")) case "failed" + => ipow l + (r1::R ** r2::R)::F + else + iipow l == ipow l + + if F has ElementaryFunctionCategory then + dvpow2 l == if zero?(first l) then + 0 + else + log(first l) * first(l) ** second(l) + +@ +This operation implements the differentiation of the power operator [[%power]] +with respect to its second argument, i.e., the exponent. It uses the formula +$$\frac{d}{dx} g(y)^x = \frac{d}{dx} e^{x\log g(y)} = \log g(y) g(y)^x.$$ + +If $g(y)$ equals zero, this formula is not valid, since the logarithm is not +defined there. Although strictly speaking $0^x$ is not differentiable at zero, +we return zero for convenience. + +Note that up to [[patch--25]] this used to read +\begin{verbatim} + if F has ElementaryFunctionCategory then + dvpow2 l == log(first l) * first(l) ** second(l) +\end{verbatim} +which caused differentiating $0^x$ to fail. (Issue~\#19) + +<>= + evaluate(opfact, iifact)$BasicOperatorFunctions1(F) + evaluate(oppow, iipow) + evaluate(opperm, iiperm) + evaluate(opbinom, iibinom) + evaluate(opsum, isum) + evaluate(opdsum, iidsum) + evaluate(opprod, iprod) + evaluate(opdprod, iidprod) + derivative(oppow, [dvpow1, dvpow2]) + setProperty(opsum, SPECIALDIFF, dvsum@((List F, SE) -> F) pretend None) + setProperty(opdsum, SPECIALDIFF, dvdsum@((List F, SE)->F) pretend None) + setProperty(opprod, SPECIALDIFF, dvprod@((List F, SE)->F) pretend None) + setProperty(opdprod, SPECIALDIFF, dvdprod@((List F, SE)->F) pretend None) +@ +The last four properties define special differentiation rules for sums and +products. Note that up to [[patch--45]] the rules for products were missing. +Thus products were differentiated according the usual chain-rule, which gave +incorrect results. + +<>= + setProperty(opsum, SPECIALDISP, dsum@(List F -> O) pretend None) + setProperty(opdsum, SPECIALDISP, ddsum@(List F -> O) pretend None) + setProperty(opprod, SPECIALDISP, dprod@(List F -> O) pretend None) + setProperty(opdprod, SPECIALDISP, ddprod@(List F -> O) pretend None) + setProperty(opsum, SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None) + setProperty(opdsum, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None) + setProperty(opprod, SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None) + setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None) + +@ +Finally, we set the properties for displaying sums and products and testing for +equality. + + +<>= +"COMBF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=COMBF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"COMBF" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CDEN CommonDenominator} +\pagehead{CommonDenominator}{CDEN} +\pagepic{ps/v104commondenominator.ps}{CDEN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CDEN CommonDenominator +--% CommonDenominator +++ Author: Manuel Bronstein +++ Date Created: 2 May 1988 +++ Date Last Updated: 22 Nov 1989 +++ Description: CommonDenominator provides functions to compute the +++ common denominator of a finite linear aggregate of elements of +++ the quotient field of an integral domain. +++ Keywords: gcd, quotient, common, denominator. +CommonDenominator(R, Q, A): Exports == Implementation where + R: IntegralDomain + Q: QuotientFieldCategory R + A: FiniteLinearAggregate Q + + Exports ==> with + commonDenominator: A -> R + ++ commonDenominator([q1,...,qn]) returns a common denominator + ++ d for q1,...,qn. + clearDenominator : A -> A + ++ clearDenominator([q1,...,qn]) returns \spad{[p1,...,pn]} such that + ++ \spad{qi = pi/d} where d is a common denominator for the qi's. + splitDenominator : A -> Record(num: A, den: R) + ++ splitDenominator([q1,...,qn]) returns + ++ \spad{[[p1,...,pn], d]} such that + ++ \spad{qi = pi/d} and d is a common denominator for the qi's. + + Implementation ==> add + clearDenominator l == + d := commonDenominator l + map(numer(d * #1)::Q, l) + + splitDenominator l == + d := commonDenominator l + [map(numer(d * #1)::Q, l), d] + + if R has GcdDomain then + qlcm: (Q, Q) -> Q + + qlcm(a, b) == lcm(numer a, numer b)::Q + commonDenominator l == numer reduce(qlcm, map(denom(#1)::Q, l), 1) + else + commonDenominator l == numer reduce("*", map(denom(#1)::Q, l), 1) + +@ +<>= +"CDEN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CDEN"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"CDEN" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CRFP ComplexRootFindingPackage} +\pagehead{ComplexRootFindingPackage}{CRFP} +\pagepic{ps/v104complexrootfindingpackage.ps}{CRFP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CRFP ComplexRootFindingPackage +++ Author: J. Grabmeier +++ Date Created: 31 January 1991 +++ Date Last Updated: 12 April 1991 +++ Basic Operations: factor, pleskenSplit +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: complex zeros, roots +++ References: J. Grabmeier: On Plesken's root finding algorithm, +++ in preparation +++ A. Schoenhage: The fundamental theorem of algebra in terms of computational +++ complexity, preliminary report, Univ. Tuebingen, 1982 +++ Description: +++ \spadtype{ComplexRootFindingPackage} provides functions to +++ find all roots of a polynomial p over the complex number by +++ using Plesken's idea to calculate in the polynomial ring +++ modulo f and employing the Chinese Remainder Theorem. +++ In this first version, the precision (see \spadfunFrom{digits}{Float}) +++ is not increased when this is necessary to +++ avoid rounding errors. Hence it is the user's responsibility to +++ increase the precision if necessary. +++ Note also, if this package is called with e.g. \spadtype{Fraction Integer}, +++ the precise calculations could require a lot of time. +++ Also note that evaluating the zeros is not necessarily a good check +++ whether the result is correct: already evaluation can cause +++ rounding errors. +ComplexRootFindingPackage(R, UP): public == private where + -- R : Join(Field, OrderedRing, CharacteristicZero) + -- Float not in CharacteristicZero !| + R : Join(Field, OrderedRing) + UP : UnivariatePolynomialCategory Complex R + + C ==> Complex R + FR ==> Factored + I ==> Integer + L ==> List + FAE ==> Record(factors : L UP, error : R) + NNI ==> NonNegativeInteger + OF ==> OutputForm + ICF ==> IntegerCombinatoricFunctions(I) + + public ==> with + complexZeros : UP -> L C + ++ complexZeros(p) tries to determine all complex zeros + ++ of the polynomial p with accuracy given by the package + ++ constant {\em globalEps} which you may change by + ++ {\em setErrorBound}. + complexZeros : (UP, R) -> L C + ++ complexZeros(p, eps) tries to determine all complex zeros + ++ of the polynomial p with accuracy given by {\em eps}. + divisorCascade : (UP,UP, Boolean) -> L FAE + ++ divisorCascade(p,tp) assumes that degree of polynomial {\em tp} + ++ is smaller than degree of polynomial p, both monic. + ++ A sequence of divisions are calculated + ++ using the remainder, made monic, as divisor + ++ for the the next division. The result contains also the error of the + ++ factorizations, i.e. the norm of the remainder polynomial. + ++ If {\em info} is {\em true}, then information messages are issued. + divisorCascade : (UP,UP) -> L FAE + ++ divisorCascade(p,tp) assumes that degree of polynomial {\em tp} + ++ is smaller than degree of polynomial p, both monic. + ++ A sequence of divisions is calculated + ++ using the remainder, made monic, as divisor + ++ for the the next division. The result contains also the error of the + ++ factorizations, i.e. the norm of the remainder polynomial. + factor: (UP,R,Boolean) -> FR UP + ++ factor(p, eps, info) tries to factor p into linear factors + ++ with error atmost {\em eps}. An overall error bound + ++ {\em eps0} is determined and iterated tree-like calls + ++ to {\em pleskenSplit} are used to get the factorization. + ++ If {\em info} is {\em true}, then information messages are given. + factor: (UP,R) -> FR UP + ++ factor(p, eps) tries to factor p into linear factors + ++ with error atmost {\em eps}. An overall error bound + ++ {\em eps0} is determined and iterated tree-like calls + ++ to {\em pleskenSplit} are used to get the factorization. + factor: UP -> FR UP + ++ factor(p) tries to factor p into linear factors + ++ with error atmost {\em globalEps}, the internal error bound, + ++ which can be set by {\em setErrorBound}. An overall error bound + ++ {\em eps0} is determined and iterated tree-like calls + ++ to {\em pleskenSplit} are used to get the factorization. + graeffe : UP -> UP + ++ graeffe p determines q such that \spad{q(-z**2) = p(z)*p(-z)}. + ++ Note that the roots of q are the squares of the roots of p. + norm : UP -> R + ++ norm(p) determines sum of absolute values of coefficients + ++ Note: this function depends on \spadfunFrom{abs}{Complex}. + pleskenSplit: (UP, R, Boolean) -> FR UP + ++ pleskenSplit(poly,eps,info) determines a start polynomial {\em start} + ++ by using "startPolynomial then it increases the exponent + ++ n of {\em start ** n mod poly} to get an approximate factor of + ++ {\em poly}, in general of degree "degree poly -1". Then a divisor + ++ cascade is calculated and the best splitting is chosen, as soon + ++ as the error is small enough. + --++ In a later version we plan + --++ to use the whole information to get a split into more than 2 + --++ factors. + ++ If {\em info} is {\em true}, then information messages are issued. + pleskenSplit: (UP, R) -> FR UP + ++ pleskenSplit(poly, eps) determines a start polynomial {\em start}\ + ++ by using "startPolynomial then it increases the exponent + ++ n of {\em start ** n mod poly} to get an approximate factor of + ++ {\em poly}, in general of degree "degree poly -1". Then a divisor + ++ cascade is calculated and the best splitting is chosen, as soon + ++ as the error is small enough. + --++ In a later version we plan + --++ to use the whole information to get a split into more than 2 + --++ factors. + reciprocalPolynomial: UP -> UP + ++ reciprocalPolynomial(p) calulates a polynomial which has exactly + ++ the inverses of the non-zero roots of p as roots, and the same + ++ number of 0-roots. + rootRadius: (UP,R) -> R + ++ rootRadius(p,errQuot) calculates the root radius of p with a + ++ maximal error quotient of {\em errQuot}. + rootRadius: UP -> R + ++ rootRadius(p) calculates the root radius of p with a + ++ maximal error quotient of {\em 1+globalEps}, where + ++ {\em globalEps} is the internal error bound, which can be + ++ set by {\em setErrorBound}. + schwerpunkt: UP -> C + ++ schwerpunkt(p) determines the 'Schwerpunkt' of the roots of the + ++ polynomial p of degree n, i.e. the center of gravity, which is + ++ {\em coeffient of \spad{x**(n-1)}} divided by + ++ {\em n times coefficient of \spad{x**n}}. + setErrorBound : R -> R + ++ setErrorBound(eps) changes the internal error bound, + -- by default being {\em 10 ** (-20)} to eps, if R is + ++ by default being {\em 10 ** (-3)} to eps, if R is + ++ a member in the category \spadtype{QuotientFieldCategory Integer}. + ++ The internal {\em globalDigits} is set to + -- {\em ceiling(1/r)**2*10} being {\em 10**41} by default. + ++ {\em ceiling(1/r)**2*10} being {\em 10**7} by default. + startPolynomial: UP -> Record(start: UP, factors: FR UP) + ++ startPolynomial(p) uses the ideas of Schoenhage's + ++ variant of Graeffe's method to construct circles which separate + ++ roots to get a good start polynomial, i.e. one whose + ++ image under the Chinese Remainder Isomorphism has both entries + ++ of norm smaller and greater or equal to 1. In case the + ++ roots are found during internal calculations. + ++ The corresponding factors + ++ are in {\em factors} which are otherwise 1. + + private ==> add + + + Rep := ModMonic(C, UP) + + -- constants + c : C + r : R + --globalDigits : I := 10 ** 41 + globalDigits : I := 10 ** 7 + globalEps : R := + --a : R := (1000000000000000000000 :: I) :: R + a : R := (1000 :: I) :: R + 1/a + emptyLine : OF := " " + dashes : OF := center "---------------------------------------------------" + dots : OF := center "..................................................." + one : R := 1$R + two : R := 2 * one + ten : R := 10 * one + eleven : R := 11 * one + weakEps := eleven/ten + --invLog2 : R := 1/log10 (2*one) + + -- signatures of local functions + + absC : C -> R + -- + absR : R -> R + -- + calculateScale : UP -> R + -- + makeMonic : UP -> UP + -- 'makeMonic p' divides 'p' by the leading coefficient, + -- to guarantee new leading coefficient to be 1$R we cannot + -- simply divide the leading monomial by the leading coefficient + -- because of possible rounding errors + min: (FAE, FAE) -> FAE + -- takes factorization with smaller error + nthRoot : (R, NNI) -> R + -- nthRoot(r,n) determines an approximation to the n-th + -- root of r, if \spadtype{R} has {\em ?**?: (R,Fraction Integer)->R} + -- we use this, otherwise we use {\em approxNthRoot} via + -- \spadtype{Integer} + shift: (UP,C) -> UP + -- shift(p,c) changes p(x) into p(x+c), thereby modifying the + -- roots u_j of p to the roots (u_j - c) of shift(p,c) + scale: (UP,C) -> UP + -- scale(p,c) changes p(x) into p(cx), thereby modifying the + -- roots u_j of p to the roots ((1/c) u_j) of scale(p,c) + + + -- implementation of exported functions + + + complexZeros(p,eps) == + --r1 : R := rootRadius(p,weakEps) + --eps0 : R = r1 * nthRoot(eps, degree p) + -- right now we are content with + eps0 : R := eps/(ten ** degree p) + facs : FR UP := factor(p,eps0) + [-coefficient(linfac.factor,0) for linfac in factors facs] + + complexZeros p == complexZeros(p,globalEps) + setErrorBound r == + r <= 0 => error "setErrorBound: need error bound greater 0" + globalEps := r + if R has QuotientFieldCategory Integer then + rd : Integer := ceiling(1/r) + globalDigits := rd * rd * 10 + lof : List OF := _ + ["setErrorBound: internal digits set to",globalDigits::OF] + print hconcat lof + messagePrint "setErrorBound: internal error bound set to" + globalEps + + pleskenSplit(poly,eps,info) == + p := makeMonic poly + fp : FR UP + if not zero? (md := minimumDegree p) then + fp : FR UP := irreducibleFactor(monomial(1,1)$UP,md)$(FR UP) + p := p quo monomial(1,md)$UP + sP : Record(start: UP, factors: FR UP) := startPolynomial p + fp : FR UP := sP.factors +-- if not one? fp then + if not (fp = 1) then + qr: Record(quotient: UP, remainder: UP):= divide(p,makeMonic expand fp) + p := qr.quotient + st := sP.start + zero? degree st => fp + -- we calculate in ModMonic(C, UP), + -- next line defines the polynomial, which is used for reducing + setPoly p + nm : R := eps + split : FAE + sR : Rep := st :: Rep + psR : Rep := sR ** (degree poly) + + notFoundSplit : Boolean := true + while notFoundSplit repeat + -- if info then + -- lof : L OF := ["not successfull, new exponent:", nn::OF] + -- print hconcat lof + psR := psR * psR * sR -- exponent (2*d +1) + -- be careful, too large exponent results in rounding errors + -- tp is the first approximation of a divisor of poly: + tp : UP := lift psR + zero? degree tp => + if info then print "we leave as we got constant factor" + nilFactor(poly,1)$(FR UP) + -- this was the case where we don't find a non-trivial factorization + -- we refine tp by repeated polynomial division and hope that + -- the norm of the remainder gets small from time to time + splits : L FAE := divisorCascade(p, makeMonic tp, info) + split := reduce(min,splits) + notFoundSplit := (eps <= split.error) + + for fac in split.factors repeat + fp := +-- one? degree fac => fp * nilFactor(fac,1)$(FR UP) + (degree fac = 1) => fp * nilFactor(fac,1)$(FR UP) + fp * irreducibleFactor(fac,1)$(FR UP) + fp + + startPolynomial p == -- assume minimumDegree is 0 + --print (p :: OF) + fp : FR UP := 1 +-- one? degree p => + (degree p = 1) => + p := makeMonic p + [p,irreducibleFactor(p,1)] + startPoly : UP := monomial(1,1)$UP + eps : R := weakEps -- 10 per cent errors allowed + r1 : R := rootRadius(p, eps) + rd : R := 1/rootRadius(reciprocalPolynomial p, eps) + (r1 > (2::R)) and (rd < 1/(2::R)) => [startPoly,fp] -- unit circle splitting! + -- otherwise the norms of the roots are too closed so we + -- take the center of gravity as new origin: + u : C := schwerpunkt p + startPoly := startPoly-monomial(u,0) + p := shift(p,-u) + -- determine new rootRadius: + r1 : R := rootRadius(p, eps) + startPoly := startPoly/(r1::C) + -- use one of the 4 points r1*zeta, where zeta is a 4th root of unity + -- as new origin, this could be changed to an arbitrary list + -- of elements of norm 1. + listOfCenters : L C := [complex(r1,0), complex(0,r1), _ + complex(-r1,0), complex(0,-r1)] + lp : L UP := [shift(p,v) for v in listOfCenters] + -- next we check if one of these centers is a root + centerIsRoot : Boolean := false + for i in 1..maxIndex lp repeat + if (mD := minimumDegree lp.i) > 0 then + pp : UP := monomial(1,1)-monomial(listOfCenters.i-u,0) + centerIsRoot := true + fp := fp * irreducibleFactor(pp,mD) + centerIsRoot => + p := shift(p,u) quo expand fp + --print (p::OF) + zero? degree p => [p,fp] + sP:= startPolynomial(p) + [sP.start,fp] + -- choose the best one w.r.t. maximal quotient of norm of largest + -- root and norm of smallest root + lpr1 : L R := [rootRadius(q,eps) for q in lp] + lprd : L R := [1/rootRadius(reciprocalPolynomial q,eps) for q in lp] + -- later we should check here of an rd is smaller than globalEps + lq : L R := [] + for i in 1..maxIndex lpr1 repeat + lq := cons(lpr1.i/lprd.i, lq) + --lq : L R := [(l/s)::R for l in lpr1 for s in lprd]) + lq := reverse lq + po := position(reduce(max,lq),lq) + --p := lp.po + --lrr : L R := [rootRadius(p,i,1+eps) for i in 2..(degree(p)-1)] + --lrr := concat(concat(lpr1.po,lrr),lprd.po) + --lu : L R := [(lrr.i + lrr.(i+1))/2 for i in 1..(maxIndex(lrr)-1)] + [startPoly - monomial(listOfCenters.po,0),fp] + + norm p == + -- reduce(_+$R,map(absC,coefficients p)) + nm : R := 0 + for c in coefficients p repeat + nm := nm + absC c + nm + + pleskenSplit(poly,eps) == pleskenSplit(poly,eps,false) + + graeffe p == + -- If p = ao x**n + a1 x**(n-1) + ... + a x + an + -- and q = bo x**n + b1 x**(n-1) + ... + b x + bn + -- are such that q(-x**2) = p(x)p(-x), then + -- bk := ak**2 + 2 * ((-1) * a*a + ... + + -- (-1)**l * a*a) where l = min(k, n-k). + -- graeffe(p) constructs q using these identities. + n : NNI := degree p + aForth : L C := [] + for k in 0..n repeat -- aForth = [a0, a1, ..., a, an] + aForth := cons(coefficient(p, k::NNI), aForth) + aBack : L C := [] -- after k steps + -- aBack = [ak, a, ..., a1, a0] + gp : UP := 0$UP + for k in 0..n repeat + ak : C := first aForth + aForth := rest aForth + aForthCopy : L C := aForth -- we iterate over aForth and + aBackCopy : L C := aBack -- aBack but do not want to + -- destroy them + sum : C := 0 + const : I := -1 -- after i steps const = (-1)**i + for aminus in aBack for aplus in aForth repeat + -- after i steps aminus = a and aplus = a + sum := sum + const * aminus * aplus + aForthCopy := rest aForthCopy + aBackCopy := rest aBackCopy + const := -const + gp := gp + monomial(ak*ak + 2 * sum, (n-k)::NNI) + aBack := cons(ak, aBack) + gp + + + + rootRadius(p,errorQuotient) == + errorQuotient <= 1$R => + error "rootRadius: second Parameter must be greater than 1" + pp : UP := p + rho : R := calculateScale makeMonic pp + rR : R := rho + pp := makeMonic scale(pp,complex(rho,0$R)) + expo : NNI := 1 + d : NNI := degree p + currentError: R := nthRoot(2::R, 2) + currentError := d*20*currentError + while nthRoot(currentError, expo) >= errorQuotient repeat + -- if info then print (expo :: OF) + pp := graeffe pp + rho := calculateScale pp + expo := 2 * expo + rR := nthRoot(rho, expo) * rR + pp := makeMonic scale(pp,complex(rho,0$R)) + rR + + rootRadius(p) == rootRadius(p, 1+globalEps) + + schwerpunkt p == + zero? p => 0$C + zero? (d := degree p) => error _ + "schwerpunkt: non-zero const. polynomial has no roots and no schwerpunkt" + -- coeffient of x**d and x**(d-1) + lC : C := coefficient(p,d) -- ^= 0 + nC : C := coefficient(p,(d-1) pretend NNI) + (denom := recip ((d::I::C)*lC)) case "failed" => error "schwerpunkt: _ + degree * leadingCoefficient not invertible in ring of coefficients" + - (nC*(denom::C)) + + reciprocalPolynomial p == + zero? p => 0 + d : NNI := degree p + md : NNI := d+minimumDegree p + lm : L UP := [monomial(coefficient(p,i),(md-i) :: NNI) for i in 0..d] + sol := reduce(_+, lm) + + divisorCascade(p, tp, info) == + lfae : L FAE := nil() + for i in 1..degree tp while (degree tp > 0) repeat + -- USE monicDivide !!! + qr : Record(quotient: UP, remainder: UP) := divide(p,tp) + factor1 : UP := tp + factor2 : UP := makeMonic qr.quotient + -- refinement of tp: + tp := qr.remainder + nm : R := norm tp + listOfFactors : L UP := cons(factor2,nil()$(L UP)) + listOfFactors := cons(factor1,listOfFactors) + lfae := cons( [listOfFactors,nm], lfae) + if info then + --lof : L OF := [i :: OF,"-th division:"::OF] + --print center box hconcat lof + print emptyLine + lof : L OF := ["error polynomial has degree " ::OF,_ + (degree tp)::OF, " and norm " :: OF, nm :: OF] + print center hconcat lof + lof : L OF := ["degrees of factors:" ::OF,_ + (degree factor1)::OF," ", (degree factor2)::OF] + print center hconcat lof + if info then print emptyLine + reverse lfae + + divisorCascade(p, tp) == divisorCascade(p, tp, false) + + factor(poly,eps) == factor(poly,eps,false) + factor(p) == factor(p, globalEps) + + factor(poly,eps,info) == + result : FR UP := coerce monomial(leadingCoefficient poly,0) + d : NNI := degree poly + --should be + --den : R := (d::I)::R * two**(d::Integer) * norm poly + --eps0 : R := eps / den + -- for now only + eps0 : R := eps / (ten*ten) +-- one? d => irreducibleFactor(poly,1)$(FR UP) + (d = 1) => irreducibleFactor(poly,1)$(FR UP) + listOfFactors : L Record(factor: UP,exponent: I) :=_ + list [makeMonic poly,1] + if info then + lof : L OF := [dashes,dots,"list of Factors:",dots,listOfFactors::OF, _ + dashes, "list of Linear Factors:", dots, result::OF, _ + dots,dashes] + print vconcat lof + while not null listOfFactors repeat + p : UP := (first listOfFactors).factor + exponentOfp : I := (first listOfFactors).exponent + listOfFactors := rest listOfFactors + if info then + lof : L OF := ["just now we try to split the polynomial:",p::OF] + print vconcat lof + split : FR UP := pleskenSplit(p, eps0, info) +-- one? numberOfFactors split => + (numberOfFactors split = 1) => + -- in a later version we will change error bound and + -- accuracy here to deal this case as well + lof : L OF := ["factor: couldn't split factor",_ + center(p :: OF), "with required error bound"] + print vconcat lof + result := result * nilFactor(p, exponentOfp) + -- now we got 2 good factors of p, we drop p and continue + -- with the factors, if they are not linear, or put a + -- linear factor to the result + for rec in factors(split)$(FR UP) repeat + newFactor : UP := rec.factor + expOfFactor := exponentOfp * rec.exponent +-- one? degree newFactor => + (degree newFactor = 1) => + result := result * nilFactor(newFactor,expOfFactor) + listOfFactors:=cons([newFactor,expOfFactor],_ + listOfFactors) + result + + -- implementation of local functions + + absC c == nthRoot(norm(c)$C,2) + absR r == + r < 0 => -r + r + min(fae1,fae2) == + fae2.error < fae1.error => fae2 + fae1 + calculateScale p == + d := degree p + maxi :R := 0 + for j in 1..d for cof in rest coefficients p repeat + -- here we need abs: R -> R + rc : R := absR real cof + ic : R := absR imag cof + locmax: R := max(rc,ic) + maxi := max( nthRoot( locmax/(binomial(d,j)$ICF::R), j), maxi) + -- Maybe I should use some type of logarithm for the following: + maxi = 0$R => error("Internal Error: scale cannot be 0") + rho :R := one + rho < maxi => + while rho < maxi repeat rho := ten * rho + rho / ten + while maxi < rho repeat rho := rho / ten + rho = 0 => one + rho + makeMonic p == + p = 0 => p + monomial(1,degree p)$UP + (reductum p)/(leadingCoefficient p) + + scale(p, c) == + -- eval(p,cx) is missing !! + eq : Equation UP := equation(monomial(1,1), monomial(c,1)) + eval(p,eq) + -- improvement?: direct calculation of the new coefficients + + shift(p,c) == + rhs : UP := monomial(1,1) + monomial(c,0) + eq : Equation UP := equation(monomial(1,1), rhs) + eval(p,eq) + -- improvement?: direct calculation of the new coefficients + + nthRoot(r,n) == + R has RealNumberSystem => r ** (1/n) + R has QuotientFieldCategory Integer => + den : I := approxNthRoot(globalDigits * denom r ,n)$IntegerRoots(I) + num : I := approxNthRoot(globalDigits * numer r ,n)$IntegerRoots(I) + num/den + -- the following doesn't compile + --R has coerce: % -> Fraction Integer => + -- q : Fraction Integer := coerce(r)@Fraction(Integer) + -- den : I := approxNthRoot(globalDigits * denom q ,n)$IntegerRoots(I) + -- num : I := approxNthRoot(globalDigits * numer q ,n)$IntegerRoots(I) + -- num/den + r -- this is nonsense, perhaps a Newton iteration for x**n-r here + +)fin + -- for late use: + + graeffe2 p == + -- substitute x by -x : + eq : Equation UP := equation(monomial(1,1), monomial(-1$C,1)) + pp : UP := p*eval(p,eq) + gp : UP := 0$UP + while pp ^= 0 repeat + i:NNI := (degree pp) quo (2::NNI) + coef:C:= + even? i => leadingCoefficient pp + - leadingCoefficient pp + gp := gp + monomial(coef,i) + pp := reductum pp + gp + shift2(p,c) == + d := degree p + cc : C := 1 + coef := List C := [cc := c * cc for i in 1..d] + coef := cons(1,coef) + coef := [coefficient(p,i)*coef.(1+i) for i in 0..d] + res : UP := 0 + for j in 0..d repeat + cc := 0 + for i in j..d repeat + cc := cc + coef.i * (binomial(i,j)$ICF :: R) + res := res + monomial(cc,j)$UP + res + scale2(p,c) == + d := degree p + cc : C := 1 + coef := List C := [cc := c * cc for i in 1..d] + coef := cons(1,coef) + coef := [coefficient(p,i)*coef.(i+1) for i in 0..d] + res : UP := 0 + for i in 0..d repeat res := res + monomial(coef.(i+1),i)$UP + res + scale2: (UP,C) -> UP + shift2: (UP,C) -> UP + graeffe2 : UP -> UP + ++ graeffe2 p determines q such that \spad{q(-z**2) = p(z)*p(-z)}. + ++ Note that the roots of q are the squares of the roots of p. + +@ +<>= +"CRFP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CRFP"] +"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"] +"CRFP" -> "COMPCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CMPLXRT ComplexRootPackage} +\pagehead{ComplexRootPackage}{CMPLXRT} +\pagepic{ps/v104complexrootpackage.ps}{CMPLXRT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CMPLXRT ComplexRootPackage +++ Author: P. Gianni +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: Complex, Float, Fraction, UnivariatePolynomial +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package provides functions complexZeros +++ for finding the complex zeros +++ of univariate polynomials with complex rational number coefficients. +++ The results are to any user specified precision and are returned +++ as either complex rational number or complex floating point numbers +++ depending on the type of the second argument which specifies the +++ precision. + +-- Packages for the computation of complex roots of +-- univariate polynomials with rational or gaussian coefficients. + +-- Simplified version, the old original based on Gebauer's solver is +-- in ocmplxrt spad +RN ==> Fraction Integer +I ==> Integer +NF ==> Float + +ComplexRootPackage(UP,Par) : T == C where + UP : UnivariatePolynomialCategory Complex Integer + Par : Join(Field, OrderedRing) -- will be Float or RN + CP ==> Complex Par + PCI ==> Polynomial Complex Integer + + T == with + complexZeros:(UP,Par) -> List CP + ++ complexZeros(poly, eps) finds the complex zeros of the + ++ univariate polynomial poly to precision eps with + ++ solutions returned as complex floats or rationals + ++ depending on the type of eps. + + C == add + complexZeros(p:UP,eps:Par):List CP == + x1:Symbol():=new() + x2:Symbol():=new() + vv:Symbol():=new() + lpf:=factors factor(p)$ComplexFactorization(I,UP) + ris:List CP:=empty() + for pf in lpf repeat + pp:=pf.factor pretend SparseUnivariatePolynomial Complex Integer + q:PCI :=multivariate(pp,vv) + q:=eval(q,vv,x1::PCI+complex(0,1)*(x2::PCI)) + p1:=map(real,q)$PolynomialFunctions2(Complex I,I) + p2:=map(imag,q)$PolynomialFunctions2(Complex I,I) + lz:=innerSolve([p1,p2],[],[x1,x2], + eps)$InnerNumericFloatSolvePackage(I,Par,Par) + ris:=append([complex(first z,second z) for z in lz],ris) + ris + +@ +<>= +"CMPLXRT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CMPLXRT"] +"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"] +"CMPLXRT" -> "COMPCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CRAPACK CRApackage} +\pagehead{CRApackage}{CRAPACK} +\pagepic{ps/v104crapackage.ps}{CRAPACK}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CRAPACK CRApackage + +++ This package \undocumented{} +CRApackage(R:EuclideanDomain): Exports == Implementation where + Exports == with + modTree: (R,List R) -> List R + ++ modTree(r,l) \undocumented{} + chineseRemainder: (List R, List R) -> R + ++ chineseRemainder(lv,lm) returns a value \axiom{v} such that, if + ++ x is \axiom{lv.i} modulo \axiom{lm.i} for all \axiom{i}, then + ++ x is \axiom{v} modulo \axiom{lm(1)*lm(2)*...*lm(n)}. + chineseRemainder: (List List R, List R) -> List R + ++ chineseRemainder(llv,lm) returns a list of values, each of which + ++ corresponds to the Chinese remainder of the associated element of + ++ \axiom{llv} and axiom{lm}. This is more efficient than applying + ++ chineseRemainder several times. + multiEuclideanTree: (List R, R) -> List R + ++ multiEuclideanTree(l,r) \undocumented{} + Implementation == add + + BB:=BalancedBinaryTree(R) + x:BB + + -- Definition for modular reduction mapping with several moduli + modTree(a,lm) == + t := balancedBinaryTree(#lm, 0$R) + setleaves_!(t,lm) + mapUp_!(t,"*") + leaves mapDown_!(t, a, "rem") + + chineseRemainder(lv:List(R), lm:List(R)):R == + #lm ^= #lv => error "lists of moduli and values not of same length" + x := balancedBinaryTree(#lm, 0$R) + x := setleaves_!(x, lm) + mapUp_!(x,"*") + y := balancedBinaryTree(#lm, 1$R) + y := mapUp_!(copy y,x,#1 * #4 + #2 * #3) + (u := extendedEuclidean(value y, value x,1)) case "failed" => + error "moduli not relatively prime" + inv := u . coef1 + linv := modTree(inv, lm) + l := [(u*v) rem m for v in lv for u in linv for m in lm] + y := setleaves_!(y,l) + value(mapUp_!(y, x, #1 * #4 + #2 * #3)) rem value(x) + + chineseRemainder(llv:List List(R), lm:List(R)):List(R) == + x := balancedBinaryTree(#lm, 0$R) + x := setleaves_!(x, lm) + mapUp_!(x,"*") + y := balancedBinaryTree(#lm, 1$R) + y := mapUp_!(copy y,x,#1 * #4 + #2 * #3) + (u := extendedEuclidean(value y, value x,1)) case "failed" => + error "moduli not relatively prime" + inv := u . coef1 + linv := modTree(inv, lm) + retVal:List(R) := [] + for lv in llv repeat + l := [(u3*v) rem m for v in lv for u3 in linv for m in lm] + y := setleaves!(y,l) + retVal := cons(value(mapUp!(y, x, #1*#4+#2*#3)) rem value(x),retVal) + reverse retVal + + extEuclidean: (R, R, R) -> List R + extEuclidean(a, b, c) == + u := extendedEuclidean(a, b, c) + u case "failed" => error [c, " not spanned by ", a, " and ",b] + [u.coef2, u.coef1] + + multiEuclideanTree(fl, rhs) == + x := balancedBinaryTree(#fl, rhs) + x := setleaves_!(x, fl) + mapUp_!(x,"*") + leaves mapDown_!(x, rhs, extEuclidean) + +@ +<>= +"CRAPACK" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CRAPACK"] +"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"] +"CRAPACK" -> "FLAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CYCLES CycleIndicators} +<>= +-- cycles.spad.pamphlet CycleIndicators.input +)spool CycleIndicators.output +)set message test on +)set message auto off +)clear all +--S 1 of 47 +complete 1 +--R +--R +--R (1) (1) +--R Type: SymmetricPolynomial Fraction Integer +--E 1 + +--S 2 of 47 +complete 2 +--R +--R +--R 1 1 2 +--R (2) - (2) + - (1 ) +--R 2 2 +--R Type: SymmetricPolynomial Fraction Integer +--E 2 + +--S 3 of 47 +complete 3 +--R +--R +--R 1 1 1 3 +--R (3) - (3) + - (2 1) + - (1 ) +--R 3 2 6 +--R Type: SymmetricPolynomial Fraction Integer +--E 3 + +--S 4 of 47 +complete 7 +--R +--R +--R (4) +--R 1 1 1 1 2 1 1 1 3 +--R - (7) + - (6 1) + -- (5 2) + -- (5 1 ) + -- (4 3) + - (4 2 1) + -- (4 1 ) +--R 7 6 10 10 12 8 24 +--R + +--R 1 2 1 2 1 2 1 4 1 3 1 2 3 +--R -- (3 1) + -- (3 2 ) + -- (3 2 1 ) + -- (3 1 ) + -- (2 1) + -- (2 1 ) +--R 18 24 12 72 48 48 +--R + +--R 1 5 1 7 +--R --- (2 1 ) + ---- (1 ) +--R 240 5040 +--R Type: SymmetricPolynomial Fraction Integer +--E 4 + +--S 5 of 47 +elementary 7 +--R +--R +--R (5) +--R 1 1 1 1 2 1 1 1 3 +--R - (7) - - (6 1) - -- (5 2) + -- (5 1 ) - -- (4 3) + - (4 2 1) - -- (4 1 ) +--R 7 6 10 10 12 8 24 +--R + +--R 1 2 1 2 1 2 1 4 1 3 1 2 3 +--R -- (3 1) + -- (3 2 ) - -- (3 2 1 ) + -- (3 1 ) - -- (2 1) + -- (2 1 ) +--R 18 24 12 72 48 48 +--R + +--R 1 5 1 7 +--R - --- (2 1 ) + ---- (1 ) +--R 240 5040 +--R Type: SymmetricPolynomial Fraction Integer +--E 5 + +--S 6 of 47 +alternating 7 +--R +--R +--R (6) +--R 2 1 2 1 1 2 1 2 1 4 1 2 3 +--R - (7) + - (5 1 ) + - (4 2 1) + - (3 1) + -- (3 2 ) + -- (3 1 ) + -- (2 1 ) +--R 7 5 4 9 12 36 24 +--R + +--R 1 7 +--R ---- (1 ) +--R 2520 +--R Type: SymmetricPolynomial Fraction Integer +--E 6 + +--S 7 of 47 +cyclic 7 +--R +--R +--R 6 1 7 +--R (7) - (7) + - (1 ) +--R 7 7 +--R Type: SymmetricPolynomial Fraction Integer +--E 7 + +--S 8 of 47 +dihedral 7 +--R +--R +--R 3 1 3 1 7 +--R (8) - (7) + - (2 1) + -- (1 ) +--R 7 2 14 +--R Type: SymmetricPolynomial Fraction Integer +--E 8 + +--S 9 of 47 +graphs 5 +--R +--R +--R (9) +--R 1 1 2 1 2 1 3 1 4 2 1 3 4 1 10 +--R - (6 3 1) + - (5 ) + - (4 2) + - (3 1) + - (2 1 ) + -- (2 1 ) + --- (1 ) +--R 6 5 4 6 8 12 120 +--R Type: SymmetricPolynomial Fraction Integer +--E 9 + +--S 10 of 47 +cap(complete 2**2, complete 2*complete 1**2) +--R +--R +--R (10) 4 +--R Type: Fraction Integer +--E 10 + +--S 11 of 47 +cap(elementary 2**2, complete 2*complete 1**2) +--R +--R +--R (11) 2 +--R Type: Fraction Integer +--E 11 + +--S 12 of 47 +cap(complete 3*complete 2*complete 1,complete 2**2*complete 1**2) +--R +--R +--R (12) 24 +--R Type: Fraction Integer +--E 12 + +--S 13 of 47 +cap(elementary 3*elementary 2*elementary 1,complete 2**2*complete 1**2) +--R +--R +--R (13) 8 +--R Type: Fraction Integer +--E 13 + +--S 14 of 47 +cap(complete 3*complete 2*complete 1,elementary 2**2*elementary 1**2) +--R +--R +--R (14) 8 +--R Type: Fraction Integer +--E 14 + +--S 15 of 47 +eval(cup(complete 3*complete 2*complete 1, cup(complete 2**2*complete 1**2,complete 2**3))) +--R +--R +--R (15) 1500 +--R Type: Fraction Integer +--E 15 + +--S 16 of 47 +square:=dihedral 4 +--R +--R +--R 1 3 2 1 2 1 4 +--R (16) - (4) + - (2 ) + - (2 1 ) + - (1 ) +--R 4 8 4 8 +--R Type: SymmetricPolynomial Fraction Integer +--E 16 + +--S 17 of 47 +cap(complete 2**2,square) +--R +--R +--R (17) 2 +--R Type: Fraction Integer +--E 17 + +--S 18 of 47 +cap(complete 3*complete 2**2,dihedral 7) +--R +--R +--R (18) 18 +--R Type: Fraction Integer +--E 18 + +--S 19 of 47 +cap(graphs 5,complete 7*complete 3) +--R +--R +--R (19) 4 +--R Type: Fraction Integer +--E 19 + +--S 20 of 47 +s(x) == powerSum(x) +--R +--R Type: Void +--E 20 + +--S 21 of 47 +cube:=(1/24)*(s 1**8+9*s 2**4 + 8*s 3**2*s 1**2+6*s 4**2) +--R +--R Compiling function s with type PositiveInteger -> +--R SymmetricPolynomial Fraction Integer +--R +--R 1 2 1 2 2 3 4 1 8 +--R (21) - (4 ) + - (3 1 ) + - (2 ) + -- (1 ) +--R 4 3 8 24 +--R Type: SymmetricPolynomial Fraction Integer +--E 21 + +--S 22 of 47 +cap(complete 4**2,cube) +--R +--R +--R (22) 7 +--R Type: Fraction Integer +--E 22 + +--S 23 of 47 +cap(complete 2**3*complete 1**2,wreath(elementary 4,elementary 2)) +--R +--R +--R (23) 7 +--R Type: Fraction Integer +--E 23 + +--S 24 of 47 +cap(complete 2**3*complete 1**2,wreath(elementary 4,complete 2)) +--R +--R +--R (24) 17 +--R Type: Fraction Integer +--E 24 + +--S 25 of 47 +cap(complete 2**3*complete 1**2,wreath(complete 4,elementary 2)) +--R +--R +--R (25) 10 +--R Type: Fraction Integer +--E 25 + +--S 26 of 47 +cap(complete 2**3*complete 1**2,wreath(complete 4,complete 2)) +--R +--R +--R (26) 23 +--R Type: Fraction Integer +--E 26 + +--S 27 of 47 +x: ULS(FRAC INT,'x,0) := 'x +--R +--R +--R (27) x +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 27 + +--S 28 of 47 +ZeroOrOne: INT -> ULS(FRAC INT, 'x, 0) +--R +--R Type: Void +--E 28 + +--S 29 of 47 +Integers: INT -> ULS(FRAC INT, 'x, 0) +--R +--R Type: Void +--E 29 + +--S 30 of 47 +ZeroOrOne n == 1+x**n +--R +--R Type: Void +--E 30 + +--S 31 of 47 +ZeroOrOne 5 +--R +--R Compiling function ZeroOrOne with type Integer -> +--R UnivariateLaurentSeries(Fraction Integer,x,0) +--R +--R 5 +--R (31) 1 + x +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 31 + +--S 32 of 47 +Integers n == 1/(1-x**n) +--R +--R Type: Void +--E 32 + +--S 33 of 47 +Integers 5 +--R +--R Compiling function Integers with type Integer -> +--R UnivariateLaurentSeries(Fraction Integer,x,0) +--R +--R 5 10 11 +--R (33) 1 + x + x + O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 33 + +--S 34 of 47 +)expose EVALCYC +--R +--I EvaluateCycleIndicators is now explicitly exposed in frame frame0 +--E 34 + +--S 35 of 47 +eval(ZeroOrOne, graphs 5) +--R +--R +--R 2 3 4 5 6 7 8 9 10 11 +--R (34) 1 + x + 2x + 4x + 6x + 6x + 6x + 4x + 2x + x + x + O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 35 + +--S 36 of 47 +eval(ZeroOrOne,dihedral 8) +--R +--R +--R 2 3 4 5 6 7 8 +--R (35) 1 + x + 4x + 5x + 8x + 5x + 4x + x + x +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 36 + +--S 37 of 47 +eval(Integers,complete 4) +--R +--R +--R (36) +--R 2 3 4 5 6 7 8 9 10 11 +--R 1 + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x + O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 37 + +--S 38 of 47 +eval(Integers,elementary 4) +--R +--R +--R (37) +--R 6 7 8 9 10 11 12 13 14 15 16 +--R x + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x +--R + +--R 17 +--R O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 38 + +--S 39 of 47 +eval(ZeroOrOne,cube) +--R +--R +--R 2 3 4 5 6 7 8 +--R (38) 1 + x + 3x + 3x + 7x + 3x + 3x + x + x +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 39 + +--S 40 of 47 +eval(Integers,cube) +--R +--R +--R (39) +--R 2 3 4 5 6 7 8 9 10 +--R 1 + x + 4x + 7x + 21x + 37x + 85x + 151x + 292x + 490x + 848x +--R + +--R 11 +--R O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 40 + +--S 41 of 47 +eval(Integers,graphs 5) +--R +--R +--R (40) +--R 2 3 4 5 6 7 8 9 10 +--R 1 + x + 3x + 7x + 17x + 35x + 76x + 149x + 291x + 539x + 974x +--R + +--R 11 +--R O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 41 + +--S 42 of 47 +eval(ZeroOrOne ,graphs 15) +--R +--R +--R (41) +--R 2 3 4 5 6 7 8 9 10 +--R 1 + x + 2x + 5x + 11x + 26x + 68x + 177x + 496x + 1471x + 4583x +--R + +--R 11 +--R O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 42 + +--S 43 of 47 +cap(dihedral 30,complete 7*complete 8*complete 5*complete 10) +--R +--R +--R (42) 49958972383320 +--R Type: Fraction Integer +--E 43 + +--S 44 of 47 +sf3221:= SFunction [3,2,2,1] +--R +--R +--R (43) +--R 1 1 2 1 2 1 1 4 1 2 +--R -- (6 2) - -- (6 1 ) - -- (4 ) + -- (4 3 1) + -- (4 1 ) - -- (3 2) +--R 12 12 16 12 24 36 +--R + +--R 1 2 2 1 2 1 3 1 5 1 4 1 3 2 +--R -- (3 1 ) - -- (3 2 1) - -- (3 2 1 ) - -- (3 1 ) - --- (2 ) + -- (2 1 ) +--R 36 24 36 72 192 48 +--R + +--R 1 2 4 1 6 1 8 +--R -- (2 1 ) - --- (2 1 ) + --- (1 ) +--R 96 144 576 +--R Type: SymmetricPolynomial Fraction Integer +--E 44 + +--S 45 of 47 +cap(sf3221,complete 2**4) +--R +--R +--R (44) 3 +--R Type: Fraction Integer +--E 45 + +--S 46 of 47 +cap(sf3221, powerSum 1**8) +--R +--R +--R (45) 70 +--R Type: Fraction Integer +--E 46 + +--S 47 of 47 +eval(Integers, sf3221) +--R +--R +--R (46) +--R 9 10 11 12 13 14 15 16 17 18 +--R x + 3x + 7x + 14x + 27x + 47x + 79x + 126x + 196x + 294x +--R + +--R 19 20 +--R 432x + O(x ) +--R Type: UnivariateLaurentSeries(Fraction Integer,x,0) +--E 47 +)spool +)lisp (bye) +@ +<>= +==================================================================== +CycleIndicators examples +==================================================================== + +This section is based upon the paper J. H. Redfield, ``The Theory of +Group-Reduced Distributions'', American J. Math.,49 (1927) 433-455, +and is an application of group theory to enumeration problems. It is +a development of the work by P. A. MacMahon on the application of +symmetric functions and Hammond operators to combinatorial theory. + +The theory is based upon the power sum symmetric functions s(i) which +are the sum of the i-th powers of the variables. The cycle index of a +permutation is an expression that specifies the sizes of the cycles of +a permutation, and may be represented as a partition. A partition of +a non-negative integer n is a collection of positive integers called +its parts whose sum is n. For example, the partition (3^2 2 1^2) will +be used to represent s^2_3 s_2 s^2_1 and will indicate that the +permutation has two cycles of length 3, one of length 2 and two of +length 1. The cycle index of a permutation group is the sum of the +cycle indices of its permutations divided by the number of +permutations. The cycle indices of certain groups are provided. + +The operation complete returns the cycle index of the symmetric group +of order n for argument n. Alternatively, it is the n-th complete +homogeneous symmetric function expressed in terms of power sum +symmetric functions. + + complete 1 + (1) + Type: SymmetricPolynomial Fraction Integer + + complete 2 + 1 1 2 + - (2) + - (1 ) + 2 2 + Type: SymmetricPolynomial Fraction Integer + + complete 3 + 1 1 1 3 + - (3) + - (2 1) + - (1 ) + 3 2 6 + Type: SymmetricPolynomial Fraction Integer + + complete 7 + 1 1 1 1 2 1 1 1 3 + - (7) + - (6 1) + -- (5 2) + -- (5 1 ) + -- (4 3) + - (4 2 1) + -- (4 1 ) + 7 6 10 10 12 8 24 + + + 1 2 1 2 1 2 1 4 1 3 1 2 3 + -- (3 1) + -- (3 2 ) + -- (3 2 1 ) + -- (3 1 ) + -- (2 1) + -- (2 1 ) + 18 24 12 72 48 48 + + + 1 5 1 7 + --- (2 1 ) + ---- (1 ) + 240 5040 + Type: SymmetricPolynomial Fraction Integer + +The operation elementary computes the n-th elementary symmetric +function for argument n. + + elementary 7 + 1 1 1 1 2 1 1 1 3 + - (7) - - (6 1) - -- (5 2) + -- (5 1 ) - -- (4 3) + - (4 2 1) - -- (4 1 ) + 7 6 10 10 12 8 24 + + + 1 2 1 2 1 2 1 4 1 3 1 2 3 + -- (3 1) + -- (3 2 ) - -- (3 2 1 ) + -- (3 1 ) - -- (2 1) + -- (2 1 ) + 18 24 12 72 48 48 + + + 1 5 1 7 + - --- (2 1 ) + ---- (1 ) + 240 5040 + Type: SymmetricPolynomial Fraction Integer + +The operation alternating returns the cycle index of the alternating +group having an even number of even parts in each cycle partition. + + alternating 7 + 2 1 2 1 1 2 1 2 1 4 1 2 3 + - (7) + - (5 1 ) + - (4 2 1) + - (3 1) + -- (3 2 ) + -- (3 1 ) + -- (2 1 ) + 7 5 4 9 12 36 24 + + + 1 7 + ---- (1 ) + 2520 + Type: SymmetricPolynomial Fraction Integer + +The operation cyclic returns the cycle index of the cyclic group. + + cyclic 7 + 6 1 7 + - (7) + - (1 ) + 7 7 + Type: SymmetricPolynomial Fraction Integer + +The operation dihedral is the cycle index of the dihedral group. + + dihedral 7 + 3 1 3 1 7 + - (7) + - (2 1) + -- (1 ) + 7 2 14 + Type: SymmetricPolynomial Fraction Integer + +The operation graphs for argument n returns the cycle index of the +group of permutations on the edges of the complete graph with n nodes +induced by applying the symmetric group to the nodes. + + graphs 5 + 1 1 2 1 2 1 3 1 4 2 1 3 4 1 10 + - (6 3 1) + - (5 ) + - (4 2) + - (3 1) + - (2 1 ) + -- (2 1 ) + --- (1 ) + 6 5 4 6 8 12 120 + Type: SymmetricPolynomial Fraction Integer + +The cycle index of a direct product of two groups is the product of +the cycle indices of the groups. Redfield provided two operations on +two cycle indices which will be called "cup" and "cap" here. The cup +of two cycle indices is a kind of scalar product that combines +monomials for permutations with the same cycles. The cap operation +provides the sum of the coefficients of the result of the cup +operation which will be an integer that enumerates what Redfield +called group-reduced distributions. + +We can, for example, represent complete 2 * complete 2 as the set of +objects a a b b and complete 2 * complete 1 * complete 1 as c c d e. + +This integer is the number of different sets of four pairs. + + cap(complete 2**2, complete 2*complete 1**2) + 4 + Type: Fraction Integer + +For example, + a a b b a a b b a a b b a a b b + c c d e c d c e c e c d d e c c + +This integer is the number of different sets of four pairs no two +pairs being equal. + + cap(elementary 2**2, complete 2*complete 1**2) + 2 + Type: Fraction Integer + +For example, + + a a b b a a b b + c d c e c e c d + +In this case the configurations enumerated are easily constructed, +however the theory merely enumerates them providing little help in +actually constructing them. + +Here are the number of 6-pairs, first from a a a b b c, second +from d d e e f g. + + cap(complete 3*complete 2*complete 1,complete 2**2*complete 1**2) + 24 + Type: Fraction Integer + +Here it is again, but with no equal pairs. + + cap(elementary 3*elementary 2*elementary 1,complete 2**2*complete 1**2) + 8 + Type: Fraction Integer + + cap(complete 3*complete 2*complete 1,elementary 2**2*elementary 1**2) + 8 + Type: Fraction Integer + +The number of 6-triples, first from a a a b b c, second from +d d e e f g, third from h h i i j j. + + eval(cup(complete 3*complete 2*complete 1, cup(complete 2**2*complete 1**2,complete 2**3))) + 1500 + Type: Fraction Integer + +The cycle index of vertices of a square is dihedral 4. + + square:=dihedral 4 + 1 3 2 1 2 1 4 + - (4) + - (2 ) + - (2 1 ) + - (1 ) + 4 8 4 8 + Type: SymmetricPolynomial Fraction Integer + +The number of different squares with 2 red vertices and 2 blue vertices. + + cap(complete 2**2,square) + 2 + Type: Fraction Integer + +The number of necklaces with 3 red beads, 2 blue beads and 2 green beads. + + cap(complete 3*complete 2**2,dihedral 7) + 18 + Type: Fraction Integer + +The number of graphs with 5 nodes and 7 edges. + + cap(graphs 5,complete 7*complete 3) + 4 + Type: Fraction Integer + +The cycle index of rotations of vertices of a cube. + + s(x) == powerSum(x) + Type: Void + + cube:=(1/24)*(s 1**8+9*s 2**4 + 8*s 3**2*s 1**2+6*s 4**2) + 1 2 1 2 2 3 4 1 8 + - (4 ) + - (3 1 ) + - (2 ) + -- (1 ) + 4 3 8 24 + Type: SymmetricPolynomial Fraction Integer + +The number of cubes with 4 red vertices and 4 blue vertices. + + cap(complete 4**2,cube) + 7 + Type: Fraction Integer + +The number of labeled graphs with degree sequence 2 2 2 1 1 with no +loops or multiple edges. + + cap(complete 2**3*complete 1**2,wreath(elementary 4,elementary 2)) + 7 + Type: Fraction Integer + +Again, but with loops allowed but not multiple edges. + + cap(complete 2**3*complete 1**2,wreath(elementary 4,complete 2)) + 17 + Type: Fraction Integer + +Again, but with multiple edges allowed, but not loops + + cap(complete 2**3*complete 1**2,wreath(complete 4,elementary 2)) + 10 + Type: Fraction Integer + +Again, but with both multiple edges and loops allowed + + cap(complete 2**3*complete 1**2,wreath(complete 4,complete 2)) + 23 + Type: Fraction Integer + +Having constructed a cycle index for a configuration we are at liberty +to evaluate the s_i components any way we please. For example we can +produce enumerating generating functions. This is done by providing a +function f on an integer i to the value required of s_i, and then +evaluating eval(f, cycleindex). + + x: ULS(FRAC INT,'x,0) := 'x + x + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + + ZeroOrOne: INT -> ULS(FRAC INT, 'x, 0) + Type: Void + + Integers: INT -> ULS(FRAC INT, 'x, 0) + Type: Void + +For the integers 0 and 1, or two colors. + + ZeroOrOne n == 1+x**n + Type: Void + + ZeroOrOne 5 + 5 + 1 + x + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +For the integers 0, 1, 2, ... we have this. + + Integers n == 1/(1-x**n) + Type: Void + + Integers 5 + 5 10 11 + 1 + x + x + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of graphs with 5 nodes and n edges. + +Note that there is an eval function that takes two arguments. It has the +signature: + + ((Integer -> D1),SymmetricPolynomial Fraction Integer) -> D1 + from EvaluateCycleIndicators D1 if D1 has ALGEBRA FRAC INT + +This function is not normally exposed (it will not normally be considered +in the list of eval functions) as it is only useful for this particular +domain. To use it we ask that it be considered thus: + + )expose EVALCYC + +and now we can use it: + + eval(ZeroOrOne, graphs 5) + 2 3 4 5 6 7 8 9 10 11 + 1 + x + 2x + 4x + 6x + 6x + 6x + 4x + 2x + x + x + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of necklaces with n red beads +and n-8 green beads. + + eval(ZeroOrOne,dihedral 8) + 2 3 4 5 6 7 8 + 1 + x + 4x + 5x + 8x + 5x + 4x + x + x + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of partitions of n into 4 or fewer parts. + + eval(Integers,complete 4) + 2 3 4 5 6 7 8 9 10 11 + 1 + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of partitions of n into 4 boxes +containing ordered distinct parts. + + eval(Integers,elementary 4) + 6 7 8 9 10 11 12 13 14 15 16 + x + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x + + + 17 + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of different cubes with n red +vertices and 8-n green ones. + + eval(ZeroOrOne,cube) + 2 3 4 5 6 7 8 + 1 + x + 3x + 3x + 7x + 3x + 3x + x + x + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of different cubes with integers +on the vertices whose sum is n. + + eval(Integers,cube) + 2 3 4 5 6 7 8 9 10 + 1 + x + 4x + 7x + 21x + 37x + 85x + 151x + 292x + 490x + 848x + + + 11 + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The coefficient of x^n is the number of graphs with 5 nodes and with +integers on the edges whose sum is n. In other words, the enumeration +is of multigraphs with 5 nodes and n edges. + + eval(Integers,graphs 5) + 2 3 4 5 6 7 8 9 10 + 1 + x + 3x + 7x + 17x + 35x + 76x + 149x + 291x + 539x + 974x + + + 11 + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +Graphs with 15 nodes enumerated with respect to number of edges. + + eval(ZeroOrOne ,graphs 15) + 2 3 4 5 6 7 8 9 10 + 1 + x + 2x + 5x + 11x + 26x + 68x + 177x + 496x + 1471x + 4583x + + + 11 + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +Necklaces with 7 green beads, 8 white beads, 5 yellow beads and 10 +red beads. + + cap(dihedral 30,complete 7*complete 8*complete 5*complete 10) + 49958972383320 + Type: Fraction Integer + +The operation SFunction is the S-function or Schur function of a +partition written as a descending list of integers expressed in terms +of power sum symmetric functions. + +In this case the argument partition represents a tableau shape. For +example 3,2,2,1 represents a tableau with three boxes in the first +row, two boxes in the second and third rows, and one box in the fourth +row. SFunction [3,2,2,1] counts the number of different tableaux of +shape 3, 2, 2, 1 filled with objects with an ascending order in the +columns and a non-descending order in the rows. + + sf3221:= SFunction [3,2,2,1] + 1 1 2 1 2 1 1 4 1 2 + -- (6 2) - -- (6 1 ) - -- (4 ) + -- (4 3 1) + -- (4 1 ) - -- (3 2) + 12 12 16 12 24 36 + + + 1 2 2 1 2 1 3 1 5 1 4 1 3 2 + -- (3 1 ) - -- (3 2 1) - -- (3 2 1 ) - -- (3 1 ) - --- (2 ) + -- (2 1 ) + 36 24 36 72 192 48 + + + 1 2 4 1 6 1 8 + -- (2 1 ) - --- (2 1 ) + --- (1 ) + 96 144 576 + Type: SymmetricPolynomial Fraction Integer + +This is the number filled with a a b b c c d d. + + cap(sf3221,complete 2**4) + 3 + Type: Fraction Integer + +The configurations enumerated above are: + + a a b a a c a a d + b c b b b b + c d c d c c + d d d + +This is the number of tableaux filled with 1..8. + + cap(sf3221, powerSum 1**8) + 70 + Type: Fraction Integer + +The coefficient of x^n is the number of column strict reverse plane +partitions of n of shape 3 2 2 1. + + eval(Integers, sf3221) + 9 10 11 12 13 14 15 16 17 + x + 3x + 7x + 14x + 27x + 47x + 79x + 126x + 196x + + + 18 19 20 + 294x + 432x + O(x ) + Type: UnivariateLaurentSeries(Fraction Integer,x,0) + +The smallest is + + 0 0 0 + 1 1 + 2 2 + 3 + +See Also: +o )show CycleIndicators +o $AXIOM/doc/src/algebra/cycles.spad.dvi + +@ +\pagehead{CycleIndicators}{CYCLES} +\pagepic{ps/v104cycleindicators.ps}{CYCLES}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CYCLES CycleIndicators +++ Polya-Redfield enumeration by cycle indices. +++ Author: William H. Burge +++ Date Created: 1986 +++ Date Last Updated: 11 Feb 1992 +++ Keywords:Polya, Redfield, enumeration +++ Examples: +++ References: J.H.Redfield, 'The Theory of Group-Reduced Distributions', +++ American J. Math., 49 (1927) 433-455. +++ G.Polya, 'Kombinatorische Anzahlbestimmungen fur Gruppen, +++ Graphen und chemische Verbindungen', Acta Math. 68 +++ (1937) 145-254. +++ Description: Enumeration by cycle indices. +CycleIndicators: Exports == Implementation where + I ==> Integer + L ==> List + B ==> Boolean + SPOL ==> SymmetricPolynomial + PTN ==> Partition + RN ==> Fraction Integer + FR ==> Factored Integer + h ==> complete + s ==> powerSum + --a ==> elementary + alt ==> alternating + cyc ==> cyclic + dih ==> dihedral + ev == eval + Exports ==> with + + complete: I -> SPOL RN + ++\spad{complete n} is the \spad{n} th complete homogeneous + ++ symmetric function expressed in terms of power sums. + ++ Alternatively it is the cycle index of the symmetric + ++ group of degree n. + + powerSum: I -> SPOL RN + ++\spad{powerSum n} is the \spad{n} th power sum symmetric + ++ function. + + elementary: I -> SPOL RN + ++\spad{elementary n} is the \spad{n} th elementary symmetric + ++ function expressed in terms of power sums. + + -- s2h: I -> SPOL RN--s to h + + alternating: I -> SPOL RN + ++\spad{alternating n} is the cycle index of the + ++ alternating group of degree n. + + cyclic: I -> SPOL RN --cyclic group + ++\spad{cyclic n} is the cycle index of the + ++ cyclic group of degree n. + + dihedral: I -> SPOL RN --dihedral group + ++\spad{dihedral n} is the cycle index of the + ++ dihedral group of degree n. + + graphs: I -> SPOL RN + ++\spad{graphs n} is the cycle index of the group induced on + ++ the edges of a graph by applying the symmetric function to the + ++ n nodes. + + cap: (SPOL RN,SPOL RN) -> RN + ++\spad{cap(s1,s2)}, introduced by Redfield, + ++ is the scalar product of two cycle indices. + + cup: (SPOL RN,SPOL RN) -> SPOL RN + ++\spad{cup(s1,s2)}, introduced by Redfield, + ++ is the scalar product of two cycle indices, in which the + ++ power sums are retained to produce a cycle index. + + eval: SPOL RN -> RN + ++\spad{eval s} is the sum of the coefficients of a cycle index. + + wreath: (SPOL RN,SPOL RN) -> SPOL RN + ++\spad{wreath(s1,s2)} is the cycle index of the wreath product + ++ of the two groups whose cycle indices are \spad{s1} and + ++ \spad{s2}. + + SFunction:L I -> SPOL RN + ++\spad{SFunction(li)} is the S-function of the partition \spad{li} + ++ expressed in terms of power sum symmetric functions. + + skewSFunction:(L I,L I) -> SPOL RN + ++\spad{skewSFunction(li1,li2)} is the S-function + ++ of the partition difference \spad{li1 - li2} + ++ expressed in terms of power sum symmetric functions. + + Implementation ==> add + import PartitionsAndPermutations + import IntegerNumberTheoryFunctions + + trm: PTN -> SPOL RN + trm pt == monomial(inv(pdct(pt) :: RN),pt) + + list: Stream L I -> L L I + list st == entries complete st + + complete i == + if i=0 + then 1 + else if i<0 + then 0 + else + _+/[trm(partition pt) for pt in list(partitions i)] + + + even?: L I -> B + even? li == even?( #([i for i in li | even? i])) + + alt i == + 2 * _+/[trm(partition li) for li in list(partitions i) | even? li] + elementary i == + if i=0 + then 1 + else if i<0 + then 0 + else + _+/[(spol := trm(partition pt); even? pt => spol; -spol) + for pt in list(partitions i)] + + divisors: I -> L I + divisors n == + b := factors(n :: FR) + c := concat(1,"append"/ + [[a.factor**j for j in 1..a.exponent] for a in b]); + if #(b) = 1 then c else concat(n,c) + + ss: (I,I) -> SPOL RN + ss(n,m) == + li : L I := [n for j in 1..m] + monomial(1,partition li) + + s n == ss(n,1) + + cyc n == + n = 1 => s 1 + _+/[(eulerPhi(i) / n) * ss(i,numer(n/i)) for i in divisors n] + + dih n == + k := n quo 2 + odd? n => (1/2) * cyc n + (1/2) * ss(2,k) * s 1 + (1/2) * cyc n + (1/4) * ss(2,k) + (1/4) * ss(2,k-1) * ss(1,2) + + trm2: L I -> SPOL RN + trm2 li == + lli := powers(li)$PTN + xx := 1/(pdct partition li) + prod : SPOL RN := 1 + for ll in lli repeat + ll0 := first ll; ll1 := second ll + k := ll0 quo 2 + c := + odd? ll0 => ss(ll0,ll1 * k) + ss(k,ll1) * ss(ll0,ll1 * (k - 1)) + c := c * ss(ll0,ll0 * ((ll1*(ll1 - 1)) quo 2)) + prod2 : SPOL RN := 1 + for r in lli | first(r) < ll0 repeat + r0 := first r; r1 := second r + prod2 := ss(lcm(r0,ll0),gcd(r0,ll0) * r1 * ll1) * prod2 + prod := c * prod2 * prod + xx * prod + + graphs n == _+/[trm2 li for li in list(partitions n)] + + cupp: (PTN,SPOL RN) -> SPOL RN + cupp(pt,spol) == + zero? spol => 0 + (dg := degree spol) < pt => 0 + dg = pt => (pdct pt) * monomial(leadingCoefficient spol,dg) + cupp(pt,reductum spol) + + cup(spol1,spol2) == + zero? spol1 => 0 + p := leadingCoefficient(spol1) * cupp(degree spol1,spol2) + p + cup(reductum spol1,spol2) + + ev spol == + zero? spol => 0 + leadingCoefficient(spol) + ev(reductum spol) + + cap(spol1,spol2) == ev cup(spol1,spol2) + + mtpol: (I,SPOL RN) -> SPOL RN + mtpol(n,spol)== + zero? spol => 0 + deg := partition [n*k for k in (degree spol)::L(I)] + monomial(leadingCoefficient spol,deg) + mtpol(n,reductum spol) + + fn2: I -> SPOL RN + evspol: ((I -> SPOL RN),SPOL RN) -> SPOL RN + evspol(fn2,spol) == + zero? spol => 0 + lc := leadingCoefficient spol + prod := _*/[fn2 i for i in (degree spol)::L(I)] + lc * prod + evspol(fn2,reductum spol) + + wreath(spol1,spol2) == evspol(mtpol(#1,spol2),spol1) + + hh: I -> SPOL RN --symmetric group + hh n == if n=0 then 1 else if n<0 then 0 else h n + SFunction li== + a:Matrix SPOL RN:=matrix [[hh(k -j+i) for k in li for j in 1..#li] + for i in 1..#li] + determinant a + + roundup:(L I,L I)-> L I + roundup(li1,li2)== + #li1 > #li2 => roundup(li1,concat(li2,0)) + li2 + + skewSFunction(li1,li2)== + #li1 < #li2 => + error "skewSFunction: partition1 does not include partition2" + li2:=roundup (li1,li2) + a:Matrix SPOL RN:=matrix [[hh(k-li2.i-j+i) + for k in li1 for j in 1..#li1] for i in 1..#li1] + determinant a + +@ +<>= +"CYCLES" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CYCLES"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"CYCLES" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CYCLOTOM CyclotomicPolynomialPackage} +\pagehead{CyclotomicPolynomialPackage}{CYCLOTOM} +\pagepic{ps/v104cyclotomicpolynomialpackage.ps}{CYCLOTOM}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CYCLOTOM CyclotomicPolynomialPackage +++ This package \undocumented{} +CyclotomicPolynomialPackage: public == private where + SUP ==> SparseUnivariatePolynomial(Integer) + LSUP ==> List(SUP) + NNI ==> NonNegativeInteger + FR ==> Factored SUP + IFP ==> IntegerFactorizationPackage Integer + + public == with + cyclotomicDecomposition: Integer -> LSUP + ++ cyclotomicDecomposition(n) \undocumented{} + cyclotomic: Integer -> SUP + ++ cyclotomic(n) \undocumented{} + cyclotomicFactorization: Integer -> FR + ++ cyclotomicFactorization(n) \undocumented{} + + private == add + cyclotomic(n:Integer): SUP == + x,y,z,l: SUP + g := factors factor(n)$IFP + --Now, for each prime in the factorization apply recursion + l := monomial(1,1) - monomial(1,0) + for u in g repeat + l := (monicDivide(multiplyExponents(l,u.factor::NNI),l)).quotient + if u.exponent>1 then + l := multiplyExponents(l,((u.factor)**((u.exponent-1)::NNI))::NNI) + l + + cyclotomicDecomposition(n:Integer):LSUP == + x,y,z: SUP + l,ll,m: LSUP + rr: Integer + g := factors factor(n)$IFP + l := [monomial(1,1) - monomial(1,0)] + --Now, for each prime in the factorization apply recursion + for u in g repeat + m := [(monicDivide( + multiplyExponents(z,u.factor::NNI),z)).quotient for z in l] + for rr in 1..(u.exponent-1) repeat + l := append(l,m) + m := [multiplyExponents(z,u.factor::NNI) for z in m] + l := append(l,m) + l + + cyclotomicFactorization(n:Integer):FR == + f : SUP + fr : FR := 1$FR + for f in cyclotomicDecomposition(n) repeat + fr := fr * primeFactor(f,1$Integer) + fr + +@ +<>= +"CYCLOTOM" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CYCLOTOM"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"CYCLOTOM" -> "PFECAT" @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter D} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package COORDSYS CoordinateSystems} +\pagehead{CoordinateSystems}{COORDSYS} +\pagepic{ps/v104coordinatesystems.ps}{COORDSYS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package COORDSYS CoordinateSystems +++ Author: Jim Wen +++ Date Created: 12 March 1990 +++ Date Last Updated: 19 June 1990, Clifton J. Williamson +++ Basic Operations: cartesian, polar, cylindrical, spherical, parabolic, elliptic, +++ parabolicCylindrical, paraboloidal, ellipticCylindrical, prolateSpheroidal, +++ oblateSpheroidal, bipolar, bipolarCylindrical, toroidal, conical +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: CoordinateSystems provides coordinate transformation functions +++ for plotting. Functions in this package return conversion functions +++ which take points expressed in other coordinate systems and return points +++ with the corresponding Cartesian coordinates. + +CoordinateSystems(R): Exports == Implementation where + + R : Join(Field,TranscendentalFunctionCategory,RadicalCategory) + Pt ==> Point R + + Exports ==> with + cartesian : Pt -> Pt + ++ cartesian(pt) returns the Cartesian coordinates of point pt. + polar: Pt -> Pt + ++ polar(pt) transforms pt from polar coordinates to Cartesian + ++ coordinates: the function produced will map the point \spad{(r,theta)} + ++ to \spad{x = r * cos(theta)} , \spad{y = r * sin(theta)}. + cylindrical: Pt -> Pt + ++ cylindrical(pt) transforms pt from polar coordinates to Cartesian + ++ coordinates: the function produced will map the point \spad{(r,theta,z)} + ++ to \spad{x = r * cos(theta)}, \spad{y = r * sin(theta)}, \spad{z}. + spherical: Pt -> Pt + ++ spherical(pt) transforms pt from spherical coordinates to Cartesian + ++ coordinates: the function produced will map the point \spad{(r,theta,phi)} + ++ to \spad{x = r*sin(phi)*cos(theta)}, \spad{y = r*sin(phi)*sin(theta)}, + ++ \spad{z = r*cos(phi)}. + parabolic: Pt -> Pt + ++ parabolic(pt) transforms pt from parabolic coordinates to Cartesian + ++ coordinates: the function produced will map the point \spad{(u,v)} to + ++ \spad{x = 1/2*(u**2 - v**2)}, \spad{y = u*v}. + parabolicCylindrical: Pt -> Pt + ++ parabolicCylindrical(pt) transforms pt from parabolic cylindrical + ++ coordinates to Cartesian coordinates: the function produced will + ++ map the point \spad{(u,v,z)} to \spad{x = 1/2*(u**2 - v**2)}, + ++ \spad{y = u*v}, \spad{z}. + paraboloidal: Pt -> Pt + ++ paraboloidal(pt) transforms pt from paraboloidal coordinates to + ++ Cartesian coordinates: the function produced will map the point + ++ \spad{(u,v,phi)} to \spad{x = u*v*cos(phi)}, \spad{y = u*v*sin(phi)}, + ++ \spad{z = 1/2 * (u**2 - v**2)}. + elliptic: R -> (Pt -> Pt) + ++ elliptic(a) transforms from elliptic coordinates to Cartesian + ++ coordinates: \spad{elliptic(a)} is a function which will map the + ++ point \spad{(u,v)} to \spad{x = a*cosh(u)*cos(v)}, \spad{y = a*sinh(u)*sin(v)}. + ellipticCylindrical: R -> (Pt -> Pt) + ++ ellipticCylindrical(a) transforms from elliptic cylindrical coordinates + ++ to Cartesian coordinates: \spad{ellipticCylindrical(a)} is a function + ++ which will map the point \spad{(u,v,z)} to \spad{x = a*cosh(u)*cos(v)}, + ++ \spad{y = a*sinh(u)*sin(v)}, \spad{z}. + prolateSpheroidal: R -> (Pt -> Pt) + ++ prolateSpheroidal(a) transforms from prolate spheroidal coordinates to + ++ Cartesian coordinates: \spad{prolateSpheroidal(a)} is a function + ++ which will map the point \spad{(xi,eta,phi)} to + ++ \spad{x = a*sinh(xi)*sin(eta)*cos(phi)}, \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, + ++ \spad{z = a*cosh(xi)*cos(eta)}. + oblateSpheroidal: R -> (Pt -> Pt) + ++ oblateSpheroidal(a) transforms from oblate spheroidal coordinates to + ++ Cartesian coordinates: \spad{oblateSpheroidal(a)} is a function which + ++ will map the point \spad{(xi,eta,phi)} to \spad{x = a*sinh(xi)*sin(eta)*cos(phi)}, + ++ \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, \spad{z = a*cosh(xi)*cos(eta)}. + bipolar: R -> (Pt -> Pt) + ++ bipolar(a) transforms from bipolar coordinates to Cartesian coordinates: + ++ \spad{bipolar(a)} is a function which will map the point \spad{(u,v)} to + ++ \spad{x = a*sinh(v)/(cosh(v)-cos(u))}, \spad{y = a*sin(u)/(cosh(v)-cos(u))}. + bipolarCylindrical: R -> (Pt -> Pt) + ++ bipolarCylindrical(a) transforms from bipolar cylindrical coordinates + ++ to Cartesian coordinates: \spad{bipolarCylindrical(a)} is a function which + ++ will map the point \spad{(u,v,z)} to \spad{x = a*sinh(v)/(cosh(v)-cos(u))}, + ++ \spad{y = a*sin(u)/(cosh(v)-cos(u))}, \spad{z}. + toroidal: R -> (Pt -> Pt) + ++ toroidal(a) transforms from toroidal coordinates to Cartesian + ++ coordinates: \spad{toroidal(a)} is a function which will map the point + ++ \spad{(u,v,phi)} to \spad{x = a*sinh(v)*cos(phi)/(cosh(v)-cos(u))}, + ++ \spad{y = a*sinh(v)*sin(phi)/(cosh(v)-cos(u))}, \spad{z = a*sin(u)/(cosh(v)-cos(u))}. + conical: (R,R) -> (Pt -> Pt) + ++ conical(a,b) transforms from conical coordinates to Cartesian coordinates: + ++ \spad{conical(a,b)} is a function which will map the point \spad{(lambda,mu,nu)} to + ++ \spad{x = lambda*mu*nu/(a*b)}, + ++ \spad{y = lambda/a*sqrt((mu**2-a**2)*(nu**2-a**2)/(a**2-b**2))}, + ++ \spad{z = lambda/b*sqrt((mu**2-b**2)*(nu**2-b**2)/(b**2-a**2))}. + + Implementation ==> add + + cartesian pt == + -- we just want to interpret the cartesian coordinates + -- from the first N elements of the point - so the + -- identity function will do + pt + + polar pt0 == + pt := copy pt0 + r := elt(pt0,1); theta := elt(pt0,2) + pt.1 := r * cos(theta); pt.2 := r * sin(theta) + pt + + cylindrical pt0 == polar pt0 + -- apply polar transformation to first 2 coordinates + + spherical pt0 == + pt := copy pt0 + r := elt(pt0,1); theta := elt(pt0,2); phi := elt(pt0,3) + pt.1 := r * sin(phi) * cos(theta); pt.2 := r * sin(phi) * sin(theta) + pt.3 := r * cos(phi) + pt + + parabolic pt0 == + pt := copy pt0 + u := elt(pt0,1); v := elt(pt0,2) + pt.1 := (u*u - v*v)/(2::R) ; pt.2 := u*v + pt + + parabolicCylindrical pt0 == parabolic pt0 + -- apply parabolic transformation to first 2 coordinates + + paraboloidal pt0 == + pt := copy pt0 + u := elt(pt0,1); v := elt(pt0,2); phi := elt(pt0,3) + pt.1 := u*v*cos(phi); pt.2 := u*v*sin(phi); pt.3 := (u*u - v*v)/(2::R) + pt + + elliptic a == + pt := copy(#1) + u := elt(#1,1); v := elt(#1,2) + pt.1 := a*cosh(u)*cos(v); pt.2 := a*sinh(u)*sin(v) + pt + + ellipticCylindrical a == elliptic a + -- apply elliptic transformation to first 2 coordinates + + prolateSpheroidal a == + pt := copy(#1) + xi := elt(#1,1); eta := elt(#1,2); phi := elt(#1,3) + pt.1 := a*sinh(xi)*sin(eta)*cos(phi) + pt.2 := a*sinh(xi)*sin(eta)*sin(phi) + pt.3 := a*cosh(xi)*cos(eta) + pt + + oblateSpheroidal a == + pt := copy(#1) + xi := elt(#1,1); eta := elt(#1,2); phi := elt(#1,3) + pt.1 := a*sinh(xi)*sin(eta)*cos(phi) + pt.2 := a*cosh(xi)*cos(eta)*sin(phi) + pt.3 := a*sinh(xi)*sin(eta) + pt + + bipolar a == + pt := copy(#1) + u := elt(#1,1); v := elt(#1,2) + pt.1 := a*sinh(v)/(cosh(v)-cos(u)) + pt.2 := a*sin(u)/(cosh(v)-cos(u)) + pt + + bipolarCylindrical a == bipolar a + -- apply bipolar transformation to first 2 coordinates + + toroidal a == + pt := copy(#1) + u := elt(#1,1); v := elt(#1,2); phi := elt(#1,3) + pt.1 := a*sinh(v)*cos(phi)/(cosh(v)-cos(u)) + pt.2 := a*sinh(v)*sin(phi)/(cosh(v)-cos(u)) + pt.3 := a*sin(u)/(cosh(v)-cos(u)) + pt + + conical(a,b) == + pt := copy(#1) + lambda := elt(#1,1); mu := elt(#1,2); nu := elt(#1,3) + pt.1 := lambda*mu*nu/(a*b) + pt.2 := lambda/a*sqrt((mu**2-a**2)*(nu**2-a**2)/(a**2-b**2)) + pt.3 := lambda/b*sqrt((mu**2-b**2)*(nu**2-b**2)/(b**2-a**2)) + pt + +@ +<>= +"COORDSYS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=COORDSYS"] +"PTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PTCAT"] +"COORDSYS" -> "PTCAT" + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter E} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package EVALCYC EvaluateCycleIndicators} +\pagehead{EvaluateCycleIndicators}{EVALCYC} +\pagepic{ps/v104evaluatecycleindicators.ps}{EVALCYC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package EVALCYC EvaluateCycleIndicators +++ Author: William H. Burge +++ Date Created: 1986 +++ Date Last Updated: Feb 1992 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: This package is to be used in conjuction with +++ the CycleIndicators package. It provides an evaluation +++ function for SymmetricPolynomials. +EvaluateCycleIndicators(F):T==C where + F:Algebra Fraction Integer + I==>Integer + L==>List + SPOL==SymmetricPolynomial + RN==>Fraction Integer + PR==>Polynomial(RN) + PTN==>Partition() + lc ==> leadingCoefficient + red ==> reductum + T== with + eval:((I->F),SPOL RN)->F + ++\spad{eval(f,s)} evaluates the cycle index s by applying + ++ the function f to each integer in a monomial partition, + ++ forms their product and sums the results over all monomials. + C== add + evp:((I->F),PTN)->F + fn:I->F + pt:PTN + spol:SPOL RN + i:I + evp(fn, pt)== _*/[fn i for i in pt::(L I)] + + eval(fn,spol)== + if spol=0 + then 0 + else ((lc spol)* evp(fn,degree spol)) + eval(fn,red spol) + +@ +<>= +"EVALCYC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=EVALCYC"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"EVALCYC" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ESCONT ExpertSystemContinuityPackage} +\pagehead{ExpertSystemContinuityPackage}{ESCONT} +\pagepic{ps/v104expertsystemcontinuitypackage.ps}{ESCONT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +"ESCONT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ESCONT"] + +@ +<>= +)abbrev package ESCONT ExpertSystemContinuityPackage +++ Author: Brian Dupee +++ Date Created: May 1994 +++ Date Last Updated: June 1995 +++ Basic Operations: problemPoints, singularitiesOf, zerosOf +++ Related Constructors: +++ Description: +++ ExpertSystemContinuityPackage is a package of functions for the use of domains +++ belonging to the category \axiomType{NumericalIntegration}. + +ExpertSystemContinuityPackage(): E == I where + EF2 ==> ExpressionFunctions2 + FI ==> Fraction Integer + EFI ==> Expression Fraction Integer + PFI ==> Polynomial Fraction Integer + DF ==> DoubleFloat + LDF ==> List DoubleFloat + EDF ==> Expression DoubleFloat + VEDF ==> Vector Expression DoubleFloat + SDF ==> Stream DoubleFloat + SS ==> Stream String + EEDF ==> Equation Expression DoubleFloat + LEDF ==> List Expression DoubleFloat + KEDF ==> Kernel Expression DoubleFloat + LKEDF ==> List Kernel Expression DoubleFloat + PDF ==> Polynomial DoubleFloat + FPDF ==> Fraction Polynomial DoubleFloat + OCDF ==> OrderedCompletion DoubleFloat + SOCDF ==> Segment OrderedCompletion DoubleFloat + NIA ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF) + UP ==> UnivariatePolynomial + BO ==> BasicOperator + RS ==> Record(zeros: SDF,ones: SDF,singularities: SDF) + + E ==> with + + getlo : SOCDF -> DF + ++ getlo(u) gets the \axiomType{DoubleFloat} equivalent of + ++ the first endpoint of the range \axiom{u} + gethi : SOCDF -> DF + ++ gethi(u) gets the \axiomType{DoubleFloat} equivalent of + ++ the second endpoint of the range \axiom{u} + functionIsFracPolynomial?: NIA -> Boolean + ++ functionIsFracPolynomial?(args) tests whether the function + ++ can be retracted to \axiomType{Fraction(Polynomial(DoubleFloat))} + problemPoints:(EDF,Symbol,SOCDF) -> List DF + ++ problemPoints(f,var,range) returns a list of possible problem points + ++ by looking at the zeros of the denominator of the function \spad{f} + ++ if it can be retracted to \axiomType{Polynomial(DoubleFloat)}. + zerosOf:(EDF,List Symbol,SOCDF) -> SDF + ++ zerosOf(e,vars,range) returns a list of points + ++ (\axiomType{Doublefloat}) at which a NAG fortran version of \spad{e} + ++ will most likely produce an error. + singularitiesOf: (EDF,List Symbol,SOCDF) -> SDF + ++ singularitiesOf(e,vars,range) returns a list of points + ++ (\axiomType{Doublefloat}) at which a NAG fortran + ++ version of \spad{e} will most likely produce + ++ an error. This includes those points which evaluate to 0/0. + singularitiesOf: (Vector EDF,List Symbol,SOCDF) -> SDF + ++ singularitiesOf(v,vars,range) returns a list of points + ++ (\axiomType{Doublefloat}) at which a NAG fortran + ++ version of \spad{v} will most likely produce + ++ an error. This includes those points which evaluate to 0/0. + polynomialZeros:(PFI,Symbol,SOCDF) -> LDF + ++ polynomialZeros(fn,var,range) calculates the real zeros of the + ++ polynomial which are contained in the given interval. It returns + ++ a list of points (\axiomType{Doublefloat}) for which the univariate + ++ polynomial \spad{fn} is zero. + df2st:DF -> String + ++ df2st(n) coerces a \axiomType{DoubleFloat} to \axiomType{String} + ldf2lst:LDF -> List String + ++ ldf2lst(ln) coerces a List of \axiomType{DoubleFloat} to + ++ \axiomType{List}(\axiomType{String}) + sdf2lst:SDF -> List String + ++ sdf2lst(ln) coerces a Stream of \axiomType{DoubleFloat} to + ++ \axiomType{List}(\axiomType{String}) + + I ==> ExpertSystemToolsPackage add + + import ExpertSystemToolsPackage + + functionIsPolynomial?(args:NIA):Boolean == + -- tests whether the function can be retracted to a polynomial + (retractIfCan(args.fn)@Union(PDF,"failed"))$EDF case PDF + + isPolynomial?(f:EDF):Boolean == + -- tests whether the function can be retracted to a polynomial + (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF + + isConstant?(f:EDF):Boolean == + -- tests whether the function can be retracted to a constant (DoubleFloat) + (retractIfCan(f)@Union(DF,"failed"))$EDF case DF + + denominatorIsPolynomial?(args:NIA):Boolean == + -- tests if the denominator can be retracted to polynomial + a:= copy args + a.fn:=denominator(args.fn) + (functionIsPolynomial?(a))@Boolean + + denIsPolynomial?(f:EDF):Boolean == + -- tests if the denominator can be retracted to polynomial + (isPolynomial?(denominator f))@Boolean + + listInRange(l:LDF,range:SOCDF):LDF == + -- returns a list with only those elements internal to the range range + [t for t in l | in?(t,range)] + + loseUntil(l:SDF,a:DF):SDF == + empty?(l)$SDF => l + f := first(l)$SDF + (abs(f) <= abs(a)) => loseUntil(rest(l)$SDF,a) + l + + retainUntil(l:SDF,a:DF,b:DF,flag:Boolean):SDF == + empty?(l)$SDF => l + f := first(l)$SDF + (in?(f)$ExpertSystemContinuityPackage1(a,b)) => + concat(f,retainUntil(rest(l),a,b,false)) + flag => empty()$SDF + retainUntil(rest(l),a,b,true) + + streamInRange(l:SDF,range:SOCDF):SDF == + -- returns a stream with only those elements internal to the range range + a := getlo(range := dfRange(range)) + b := gethi(range) + explicitlyFinite?(l) => + select(in?$ExpertSystemContinuityPackage1(a,b),l)$SDF + negative?(a*b) => retainUntil(l,a,b,false) + negative?(a) => + l := loseUntil(l,b) + retainUntil(l,a,b,false) + l := loseUntil(l,a) + retainUntil(l,a,b,false) + + getStream(n:Symbol,s:String):SDF == + import RS + entry?(n,bfKeys()$BasicFunctions)$(List(Symbol)) => + c := bfEntry(n)$BasicFunctions + (s = "zeros")@Boolean => c.zeros + (s = "singularities")@Boolean => c.singularities + (s = "ones")@Boolean => c.ones + empty()$SDF + + polynomialZeros(fn:PFI,var:Symbol,range:SOCDF):LDF == + up := unmakeSUP(univariate(fn)$PFI)$UP(var,FI) + range := dfRange(range) + r:Record(left:FI,right:FI) := [df2fi(getlo(range)), df2fi(gethi(range))] + ans:List(Record(left:FI,right:FI)) := + realZeros(up,r,1/1000000000000000000)$RealZeroPackageQ(UP(var,FI)) + listInRange(dflist(ans),range) + + functionIsFracPolynomial?(args:NIA):Boolean == + -- tests whether the function can be retracted to a fraction + -- where both numerator and denominator are polynomial + (retractIfCan(args.fn)@Union(FPDF,"failed"))$EDF case FPDF + + problemPoints(f:EDF,var:Symbol,range:SOCDF):LDF == + (denIsPolynomial?(f))@Boolean => + c := retract(edf2efi(denominator(f)))@PFI + polynomialZeros(c,var,range) + empty()$LDF + + zerosOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == + (u := isQuotient(e)) case EDF => + singularitiesOf(u,vars,range) + k := kernels(e)$EDF + ((nk := # k) = 0)@Boolean => empty()$SDF -- constant found. + (nk = 1)@Boolean => -- single expression found. + ker := first(k)$LKEDF + n := name(operator(ker)$KEDF)$BO + entry?(n,vars) => -- polynomial found. + c := retract(edf2efi(e))@PFI + coerce(polynomialZeros(c,n,range))$SDF + a := first(argument(ker)$KEDF)$LEDF + (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) => + var:Symbol := first(variables(a)) + c:EDF := w.2 + c1:EDF := w.1 +-- entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) => + entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) => + c2:DF := edf2df c + c3 := c2 :: OCDF + varEdf := var :: EDF + varEqn := equation(varEdf,c1-c)$EEDF + range2 := (lo(range)+c3)..(hi(range)+c3) + s := zerosOf(subst(e,varEqn)$EDF,vars,range2) + st := map(#1-c2,s)$StreamFunctions2(DF,DF) + streamInRange(st,range) + zerosOf(a,vars,range) + (t := isPlus(e)$EDF) case LEDF => -- constant + expression + # t > 2 => empty()$SDF + entry?(a,[b::EDF for b in vars]) => -- finds entries like sqrt(x) + st := getStream(n,"ones") + o := edf2df(second(t)$LEDF) +-- one?(o) or one?(-o) => -- is it like (f(x) -/+ 1) + (o = 1) or (-o = 1) => -- is it like (f(x) -/+ 1) + st := map(-#1/o,st)$StreamFunctions2(DF,DF) + streamInRange(st,range) + empty()$SDF + empty()$SDF + entry?(a,[b::EDF for b in vars]) => -- finds entries like sqrt(x) + st := getStream(n,"zeros") + streamInRange(st,range) + (n = tan :: Symbol)@Boolean => + concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) + (n = sin :: Symbol)@Boolean => + concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) + empty()$SDF + (t := isPlus(e)$EDF) case LEDF => empty()$SDF -- INCOMPLETE!!! + (v := isTimes(e)$EDF) case LEDF => + concat([zerosOf(u,vars,range) for u in v]) + empty()$SDF + + singularitiesOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == + (u := isQuotient(e)) case EDF => + zerosOf(u,vars,range) + (t := isPlus e) case LEDF => + concat([singularitiesOf(u,vars,range) for u in t]) + (v := isTimes e) case LEDF => + concat([singularitiesOf(u,vars,range) for u in v]) + (k := mainKernel e) case KEDF => + n := name(operator k) + entry?(n,vars) => coerce(problemPoints(e,n,range))$SDF + a:EDF := (argument k).1 + (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) => + var:Symbol := first(variables(a)) + c:EDF := w.2 + c1:EDF := w.1 +-- entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) => + entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) => + c2:DF := edf2df c + c3 := c2 :: OCDF + varEdf := var :: EDF + varEqn := equation(varEdf,c1-c)$EEDF + range2 := (lo(range)+c3)..(hi(range)+c3) + s := singularitiesOf(subst(e,varEqn)$EDF,vars,range2) + st := map(#1-c2,s)$StreamFunctions2(DF,DF) + streamInRange(st,range) + singularitiesOf(a,vars,range) + entry?(a,[b::EDF for b in vars]) => + st := getStream(n,"singularities") + streamInRange(st,range) + (n = log :: Symbol)@Boolean => + concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) + singularitiesOf(a,vars,range) + empty()$SDF + + singularitiesOf(v:VEDF,vars:List Symbol,range:SOCDF):SDF == + ls := [singularitiesOf(u,vars,range) for u in entries(v)$VEDF] + concat(ls)$SDF + +@ +<>= +"ESCONT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ESCONT"] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ESCONT1 ExpertSystemContinuityPackage1} +\pagehead{ExpertSystemContinuityPackage1}{ESCONT1} +\pagepic{ps/v104expertsystemcontinuitypackage1.ps}{ESCONT1}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ESCONT1 ExpertSystemContinuityPackage1 +++ Author: Brian Dupee +++ Date Created: May 1994 +++ Date Last Updated: June 1995 +++ Basic Operations: problemPoints, singularitiesOf, zerosOf +++ Related Constructors: +++ Description: +++ ExpertSystemContinuityPackage1 exports a function to check range inclusion + +ExpertSystemContinuityPackage1(A:DF,B:DF): E == I where + EF2 ==> ExpressionFunctions2 + FI ==> Fraction Integer + EFI ==> Expression Fraction Integer + PFI ==> Polynomial Fraction Integer + DF ==> DoubleFloat + LDF ==> List DoubleFloat + EDF ==> Expression DoubleFloat + VEDF ==> Vector Expression DoubleFloat + SDF ==> Stream DoubleFloat + SS ==> Stream String + EEDF ==> Equation Expression DoubleFloat + LEDF ==> List Expression DoubleFloat + KEDF ==> Kernel Expression DoubleFloat + LKEDF ==> List Kernel Expression DoubleFloat + PDF ==> Polynomial DoubleFloat + FPDF ==> Fraction Polynomial DoubleFloat + OCDF ==> OrderedCompletion DoubleFloat + SOCDF ==> Segment OrderedCompletion DoubleFloat + NIA ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF) + UP ==> UnivariatePolynomial + BO ==> BasicOperator + RS ==> Record(zeros: SDF,ones: SDF,singularities: SDF) + + E ==> with + + in?:DF -> Boolean + ++ in?(p) tests whether point p is internal to the range [\spad{A..B}] + + I ==> add + + in?(p:DF):Boolean == + a:Boolean := (p < B)$DF + b:Boolean := (A < p)$DF + (a and b)@Boolean + +@ +<>= +"ESCONT1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ESCONT1"] +"ESCONT1" -> "Package" + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter F} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1941,6 +5410,522 @@ FiniteSetAggregateFunctions2(S, A, R, B): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package FFCAT2 FunctionFieldCategoryFunctions2} +\pagehead{FunctionFieldCategoryFunctions2}{FFCAT2} +\pagepic{ps/v104functionfieldcategoryfunctions2.ps}{FFCAT2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package FFCAT2 FunctionFieldCategoryFunctions2 +++ Lifts a map from rings to function fields over them +++ Author: Manuel Bronstein +++ Date Created: May 1988 +++ Date Last Updated: 26 Jul 1988 +++ Description: Lifts a map from rings to function fields over them. +FunctionFieldCategoryFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2): + Exports == Implementation where + R1 : UniqueFactorizationDomain + UP1 : UnivariatePolynomialCategory R1 + UPUP1: UnivariatePolynomialCategory Fraction UP1 + F1 : FunctionFieldCategory(R1, UP1, UPUP1) + R2 : UniqueFactorizationDomain + UP2 : UnivariatePolynomialCategory R2 + UPUP2: UnivariatePolynomialCategory Fraction UP2 + F2 : FunctionFieldCategory(R2, UP2, UPUP2) + + Exports ==> with + map: (R1 -> R2, F1) -> F2 + ++ map(f, p) lifts f to F1 and applies it to p. + + Implementation ==> add + map(f, f1) == + reduce(map(f, lift f1)$MultipleMap(R1, UP1, UPUP1, R2, UP2, UPUP2)) + +@ +<>= +"FFCAT2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=FFCAT2"] +"FFCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FFCAT"] +"FFCAT2" -> "FFCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package SUMFS FunctionSpaceSum} +\pagehead{FunctionSpaceSum}{SUMFS} +\pagepic{ps/v104functionspacesum.ps}{SUMFS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package SUMFS FunctionSpaceSum +++ Top-level sum function +++ Author: Manuel Bronstein +++ Date Created: ??? +++ Date Last Updated: 19 April 1991 +++ Description: computes sums of top-level expressions; +FunctionSpaceSum(R, F): Exports == Implementation where + R: Join(IntegralDomain, OrderedSet, + RetractableTo Integer, LinearlyExplicitRingOver Integer) + F: Join(FunctionSpace R, CombinatorialOpsCategory, + AlgebraicallyClosedField, TranscendentalFunctionCategory) + + SE ==> Symbol + K ==> Kernel F + + Exports ==> with + sum: (F, SE) -> F + ++ sum(a(n), n) returns A(n) such that A(n+1) - A(n) = a(n); + sum: (F, SegmentBinding F) -> F + ++ sum(f(n), n = a..b) returns f(a) + f(a+1) + ... + f(b); + + Implementation ==> add + import ElementaryFunctionStructurePackage(R, F) + import GosperSummationMethod(IndexedExponents K, K, R, + SparseMultivariatePolynomial(R, K), F) + + innersum: (F, K) -> Union(F, "failed") + notRF? : (F, K) -> Boolean + newk : () -> K + + newk() == kernel(new()$SE) + + sum(x:F, s:SegmentBinding F) == + k := kernel(variable s)@K + (u := innersum(x, k)) case "failed" => summation(x, s) + eval(u::F, k, 1 + hi segment s) - eval(u::F, k, lo segment s) + + sum(x:F, v:SE) == + (u := innersum(x, kernel(v)@K)) case "failed" => summation(x,v) + u::F + + notRF?(f, k) == + for kk in tower f repeat + member?(k, tower(kk::F)) and (symbolIfCan(kk) case "failed") => + return true + false + + innersum(x, k) == + zero? x => 0 + notRF?(f := normalize(x / (x1 := eval(x, k, k::F - 1))), k) => + "failed" + (u := GospersMethod(f, k, newk)) case "failed" => "failed" + x1 * eval(u::F, k, k::F - 1) + +@ +<>= +"SUMFS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=SUMFS"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"SUMFS" -> "FS" +"SUMFS" -> "ACF" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package FSPECF FunctionalSpecialFunction} +\pagehead{FunctionalSpecialFunction}{FSPECF} +\pagepic{ps/v104functionalspecialfunction.ps}{FSPECF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package FSPECF FunctionalSpecialFunction +++ Provides the special functions +++ Author: Manuel Bronstein +++ Date Created: 18 Apr 1989 +++ Date Last Updated: 4 October 1993 +++ Description: Provides some special functions over an integral domain. +++ Keywords: special, function. +FunctionalSpecialFunction(R, F): Exports == Implementation where + R: Join(OrderedSet, IntegralDomain) + F: FunctionSpace R + + OP ==> BasicOperator + K ==> Kernel F + SE ==> Symbol + SPECIALDIFF ==> "%specialDiff" + + Exports ==> with + belong? : OP -> Boolean + ++ belong?(op) is true if op is a special function operator; + operator: OP -> OP + ++ operator(op) returns a copy of op with the domain-dependent + ++ properties appropriate for F; + ++ error if op is not a special function operator + abs : F -> F + ++ abs(f) returns the absolute value operator applied to f + Gamma : F -> F + ++ Gamma(f) returns the formal Gamma function applied to f + Gamma : (F,F) -> F + ++ Gamma(a,x) returns the incomplete Gamma function applied to a and x + Beta: (F,F) -> F + ++ Beta(x,y) returns the beta function applied to x and y + digamma: F->F + ++ digamma(x) returns the digamma function applied to x + polygamma: (F,F) ->F + ++ polygamma(x,y) returns the polygamma function applied to x and y + besselJ: (F,F) -> F + ++ besselJ(x,y) returns the besselj function applied to x and y + besselY: (F,F) -> F + ++ besselY(x,y) returns the bessely function applied to x and y + besselI: (F,F) -> F + ++ besselI(x,y) returns the besseli function applied to x and y + besselK: (F,F) -> F + ++ besselK(x,y) returns the besselk function applied to x and y + airyAi: F -> F + ++ airyAi(x) returns the airyai function applied to x + airyBi: F -> F + ++ airyBi(x) returns the airybi function applied to x + +@ + +In case we want to have more special function operators here, do not forget to +add them to the list [[specop]] in [[CommonOperators]]. Otherwise they will +not have the \lq special\rq\ attribute and will not be recognised here. One +effect could be that +\begin{verbatim} +myNewSpecOp(1::Expression Integer)::Expression DoubleFloat +\end{verbatim} +might not re-evaluate the operator. + +<>= + iiGamma : F -> F + ++ iiGamma(x) should be local but conditional; + iiabs : F -> F + ++ iiabs(x) should be local but conditional; + iiBeta : List F -> F + ++ iiGamma(x) should be local but conditional; + iidigamma : F -> F + ++ iidigamma(x) should be local but conditional; + iipolygamma: List F -> F + ++ iipolygamma(x) should be local but conditional; + iiBesselJ : List F -> F + ++ iiBesselJ(x) should be local but conditional; + iiBesselY : List F -> F + ++ iiBesselY(x) should be local but conditional; + iiBesselI : List F -> F + ++ iiBesselI(x) should be local but conditional; + iiBesselK : List F -> F + ++ iiBesselK(x) should be local but conditional; + iiAiryAi : F -> F + ++ iiAiryAi(x) should be local but conditional; + iiAiryBi : F -> F + ++ iiAiryBi(x) should be local but conditional; + + Implementation ==> add + iabs : F -> F + iGamma : F -> F + iBeta : (F, F) -> F + idigamma : F -> F + iiipolygamma: (F, F) -> F + iiiBesselJ : (F, F) -> F + iiiBesselY : (F, F) -> F + iiiBesselI : (F, F) -> F + iiiBesselK : (F, F) -> F + iAiryAi : F -> F + iAiryBi : F -> F + + opabs := operator("abs"::Symbol)$CommonOperators + opGamma := operator("Gamma"::Symbol)$CommonOperators + opGamma2 := operator("Gamma2"::Symbol)$CommonOperators + opBeta := operator("Beta"::Symbol)$CommonOperators + opdigamma := operator("digamma"::Symbol)$CommonOperators + oppolygamma := operator("polygamma"::Symbol)$CommonOperators + opBesselJ := operator("besselJ"::Symbol)$CommonOperators + opBesselY := operator("besselY"::Symbol)$CommonOperators + opBesselI := operator("besselI"::Symbol)$CommonOperators + opBesselK := operator("besselK"::Symbol)$CommonOperators + opAiryAi := operator("airyAi"::Symbol)$CommonOperators + opAiryBi := operator("airyBi"::Symbol)$CommonOperators + + abs x == opabs x + Gamma(x) == opGamma(x) + Gamma(a,x) == opGamma2(a,x) + Beta(x,y) == opBeta(x,y) + digamma x == opdigamma(x) + polygamma(k,x)== oppolygamma(k,x) + besselJ(a,x) == opBesselJ(a,x) + besselY(a,x) == opBesselY(a,x) + besselI(a,x) == opBesselI(a,x) + besselK(a,x) == opBesselK(a,x) + airyAi(x) == opAiryAi(x) + airyBi(x) == opAiryBi(x) + + belong? op == has?(op, "special") + + operator op == + is?(op, "abs"::Symbol) => opabs + is?(op, "Gamma"::Symbol) => opGamma + is?(op, "Gamma2"::Symbol) => opGamma2 + is?(op, "Beta"::Symbol) => opBeta + is?(op, "digamma"::Symbol) => opdigamma + is?(op, "polygamma"::Symbol)=> oppolygamma + is?(op, "besselJ"::Symbol) => opBesselJ + is?(op, "besselY"::Symbol) => opBesselY + is?(op, "besselI"::Symbol) => opBesselI + is?(op, "besselK"::Symbol) => opBesselK + is?(op, "airyAi"::Symbol) => opAiryAi + is?(op, "airyBi"::Symbol) => opAiryBi + + error "Not a special operator" + + -- Could put more unconditional special rules for other functions here + iGamma x == +-- one? x => x + (x = 1) => x + kernel(opGamma, x) + + iabs x == + zero? x => 0 + is?(x, opabs) => x + x < 0 => kernel(opabs, -x) + kernel(opabs, x) + + iBeta(x, y) == kernel(opBeta, [x, y]) + idigamma x == kernel(opdigamma, x) + iiipolygamma(n, x) == kernel(oppolygamma, [n, x]) + iiiBesselJ(x, y) == kernel(opBesselJ, [x, y]) + iiiBesselY(x, y) == kernel(opBesselY, [x, y]) + iiiBesselI(x, y) == kernel(opBesselI, [x, y]) + iiiBesselK(x, y) == kernel(opBesselK, [x, y]) + iAiryAi x == kernel(opAiryAi, x) + iAiryBi x == kernel(opAiryBi, x) + + + -- Could put more conditional special rules for other functions here + + if R has abs : R -> R then + iiabs x == + (r := retractIfCan(x)@Union(Fraction Polynomial R, "failed")) + case "failed" => iabs x + f := r::Fraction Polynomial R + (a := retractIfCan(numer f)@Union(R, "failed")) case "failed" or + (b := retractIfCan(denom f)@Union(R,"failed")) case "failed" => iabs x + abs(a::R)::F / abs(b::R)::F + + else iiabs x == iabs x + + if R has SpecialFunctionCategory then + iiGamma x == + (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iGamma x + Gamma(r::R)::F + + iiBeta l == + (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ + (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ + => iBeta(first l, second l) + Beta(r::R, s::R)::F + + iidigamma x == + (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => idigamma x + digamma(r::R)::F + + iipolygamma l == + (s:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ + (r:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ + => iiipolygamma(first l, second l) + polygamma(s::R, r::R)::F + + iiBesselJ l == + (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ + (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ + => iiiBesselJ(first l, second l) + besselJ(r::R, s::R)::F + + iiBesselY l == + (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ + (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ + => iiiBesselY(first l, second l) + besselY(r::R, s::R)::F + + iiBesselI l == + (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ + (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ + => iiiBesselI(first l, second l) + besselI(r::R, s::R)::F + + iiBesselK l == + (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ + (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ + => iiiBesselK(first l, second l) + besselK(r::R, s::R)::F + + iiAiryAi x == + (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryAi x + airyAi(r::R)::F + + iiAiryBi x == + (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryBi x + airyBi(r::R)::F + + else + if R has RetractableTo Integer then + iiGamma x == + (r := retractIfCan(x)@Union(Integer, "failed")) case Integer + and (r::Integer >= 1) => factorial(r::Integer - 1)::F + iGamma x + else + iiGamma x == iGamma x + + iiBeta l == iBeta(first l, second l) + iidigamma x == idigamma x + iipolygamma l == iiipolygamma(first l, second l) + iiBesselJ l == iiiBesselJ(first l, second l) + iiBesselY l == iiiBesselY(first l, second l) + iiBesselI l == iiiBesselI(first l, second l) + iiBesselK l == iiiBesselK(first l, second l) + iiAiryAi x == iAiryAi x + iiAiryBi x == iAiryBi x + + -- Default behaviour is to build a kernel + evaluate(opGamma, iiGamma)$BasicOperatorFunctions1(F) + evaluate(opabs, iiabs)$BasicOperatorFunctions1(F) +-- evaluate(opGamma2 ,iiGamma2 )$BasicOperatorFunctions1(F) + evaluate(opBeta ,iiBeta )$BasicOperatorFunctions1(F) + evaluate(opdigamma ,iidigamma )$BasicOperatorFunctions1(F) + evaluate(oppolygamma ,iipolygamma)$BasicOperatorFunctions1(F) + evaluate(opBesselJ ,iiBesselJ )$BasicOperatorFunctions1(F) + evaluate(opBesselY ,iiBesselY )$BasicOperatorFunctions1(F) + evaluate(opBesselI ,iiBesselI )$BasicOperatorFunctions1(F) + evaluate(opBesselK ,iiBesselK )$BasicOperatorFunctions1(F) + evaluate(opAiryAi ,iiAiryAi )$BasicOperatorFunctions1(F) + evaluate(opAiryBi ,iiAiryBi )$BasicOperatorFunctions1(F) +@ + +\subsection{differentiation of special functions} + +In the following we define the symbolic derivatives of the special functions we +provide. The formulas we use for the Bessel functions can be found in Milton +Abramowitz and Irene A. Stegun, eds. (1965). Handbook of Mathematical +Functions with Formulas, Graphs, and Mathematical Tables. New York: Dover. ISBN +0-486-61272-4, Equations~9.1.27 and 9.6.26. Up to [[patch--50]] the formula +for $K$ missed the minus sign. (Issue~\#355) + +We do not attempt to provide formulas for the derivative with respect to the +first argument currently. Instead, we leave such derivatives unevaluated. + +<>= + import Fraction Integer + ahalf: F := recip(2::F)::F + athird: F := recip(2::F)::F + twothirds: F := 2*recip(3::F)::F +@ + +We need to get hold of the differentiation operator as modified by +[[FunctionSpace]]. Otherwise, for example, display will be ugly. We accomplish +that by differentiating an operator, which will certainly result in a single +kernel only. + +<>= + dummyArg: SE := new()$SE + opdiff := operator first kernels D((operator(new()$SE)$BasicOperator) + (dummyArg::F), dummyArg) +@ + +The differentiation operator [[opdiff]] takes three arguments corresponding to +$$ +F_{,i}(a_1,a_2,\dots,a_n): +$$ +\begin{enumerate} +\item $F(a_1,...,dm,...a_n)$, where the $i$\textsuperscript{th} argument is a + dummy variable, +\item $dm$, the dummy variable, and +\item $a_i$, the point at which the differential is evaluated. +\end{enumerate} + +In the following, it seems to be safe to use the same dummy variable +troughout. At least, this is done also in [[FunctionSpace]], and did not cause +problems. + +The operation [[symbolicGrad]] returns the first component of the gradient of +[[op l]]. + +<>= + dm := new()$SE :: F + + iBesselJ(l: List F, t: SE): F == + n := first l; x := second l + differentiate(n, t)*kernel(opdiff, [opBesselJ [dm, x], dm, n]) + + differentiate(x, t) * ahalf * (besselJ (n-1,x) - besselJ (n+1,x)) + + iBesselY(l: List F, t: SE): F == + n := first l; x := second l + differentiate(n, t)*kernel(opdiff, [opBesselY [dm, x], dm, n]) + + differentiate(x, t) * ahalf * (besselY (n-1,x) - besselY (n+1,x)) + + iBesselI(l: List F, t: SE): F == + n := first l; x := second l + differentiate(n, t)*kernel(opdiff, [opBesselI [dm, x], dm, n]) + + differentiate(x, t)* ahalf * (besselI (n-1,x) + besselI (n+1,x)) + + iBesselK(l: List F, t: SE): F == + n := first l; x := second l + differentiate(n, t)*kernel(opdiff, [opBesselK [dm, x], dm, n]) + - differentiate(x, t)* ahalf * (besselK (n-1,x) + besselK (n+1,x)) + +@ + +For the moment we throw an error if we try to differentiate [[polygamma]] with +respect to the first argument. + +<>= + ipolygamma(l: List F, x: SE): F == + member?(x, variables first l) => + error "cannot differentiate polygamma with respect to the first argument" + n := first l; y := second l + differentiate(y, x)*polygamma(n+1, y) + iBetaGrad1(l: List F): F == + x := first l; y := second l + Beta(x,y)*(digamma x - digamma(x+y)) + iBetaGrad2(l: List F): F == + x := first l; y := second l + Beta(x,y)*(digamma y - digamma(x+y)) + + if F has ElementaryFunctionCategory then + iGamma2(l: List F, t: SE): F == + a := first l; x := second l + differentiate(a, t)*kernel(opdiff, [opGamma2 [dm, x], dm, a]) + - differentiate(x, t)* x ** (a - 1) * exp(-x) + setProperty(opGamma2, SPECIALDIFF, iGamma2@((List F, SE)->F) + pretend None) +@ + +Finally, we tell Axiom to use these functions for differentiation. Note that +up to [[patch--50]], the properties for the Bessel functions were set using +[[derivative(oppolygamma, [lzero, ipolygammaGrad])]], where [[lzero]] returned +zero always. Trying to replace [[lzero]] by a function that returns the first +component of the gradient failed, it resulted in an infinite loop for +[[integrate(D(besselJ(a,x),a),a)]]. + +<>= + derivative(opabs, abs(#1) * inv(#1)) + derivative(opGamma, digamma #1 * Gamma #1) + derivative(opBeta, [iBetaGrad1, iBetaGrad2]) + derivative(opdigamma, polygamma(1, #1)) + setProperty(oppolygamma, SPECIALDIFF, ipolygamma@((List F, SE)->F) + pretend None) + setProperty(opBesselJ, SPECIALDIFF, iBesselJ@((List F, SE)->F) + pretend None) + setProperty(opBesselY, SPECIALDIFF, iBesselY@((List F, SE)->F) + pretend None) + setProperty(opBesselI, SPECIALDIFF, iBesselI@((List F, SE)->F) + pretend None) + setProperty(opBesselK, SPECIALDIFF, iBesselK@((List F, SE)->F) + pretend None) + +@ +<>= +"FSPECF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=FSPECF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"FSPECF" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter G} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package GENMFACT GeneralizedMultivariateFactorize} @@ -2011,6 +5996,43 @@ GeneralizedMultivariateFactorize(OV,E,S,R,P) : C == T %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter I} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INFINITY Infinity} +\pagehead{Infinity}{INFINITY} +\pagepic{ps/v104infinity.ps}{INFINITY}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INFINITY Infinity +++ Top-level infinity +++ Author: Manuel Bronstein +++ Description: Default infinity signatures for the interpreter; +++ Date Created: 4 Oct 1989 +++ Date Last Updated: 4 Oct 1989 +Infinity(): with + infinity : () -> OnePointCompletion Integer + ++ infinity() returns infinity. + plusInfinity : () -> OrderedCompletion Integer + ++ plusInfinity() returns plusIinfinity. + minusInfinity: () -> OrderedCompletion Integer + ++ minusInfinity() returns minusInfinity. + == add + infinity() == infinity()$OnePointCompletion(Integer) + plusInfinity() == plusInfinity()$OrderedCompletion(Integer) + minusInfinity() == minusInfinity()$OrderedCompletion(Integer) + +@ +<>= +"INFINITY" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INFINITY"] +"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"] +"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"] +"INFINITY" -> "PID" +"INFINITY" -> "OAGROUP" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package IALGFACT InnerAlgFactor} \pagehead{InnerAlgFactor}{IALGFACT} \pagepic{ps/v104inneralgfactor.ps}{IALGFACT}{1.00} @@ -2112,6 +6134,227 @@ InnerAlgFactor(F, UP, AlExt, AlPol): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ICDEN InnerCommonDenominator} +\pagehead{InnerCommonDenominator}{ICDEN} +\pagepic{ps/v104innercommondenominator.ps}{ICDEN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ICDEN InnerCommonDenominator +--% InnerCommonDenominator +++ Author: Manuel Bronstein +++ Date Created: 2 May 1988 +++ Date Last Updated: 22 Nov 1989 +++ Description: InnerCommonDenominator provides functions to compute +++ the common denominator of a finite linear aggregate of elements +++ of the quotient field of an integral domain. +++ Keywords: gcd, quotient, common, denominator. +InnerCommonDenominator(R, Q, A, B): Exports == Implementation where + R: IntegralDomain + Q: QuotientFieldCategory R + A: FiniteLinearAggregate R + B: FiniteLinearAggregate Q + + Exports ==> with + commonDenominator: B -> R + ++ commonDenominator([q1,...,qn]) returns a common denominator + ++ d for q1,...,qn. + clearDenominator : B -> A + ++ clearDenominator([q1,...,qn]) returns \spad{[p1,...,pn]} such that + ++ \spad{qi = pi/d} where d is a common denominator for the qi's. + splitDenominator : B -> Record(num: A, den: R) + ++ splitDenominator([q1,...,qn]) returns + ++ \spad{[[p1,...,pn], d]} such that + ++ \spad{qi = pi/d} and d is a common denominator for the qi's. + + Implementation ==> add + import FiniteLinearAggregateFunctions2(Q, B, R, A) + + clearDenominator l == + d := commonDenominator l + map(numer(d * #1), l) + + splitDenominator l == + d := commonDenominator l + [map(numer(d * #1), l), d] + + if R has GcdDomain then + commonDenominator l == reduce(lcm, map(denom, l),1) + else + commonDenominator l == reduce("*", map(denom, l), 1) + +@ +<>= +"ICDEN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ICDEN"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"ICDEN" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package COMBINAT IntegerCombinatoricFunctions} +\pagehead{IntegerCombinatoricFunctions}{COMBINAT} +\pagepic{ps/v104integercombinatoricfunctions.ps}{COMBINAT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package COMBINAT IntegerCombinatoricFunctions +++ Authors: Martin Brock, Robert Sutor, Michael Monagan +++ Date Created: June 1987 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: integer, combinatoric function +++ Examples: +++ References: +++ Description: +++ The \spadtype{IntegerCombinatoricFunctions} package provides some +++ standard functions in combinatorics. +Z ==> Integer +N ==> NonNegativeInteger +SUP ==> SparseUnivariatePolynomial + +IntegerCombinatoricFunctions(I:IntegerNumberSystem): with + binomial: (I, I) -> I + ++ \spad{binomial(n,r)} returns the binomial coefficient + ++ \spad{C(n,r) = n!/(r! (n-r)!)}, where \spad{n >= r >= 0}. + ++ This is the number of combinations of n objects taken r at a time. + factorial: I -> I + ++ \spad{factorial(n)} returns \spad{n!}. this is the product of all + ++ integers between 1 and n (inclusive). + ++ Note: \spad{0!} is defined to be 1. + multinomial: (I, List I) -> I + ++ \spad{multinomial(n,[m1,m2,...,mk])} returns the multinomial + ++ coefficient \spad{n!/(m1! m2! ... mk!)}. + partition: I -> I + ++ \spad{partition(n)} returns the number of partitions of the integer n. + ++ This is the number of distinct ways that n can be written as + ++ a sum of positive integers. + permutation: (I, I) -> I + ++ \spad{permutation(n)} returns \spad{!P(n,r) = n!/(n-r)!}. This is + ++ the number of permutations of n objects taken r at a time. + stirling1: (I, I) -> I + ++ \spad{stirling1(n,m)} returns the Stirling number of the first kind + ++ denoted \spad{S[n,m]}. + stirling2: (I, I) -> I + ++ \spad{stirling2(n,m)} returns the Stirling number of the second kind + ++ denoted \spad{SS[n,m]}. + == add + F : Record(Fn:I, Fv:I) := [0,1] + B : Record(Bn:I, Bm:I, Bv:I) := [0,0,0] + S : Record(Sn:I, Sp:SUP I) := [0,0] + P : IndexedFlexibleArray(I,0) := new(1,1)$IndexedFlexibleArray(I,0) + + partition n == + -- This is the number of ways of expressing n as a sum of positive + -- integers, without regard to order. For example partition 5 = 7 + -- since 5 = 1+1+1+1+1 = 1+1+1+2 = 1+2+2 = 1+1+3 = 1+4 = 2+3 = 5 . + -- Uses O(sqrt n) term recurrence from Abramowitz & Stegun pp. 825 + -- p(n) = sum (-1)**k p(n-j) where 0 < j := (3*k**2+-k) quo 2 <= n + minIndex(P) ^= 0 => error "Partition: must have minIndex of 0" + m := #P + n < 0 => error "partition is not defined for negative integers" + n < m::I => P(convert(n)@Z) + concat_!(P, new((convert(n+1)@Z - m)::N,0)$IndexedFlexibleArray(I,0)) + for i in m..convert(n)@Z repeat + s:I := 1 + t:I := 0 + for k in 1.. repeat + l := (3*k*k-k) quo 2 + l > i => leave + u := l+k + t := t + s * P(convert(i-l)@Z) + u > i => leave + t := t + s * P(convert(i-u)@Z) + s := -s + P.i := t + P(convert(n)@Z) + + factorial n == + s,f,t : I + n < 0 => error "factorial not defined for negative integers" + if n <= F.Fn then s := f := 1 else (s, f) := F + for k in convert(s+1)@Z .. convert(n)@Z by 2 repeat + if k::I = n then t := n else t := k::I * (k+1)::I + f := t * f + F.Fn := n + F.Fv := f + + binomial(n, m) == + s,b:I + n < 0 or m < 0 or m > n => 0 + m = 0 => 1 + n < 2*m => binomial(n, n-m) + (s,b) := (0,1) + if B.Bn = n then + B.Bm = m+1 => + b := (B.Bv * (m+1)) quo (n-m) + B.Bn := n + B.Bm := m + return(B.Bv := b) + if m >= B.Bm then (s := B.Bm; b := B.Bv) else (s,b) := (0,1) + for k in convert(s+1)@Z .. convert(m)@Z repeat + b := (b*(n-k::I+1)) quo k::I + B.Bn := n + B.Bm := m + B.Bv := b + + multinomial(n, m) == + for t in m repeat t < 0 => return 0 + n < _+/m => 0 + s:I := 1 + for t in m repeat s := s * factorial t + factorial n quo s + + permutation(n, m) == + t:I + m < 0 or n < m => 0 + m := n-m + p:I := 1 + for k in convert(m+1)@Z .. convert(n)@Z by 2 repeat + if k::I = n then t := n else t := (k*(k+1))::I + p := p * t + p + + stirling1(n, m) == + -- Definition: (-1)**(n-m) S[n,m] is the number of + -- permutations of n symbols which have m cycles. + n < 0 or m < 1 or m > n => 0 + m = n => 1 + S.Sn = n => coefficient(S.Sp, convert(m)@Z :: N) + x := monomial(1, 1)$SUP(I) + S.Sn := n + S.Sp := x + for k in 1 .. convert(n-1)@Z repeat S.Sp := S.Sp * (x - k::SUP(I)) + coefficient(S.Sp, convert(m)@Z :: N) + + stirling2(n, m) == + -- definition: SS[n,m] is the number of ways of partitioning + -- a set of n elements into m non-empty subsets + n < 0 or m < 1 or m > n => 0 + m = 1 or n = m => 1 + s:I := if odd? m then -1 else 1 + t:I := 0 + for k in 1..convert(m)@Z repeat + s := -s + t := t + s * binomial(m, k::I) * k::I ** (convert(n)@Z :: N) + t quo factorial m + +@ +<>= +"COMBINAT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=COMBINAT"] +"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"] +"COMBINAT" -> "A1AGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter J} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2123,6 +6366,67 @@ InnerAlgFactor(F, UP, AlExt, AlPol): Exports == Implementation where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter M} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MCDEN MatrixCommonDenominator} +\pagehead{MatrixCommonDenominator}{MCDEN} +\pagepic{ps/v104matrixcommondenominator.ps}{MCDEN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MCDEN MatrixCommonDenominator +--% MatrixCommonDenominator +++ Author: Manuel Bronstein +++ Date Created: 2 May 1988 +++ Date Last Updated: 20 Jul 1990 +++ Description: MatrixCommonDenominator provides functions to +++ compute the common denominator of a matrix of elements of the +++ quotient field of an integral domain. +++ Keywords: gcd, quotient, matrix, common, denominator. +MatrixCommonDenominator(R, Q): Exports == Implementation where + R: IntegralDomain + Q: QuotientFieldCategory R + + VR ==> Vector R + VQ ==> Vector Q + + Exports ==> with + commonDenominator: Matrix Q -> R + ++ commonDenominator(q) returns a common denominator d for + ++ the elements of q. + clearDenominator : Matrix Q -> Matrix R + ++ clearDenominator(q) returns p such that \spad{q = p/d} where d is + ++ a common denominator for the elements of q. + splitDenominator : Matrix Q -> Record(num: Matrix R, den: R) + ++ splitDenominator(q) returns \spad{[p, d]} such that \spad{q = p/d} and d + ++ is a common denominator for the elements of q. + + Implementation ==> add + import ListFunctions2(Q, R) + import MatrixCategoryFunctions2(Q,VQ,VQ,Matrix Q,R,VR,VR,Matrix R) + + clearDenominator m == + d := commonDenominator m + map(numer(d * #1), m) + + splitDenominator m == + d := commonDenominator m + [map(numer(d * #1), m), d] + + if R has GcdDomain then + commonDenominator m == lcm map(denom, parts m) + else + commonDenominator m == reduce("*",map(denom, parts m),1)$List(R) + +@ +<>= +"MCDEN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MCDEN"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MCDEN" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MTHING MergeThing} \pagehead{MergeThing}{MTHING} \pagepic{ps/v104mergething.ps}{MTHING}{1.00} @@ -2474,8 +6778,576 @@ MRationalFactorize(E,OV,R,P) : C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MMAP MultipleMap} +\pagehead{MultipleMap}{MMAP} +\pagepic{ps/v104multiplemap.ps}{MMAP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MMAP MultipleMap +++ Lifting a map through 2 levels of polynomials +++ Author: Manuel Bronstein +++ Date Created: May 1988 +++ Date Last Updated: 11 Jul 1990 +++ Description: Lifting of a map through 2 levels of polynomials; +MultipleMap(R1,UP1,UPUP1,R2,UP2,UPUP2): Exports == Implementation where + R1 : IntegralDomain + UP1 : UnivariatePolynomialCategory R1 + UPUP1: UnivariatePolynomialCategory Fraction UP1 + R2 : IntegralDomain + UP2 : UnivariatePolynomialCategory R2 + UPUP2: UnivariatePolynomialCategory Fraction UP2 + + Q1 ==> Fraction UP1 + Q2 ==> Fraction UP2 + + Exports ==> with + map: (R1 -> R2, UPUP1) -> UPUP2 + ++ map(f, p) lifts f to the domain of p then applies it to p. + + Implementation ==> add + import UnivariatePolynomialCategoryFunctions2(R1, UP1, R2, UP2) + + rfmap: (R1 -> R2, Q1) -> Q2 + + rfmap(f, q) == map(f, numer q) / map(f, denom q) + + map(f, p) == + map(rfmap(f, #1), + p)$UnivariatePolynomialCategoryFunctions2(Q1, UPUP1, Q2, UPUP2) + +@ +<>= +"MMAP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MMAP"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MMAP" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter N} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package NAGC02 NagPolynomialRootsPackage} +\pagehead{NagPolynomialRootsPackage}{NAGC02} +\pagepic{ps/v104nagpolynomialrootspackage.ps}{NAGC02}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package NAGC02 NagPolynomialRootsPackage +++ Author: Godfrey Nolan and Mike Dewar +++ Date Created: Jan 1994 +++ Date Last Updated: Thu May 12 17:44:27 1994 +++ Description: +++ This package uses the NAG Library to compute the zeros of a +++ polynomial with real or complex coefficients. +++ See \downlink{Manual Page}{manpageXXc02}. + +NagPolynomialRootsPackage(): Exports == Implementation where + S ==> Symbol + FOP ==> FortranOutputStackPackage + + Exports ==> with + c02aff : (Matrix DoubleFloat,Integer,Boolean,Integer) -> Result + ++ c02aff(a,n,scale,ifail) + ++ finds all the roots of a complex polynomial equation, + ++ using a variant of Laguerre's Method. + ++ See \downlink{Manual Page}{manpageXXc02aff}. + c02agf : (Matrix DoubleFloat,Integer,Boolean,Integer) -> Result + ++ c02agf(a,n,scale,ifail) + ++ finds all the roots of a real polynomial equation, using a + ++ variant of Laguerre's Method. + ++ See \downlink{Manual Page}{manpageXXc02agf}. + Implementation ==> add + + import Lisp + import DoubleFloat + import Matrix DoubleFloat + import Any + import Record + import Integer + import Boolean + import NAGLinkSupportPackage + import AnyFunctions1(Matrix DoubleFloat) + import AnyFunctions1(Integer) + import AnyFunctions1(Boolean) + + + c02aff(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ + ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c02aff",_ + ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_ + ["z"::S,"w"::S]$Lisp,_ + [["double"::S,["a"::S,2$Lisp,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ + ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1$Lisp]$Lisp,4$Lisp]$Lisp]$Lisp]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ,["logical"::S,"scale"::S]$Lisp_ + ]$Lisp,_ + ["z"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,scaleArg::Any,ifailArg::Any,aArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + + + c02agf(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ + ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c02agf",_ + ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_ + ["z"::S,"w"::S]$Lisp,_ + [["double"::S,["a"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ + ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1$Lisp]$Lisp,2$Lisp]$Lisp]$Lisp]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ,["logical"::S,"scale"::S]$Lisp_ + ]$Lisp,_ + ["z"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,scaleArg::Any,ifailArg::Any,aArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + +@ +<>= +"NAGC02" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NAGC02"] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package NAGC05 NagRootFindingPackage} +\pagehead{NagRootFindingPackage}{NAGC05} +\pagepic{ps/v104nagrootfindingpackage.ps}{NAGC05}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package NAGC05 NagRootFindingPackage +++ Author: Godfrey Nolan and Mike Dewar +++ Date Created: Jan 1994 +++ Date Last Updated: Thu May 12 17:44:28 1994 +++ Description: +++ This package uses the NAG Library to calculate real zeros of +++ continuous real functions of one or more variables. (Complex +++ equations must be expressed in terms of the equivalent larger +++ system of real equations.) +++ See \downlink{Manual Page}{manpageXXc05}. + +NagRootFindingPackage(): Exports == Implementation where + S ==> Symbol + FOP ==> FortranOutputStackPackage + + Exports ==> with + c05adf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,_ + Integer,Union(fn:FileName,fp:Asp1(F))) -> Result + ++ c05adf(a,b,eps,eta,ifail,f) + ++ locates a zero of a continuous function in a given + ++ interval by a combination of the methods of linear interpolation, + ++ extrapolation and bisection. + ++ See \downlink{Manual Page}{manpageXXc05adf}. + c05nbf : (Integer,Integer,Matrix DoubleFloat,DoubleFloat,_ + Integer,Union(fn:FileName,fp:Asp6(FCN))) -> Result + ++ c05nbf(n,lwa,x,xtol,ifail,fcn) + ++ is an easy-to-use routine to find a solution of a system + ++ of nonlinear equations by a modification of the Powell hybrid + ++ method. + ++ See \downlink{Manual Page}{manpageXXc05nbf}. + c05pbf : (Integer,Integer,Integer,Matrix DoubleFloat,_ + DoubleFloat,Integer,Union(fn:FileName,fp:Asp35(FCN))) -> Result + ++ c05pbf(n,ldfjac,lwa,x,xtol,ifail,fcn) + ++ is an easy-to-use routine to find a solution of a system + ++ of nonlinear equations by a modification of the Powell hybrid + ++ method. The user must provide the Jacobian. + ++ See \downlink{Manual Page}{manpageXXc05pbf}. + Implementation ==> add + + import Lisp + import DoubleFloat + import Any + import Record + import Integer + import Matrix DoubleFloat + import Boolean + import NAGLinkSupportPackage + import FortranPackage + import Union(fn:FileName,fp:Asp1(F)) + import AnyFunctions1(DoubleFloat) + import AnyFunctions1(Matrix DoubleFloat) + import AnyFunctions1(Integer) + + + c05adf(aArg:DoubleFloat,bArg:DoubleFloat,epsArg:DoubleFloat,_ + etaArg:DoubleFloat,ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == + pushFortranOutputStack(fFilename := aspFilename "f")$FOP + if fArg case fn + then outputAsFortran(fArg.fn) + else outputAsFortran(fArg.fp) + popFortranOutputStack()$FOP + [(invokeNagman([fFilename]$Lisp,_ + "c05adf",_ + ["a"::S,"b"::S,"eps"::S,"eta"::S,"x"::S_ + ,"ifail"::S,"f"::S]$Lisp,_ + ["x"::S,"f"::S]$Lisp,_ + [["double"::S,"a"::S,"b"::S,"eps"::S,"eta"::S_ + ,"x"::S,"f"::S]$Lisp_ + ,["integer"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"ifail"::S]$Lisp,_ + [([aArg::Any,bArg::Any,epsArg::Any,etaArg::Any,ifailArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c05nbf(nArg:Integer,lwaArg:Integer,xArg:Matrix DoubleFloat,_ + xtolArg:DoubleFloat,ifailArg:Integer,fcnArg:Union(fn:FileName,fp:Asp6(FCN))): Result == + pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP + if fcnArg case fn + then outputAsFortran(fcnArg.fn) + else outputAsFortran(fcnArg.fp) + popFortranOutputStack()$FOP + [(invokeNagman([fcnFilename]$Lisp,_ + "c05nbf",_ + ["n"::S,"lwa"::S,"xtol"::S,"ifail"::S,"fcn"::S_ + ,"fvec"::S,"x"::S,"wa"::S]$Lisp,_ + ["fvec"::S,"wa"::S,"fcn"::S]$Lisp,_ + [["double"::S,["fvec"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp_ + ,"xtol"::S,["wa"::S,"lwa"::S]$Lisp,"fcn"::S]$Lisp_ + ,["integer"::S,"n"::S,"lwa"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["fvec"::S,"x"::S,"xtol"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,lwaArg::Any,xtolArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c05pbf(nArg:Integer,ldfjacArg:Integer,lwaArg:Integer,_ + xArg:Matrix DoubleFloat,xtolArg:DoubleFloat,ifailArg:Integer,_ + fcnArg:Union(fn:FileName,fp:Asp35(FCN))): Result == + pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP + if fcnArg case fn + then outputAsFortran(fcnArg.fn) + else outputAsFortran(fcnArg.fp) + popFortranOutputStack()$FOP + [(invokeNagman([fcnFilename]$Lisp,_ + "c05pbf",_ + ["n"::S,"ldfjac"::S,"lwa"::S,"xtol"::S,"ifail"::S_ + ,"fcn"::S,"fvec"::S,"fjac"::S,"x"::S,"wa"::S]$Lisp,_ + ["fvec"::S,"fjac"::S,"wa"::S,"fcn"::S]$Lisp,_ + [["double"::S,["fvec"::S,"n"::S]$Lisp,["fjac"::S,"ldfjac"::S,"n"::S]$Lisp_ + ,["x"::S,"n"::S]$Lisp,"xtol"::S,["wa"::S,"lwa"::S]$Lisp,"fcn"::S]$Lisp_ + ,["integer"::S,"n"::S,"ldfjac"::S,"lwa"::S_ + ,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["fvec"::S,"fjac"::S,"x"::S,"xtol"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,ldfjacArg::Any,lwaArg::Any,xtolArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + +@ +<>= +"NAGC05" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NAGC05"] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package NAGC06 NagSeriesSummationPackage} +\pagehead{NagSeriesSummationPackage}{NAGC06} +\pagepic{ps/v104nagseriessummationpackage.ps}{NAGC06}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package NAGC06 NagSeriesSummationPackage +++ Author: Godfrey Nolan and Mike Dewar +++ Date Created: Jan 1994 +++ Date Last Updated: Thu May 12 17:44:30 1994 +++ Description: +++ This package uses the NAG Library to calculate the discrete Fourier +++ transform of a sequence of real or complex data values, and +++ applies it to calculate convolutions and correlations. +++ See \downlink{Manual Page}{manpageXXc06}. + +NagSeriesSummationPackage(): Exports == Implementation where + S ==> Symbol + FOP ==> FortranOutputStackPackage + + Exports ==> with + c06eaf : (Integer,Matrix DoubleFloat,Integer) -> Result + ++ c06eaf(n,x,ifail) + ++ calculates the discrete Fourier transform of a sequence of + ++ n real data values. (No extra workspace required.) + ++ See \downlink{Manual Page}{manpageXXc06eaf}. + c06ebf : (Integer,Matrix DoubleFloat,Integer) -> Result + ++ c06ebf(n,x,ifail) + ++ calculates the discrete Fourier transform of a Hermitian + ++ sequence of n complex data values. (No extra workspace required.) + ++ See \downlink{Manual Page}{manpageXXc06ebf}. + c06ecf : (Integer,Matrix DoubleFloat,Matrix DoubleFloat,Integer) -> Result + ++ c06ecf(n,x,y,ifail) + ++ calculates the discrete Fourier transform of a sequence of + ++ n complex data values. (No extra workspace required.) + ++ See \downlink{Manual Page}{manpageXXc06ecf}. + c06ekf : (Integer,Integer,Matrix DoubleFloat,Matrix DoubleFloat,_ + Integer) -> Result + ++ c06ekf(job,n,x,y,ifail) + ++ calculates the circular convolution of two + ++ real vectors of period n. No extra workspace is required. + ++ See \downlink{Manual Page}{manpageXXc06ekf}. + c06fpf : (Integer,Integer,String,Matrix DoubleFloat,_ + Matrix DoubleFloat,Integer) -> Result + ++ c06fpf(m,n,init,x,trig,ifail) + ++ computes the discrete Fourier transforms of m sequences, + ++ each containing n real data values. This routine is designed to + ++ be particularly efficient on vector processors. + ++ See \downlink{Manual Page}{manpageXXc06fpf}. + c06fqf : (Integer,Integer,String,Matrix DoubleFloat,_ + Matrix DoubleFloat,Integer) -> Result + ++ c06fqf(m,n,init,x,trig,ifail) + ++ computes the discrete Fourier transforms of m Hermitian + ++ sequences, each containing n complex data values. This routine is + ++ designed to be particularly efficient on vector processors. + ++ See \downlink{Manual Page}{manpageXXc06fqf}. + c06frf : (Integer,Integer,String,Matrix DoubleFloat,_ + Matrix DoubleFloat,Matrix DoubleFloat,Integer) -> Result + ++ c06frf(m,n,init,x,y,trig,ifail) + ++ computes the discrete Fourier transforms of m sequences, + ++ each containing n complex data values. This routine is designed + ++ to be particularly efficient on vector processors. + ++ See \downlink{Manual Page}{manpageXXc06frf}. + c06fuf : (Integer,Integer,String,Matrix DoubleFloat,_ + Matrix DoubleFloat,Matrix DoubleFloat,Matrix DoubleFloat,Integer) -> Result + ++ c06fuf(m,n,init,x,y,trigm,trign,ifail) + ++ computes the two-dimensional discrete Fourier transform of + ++ a bivariate sequence of complex data values. This routine is + ++ designed to be particularly efficient on vector processors. + ++ See \downlink{Manual Page}{manpageXXc06fuf}. + c06gbf : (Integer,Matrix DoubleFloat,Integer) -> Result + ++ c06gbf(n,x,ifail) + ++ forms the complex conjugate of n + ++ data values. + ++ See \downlink{Manual Page}{manpageXXc06gbf}. + c06gcf : (Integer,Matrix DoubleFloat,Integer) -> Result + ++ c06gcf(n,y,ifail) + ++ forms the complex conjugate of a sequence of n data + ++ values. + ++ See \downlink{Manual Page}{manpageXXc06gcf}. + c06gqf : (Integer,Integer,Matrix DoubleFloat,Integer) -> Result + ++ c06gqf(m,n,x,ifail) + ++ forms the complex conjugates, + ++ each containing n data values. + ++ See \downlink{Manual Page}{manpageXXc06gqf}. + c06gsf : (Integer,Integer,Matrix DoubleFloat,Integer) -> Result + ++ c06gsf(m,n,x,ifail) + ++ takes m Hermitian sequences, each containing n data + ++ values, and forms the real and imaginary parts of the m + ++ corresponding complex sequences. + ++ See \downlink{Manual Page}{manpageXXc06gsf}. + Implementation ==> add + + import Lisp + import DoubleFloat + import Any + import Record + import Integer + import Matrix DoubleFloat + import Boolean + import NAGLinkSupportPackage + import AnyFunctions1(Integer) + import AnyFunctions1(String) + import AnyFunctions1(Matrix DoubleFloat) + + + c06eaf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06eaf",_ + ["n"::S,"ifail"::S,"x"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + + c06ebf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06ebf",_ + ["n"::S,"ifail"::S,"x"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06ecf(nArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ + ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06ecf",_ + ["n"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_ + ]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"y"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06ekf(jobArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ + yArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06ekf",_ + ["job"::S,"n"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_ + ]$Lisp_ + ,["integer"::S,"job"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"y"::S,"ifail"::S]$Lisp,_ + [([jobArg::Any,nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06fpf(mArg:Integer,nArg:Integer,initArg:String,_ + xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06fpf",_ + ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"trig"::S,"work"::S]$Lisp,_ + ["work"::S]$Lisp,_ + [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ + ,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_ + ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ + ,["character"::S,"init"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"trig"::S,"ifail"::S]$Lisp,_ + [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,trigArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06fqf(mArg:Integer,nArg:Integer,initArg:String,_ + xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06fqf",_ + ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"trig"::S,"work"::S]$Lisp,_ + ["work"::S]$Lisp,_ + [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ + ,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_ + ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ + ,["character"::S,"init"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"trig"::S,"ifail"::S]$Lisp,_ + [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,trigArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06frf(mArg:Integer,nArg:Integer,initArg:String,_ + xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,_ + ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06frf",_ + ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"y"::S,"trig"::S,"work"::S]$Lisp,_ + ["work"::S]$Lisp,_ + [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ + ,["y"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,["*"::S,["*"::S,2$Lisp,"m"::S]$Lisp,"n"::S]$Lisp]$Lisp_ + ]$Lisp_ + ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ + ,["character"::S,"init"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"y"::S,"trig"::S,"ifail"::S]$Lisp,_ + [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,yArg::Any,trigArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06fuf(mArg:Integer,nArg:Integer,initArg:String,_ + xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,trigmArg:Matrix DoubleFloat,_ + trignArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06fuf",_ + ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"y"::S,"trigm"::S,"trign"::S,"work"::S_ + ]$Lisp,_ + ["work"::S]$Lisp,_ + [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ + ,["y"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["trigm"::S,["*"::S,2$Lisp,"m"::S]$Lisp]$Lisp,["trign"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp_ + ,["work"::S,["*"::S,["*"::S,2$Lisp,"m"::S]$Lisp,"n"::S]$Lisp]$Lisp]$Lisp_ + ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ + ,["character"::S,"init"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"y"::S,"trigm"::S,"trign"::S,"ifail"::S]$Lisp,_ + [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,yArg::Any,trigmArg::Any,trignArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06gbf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06gbf",_ + ["n"::S,"ifail"::S,"x"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06gcf(nArg:Integer,yArg:Matrix DoubleFloat,ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06gcf",_ + ["n"::S,"ifail"::S,"y"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["y"::S,"n"::S]$Lisp]$Lisp_ + ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["y"::S,"ifail"::S]$Lisp,_ + [([nArg::Any,ifailArg::Any,yArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06gqf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ + ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06gqf",_ + ["m"::S,"n"::S,"ifail"::S,"x"::S]$Lisp,_ + []$Lisp,_ + [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ + ]$Lisp_ + ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["x"::S,"ifail"::S]$Lisp,_ + [([mArg::Any,nArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + + c06gsf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ + ifailArg:Integer): Result == + [(invokeNagman(NIL$Lisp,_ + "c06gsf",_ + ["m"::S,"n"::S,"ifail"::S,"x"::S,"u"::S,"v"::S]$Lisp,_ + ["u"::S,"v"::S]$Lisp,_ + [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ + ,["u"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["v"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_ + ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ + ]$Lisp,_ + ["u"::S,"v"::S,"ifail"::S]$Lisp,_ + [([mArg::Any,nArg::Any,ifailArg::Any,xArg::Any ])_ + @List Any]$Lisp)$Lisp)_ + pretend List (Record(key:Symbol,entry:Any))]$Result + +@ +<>= +"NAGC06" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NAGC06"] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package NONE1 NoneFunctions1} \pagehead{NoneFunctions1}{NONE1} \pagepic{ps/v104nonefunctions1.ps}{NONE1}{1.00} @@ -2568,6 +7440,64 @@ NormInMonogenicAlgebra(R, PolR, E, PolE): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package NCNTFRAC NumericContinuedFraction} +\pagehead{NumericContinuedFraction}{NCNTFRAC} +\pagepic{ps/v104numericcontinuedfraction.ps}{NCNTFRAC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package NCNTFRAC NumericContinuedFraction +++ Author: Clifton J. Williamson +++ Date Created: 12 April 1990 +++ Change History: +++ Basic Operations: continuedFraction +++ Related Constructors: ContinuedFraction, Float +++ Also See: Fraction +++ AMS Classifications: 11J70 11A55 11K50 11Y65 30B70 40A15 +++ Keywords: continued fraction +++ References: +++ Description: \spadtype{NumericContinuedFraction} provides functions +++ for converting floating point numbers to continued fractions. + +NumericContinuedFraction(F): Exports == Implementation where + F : FloatingPointSystem + CFC ==> ContinuedFraction Integer + I ==> Integer + ST ==> Stream I + + Exports ==> with + continuedFraction: F -> CFC + ++ continuedFraction(f) converts the floating point number + ++ \spad{f} to a reduced continued fraction. + + Implementation ==> add + + cfc: F -> ST + cfc(a) == delay + aa := wholePart a + zero?(b := a - (aa :: F)) => concat(aa,empty()$ST) + concat(aa,cfc inv b) + + continuedFraction a == + aa := wholePart a + zero?(b := a - (aa :: F)) => + reducedContinuedFraction(aa,empty()$ST) + if negative? b then (aa := aa - 1; b := b + 1) + reducedContinuedFraction(aa,cfc inv b) + +@ +<>= +"NCNTFRAC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NCNTFRAC"] +"FIELD" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FIELD"] +"RADCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RADCAT"] +"NCNTFRAC" -> "FIELD" +"NCNTFRAC" -> "RADCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter O} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package ARRAY12 OneDimensionalArrayFunctions2} @@ -2633,6 +7563,101 @@ OneDimensionalArrayFunctions2(A, B): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ONECOMP2 OnePointCompletionFunctions2} +\pagehead{OnePointCompletionFunctions2}{ONECOMP2} +\pagepic{ps/v104onepointcompletionfunctions2.ps}{ONECOMP2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ONECOMP2 OnePointCompletionFunctions2 +++ Lifting of maps to one-point completions +++ Author: Manuel Bronstein +++ Description: Lifting of maps to one-point completions. +++ Date Created: 4 Oct 1989 +++ Date Last Updated: 4 Oct 1989 +OnePointCompletionFunctions2(R, S): Exports == Implementation where + R, S: SetCategory + + OPR ==> OnePointCompletion R + OPS ==> OnePointCompletion S + + Exports ==> with + map: (R -> S, OPR) -> OPS + ++ map(f, r) lifts f and applies it to r, assuming that + ++ f(infinity) = infinity. + map: (R -> S, OPR, OPS) -> OPS + ++ map(f, r, i) lifts f and applies it to r, assuming that + ++ f(infinity) = i. + + Implementation ==> add + map(f, r) == map(f, r, infinity()) + + map(f, r, i) == + (u := retractIfCan r) case R => (f(u::R))::OPS + i + +@ +<>= +"ONECOMP2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ONECOMP2"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"ONECOMP2" -> "BASTYPE" +"ONECOMP2" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ORDCOMP2 OrderedCompletionFunctions2} +\pagehead{OrderedCompletionFunctions2}{ORDCOMP2} +\pagepic{ps/v104orderedcompletionfunctions2.ps}{ORDCOMP2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ORDCOMP2 OrderedCompletionFunctions2 +++ Lifting of maps to ordered completions +++ Author: Manuel Bronstein +++ Description: Lifting of maps to ordered completions. +++ Date Created: 4 Oct 1989 +++ Date Last Updated: 4 Oct 1989 +OrderedCompletionFunctions2(R, S): Exports == Implementation where + R, S: SetCategory + + ORR ==> OrderedCompletion R + ORS ==> OrderedCompletion S + + Exports ==> with + map: (R -> S, ORR) -> ORS + ++ map(f, r) lifts f and applies it to r, assuming that + ++ f(plusInfinity) = plusInfinity and that + ++ f(minusInfinity) = minusInfinity. + map: (R -> S, ORR, ORS, ORS) -> ORS + ++ map(f, r, p, m) lifts f and applies it to r, assuming that + ++ f(plusInfinity) = p and that f(minusInfinity) = m. + + Implementation ==> add + map(f, r) == map(f, r, plusInfinity(), minusInfinity()) + + map(f, r, p, m) == + zero?(n := whatInfinity r) => (f retract r)::ORS +-- one? n => p + (n = 1) => p + m + +@ +<>= +"ORDCOMP2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ORDCOMP2"] +"BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] +"KOERCE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=KOERCE"] +"ORDCOMP2" -> "BASTYPE" +"ORDCOMP2" -> "KOERCE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package OPQUERY OperationsQuery} \pagehead{OperationsQuery}{OPQUERY} \pagepic{ps/v104operationsquery.ps}{OPQUERY}{1.00} @@ -3222,9 +8247,364 @@ SupFractionFactorizer(E,OV,R,P) : C == T %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter T} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CLIP TwoDimensionalPlotClipping} +\pagehead{TwoDimensionalPlotClipping}{CLIP} +\pagepic{ps/v104twodimensionalplotclipping.ps}{CLIP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CLIP TwoDimensionalPlotClipping +++ Automatic clipping for 2-dimensional plots +++ Author: Clifton J. Williamson +++ Date Created: 22 December 1989 +++ Date Last Updated: 10 July 1990 +++ Keywords: plot, singularity +++ Examples: +++ References: + +TwoDimensionalPlotClipping(): Exports == Implementation where + ++ The purpose of this package is to provide reasonable plots of + ++ functions with singularities. + B ==> Boolean + L ==> List + SEG ==> Segment + RN ==> Fraction Integer + SF ==> DoubleFloat + Pt ==> Point DoubleFloat + PLOT ==> Plot + CLIPPED ==> Record(brans: L L Pt,xValues: SEG SF,yValues: SEG SF) + + Exports ==> with + clip: PLOT -> CLIPPED + ++ clip(p) performs two-dimensional clipping on a plot, p, from + ++ the domain \spadtype{Plot} for the graph of one variable, + ++ \spad{y = f(x)}; the default parameters \spad{1/4} for the fraction + ++ and \spad{5/1} for the scale are used in the \spadfun{clip} function. + clip: (PLOT,RN,RN) -> CLIPPED + ++ clip(p,frac,sc) performs two-dimensional clipping on a plot, p, + ++ from the domain \spadtype{Plot} for the graph of one variable + ++ \spad{y = f(x)}; the fraction parameter is specified by \spad{frac} + ++ and the scale parameter is specified by \spad{sc} for use in the + ++ \spadfun{clip} function. + clipParametric: PLOT -> CLIPPED + ++ clipParametric(p) performs two-dimensional clipping on a plot, + ++ p, from the domain \spadtype{Plot} for the parametric curve + ++ \spad{x = f(t)}, \spad{y = g(t)}; the default parameters \spad{1/2} + ++ for the fraction and \spad{5/1} for the scale are used in the + ++ \fakeAxiomFun{iClipParametric} subroutine, which is called by this + ++ function. + clipParametric: (PLOT,RN,RN) -> CLIPPED + ++ clipParametric(p,frac,sc) performs two-dimensional clipping on a + ++ plot, p, from the domain \spadtype{Plot} for the parametric curve + ++ \spad{x = f(t)}, \spad{y = g(t)}; the fraction parameter is + ++ specified by \spad{frac} and the scale parameter is specified + ++ by \spad{sc} for use in the \fakeAxiomFun{iClipParametric} subroutine, + ++ which is called by this function. + clipWithRanges: (L L Pt,SF,SF,SF,SF) -> CLIPPED + ++ clipWithRanges(pointLists,xMin,xMax,yMin,yMax) performs clipping + ++ on a list of lists of points, \spad{pointLists}. Clipping is + ++ done within the specified ranges of \spad{xMin}, \spad{xMax} and + ++ \spad{yMin}, \spad{yMax}. This function is used internally by + ++ the \fakeAxiomFun{iClipParametric} subroutine in this package. + clip: L Pt -> CLIPPED + ++ clip(l) performs two-dimensional clipping on a curve l, which is + ++ a list of points; the default parameters \spad{1/2} for the + ++ fraction and \spad{5/1} for the scale are used in the + ++ \fakeAxiomFun{iClipParametric} subroutine, which is called by this + ++ function. + clip: L L Pt -> CLIPPED + ++ clip(ll) performs two-dimensional clipping on a list of lists + ++ of points, \spad{ll}; the default parameters \spad{1/2} for + ++ the fraction and \spad{5/1} for the scale are used in the + ++ \fakeAxiomFun{iClipParametric} subroutine, which is called by this + ++ function. + + Implementation ==> add + import PointPackage(DoubleFloat) + import ListFunctions2(Point DoubleFloat,DoubleFloat) + + point:(SF,SF) -> Pt + intersectWithHorizLine:(SF,SF,SF,SF,SF) -> Pt + intersectWithVertLine:(SF,SF,SF,SF,SF) -> Pt + intersectWithBdry:(SF,SF,SF,SF,Pt,Pt) -> Pt + discardAndSplit: (L Pt,Pt -> B,SF,SF,SF,SF) -> L L Pt + norm: Pt -> SF + iClipParametric: (L L Pt,RN,RN) -> CLIPPED + findPt: L L Pt -> Union(Pt,"failed") + Fnan?: SF ->Boolean + Pnan?:Pt ->Boolean + + Fnan? x == x~=x + Pnan? p == any?(Fnan?,p) + + iClipParametric(pointLists,fraction,scale) == + -- error checks and special cases + (fraction < 0) or (fraction > 1) => + error "clipDraw: fraction should be between 0 and 1" + empty? pointLists => [nil(),segment(0,0),segment(0,0)] + -- put all points together , sort them according to norm + sortedList := sort(norm(#1) < norm(#2),select(not Pnan? #1,concat pointLists)) + empty? sortedList => [nil(),segment(0,0),segment(0,0)] + n := # sortedList + num := numer fraction + den := denom fraction + clipNum := (n * num) quo den + lastN := n - 1 - clipNum + firstPt := first sortedList + xMin : SF := xCoord firstPt + xMax : SF := xCoord firstPt + yMin : SF := yCoord firstPt + yMax : SF := yCoord firstPt + -- calculate min/max for the first (1-fraction)*N points + -- this contracts the range + -- this unnecessarily clips monotonic functions (step-function, x^(high power),etc.) + for k in 0..lastN for pt in rest sortedList repeat + xMin := min(xMin,xCoord pt) + xMax := max(xMax,xCoord pt) + yMin := min(yMin,yCoord pt) + yMax := max(yMax,yCoord pt) + xDiff := xMax - xMin; yDiff := yMax - yMin + xDiff = 0 => + yDiff = 0 => + [pointLists,segment(xMin-1,xMax+1),segment(yMin-1,yMax+1)] + [pointLists,segment(xMin-1,xMax+1),segment(yMin,yMax)] + yDiff = 0 => + [pointLists,segment(xMin,xMax),segment(yMin-1,yMax+1)] + numm := numer scale; denn := denom scale + -- now expand the range by scale + xMin := xMin - (numm :: SF) * xDiff / (denn :: SF) + xMax := xMax + (numm :: SF) * xDiff / (denn :: SF) + yMin := yMin - (numm :: SF) * yDiff / (denn :: SF) + yMax := yMax + (numm :: SF) * yDiff / (denn :: SF) + -- clip with the calculated range + newclip:=clipWithRanges(pointLists,xMin,xMax,yMin,yMax) + -- if we split the lists use the new clip + # (newclip.brans) > # pointLists => newclip + -- calculate extents + xs :L SF:= map (xCoord,sortedList) + ys :L SF:= map (yCoord,sortedList) + xMin :SF :=reduce (min,xs) + yMin :SF :=reduce (min,ys) + xMax :SF :=reduce (max,xs) + yMax :SF :=reduce (max,ys) + xseg:SEG SF :=xMin..xMax + yseg:SEG SF :=yMin..yMax + -- return original + [pointLists,xseg,yseg]@CLIPPED + + + + + point(xx,yy) == point(l : L SF := [xx,yy]) + + intersectWithHorizLine(x1,y1,x2,y2,yy) == + x1 = x2 => point(x1,yy) + point(x1 + (x2 - x1)*(yy - y1)/(y2 - y1),yy) + + intersectWithVertLine(x1,y1,x2,y2,xx) == + y1 = y2 => point(xx,y1) + point(xx,y1 + (y2 - y1)*(xx - x1)/(x2 - x1)) + + intersectWithBdry(xMin,xMax,yMin,yMax,pt1,pt2) == + -- pt1 is in rectangle, pt2 is not + x1 := xCoord pt1; y1 := yCoord pt1 + x2 := xCoord pt2; y2 := yCoord pt2 + if y2 > yMax then + pt2 := intersectWithHorizLine(x1,y1,x2,y2,yMax) + x2 := xCoord pt2; y2 := yCoord pt2 + if y2 < yMin then + pt2 := intersectWithHorizLine(x1,y1,x2,y2,yMin) + x2 := xCoord pt2; y2 := yCoord pt2 + if x2 > xMax then + pt2 := intersectWithVertLine(x1,y1,x2,y2,xMax) + x2 := xCoord pt2; y2 := yCoord pt2 + if x2 < xMin then + pt2 := intersectWithVertLine(x1,y1,x2,y2,xMin) + pt2 + + discardAndSplit(pointList,pred,xMin,xMax,yMin,yMax) == + ans : L L Pt := nil() + list : L Pt := nil() + lastPt? : B := false + lastPt : Pt := point(0,0) + while not empty? pointList repeat + pt := first pointList + pointList := rest pointList + pred(pt) => + if (empty? list) and lastPt? then + bdryPt := intersectWithBdry(xMin,xMax,yMin,yMax,pt,lastPt) + -- print bracket [ coerce bdryPt ,coerce pt ] + --list := cons(bdryPt,list) + list := cons(pt,list) + if not empty? list then + bdryPt := intersectWithBdry(xMin,xMax,yMin,yMax,first list,pt) + -- print bracket [ coerce bdryPt,coerce first list] + --list := cons(bdryPt,list) + ans := cons( list,ans) + lastPt := pt + lastPt? := true + list := nil() + empty? list => ans + reverse_! cons(reverse_! list,ans) + + clip(plot,fraction,scale) == +-- sayBrightly([" clip: "::OutputForm]$List(OutputForm))$Lisp + (fraction < 0) or (fraction > 1/2) => + error "clipDraw: fraction should be between 0 and 1/2" + xVals := xRange plot + empty?(pointLists := listBranches plot) => + [nil(),xVals,segment(0,0)] + more?(pointLists := listBranches plot,1) => + error "clipDraw: plot has more than one branch" + empty?(pointList := first pointLists) => + [nil(),xVals,segment(0,0)] + sortedList := sort(yCoord(#1) < yCoord(#2),pointList) + n := # sortedList; num := numer fraction; den := denom fraction + clipNum := (n * num) quo den + -- throw out points with large and small y-coordinates + yMin := yCoord(sortedList.clipNum) + yMax := yCoord(sortedList.(n - 1 - clipNum)) + if Fnan? yMin then yMin : SF := 0 + if Fnan? yMax then yMax : SF := 0 + (yDiff := yMax - yMin) = 0 => + [pointLists,xRange plot,segment(yMin - 1,yMax + 1)] + numm := numer scale; denn := denom scale + xMin := lo xVals; xMax := hi xVals + yMin := yMin - (numm :: SF) * yDiff / (denn :: SF) + yMax := yMax + (numm :: SF) * yDiff / (denn :: SF) + lists := discardAndSplit(pointList,_ + (yCoord(#1) < yMax) and (yCoord(#1) > yMin),xMin,xMax,yMin,yMax) + yMin := yCoord(sortedList.clipNum) + yMax := yCoord(sortedList.(n - 1 - clipNum)) + if Fnan? yMin then yMin : SF := 0 + if Fnan? yMax then yMax : SF := 0 + for list in lists repeat + for pt in list repeat + if not Fnan?(yCoord pt) then + yMin := min(yMin,yCoord pt) + yMax := max(yMax,yCoord pt) + [lists,xVals,segment(yMin,yMax)] + + clip(plot:PLOT) == clip(plot,1/4,5/1) + + norm(pt) == + x := xCoord(pt); y := yCoord(pt) + if Fnan? x then + if Fnan? y then + r:SF := 0 + else + r:SF := y**2 + else + if Fnan? y then + r:SF := x**2 + else + r:SF := x**2 + y**2 + r + + findPt lists == + for list in lists repeat + not empty? list => + for p in list repeat + not Pnan? p => return p + "failed" + + clipWithRanges(pointLists,xMin,xMax,yMin,yMax) == + lists : L L Pt := nil() + for pointList in pointLists repeat + lists := concat(lists,discardAndSplit(pointList,_ + (xCoord(#1) <= xMax) and (xCoord(#1) >= xMin) and _ + (yCoord(#1) <= yMax) and (yCoord(#1) >= yMin), _ + xMin,xMax,yMin,yMax)) + (pt := findPt lists) case "failed" => + [nil(),segment(0,0),segment(0,0)] + firstPt := pt :: Pt + xMin : SF := xCoord firstPt; xMax : SF := xCoord firstPt + yMin : SF := yCoord firstPt; yMax : SF := yCoord firstPt + for list in lists repeat + for pt in list repeat + if not Pnan? pt then + xMin := min(xMin,xCoord pt) + xMax := max(xMax,xCoord pt) + yMin := min(yMin,yCoord pt) + yMax := max(yMax,yCoord pt) + [lists,segment(xMin,xMax),segment(yMin,yMax)] + + clipParametric(plot,fraction,scale) == + iClipParametric(listBranches plot,fraction,scale) + + clipParametric plot == clipParametric(plot,1/2,5/1) + + clip(l: L Pt) == iClipParametric(list l,1/2,5/1) + clip(l: L L Pt) == iClipParametric(l,1/2,5/1) + +@ +<>= +"CLIP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CLIP"] +"PTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PTCAT"] +"CLIP" -> "PTCAT" + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter U} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package UPCDEN UnivariatePolynomialCommonDenominator} +\pagehead{UnivariatePolynomialCommonDenominator}{UPCDEN} +\pagepic{ps/v104univariatepolynomialcommondenominator.ps}{UPCDEN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package UPCDEN UnivariatePolynomialCommonDenominator +--% UnivariatePolynomialCommonDenominator +++ Author: Manuel Bronstein +++ Date Created: 2 May 1988 +++ Date Last Updated: 22 Feb 1990 +++ Description: UnivariatePolynomialCommonDenominator provides +++ functions to compute the common denominator of the coefficients of +++ univariate polynomials over the quotient field of a gcd domain. +++ Keywords: gcd, quotient, common, denominator, polynomial. + +UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where + R : IntegralDomain + Q : QuotientFieldCategory R + UP: UnivariatePolynomialCategory Q + + Exports ==> with + commonDenominator: UP -> R + ++ commonDenominator(q) returns a common denominator d for + ++ the coefficients of q. + clearDenominator : UP -> UP + ++ clearDenominator(q) returns p such that \spad{q = p/d} where d is + ++ a common denominator for the coefficients of q. + splitDenominator : UP -> Record(num: UP, den: R) + ++ splitDenominator(q) returns \spad{[p, d]} such that \spad{q = p/d} and d + ++ is a common denominator for the coefficients of q. + + Impl ==> add + import CommonDenominator(R, Q, List Q) + + commonDenominator p == commonDenominator coefficients p + + clearDenominator p == + d := commonDenominator p + map(numer(d * #1)::Q, p) + + splitDenominator p == + d := commonDenominator p + [map(numer(d * #1)::Q, p), d] + +@ +<>= +"UPCDEN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=UPCDEN"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"UPCDEN" -> "PFECAT" + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter V} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3252,24 +8632,52 @@ SupFractionFactorizer(E,OV,R,P) : C == T <> <> +<> +<> <> +<> +<> +<> +<> +<> +<> +<> +<> + +<> +<> +<> <> <> +<> +<> +<> <> +<> <> +<> +<> +<> <> <> <> <> +<> +<> +<> +<> <> <> +<> <> +<> +<> <> <> @@ -3281,6 +8689,11 @@ SupFractionFactorizer(E,OV,R,P) : C == T <> <> <> + +<> + +<> + @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Index} diff --git a/books/ps/v104cartesiantensorfunctions2.ps b/books/ps/v104cartesiantensorfunctions2.ps new file mode 100644 index 0000000..8faf6fe --- /dev/null +++ b/books/ps/v104cartesiantensorfunctions2.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 +% CARTEN2 +gsave +[ /Rect [ 4 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CARTEN2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +4 108 lineto +4 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +4 108 lineto +4 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12 85.9 moveto 62 (CARTEN2) alignedtext +grestore +% BMODULE +gsave +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=BMODULE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 86 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +86 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 86 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +86 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 70 (BMODULE) alignedtext +grestore +% CARTEN2->BMODULE +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/v104changeofvariable.ps b/books/ps/v104changeofvariable.ps new file mode 100644 index 0000000..e5ceff1 --- /dev/null +++ b/books/ps/v104changeofvariable.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 +% CHVAR +gsave +[ /Rect [ 2 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CHVAR) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2 108 lineto +2 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 85.9 moveto 47 (CHVAR) 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 +% CHVAR->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/v104characteristicpolynomialinmonogenicalalgebra.ps b/books/ps/v104characteristicpolynomialinmonogenicalalgebra.ps index 5acfc53..d93ba9c 100644 --- a/books/ps/v104characteristicpolynomialinmonogenicalalgebra.ps +++ b/books/ps/v104characteristicpolynomialinmonogenicalalgebra.ps @@ -1,5 +1,5 @@ %!PS-Adobe-2.0 -%%Creator: Graphviz version 2.18 (Wed Aug 6 10:29:47 UTC 2008) +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) %%For: (root) root %%Title: pic %%Pages: (atend) @@ -179,11 +179,11 @@ def %%EndSetup setupLatin1 %%Page: 1 1 -%%PageBoundingBox: 36 36 130 152 +%%PageBoundingBox: 36 36 132 152 %%PageOrientation: Portrait 0 0 1 beginpage gsave -36 36 94 116 boxprim clip newpath +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 @@ -200,72 +200,72 @@ newpath -4 -4 moveto closepath stroke % CPIMA gsave -[ /Rect [ 13 72 73 108 ] +[ /Rect [ 14 72 74 108 ] /Border [ 0 0 0 ] /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CPIMA) >> /Subtype /Link /ANN pdfmark 0.939 0.733 1.000 nodecolor -newpath 73 108 moveto -13 108 lineto -13 72 lineto -73 72 lineto +newpath 74 108 moveto +14 108 lineto +14 72 lineto +74 72 lineto closepath fill 1 setlinewidth filled 0.939 0.733 1.000 nodecolor -newpath 73 108 moveto -13 108 lineto -13 72 lineto -73 72 lineto +newpath 74 108 moveto +14 108 lineto +14 72 lineto +74 72 lineto closepath stroke 0.000 0.000 0.000 nodecolor -14 /Times-Roman set_font -21 86.4 moveto 44 (CPIMA) alignedtext +14.00 /Times-Roman set_font +22 85.9 moveto 44 (CPIMA) alignedtext grestore % MONOGEN gsave -[ /Rect [ 0 0 86 36 ] +[ /Rect [ 0 0 88 36 ] /Border [ 0 0 0 ] /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=MONOGEN) >> /Subtype /Link /ANN pdfmark 0.606 0.733 1.000 nodecolor -newpath 86 36 moveto -0 36 lineto -0 0 lineto -86 0 lineto +newpath 88 36 moveto +2.93238e-14 36 lineto +8.24688e-15 1.06581e-14 lineto +88 0 lineto closepath fill 1 setlinewidth filled 0.606 0.733 1.000 nodecolor -newpath 86 36 moveto -0 36 lineto -0 0 lineto -86 0 lineto +newpath 88 36 moveto +2.93238e-14 36 lineto +8.24688e-15 1.06581e-14 lineto +88 0 lineto closepath stroke 0.000 0.000 0.000 nodecolor -14 /Times-Roman set_font -8 14.4 moveto 70 (MONOGEN) alignedtext +14.00 /Times-Roman set_font +7.5 13.9 moveto 73 (MONOGEN) alignedtext grestore % CPIMA->MONOGEN gsave 1 setlinewidth 0.000 0.000 0.000 edgecolor -newpath 43 72 moveto -43 64 43 55 43 46 curveto +newpath 44 72 moveto +44 64 44 55 44 46 curveto stroke 0.000 0.000 0.000 edgecolor -newpath 46.5 46 moveto -43 36 lineto -39.5 46 lineto +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 46.5 46 moveto -43 36 lineto -39.5 46 lineto +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto closepath stroke grestore endpage @@ -275,7 +275,7 @@ grestore %%EndPage: 1 %%Trailer %%Pages: 1 -%%BoundingBox: 36 36 130 152 +%%BoundingBox: 36 36 132 152 end restore %%EOF diff --git a/books/ps/v104combinatorialfunction.ps b/books/ps/v104combinatorialfunction.ps new file mode 100644 index 0000000..d05b08e --- /dev/null +++ b/books/ps/v104combinatorialfunction.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 +% COMBF +gsave +[ /Rect [ 0 72 66 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=COMBF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +2.13163e-14 108 lineto +0 72 lineto +66 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +2.13163e-14 108 lineto +0 72 lineto +66 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 50 (COMBF) alignedtext +grestore +% FS +gsave +[ /Rect [ 6 0 60 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 60 36 moveto +6 36 lineto +6 1.06581e-14 lineto +60 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 60 36 moveto +6 36 lineto +6 1.06581e-14 lineto +60 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +25.5 13.9 moveto 15 (FS) alignedtext +grestore +% COMBF->FS +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/v104commondenominator.ps b/books/ps/v104commondenominator.ps new file mode 100644 index 0000000..93af345 --- /dev/null +++ b/books/ps/v104commondenominator.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 +% CDEN +gsave +[ /Rect [ 6 72 60 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CDEN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 60 108 moveto +6 108 lineto +6 72 lineto +60 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 60 108 moveto +6 108 lineto +6 72 lineto +60 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14 85.9 moveto 38 (CDEN) 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 +% CDEN->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/v104complexrootfindingpackage.ps b/books/ps/v104complexrootfindingpackage.ps new file mode 100644 index 0000000..881fc63 --- /dev/null +++ b/books/ps/v104complexrootfindingpackage.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 +% CRFP +gsave +[ /Rect [ 15 72 69 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CRFP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 69 108 moveto +15 108 lineto +15 72 lineto +69 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 69 108 moveto +15 108 lineto +15 72 lineto +69 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +25 85.9 moveto 34 (CRFP) alignedtext +grestore +% COMPCAT +gsave +[ /Rect [ 0 0 84 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 84 36 moveto +2.84217e-14 36 lineto +7.10543e-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.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +84 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 68 (COMPCAT) alignedtext +grestore +% CRFP->COMPCAT +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/v104complexrootpackage.ps b/books/ps/v104complexrootpackage.ps new file mode 100644 index 0000000..987cfd2 --- /dev/null +++ b/books/ps/v104complexrootpackage.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 +% CMPLXRT +gsave +[ /Rect [ 2 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CMPLXRT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2 108 lineto +2 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2 108 lineto +2 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 85.9 moveto 65 (CMPLXRT) alignedtext +grestore +% COMPCAT +gsave +[ /Rect [ 0 0 84 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 84 36 moveto +2.84217e-14 36 lineto +7.10543e-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.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +84 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 68 (COMPCAT) alignedtext +grestore +% CMPLXRT->COMPCAT +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/v104coordinatesystems.ps b/books/ps/v104coordinatesystems.ps new file mode 100644 index 0000000..97b0ce7 --- /dev/null +++ b/books/ps/v104coordinatesystems.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 +% COORDSYS +gsave +[ /Rect [ 0 72 90 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=COORDSYS) >> + /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 (COORDSYS) alignedtext +grestore +% PTCAT +gsave +[ /Rect [ 15 0 75 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PTCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +15 36 lineto +15 1.06581e-14 lineto +75 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +15 36 lineto +15 1.06581e-14 lineto +75 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +23 13.9 moveto 44 (PTCAT) alignedtext +grestore +% COORDSYS->PTCAT +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/v104crapackage.ps b/books/ps/v104crapackage.ps new file mode 100644 index 0000000..0358207 --- /dev/null +++ b/books/ps/v104crapackage.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 +% CRAPACK +gsave +[ /Rect [ 0 72 80 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CRAPACK) >> + /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 (CRAPACK) alignedtext +grestore +% FLAGG +gsave +[ /Rect [ 9 0 71 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FLAGG) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 71 36 moveto +9 36 lineto +9 1.06581e-14 lineto +71 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 71 36 moveto +9 36 lineto +9 1.06581e-14 lineto +71 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16.5 13.9 moveto 47 (FLAGG) alignedtext +grestore +% CRAPACK->FLAGG +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/v104cycleindicators.ps b/books/ps/v104cycleindicators.ps new file mode 100644 index 0000000..aeebf65 --- /dev/null +++ b/books/ps/v104cycleindicators.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 114 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 78 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% CYCLES +gsave +[ /Rect [ 0 72 70 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CYCLES) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +70 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +70 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 54 (CYCLES) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 2 0 68 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 68 36 moveto +2 36 lineto +2 1.06581e-14 lineto +68 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 68 36 moveto +2 36 lineto +2 1.06581e-14 lineto +68 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% CYCLES->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 35 72 moveto +35 64 35 55 35 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 114 152 +end +restore +%%EOF diff --git a/books/ps/v104cyclotomicpolynomialpackage.ps b/books/ps/v104cyclotomicpolynomialpackage.ps new file mode 100644 index 0000000..ba5b216 --- /dev/null +++ b/books/ps/v104cyclotomicpolynomialpackage.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 140 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 104 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 +% CYCLOTOM +gsave +[ /Rect [ 0 72 96 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CYCLOTOM) >> + /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 (CYCLOTOM) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 15 0 81 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 81 36 moveto +15 36 lineto +15 1.06581e-14 lineto +81 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 81 36 moveto +15 36 lineto +15 1.06581e-14 lineto +81 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +22.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% CYCLOTOM->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 48 72 moveto +48 64 48 55 48 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 51.5001 46 moveto +48 36 lineto +44.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 51.5001 46 moveto +48 36 lineto +44.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 140 152 +end +restore +%%EOF diff --git a/books/ps/v104evaluatecycleindicators.ps b/books/ps/v104evaluatecycleindicators.ps new file mode 100644 index 0000000..82f30ff --- /dev/null +++ b/books/ps/v104evaluatecycleindicators.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 +% EVALCYC +gsave +[ /Rect [ 0 72 80 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=EVALCYC) >> + /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 (EVALCYC) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 7 0 73 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 73 36 moveto +7 36 lineto +7 1.06581e-14 lineto +73 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 73 36 moveto +7 36 lineto +7 1.06581e-14 lineto +73 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% EVALCYC->PFECAT +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/v104expertsystemcontinuitypackage.ps b/books/ps/v104expertsystemcontinuitypackage.ps new file mode 100644 index 0000000..8e5336d --- /dev/null +++ b/books/ps/v104expertsystemcontinuitypackage.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 116 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 80 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 +% ESCONT +gsave +[ /Rect [ 0 72 72 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ESCONT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 72 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +72 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 72 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +72 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 56 (ESCONT) alignedtext +grestore +% ACFS +gsave +[ /Rect [ 9 0 63 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACFS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 63 36 moveto +9 36 lineto +9 1.06581e-14 lineto +63 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 63 36 moveto +9 36 lineto +9 1.06581e-14 lineto +63 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +18.5 13.9 moveto 35 (ACFS) alignedtext +grestore +% ESCONT->ACFS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 36 72 moveto +36 64 36 55 36 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 39.5001 46 moveto +36 36 lineto +32.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 39.5001 46 moveto +36 36 lineto +32.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 116 152 +end +restore +%%EOF diff --git a/books/ps/v104expertsystemcontinuitypackage1.ps b/books/ps/v104expertsystemcontinuitypackage1.ps new file mode 100644 index 0000000..4411cc7 --- /dev/null +++ b/books/ps/v104expertsystemcontinuitypackage1.ps @@ -0,0 +1,276 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% ESCONT1 +gsave +[ /Rect [ 0 72 78 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ESCONT1) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 78 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +78 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 78 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +78 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 62 (ESCONT1) alignedtext +grestore +% Package +gsave +0.000 0.000 1.000 nodecolor +newpath 72 36 moveto +6 36 lineto +6 1.06581e-14 lineto +72 0 lineto +closepath fill +1 setlinewidth +filled +0.000 0.000 1.000 nodecolor +newpath 72 36 moveto +6 36 lineto +6 1.06581e-14 lineto +72 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14 13.9 moveto 50 (Package) alignedtext +grestore +% ESCONT1->Package +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 152 +end +restore +%%EOF diff --git a/books/ps/v104functionalspecialfunction.ps b/books/ps/v104functionalspecialfunction.ps new file mode 100644 index 0000000..102bdaa --- /dev/null +++ b/books/ps/v104functionalspecialfunction.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 108 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 72 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 +% FSPECF +gsave +[ /Rect [ 0 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=FSPECF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +1.92121e-14 108 lineto +5.21978e-15 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +1.92121e-14 108 lineto +5.21978e-15 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 49 (FSPECF) alignedtext +grestore +% FS +gsave +[ /Rect [ 5 0 59 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 59 36 moveto +5 36 lineto +5 1.06581e-14 lineto +59 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 59 36 moveto +5 36 lineto +5 1.06581e-14 lineto +59 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +24.5 13.9 moveto 15 (FS) alignedtext +grestore +% FSPECF->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 32 72 moveto +32 64 32 55 32 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 35.5001 46 moveto +32 36 lineto +28.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 35.5001 46 moveto +32 36 lineto +28.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 108 152 +end +restore +%%EOF diff --git a/books/ps/v104functionfieldcategoryfunctions2.ps b/books/ps/v104functionfieldcategoryfunctions2.ps new file mode 100644 index 0000000..81de082 --- /dev/null +++ b/books/ps/v104functionfieldcategoryfunctions2.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 108 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 72 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 +% FFCAT2 +gsave +[ /Rect [ 0 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=FFCAT2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +1.92121e-14 108 lineto +5.21978e-15 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +1.92121e-14 108 lineto +5.21978e-15 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 49 (FFCAT2) alignedtext +grestore +% FFCAT +gsave +[ /Rect [ 3 0 61 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FFCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 61 36 moveto +3 36 lineto +3 1.06581e-14 lineto +61 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 61 36 moveto +3 36 lineto +3 1.06581e-14 lineto +61 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11 13.9 moveto 42 (FFCAT) alignedtext +grestore +% FFCAT2->FFCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 32 72 moveto +32 64 32 55 32 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 35.5001 46 moveto +32 36 lineto +28.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 35.5001 46 moveto +32 36 lineto +28.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 108 152 +end +restore +%%EOF diff --git a/books/ps/v104functionspacesum.ps b/books/ps/v104functionspacesum.ps new file mode 100644 index 0000000..2258299 --- /dev/null +++ b/books/ps/v104functionspacesum.ps @@ -0,0 +1,326 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 170 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 134 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% SUMFS +gsave +[ /Rect [ 32 72 94 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=SUMFS) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 94 108 moveto +32 108 lineto +32 72 lineto +94 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 94 108 moveto +32 108 lineto +32 72 lineto +94 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +40 85.9 moveto 46 (SUMFS) alignedtext +grestore +% FS +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 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 +19.5 13.9 moveto 15 (FS) alignedtext +grestore +% SUMFS->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 54 72 moveto +50 64 45 54 40 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath stroke +grestore +% ACF +gsave +[ /Rect [ 72 0 126 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 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +85.5 13.9 moveto 27 (ACF) alignedtext +grestore +% SUMFS->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 72 72 moveto +76 64 81 54 86 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 170 152 +end +restore +%%EOF diff --git a/books/ps/v104infinity.ps b/books/ps/v104infinity.ps new file mode 100644 index 0000000..fbb1d33 --- /dev/null +++ b/books/ps/v104infinity.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 +% INFINITY +gsave +[ /Rect [ 33 72 107 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INFINITY) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 107 108 moveto +33 108 lineto +33 72 lineto +107 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 107 108 moveto +33 108 lineto +33 72 lineto +107 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +40.5 85.9 moveto 59 (INFINITY) 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 +% INFINITY->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 +% INFINITY->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/v104innercommondenominator.ps b/books/ps/v104innercommondenominator.ps new file mode 100644 index 0000000..73e06a7 --- /dev/null +++ b/books/ps/v104innercommondenominator.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 +% ICDEN +gsave +[ /Rect [ 4 72 62 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ICDEN) >> + /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 +11.5 85.9 moveto 43 (ICDEN) 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 +% ICDEN->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/v104integercombinatoricfunctions.ps b/books/ps/v104integercombinatoricfunctions.ps new file mode 100644 index 0000000..694c9f0 --- /dev/null +++ b/books/ps/v104integercombinatoricfunctions.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 +% COMBINAT +gsave +[ /Rect [ 0 72 90 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=COMBINAT) >> + /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 (COMBINAT) alignedtext +grestore +% A1AGG +gsave +[ /Rect [ 14 0 76 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 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 +21.5 13.9 moveto 47 (A1AGG) alignedtext +grestore +% COMBINAT->A1AGG +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/v104matrixcommondenominator.ps b/books/ps/v104matrixcommondenominator.ps new file mode 100644 index 0000000..2ba7842 --- /dev/null +++ b/books/ps/v104matrixcommondenominator.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 +% MCDEN +gsave +[ /Rect [ 0 72 66 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MCDEN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +2.24404e-14 108 lineto +8.44116e-15 72 lineto +66 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +2.24404e-14 108 lineto +8.44116e-15 72 lineto +66 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 51 (MCDEN) 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 +% MCDEN->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/v104multiplemap.ps b/books/ps/v104multiplemap.ps new file mode 100644 index 0000000..5baa6f7 --- /dev/null +++ b/books/ps/v104multiplemap.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 +% MMAP +gsave +[ /Rect [ 4 72 62 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MMAP) >> + /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 +11.5 85.9 moveto 43 (MMAP) 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 +% MMAP->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/v104nagpolynomialrootspackage.ps b/books/ps/v104nagpolynomialrootspackage.ps new file mode 100644 index 0000000..610885b --- /dev/null +++ b/books/ps/v104nagpolynomialrootspackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 114 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 78 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% NAGC02 +gsave +[ /Rect [ 0 72 70 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=NAGC02) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +70 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.13163e-14 108 lineto +7.10543e-15 72 lineto +70 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 54 (NAGC02) alignedtext +grestore +% ALIST +gsave +[ /Rect [ 8 0 62 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 62 36 moveto +8 36 lineto +8 1.06581e-14 lineto +62 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 62 36 moveto +8 36 lineto +8 1.06581e-14 lineto +62 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +15.5 13.9 moveto 39 (ALIST) alignedtext +grestore +% NAGC02->ALIST +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 35 72 moveto +35 64 35 55 35 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 114 152 +end +restore +%%EOF diff --git a/books/ps/v104nagrootfindingpackage.ps b/books/ps/v104nagrootfindingpackage.ps new file mode 100644 index 0000000..3e8c3ed --- /dev/null +++ b/books/ps/v104nagrootfindingpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 114 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 78 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% NAGC05 +gsave +[ /Rect [ 0 72 70 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=NAGC05) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.73566e-14 108 lineto +6.33868e-15 72 lineto +70 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.73566e-14 108 lineto +6.33868e-15 72 lineto +70 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 55 (NAGC05) alignedtext +grestore +% ALIST +gsave +[ /Rect [ 8 0 62 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 62 36 moveto +8 36 lineto +8 1.06581e-14 lineto +62 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 62 36 moveto +8 36 lineto +8 1.06581e-14 lineto +62 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +15.5 13.9 moveto 39 (ALIST) alignedtext +grestore +% NAGC05->ALIST +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 35 72 moveto +35 64 35 55 35 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 114 152 +end +restore +%%EOF diff --git a/books/ps/v104nagseriessummationpackage.ps b/books/ps/v104nagseriessummationpackage.ps new file mode 100644 index 0000000..f269089 --- /dev/null +++ b/books/ps/v104nagseriessummationpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 114 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 78 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% NAGC06 +gsave +[ /Rect [ 0 72 70 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=NAGC06) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.73566e-14 108 lineto +6.33868e-15 72 lineto +70 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 70 108 moveto +2.73566e-14 108 lineto +6.33868e-15 72 lineto +70 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 55 (NAGC06) alignedtext +grestore +% ALIST +gsave +[ /Rect [ 8 0 62 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 62 36 moveto +8 36 lineto +8 1.06581e-14 lineto +62 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 62 36 moveto +8 36 lineto +8 1.06581e-14 lineto +62 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +15.5 13.9 moveto 39 (ALIST) alignedtext +grestore +% NAGC06->ALIST +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 35 72 moveto +35 64 35 55 35 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 38.5001 46 moveto +35 36 lineto +31.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 114 152 +end +restore +%%EOF diff --git a/books/ps/v104numericcontinuedfraction.ps b/books/ps/v104numericcontinuedfraction.ps new file mode 100644 index 0000000..f7b78cd --- /dev/null +++ b/books/ps/v104numericcontinuedfraction.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 +% NCNTFRAC +gsave +[ /Rect [ 22 72 112 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=NCNTFRAC) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 112 108 moveto +22 108 lineto +22 72 lineto +112 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 112 108 moveto +22 108 lineto +22 72 lineto +112 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +30 85.9 moveto 74 (NCNTFRAC) 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 +% NCNTFRAC->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 +% NCNTFRAC->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/v104onepointcompletionfunctions2.ps b/books/ps/v104onepointcompletionfunctions2.ps new file mode 100644 index 0000000..172e51c --- /dev/null +++ b/books/ps/v104onepointcompletionfunctions2.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 +% ORDCOMP2 +gsave +[ /Rect [ 39 72 131 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ORDCOMP2) >> + /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 +46.5 85.9 moveto 77 (ORDCOMP2) 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 +% ORDCOMP2->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 +% ORDCOMP2->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/v104orderedcompletionfunctions2.ps b/books/ps/v104orderedcompletionfunctions2.ps new file mode 100644 index 0000000..172e51c --- /dev/null +++ b/books/ps/v104orderedcompletionfunctions2.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 +% ORDCOMP2 +gsave +[ /Rect [ 39 72 131 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ORDCOMP2) >> + /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 +46.5 85.9 moveto 77 (ORDCOMP2) 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 +% ORDCOMP2->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 +% ORDCOMP2->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/v104twodimensionalplotclipping.ps b/books/ps/v104twodimensionalplotclipping.ps new file mode 100644 index 0000000..31b27a0 --- /dev/null +++ b/books/ps/v104twodimensionalplotclipping.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 104 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 68 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 +% CLIP +gsave +[ /Rect [ 3 72 57 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=CLIP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 57 108 moveto +3 108 lineto +3 72 lineto +57 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 57 108 moveto +3 108 lineto +3 72 lineto +57 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +15 85.9 moveto 30 (CLIP) alignedtext +grestore +% PTCAT +gsave +[ /Rect [ 0 0 60 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PTCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 60 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +60 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 60 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +60 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 44 (PTCAT) alignedtext +grestore +% CLIP->PTCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 30 72 moveto +30 64 30 55 30 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 33.5001 46 moveto +30 36 lineto +26.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 33.5001 46 moveto +30 36 lineto +26.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 104 152 +end +restore +%%EOF diff --git a/books/ps/v104univariatepolynomialcommondenominator.ps b/books/ps/v104univariatepolynomialcommondenominator.ps new file mode 100644 index 0000000..49b5c40 --- /dev/null +++ b/books/ps/v104univariatepolynomialcommondenominator.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 116 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 80 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 +% UPCDEN +gsave +[ /Rect [ 0 72 72 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=UPCDEN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 72 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +72 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 72 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +72 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 56 (UPCDEN) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 3 0 69 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 69 36 moveto +3 36 lineto +3 1.06581e-14 lineto +69 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 69 36 moveto +3 36 lineto +3 1.06581e-14 lineto +69 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% UPCDEN->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 36 72 moveto +36 64 36 55 36 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 39.5001 46 moveto +36 36 lineto +32.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 39.5001 46 moveto +36 36 lineto +32.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 116 152 +end +restore +%%EOF diff --git a/src/algebra/c02.spad.pamphlet b/src/algebra/c02.spad.pamphlet deleted file mode 100644 index f3adcc8..0000000 --- a/src/algebra/c02.spad.pamphlet +++ /dev/null @@ -1,130 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra c02.spad} -\author{Godfrey Nolan, Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package NAGC02 NagPolynomialRootsPackage} -<>= -)abbrev package NAGC02 NagPolynomialRootsPackage -++ Author: Godfrey Nolan and Mike Dewar -++ Date Created: Jan 1994 -++ Date Last Updated: Thu May 12 17:44:27 1994 -++ Description: -++ This package uses the NAG Library to compute the zeros of a -++ polynomial with real or complex coefficients. -++ See \downlink{Manual Page}{manpageXXc02}. - -NagPolynomialRootsPackage(): Exports == Implementation where - S ==> Symbol - FOP ==> FortranOutputStackPackage - - Exports ==> with - c02aff : (Matrix DoubleFloat,Integer,Boolean,Integer) -> Result - ++ c02aff(a,n,scale,ifail) - ++ finds all the roots of a complex polynomial equation, - ++ using a variant of Laguerre's Method. - ++ See \downlink{Manual Page}{manpageXXc02aff}. - c02agf : (Matrix DoubleFloat,Integer,Boolean,Integer) -> Result - ++ c02agf(a,n,scale,ifail) - ++ finds all the roots of a real polynomial equation, using a - ++ variant of Laguerre's Method. - ++ See \downlink{Manual Page}{manpageXXc02agf}. - Implementation ==> add - - import Lisp - import DoubleFloat - import Matrix DoubleFloat - import Any - import Record - import Integer - import Boolean - import NAGLinkSupportPackage - import AnyFunctions1(Matrix DoubleFloat) - import AnyFunctions1(Integer) - import AnyFunctions1(Boolean) - - - c02aff(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ - ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c02aff",_ - ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_ - ["z"::S,"w"::S]$Lisp,_ - [["double"::S,["a"::S,2$Lisp,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ - ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1$Lisp]$Lisp,4$Lisp]$Lisp]$Lisp]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ,["logical"::S,"scale"::S]$Lisp_ - ]$Lisp,_ - ["z"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,scaleArg::Any,ifailArg::Any,aArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - - - c02agf(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ - ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c02agf",_ - ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_ - ["z"::S,"w"::S]$Lisp,_ - [["double"::S,["a"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ - ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1$Lisp]$Lisp,2$Lisp]$Lisp]$Lisp]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ,["logical"::S,"scale"::S]$Lisp_ - ]$Lisp,_ - ["z"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,scaleArg::Any,ifailArg::Any,aArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/c05.spad.pamphlet b/src/algebra/c05.spad.pamphlet deleted file mode 100644 index 591b1fc..0000000 --- a/src/algebra/c05.spad.pamphlet +++ /dev/null @@ -1,176 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra c05.spad} -\author{Godfrey Nolan, Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package NAGC05 NagRootFindingPackage} -<>= -)abbrev package NAGC05 NagRootFindingPackage -++ Author: Godfrey Nolan and Mike Dewar -++ Date Created: Jan 1994 -++ Date Last Updated: Thu May 12 17:44:28 1994 -++ Description: -++ This package uses the NAG Library to calculate real zeros of -++ continuous real functions of one or more variables. (Complex -++ equations must be expressed in terms of the equivalent larger -++ system of real equations.) -++ See \downlink{Manual Page}{manpageXXc05}. - -NagRootFindingPackage(): Exports == Implementation where - S ==> Symbol - FOP ==> FortranOutputStackPackage - - Exports ==> with - c05adf : (DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat,_ - Integer,Union(fn:FileName,fp:Asp1(F))) -> Result - ++ c05adf(a,b,eps,eta,ifail,f) - ++ locates a zero of a continuous function in a given - ++ interval by a combination of the methods of linear interpolation, - ++ extrapolation and bisection. - ++ See \downlink{Manual Page}{manpageXXc05adf}. - c05nbf : (Integer,Integer,Matrix DoubleFloat,DoubleFloat,_ - Integer,Union(fn:FileName,fp:Asp6(FCN))) -> Result - ++ c05nbf(n,lwa,x,xtol,ifail,fcn) - ++ is an easy-to-use routine to find a solution of a system - ++ of nonlinear equations by a modification of the Powell hybrid - ++ method. - ++ See \downlink{Manual Page}{manpageXXc05nbf}. - c05pbf : (Integer,Integer,Integer,Matrix DoubleFloat,_ - DoubleFloat,Integer,Union(fn:FileName,fp:Asp35(FCN))) -> Result - ++ c05pbf(n,ldfjac,lwa,x,xtol,ifail,fcn) - ++ is an easy-to-use routine to find a solution of a system - ++ of nonlinear equations by a modification of the Powell hybrid - ++ method. The user must provide the Jacobian. - ++ See \downlink{Manual Page}{manpageXXc05pbf}. - Implementation ==> add - - import Lisp - import DoubleFloat - import Any - import Record - import Integer - import Matrix DoubleFloat - import Boolean - import NAGLinkSupportPackage - import FortranPackage - import Union(fn:FileName,fp:Asp1(F)) - import AnyFunctions1(DoubleFloat) - import AnyFunctions1(Matrix DoubleFloat) - import AnyFunctions1(Integer) - - - c05adf(aArg:DoubleFloat,bArg:DoubleFloat,epsArg:DoubleFloat,_ - etaArg:DoubleFloat,ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == - pushFortranOutputStack(fFilename := aspFilename "f")$FOP - if fArg case fn - then outputAsFortran(fArg.fn) - else outputAsFortran(fArg.fp) - popFortranOutputStack()$FOP - [(invokeNagman([fFilename]$Lisp,_ - "c05adf",_ - ["a"::S,"b"::S,"eps"::S,"eta"::S,"x"::S_ - ,"ifail"::S,"f"::S]$Lisp,_ - ["x"::S,"f"::S]$Lisp,_ - [["double"::S,"a"::S,"b"::S,"eps"::S,"eta"::S_ - ,"x"::S,"f"::S]$Lisp_ - ,["integer"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"ifail"::S]$Lisp,_ - [([aArg::Any,bArg::Any,epsArg::Any,etaArg::Any,ifailArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c05nbf(nArg:Integer,lwaArg:Integer,xArg:Matrix DoubleFloat,_ - xtolArg:DoubleFloat,ifailArg:Integer,fcnArg:Union(fn:FileName,fp:Asp6(FCN))): Result == - pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP - if fcnArg case fn - then outputAsFortran(fcnArg.fn) - else outputAsFortran(fcnArg.fp) - popFortranOutputStack()$FOP - [(invokeNagman([fcnFilename]$Lisp,_ - "c05nbf",_ - ["n"::S,"lwa"::S,"xtol"::S,"ifail"::S,"fcn"::S_ - ,"fvec"::S,"x"::S,"wa"::S]$Lisp,_ - ["fvec"::S,"wa"::S,"fcn"::S]$Lisp,_ - [["double"::S,["fvec"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp_ - ,"xtol"::S,["wa"::S,"lwa"::S]$Lisp,"fcn"::S]$Lisp_ - ,["integer"::S,"n"::S,"lwa"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["fvec"::S,"x"::S,"xtol"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,lwaArg::Any,xtolArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c05pbf(nArg:Integer,ldfjacArg:Integer,lwaArg:Integer,_ - xArg:Matrix DoubleFloat,xtolArg:DoubleFloat,ifailArg:Integer,_ - fcnArg:Union(fn:FileName,fp:Asp35(FCN))): Result == - pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP - if fcnArg case fn - then outputAsFortran(fcnArg.fn) - else outputAsFortran(fcnArg.fp) - popFortranOutputStack()$FOP - [(invokeNagman([fcnFilename]$Lisp,_ - "c05pbf",_ - ["n"::S,"ldfjac"::S,"lwa"::S,"xtol"::S,"ifail"::S_ - ,"fcn"::S,"fvec"::S,"fjac"::S,"x"::S,"wa"::S]$Lisp,_ - ["fvec"::S,"fjac"::S,"wa"::S,"fcn"::S]$Lisp,_ - [["double"::S,["fvec"::S,"n"::S]$Lisp,["fjac"::S,"ldfjac"::S,"n"::S]$Lisp_ - ,["x"::S,"n"::S]$Lisp,"xtol"::S,["wa"::S,"lwa"::S]$Lisp,"fcn"::S]$Lisp_ - ,["integer"::S,"n"::S,"ldfjac"::S,"lwa"::S_ - ,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["fvec"::S,"fjac"::S,"x"::S,"xtol"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,ldfjacArg::Any,lwaArg::Any,xtolArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/c06.spad.pamphlet b/src/algebra/c06.spad.pamphlet deleted file mode 100644 index a4ed2fe..0000000 --- a/src/algebra/c06.spad.pamphlet +++ /dev/null @@ -1,339 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra c06.spad} -\author{Godfrey Nolan, Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package NAGC06 NagSeriesSummationPackage} -<>= -)abbrev package NAGC06 NagSeriesSummationPackage -++ Author: Godfrey Nolan and Mike Dewar -++ Date Created: Jan 1994 -++ Date Last Updated: Thu May 12 17:44:30 1994 -++ Description: -++ This package uses the NAG Library to calculate the discrete Fourier -++ transform of a sequence of real or complex data values, and -++ applies it to calculate convolutions and correlations. -++ See \downlink{Manual Page}{manpageXXc06}. - -NagSeriesSummationPackage(): Exports == Implementation where - S ==> Symbol - FOP ==> FortranOutputStackPackage - - Exports ==> with - c06eaf : (Integer,Matrix DoubleFloat,Integer) -> Result - ++ c06eaf(n,x,ifail) - ++ calculates the discrete Fourier transform of a sequence of - ++ n real data values. (No extra workspace required.) - ++ See \downlink{Manual Page}{manpageXXc06eaf}. - c06ebf : (Integer,Matrix DoubleFloat,Integer) -> Result - ++ c06ebf(n,x,ifail) - ++ calculates the discrete Fourier transform of a Hermitian - ++ sequence of n complex data values. (No extra workspace required.) - ++ See \downlink{Manual Page}{manpageXXc06ebf}. - c06ecf : (Integer,Matrix DoubleFloat,Matrix DoubleFloat,Integer) -> Result - ++ c06ecf(n,x,y,ifail) - ++ calculates the discrete Fourier transform of a sequence of - ++ n complex data values. (No extra workspace required.) - ++ See \downlink{Manual Page}{manpageXXc06ecf}. - c06ekf : (Integer,Integer,Matrix DoubleFloat,Matrix DoubleFloat,_ - Integer) -> Result - ++ c06ekf(job,n,x,y,ifail) - ++ calculates the circular convolution of two - ++ real vectors of period n. No extra workspace is required. - ++ See \downlink{Manual Page}{manpageXXc06ekf}. - c06fpf : (Integer,Integer,String,Matrix DoubleFloat,_ - Matrix DoubleFloat,Integer) -> Result - ++ c06fpf(m,n,init,x,trig,ifail) - ++ computes the discrete Fourier transforms of m sequences, - ++ each containing n real data values. This routine is designed to - ++ be particularly efficient on vector processors. - ++ See \downlink{Manual Page}{manpageXXc06fpf}. - c06fqf : (Integer,Integer,String,Matrix DoubleFloat,_ - Matrix DoubleFloat,Integer) -> Result - ++ c06fqf(m,n,init,x,trig,ifail) - ++ computes the discrete Fourier transforms of m Hermitian - ++ sequences, each containing n complex data values. This routine is - ++ designed to be particularly efficient on vector processors. - ++ See \downlink{Manual Page}{manpageXXc06fqf}. - c06frf : (Integer,Integer,String,Matrix DoubleFloat,_ - Matrix DoubleFloat,Matrix DoubleFloat,Integer) -> Result - ++ c06frf(m,n,init,x,y,trig,ifail) - ++ computes the discrete Fourier transforms of m sequences, - ++ each containing n complex data values. This routine is designed - ++ to be particularly efficient on vector processors. - ++ See \downlink{Manual Page}{manpageXXc06frf}. - c06fuf : (Integer,Integer,String,Matrix DoubleFloat,_ - Matrix DoubleFloat,Matrix DoubleFloat,Matrix DoubleFloat,Integer) -> Result - ++ c06fuf(m,n,init,x,y,trigm,trign,ifail) - ++ computes the two-dimensional discrete Fourier transform of - ++ a bivariate sequence of complex data values. This routine is - ++ designed to be particularly efficient on vector processors. - ++ See \downlink{Manual Page}{manpageXXc06fuf}. - c06gbf : (Integer,Matrix DoubleFloat,Integer) -> Result - ++ c06gbf(n,x,ifail) - ++ forms the complex conjugate of n - ++ data values. - ++ See \downlink{Manual Page}{manpageXXc06gbf}. - c06gcf : (Integer,Matrix DoubleFloat,Integer) -> Result - ++ c06gcf(n,y,ifail) - ++ forms the complex conjugate of a sequence of n data - ++ values. - ++ See \downlink{Manual Page}{manpageXXc06gcf}. - c06gqf : (Integer,Integer,Matrix DoubleFloat,Integer) -> Result - ++ c06gqf(m,n,x,ifail) - ++ forms the complex conjugates, - ++ each containing n data values. - ++ See \downlink{Manual Page}{manpageXXc06gqf}. - c06gsf : (Integer,Integer,Matrix DoubleFloat,Integer) -> Result - ++ c06gsf(m,n,x,ifail) - ++ takes m Hermitian sequences, each containing n data - ++ values, and forms the real and imaginary parts of the m - ++ corresponding complex sequences. - ++ See \downlink{Manual Page}{manpageXXc06gsf}. - Implementation ==> add - - import Lisp - import DoubleFloat - import Any - import Record - import Integer - import Matrix DoubleFloat - import Boolean - import NAGLinkSupportPackage - import AnyFunctions1(Integer) - import AnyFunctions1(String) - import AnyFunctions1(Matrix DoubleFloat) - - - c06eaf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06eaf",_ - ["n"::S,"ifail"::S,"x"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - - c06ebf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06ebf",_ - ["n"::S,"ifail"::S,"x"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06ecf(nArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_ - ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06ecf",_ - ["n"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_ - ]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"y"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06ekf(jobArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ - yArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06ekf",_ - ["job"::S,"n"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_ - ]$Lisp_ - ,["integer"::S,"job"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"y"::S,"ifail"::S]$Lisp,_ - [([jobArg::Any,nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06fpf(mArg:Integer,nArg:Integer,initArg:String,_ - xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06fpf",_ - ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"trig"::S,"work"::S]$Lisp,_ - ["work"::S]$Lisp,_ - [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ - ,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_ - ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ - ,["character"::S,"init"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"trig"::S,"ifail"::S]$Lisp,_ - [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,trigArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06fqf(mArg:Integer,nArg:Integer,initArg:String,_ - xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06fqf",_ - ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"trig"::S,"work"::S]$Lisp,_ - ["work"::S]$Lisp,_ - [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ - ,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_ - ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ - ,["character"::S,"init"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"trig"::S,"ifail"::S]$Lisp,_ - [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,trigArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06frf(mArg:Integer,nArg:Integer,initArg:String,_ - xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,_ - ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06frf",_ - ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"y"::S,"trig"::S,"work"::S]$Lisp,_ - ["work"::S]$Lisp,_ - [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ - ,["y"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,["*"::S,["*"::S,2$Lisp,"m"::S]$Lisp,"n"::S]$Lisp]$Lisp_ - ]$Lisp_ - ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ - ,["character"::S,"init"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"y"::S,"trig"::S,"ifail"::S]$Lisp,_ - [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,yArg::Any,trigArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06fuf(mArg:Integer,nArg:Integer,initArg:String,_ - xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,trigmArg:Matrix DoubleFloat,_ - trignArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06fuf",_ - ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"y"::S,"trigm"::S,"trign"::S,"work"::S_ - ]$Lisp,_ - ["work"::S]$Lisp,_ - [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ - ,["y"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["trigm"::S,["*"::S,2$Lisp,"m"::S]$Lisp]$Lisp,["trign"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp_ - ,["work"::S,["*"::S,["*"::S,2$Lisp,"m"::S]$Lisp,"n"::S]$Lisp]$Lisp]$Lisp_ - ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ - ,["character"::S,"init"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"y"::S,"trigm"::S,"trign"::S,"ifail"::S]$Lisp,_ - [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,yArg::Any,trigmArg::Any,trignArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06gbf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06gbf",_ - ["n"::S,"ifail"::S,"x"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06gcf(nArg:Integer,yArg:Matrix DoubleFloat,ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06gcf",_ - ["n"::S,"ifail"::S,"y"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["y"::S,"n"::S]$Lisp]$Lisp_ - ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["y"::S,"ifail"::S]$Lisp,_ - [([nArg::Any,ifailArg::Any,yArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06gqf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ - ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06gqf",_ - ["m"::S,"n"::S,"ifail"::S,"x"::S]$Lisp,_ - []$Lisp,_ - [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ - ]$Lisp_ - ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["x"::S,"ifail"::S]$Lisp,_ - [([mArg::Any,nArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - - c06gsf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_ - ifailArg:Integer): Result == - [(invokeNagman(NIL$Lisp,_ - "c06gsf",_ - ["m"::S,"n"::S,"ifail"::S,"x"::S,"u"::S,"v"::S]$Lisp,_ - ["u"::S,"v"::S]$Lisp,_ - [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_ - ,["u"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["v"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_ - ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_ - ]$Lisp,_ - ["u"::S,"v"::S,"ifail"::S]$Lisp,_ - [([mArg::Any,nArg::Any,ifailArg::Any,xArg::Any ])_ - @List Any]$Lisp)$Lisp)_ - pretend List (Record(key:Symbol,entry:Any))]$Result - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/carten.spad.pamphlet b/src/algebra/carten.spad.pamphlet deleted file mode 100644 index 1894c2f..0000000 --- a/src/algebra/carten.spad.pamphlet +++ /dev/null @@ -1,1658 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra carten.spad} -\author{Stephen M. Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain CARTEN CartesianTensor} -<>= --- carten.spad.pamphlet CartesianTensor.input -)spool CartesianTensor.output -)set message test on -)set message auto off -)clear all ---S 1 of 48 -CT := CARTEN(i0 := 1, 2, Integer) ---R ---R ---R (1) CartesianTensor(1,2,Integer) ---R Type: Domain ---E 1 - ---S 2 of 48 -t0: CT := 8 ---R ---R ---R (2) 8 ---R Type: CartesianTensor(1,2,Integer) ---E 2 - ---S 3 of 48 -rank t0 ---R ---R ---R (3) 0 ---R Type: NonNegativeInteger ---E 3 - ---S 4 of 48 -v: DirectProduct(2, Integer) := directProduct [3,4] ---R ---R ---R (4) [3,4] ---R Type: DirectProduct(2,Integer) ---E 4 - ---S 5 of 48 -Tv: CT := v ---R ---R ---R (5) [3,4] ---R Type: CartesianTensor(1,2,Integer) ---E 5 - ---S 6 of 48 -m: SquareMatrix(2, Integer) := matrix [ [1,2],[4,5] ] ---R ---R ---R +1 2+ ---R (6) | | ---R +4 5+ ---R Type: SquareMatrix(2,Integer) ---E 6 - ---S 7 of 48 -Tm: CT := m ---R ---R ---R +1 2+ ---R (7) | | ---R +4 5+ ---R Type: CartesianTensor(1,2,Integer) ---E 7 - ---S 8 of 48 -n: SquareMatrix(2, Integer) := matrix [ [2,3],[0,1] ] ---R ---R ---R +2 3+ ---R (8) | | ---R +0 1+ ---R Type: SquareMatrix(2,Integer) ---E 8 - ---S 9 of 48 -Tn: CT := n ---R ---R ---R +2 3+ ---R (9) | | ---R +0 1+ ---R Type: CartesianTensor(1,2,Integer) ---E 9 - ---S 10 of 48 -t1: CT := [2, 3] ---R ---R ---R (10) [2,3] ---R Type: CartesianTensor(1,2,Integer) ---E 10 - ---S 11 of 48 -rank t1 ---R ---R ---R (11) 1 ---R Type: PositiveInteger ---E 11 - ---S 12 of 48 -t2: CT := [t1, t1] ---R ---R ---R +2 3+ ---R (12) | | ---R +2 3+ ---R Type: CartesianTensor(1,2,Integer) ---E 12 - ---S 13 of 48 -t3: CT := [t2, t2] ---R ---R ---R +2 3+ +2 3+ ---R (13) [| |,| |] ---R +2 3+ +2 3+ ---R Type: CartesianTensor(1,2,Integer) ---E 13 - ---S 14 of 48 -tt: CT := [t3, t3]; tt := [tt, tt] ---R ---R ---R ++2 3+ +2 3++ ++2 3+ +2 3++ ---R || | | || || | | || ---R |+2 3+ +2 3+| |+2 3+ +2 3+| ---R (14) [| |,| |] ---R |+2 3+ +2 3+| |+2 3+ +2 3+| ---R || | | || || | | || ---R ++2 3+ +2 3++ ++2 3+ +2 3++ ---R Type: CartesianTensor(1,2,Integer) ---E 14 - ---S 15 of 48 -rank tt ---R ---R ---R (15) 5 ---R Type: PositiveInteger ---E 15 - ---S 16 of 48 -Tmn := product(Tm, Tn) ---R ---R ---R ++2 3+ +4 6+ + ---R || | | | | ---R |+0 1+ +0 2+ | ---R (16) | | ---R |+8 12+ +10 15+| ---R || | | || ---R ++0 4 + +0 5 ++ ---R Type: CartesianTensor(1,2,Integer) ---E 16 - ---S 17 of 48 -Tmv := contract(Tm,2,Tv,1) ---R ---R ---R (17) [11,32] ---R Type: CartesianTensor(1,2,Integer) ---E 17 - ---S 18 of 48 -Tm*Tv ---R ---R ---R (18) [11,32] ---R Type: CartesianTensor(1,2,Integer) ---E 18 - ---S 19 of 48 -Tmv = m * v ---R ---R ---R (19) [11,32]= [11,32] ---R Type: Equation CartesianTensor(1,2,Integer) ---E 19 - ---S 20 of 48 -t0() ---R ---R ---R (20) 8 ---R Type: PositiveInteger ---E 20 - ---S 21 of 48 -t1(1+1) ---R ---R ---R (21) 3 ---R Type: PositiveInteger ---E 21 - ---S 22 of 48 -t2(2,1) ---R ---R ---R (22) 2 ---R Type: PositiveInteger ---E 22 - ---S 23 of 48 -t3(2,1,2) ---R ---R ---R (23) 3 ---R Type: PositiveInteger ---E 23 - ---S 24 of 48 -Tmn(2,1,2,1) ---R ---R ---R (24) 0 ---R Type: NonNegativeInteger ---E 24 - ---S 25 of 48 -t0[] ---R ---R ---R (25) 8 ---R Type: PositiveInteger ---E 25 - ---S 26 of 48 -t1[2] ---R ---R ---R (26) 3 ---R Type: PositiveInteger ---E 26 - ---S 27 of 48 -t2[2,1] ---R ---R ---R (27) 2 ---R Type: PositiveInteger ---E 27 - ---S 28 of 48 -t3[2,1,2] ---R ---R ---R (28) 3 ---R Type: PositiveInteger ---E 28 - ---S 29 of 48 -Tmn[2,1,2,1] ---R ---R ---R (29) 0 ---R Type: NonNegativeInteger ---E 29 - ---S 30 of 48 -cTmn := contract(Tmn,1,2) ---R ---R ---R +12 18+ ---R (30) | | ---R +0 6 + ---R Type: CartesianTensor(1,2,Integer) ---E 30 - ---S 31 of 48 -trace(m) * n ---R ---R ---R +12 18+ ---R (31) | | ---R +0 6 + ---R Type: SquareMatrix(2,Integer) ---E 31 - ---S 32 of 48 -contract(Tmn,1,2) = trace(m) * n ---R ---R ---R +12 18+ +12 18+ ---R (32) | |= | | ---R +0 6 + +0 6 + ---R Type: Equation CartesianTensor(1,2,Integer) ---E 32 - ---S 33 of 48 -contract(Tmn,1,3) = transpose(m) * n ---R ---R ---R +2 7 + +2 7 + ---R (33) | |= | | ---R +4 11+ +4 11+ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 33 - ---S 34 of 48 -contract(Tmn,1,4) = transpose(m) * transpose(n) ---R ---R ---R +14 4+ +14 4+ ---R (34) | |= | | ---R +19 5+ +19 5+ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 34 - ---S 35 of 48 -contract(Tmn,2,3) = m * n ---R ---R ---R +2 5 + +2 5 + ---R (35) | |= | | ---R +8 17+ +8 17+ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 35 - ---S 36 of 48 -contract(Tmn,2,4) = m * transpose(n) ---R ---R ---R +8 2+ +8 2+ ---R (36) | |= | | ---R +23 5+ +23 5+ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 36 - ---S 37 of 48 -contract(Tmn,3,4) = trace(n) * m ---R ---R ---R +3 6 + +3 6 + ---R (37) | |= | | ---R +12 15+ +12 15+ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 37 - ---S 38 of 48 -tTmn := transpose(Tmn,1,3) ---R ---R ---R ++2 3 + +4 6 ++ ---R || | | || ---R |+8 12+ +10 15+| ---R (38) | | ---R |+0 1+ +0 2+ | ---R || | | | | ---R ++0 4+ +0 5+ + ---R Type: CartesianTensor(1,2,Integer) ---E 38 - ---S 39 of 48 -transpose Tmn ---R ---R ---R ++2 8+ +4 10++ ---R || | | || ---R |+0 0+ +0 0 +| ---R (39) | | ---R |+3 12+ +6 15+| ---R || | | || ---R ++1 4 + +2 5 ++ ---R Type: CartesianTensor(1,2,Integer) ---E 39 - ---S 40 of 48 -transpose Tm = transpose m ---R ---R ---R +1 4+ +1 4+ ---R (40) | |= | | ---R +2 5+ +2 5+ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 40 - ---S 41 of 48 -rTmn := reindex(Tmn, [1,4,2,3]) ---R ---R ---R ++2 0+ +3 1+ + ---R || | | | | ---R |+4 0+ +6 2+ | ---R (41) | | ---R |+8 0+ +12 4+| ---R || | | || ---R ++10 0+ +15 5++ ---R Type: CartesianTensor(1,2,Integer) ---E 41 - ---S 42 of 48 -tt := transpose(Tm)*Tn - Tn*transpose(Tm) ---R ---R ---R +- 6 - 16+ ---R (42) | | ---R + 2 6 + ---R Type: CartesianTensor(1,2,Integer) ---E 42 - ---S 43 of 48 -Tv*(tt+Tn) ---R ---R ---R (43) [- 4,- 11] ---R Type: CartesianTensor(1,2,Integer) ---E 43 - ---S 44 of 48 -reindex(product(Tn,Tn),[4,3,2,1])+3*Tn*product(Tm,Tm) ---R ---R ---R ++46 84 + +57 114++ ---R || | | || ---R |+174 212+ +228 285+| ---R (44) | | ---R | +18 24+ +17 30+ | ---R | | | | | | ---R + +57 63+ +63 76+ + ---R Type: CartesianTensor(1,2,Integer) ---E 44 - ---S 45 of 48 -delta: CT := kroneckerDelta() ---R ---R ---R +1 0+ ---R (45) | | ---R +0 1+ ---R Type: CartesianTensor(1,2,Integer) ---E 45 - ---S 46 of 48 -contract(Tmn, 2, delta, 1) = reindex(Tmn, [1,3,4,2]) ---R ---R ---R + +2 4+ +0 0++ + +2 4+ +0 0++ ---R | | | | || | | | | || ---R | +3 6+ +1 2+| | +3 6+ +1 2+| ---R (46) | |= | | ---R |+8 10+ +0 0+| |+8 10+ +0 0+| ---R || | | || || | | || ---R ++12 15+ +4 5++ ++12 15+ +4 5++ ---R Type: Equation CartesianTensor(1,2,Integer) ---E 46 - ---S 47 of 48 -epsilon:CT := leviCivitaSymbol() ---R ---R ---R + 0 1+ ---R (47) | | ---R +- 1 0+ ---R Type: CartesianTensor(1,2,Integer) ---E 47 - ---S 48 of 48 -contract(epsilon*Tm*epsilon, 1,2) = 2 * determinant m ---R ---R ---R (48) - 6= - 6 ---R Type: Equation CartesianTensor(1,2,Integer) ---E 48 -)spool -)lisp (bye) -@ -<>= -==================================================================== -CartesianTensor examples -==================================================================== - -CartesianTensor(i0,dim,R) provides Cartesian tensors with components -belonging to a commutative ring R. Tensors can be described as a -generalization of vectors and matrices. This gives a concise tensor -algebra for multilinear objects supported by the CartesianTensor -domain. You can form the inner or outer product of any two tensors -and you can add or subtract tensors with the same number of components. -Additionally, various forms of traces and transpositions are useful. - -The CartesianTensor constructor allows you to specify the minimum -index for subscripting. In what follows we discuss in detail how to -manipulate tensors. - -Here we construct the domain of Cartesian tensors of dimension 2 over the -integers, with indices starting at 1. - - CT := CARTEN(i0 := 1, 2, Integer) - CartesianTensor(1,2,Integer) - Type: Domain - -==================================================================== -Forming tensors -==================================================================== - -Scalars can be converted to tensors of rank zero. - - t0: CT := 8 - 8 - Type: CartesianTensor(1,2,Integer) - - rank t0 - 0 - Type: NonNegativeInteger - -Vectors (mathematical direct products, rather than one dimensional array -structures) can be converted to tensors of rank one. - - v: DirectProduct(2, Integer) := directProduct [3,4] - [3, 4] - Type: DirectProduct(2,Integer) - - Tv: CT := v - [3, 4] - Type: CartesianTensor(1,2,Integer) - -Matrices can be converted to tensors of rank two. - - m: SquareMatrix(2, Integer) := matrix [ [1,2],[4,5] ] - +1 2+ - | | - +4 5+ - Type: SquareMatrix(2,Integer) - - Tm: CT := m - +1 2+ - | | - +4 5+ - Type: CartesianTensor(1,2,Integer) - - n: SquareMatrix(2, Integer) := matrix [ [2,3],[0,1] ] - +2 3+ - | | - +0 1+ - Type: SquareMatrix(2,Integer) - - Tn: CT := n - +2 3+ - | | - +0 1+ - Type: CartesianTensor(1,2,Integer) - -In general, a tensor of rank k can be formed by making a list of -rank k-1 tensors or, alternatively, a k-deep nested list of lists. - - t1: CT := [2, 3] - [2, 3] - Type: CartesianTensor(1,2,Integer) - - rank t1 - 1 - Type: PositiveInteger - - t2: CT := [t1, t1] - +2 3+ - | | - +2 3+ - Type: CartesianTensor(1,2,Integer) - - t3: CT := [t2, t2] - - +2 3+ +2 3+ - [| |,| |] - +2 3+ +2 3+ - Type: CartesianTensor(1,2,Integer) - - tt: CT := [t3, t3]; tt := [tt, tt] - ++2 3+ +2 3++ ++2 3+ +2 3++ - || | | || || | | || - |+2 3+ +2 3+| |+2 3+ +2 3+| - [| |,| |] - |+2 3+ +2 3+| |+2 3+ +2 3+| - || | | || || | | || - ++2 3+ +2 3++ ++2 3+ +2 3++ - Type: CartesianTensor(1,2,Integer) - - rank tt - 5 - Type: PositiveInteger - -==================================================================== -Multiplication -==================================================================== - -Given two tensors of rank k1 and k2, the outer product forms a new -tensor of rank k1+k2. Here - - Tmn(i,j,k,l) = Tm(i,j)Tn(k,l) - - Tmn := product(Tm, Tn) - ++2 3+ +4 6+ + - || | | | | - |+0 1+ +0 2+ | - | | - |+8 12+ +10 15+| - || | | || - ++0 4 + +0 5 ++ - Type: CartesianTensor(1,2,Integer) - -The inner product (contract) forms a tensor of rank k1+k2-2. This -product generalizes the vector dot product and matrix-vector product -by summing component products along two indices. - -Here we sum along the second index of Tm and the first index of Tv. Here - - Tmv = sum {j=1..dim} Tm(i,j) Tv(j) - - Tmv := contract(Tm,2,Tv,1) - [11,32] - Type: CartesianTensor(1,2,Integer) - -The multiplication operator * is scalar multiplication or an inner -product depending on the ranks of the arguments. - -If either argument is rank zero it is treated as scalar multiplication. -Otherwise, a*b is the inner product summing the last index of a with the -first index of b. - - Tm*Tv - [11,32] - Type: CartesianTensor(1,2,Integer) - -This definition is consistent with the inner product on matrices -and vectors. - - Tmv = m * v - [11,32] = [11,32] - Type: Equation CartesianTensor(1,2,Integer) - -==================================================================== -Selecting Components -==================================================================== - -For tensors of low rank (that is, four or less), components can be selected -by applying the tensor to its indices. - - t0() - 8 - Type: PositiveInteger - - t1(1+1) - 3 - Type: PositiveInteger - - t2(2,1) - 2 - Type: PositiveInteger - - t3(2,1,2) - 3 - Type: PositiveInteger - - Tmn(2,1,2,1) - 0 - Type: NonNegativeInteger - -A general indexing mechanism is provided for a list of indices. - - t0[] - 8 - Type: PositiveInteger - - t1[2] - 3 - Type: PositiveInteger - - t2[2,1] - 2 - Type: PositiveInteger - -The general mechanism works for tensors of arbitrary rank, but is -somewhat less efficient since the intermediate index list must be created. - - t3[2,1,2] - 3 - Type: PositiveInteger - - Tmn[2,1,2,1] - 0 - Type: NonNegativeInteger - -==================================================================== -Contraction -==================================================================== - -A "contraction" between two tensors is an inner product, as we have -seen above. You can also contract a pair of indices of a single -tensor. This corresponds to a "trace" in linear algebra. The -expression contract(t,k1,k2) forms a new tensor by summing the -diagonal given by indices in position k1 and k2. - -This is the tensor given by - xTmn = sum{k=1..dim} Tmn(k,k,i,j) - - cTmn := contract(Tmn,1,2) - +12 18+ - | | - +0 6 + - Type: CartesianTensor(1,2,Integer) - -Since Tmn is the outer product of matrix m and matrix n, the above is -equivalent to this. - - trace(m) * n - +12 18+ - | | - +0 6 + - Type: SquareMatrix(2,Integer) - -In this and the next few examples, we show all possible contractions -of Tmn and their matrix algebra equivalents. - - contract(Tmn,1,2) = trace(m) * n - +12 18+ +12 18+ - | |= | | - +0 6 + +0 6 + - Type: Equation CartesianTensor(1,2,Integer) - - contract(Tmn,1,3) = transpose(m) * n - +2 7 + +2 7 + - | |= | | - +4 11+ +4 11+ - Type: Equation CartesianTensor(1,2,Integer) - - contract(Tmn,1,4) = transpose(m) * transpose(n) - +14 4+ +14 4+ - | |= | | - +19 5+ +19 5+ - Type: Equation CartesianTensor(1,2,Integer) - - contract(Tmn,2,3) = m * n - +2 5 + +2 5 + - | |= | | - +8 17+ +8 17+ - Type: Equation CartesianTensor(1,2,Integer) - - contract(Tmn,2,4) = m * transpose(n) - +8 2+ +8 2+ - | |= | | - +23 5+ +23 5+ - Type: Equation CartesianTensor(1,2,Integer) - - contract(Tmn,3,4) = trace(n) * m - +3 6 + +3 6 + - | |= | | - +12 15+ +12 15+ - Type: Equation CartesianTensor(1,2,Integer) - -==================================================================== -Transpositions -==================================================================== - -You can exchange any desired pair of indices using the transpose -operation. - -Here the indices in positions one and three are exchanged, that is, - tTmn(i,j,k,l) = Tmn(k,j,i,l) - - tTmn := transpose(Tmn,1,3) - ++2 3 + +4 6 ++ - || | | || - |+8 12+ +10 15+| - | | - |+0 1+ +0 2+ | - || | | | | - ++0 4+ +0 5+ + - Type: CartesianTensor(1,2,Integer) - -If no indices are specified, the first and last index are exchanged. - - transpose Tmn - ++2 8+ +4 10++ - || | | || - |+0 0+ +0 0 +| - | | - |+3 12+ +6 15+| - || | | || - ++1 4 + +2 5 ++ - Type: CartesianTensor(1,2,Integer) - -This is consistent with the matrix transpose. - - transpose Tm = transpose m - +1 4+ +1 4+ - | |= | | - +2 5+ +2 5+ - Type: Equation CartesianTensor(1,2,Integer) - - -If a more complicated reordering of the indices is required, then the -reindex operation can be used. This operation allows the indices to -be arbitrarily permuted. - - rTmn(i,j,k,l) = Tmn(i,l,j,k) - - rTmn := reindex(Tmn, [1,4,2,3]) - ++2 0+ +3 1+ + - || | | | | - |+4 0+ +6 2+ | - | | - |+8 0+ +12 4+| - || | | || - ++10 0+ +15 5++ - Type: CartesianTensor(1,2,Integer) - -==================================================================== -Arithmetic -==================================================================== - -Tensors of equal rank can be added or subtracted so arithmetic -expressions can be used to produce new tensors. - - tt := transpose(Tm)*Tn - Tn*transpose(Tm) - +- 6 - 16+ - | | - + 2 6 + - Type: CartesianTensor(1,2,Integer) - - - Tv*(tt+Tn) - [- 4,- 11] - Type: CartesianTensor(1,2,Integer) - - reindex(product(Tn,Tn),[4,3,2,1])+3*Tn*product(Tm,Tm) - ++46 84 + +57 114++ - || | | || - |+174 212+ +228 285+| - | | - | +18 24+ +17 30+ | - | | | | | | - + +57 63+ +63 76+ + - Type: CartesianTensor(1,2,Integer) - -==================================================================== -Specific Tensors -==================================================================== - -Two specific tensors have properties which depend only on the dimension. - -The Kronecker delta satisfies - - +- -+ - | 1 if i = j | -delta(i,j) = | | - | 0 if i ^= j | - +- -+ - - - delta: CT := kroneckerDelta() - +1 0+ - | | - +0 1+ - Type: CartesianTensor(1,2,Integer) - -This can be used to reindex via contraction. - - contract(Tmn, 2, delta, 1) = reindex(Tmn, [1,3,4,2]) - + +2 4+ +0 0++ + +2 4+ +0 0++ - | | | | || | | | | || - | +3 6+ +1 2+| | +3 6+ +1 2+| - | |= | | - |+8 10+ +0 0+| |+8 10+ +0 0+| - || | | || || | | || - ++12 15+ +4 5++ ++12 15+ +4 5++ - Type: Equation CartesianTensor(1,2,Integer) - -The Levi Civita symbol determines the sign of a permutation of indices. - - epsilon:CT := leviCivitaSymbol() - + 0 1+ - | | - +- 1 0+ - Type: CartesianTensor(1,2,Integer) - -Here we have: - - epsilon(i1,...,idim) - = +1 if i1,...,idim is an even permutation of i0,...,i0+dim-1 - = -1 if i1,...,idim is an odd permutation of i0,...,i0+dim-1 - = 0 if i1,...,idim is not a permutation of i0,...,i0+dim-1 - -This property can be used to form determinants. - - contract(epsilon*Tm*epsilon, 1,2) = 2 * determinant m - - 6= - 6 - Type: Equation CartesianTensor(1,2,Integer) - - -==================================================================== -Properties of the CartesianTensor domain -==================================================================== - -GradedModule(R,E) denotes "E-graded R-module", that is, a collection -of R-modules indexed by an abelian monoid E. An element g of G[s] for -some specific s in E is said to be an element of G with degree s. -Sums are defined in each module G[s] so two elements of G can be added -if they have the same degree. Morphisms can be defined and composed -by degree to give the mathematical category of graded modules. - -GradedAlgebra(R,E) denotes "E-graded R-algebra". A graded algebra is -a graded module together with a degree preserving R-bilinear map, -called the product. - - degree(product(a,b)) = degree(a) + degree(b) - - product(r*a,b) = product(a,r*b) = r*product(a,b) - product(a1+a2,b) = product(a1,b) + product(a2,b) - product(a,b1+b2) = product(a,b1) + product(a,b2) - product(a,product(b,c)) = product(product(a,b),c) - -The domain CartesianTensor(i0, dim, R) belongs to the category -GradedAlgebra(R, NonNegativeInteger). The non-negative integer degree -is the tensor rank and the graded algebra product is the tensor outer -product. The graded module addition captures the notion that only -tensors of equal rank can be added. - -If V is a vector space of dimension dim over R, then the tensor module -T[k](V) is defined as - - T[0](V) = R - T[k](V) = T[k-1](V) * V - -where * denotes the R-module tensor product. CartesianTensor(i0,dim,R) -is the graded algebra in which the degree k module is T[k](V). - -==================================================================== -Tensor Calculus -==================================================================== - -It should be noted here that often tensors are used in the context of -tensor-valued manifold maps. This leads to the notion of covariant -and contravariant bases with tensor component functions transforming -in specific ways under a change of coordinates on the manifold. This -is no more directly supported by the CartesianTensor domain than it is -by the Vector domain. However, it is possible to have the components -implicitly represent component maps by choosing a polynomial or -expression type for the components. In this case, it is up to the -user to satisfy any constraints which arise on the basis of this -interpretation. - -See Also -o )show CartesianTensor -o $AXIOM/doc/src/algebra/carten.spad.dvi - -@ -<>= -"CARTEN" -> "GRALG" -"CartesianTensor(a:Integer,b:NonNegativeInteger,c:CommutativeRing)" -> - "GradedAlgebra(a:CommutativeRing,b:NonNegativeInteger)" -"CARTEN" -> "GRMOD" -"CartesianTensor(a:Integer,b:NonNegativeInteger,c:CommutativeRing)" -> - "GradedModule(a:Integer,b:NonNegativeInteger)" -@ -<>= -)abbrev domain CARTEN CartesianTensor -++ Author: Stephen M. Watt -++ Date Created: December 1986 -++ Date Last Updated: May 15, 1991 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: tensor, graded algebra -++ Examples: -++ References: -++ Description: -++ CartesianTensor(minix,dim,R) provides Cartesian tensors with -++ components belonging to a commutative ring R. These tensors -++ can have any number of indices. Each index takes values from -++ \spad{minix} to \spad{minix + dim - 1}. - -CartesianTensor(minix, dim, R): Exports == Implementation where - NNI ==> NonNegativeInteger - I ==> Integer - DP ==> DirectProduct - SM ==> SquareMatrix - - minix: Integer - dim: NNI - R: CommutativeRing - - Exports ==> Join(GradedAlgebra(R, NNI), GradedModule(I, NNI)) with - - coerce: DP(dim, R) -> % - ++ coerce(v) views a vector as a rank 1 tensor. - ++ - ++X v:DirectProduct(2,Integer):=directProduct [3,4] - ++X tv:CartesianTensor(1,2,Integer):=v - - coerce: SM(dim, R) -> % - ++ coerce(m) views a matrix as a rank 2 tensor. - ++ - ++X v:SquareMatrix(2,Integer):=[[1,2],[3,4]] - ++X tv:CartesianTensor(1,2,Integer):=v - - coerce: List R -> % - ++ coerce([r_1,...,r_dim]) allows tensors to be constructed - ++ using lists. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - - coerce: List % -> % - ++ coerce([t_1,...,t_dim]) allows tensors to be constructed - ++ using lists. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - ++X tm:CartesianTensor(1,2,Integer):=[tv,tv] - - rank: % -> NNI - ++ rank(t) returns the tensorial rank of t (that is, the - ++ number of indices). This is the same as the graded module - ++ degree. - ++ - ++X CT:=CARTEN(1,2,Integer) - ++X t0:CT:=8 - ++X rank t0 - - elt: (%) -> R - ++ elt(t) gives the component of a rank 0 tensor. - ++ - ++X tv:CartesianTensor(1,2,Integer):=8 - ++X elt(tv) - ++X tv[] - - elt: (%, I) -> R - ++ elt(t,i) gives a component of a rank 1 tensor. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - ++X elt(tv,2) - ++X tv[2] - - elt: (%, I, I) -> R - ++ elt(t,i,j) gives a component of a rank 2 tensor. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - ++X tm:CartesianTensor(1,2,Integer):=[tv,tv] - ++X elt(tm,2,2) - ++X tm[2,2] - - elt: (%, I, I, I) -> R - ++ elt(t,i,j,k) gives a component of a rank 3 tensor. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - ++X tm:CartesianTensor(1,2,Integer):=[tv,tv] - ++X tn:CartesianTensor(1,2,Integer):=[tm,tm] - ++X elt(tn,2,2,2) - ++X tn[2,2,2] - - elt: (%, I, I, I, I) -> R - ++ elt(t,i,j,k,l) gives a component of a rank 4 tensor. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - ++X tm:CartesianTensor(1,2,Integer):=[tv,tv] - ++X tn:CartesianTensor(1,2,Integer):=[tm,tm] - ++X tp:CartesianTensor(1,2,Integer):=[tn,tn] - ++X elt(tp,2,2,2,2) - ++X tp[2,2,2,2] - - elt: (%, List I) -> R - ++ elt(t,[i1,...,iN]) gives a component of a rank \spad{N} tensor. - ++ - ++X v:=[2,3] - ++X tv:CartesianTensor(1,2,Integer):=v - ++X tm:CartesianTensor(1,2,Integer):=[tv,tv] - ++X tn:CartesianTensor(1,2,Integer):=[tm,tm] - ++X tp:CartesianTensor(1,2,Integer):=[tn,tn] - ++X tq:CartesianTensor(1,2,Integer):=[tp,tp] - ++X elt(tq,[2,2,2,2,2]) - - -- This specializes the documentation from GradedAlgebra. - product: (%,%) -> % - ++ product(s,t) is the outer product of the tensors s and t. - ++ For example, if \spad{r = product(s,t)} for rank 2 tensors - ++ s and t, then \spad{r} is a rank 4 tensor given by - ++ \spad{r(i,j,k,l) = s(i,j)*t(k,l)}. - ++ - ++X m:SquareMatrix(2,Integer):=matrix [[1,2],[4,5]] - ++X Tm:CartesianTensor(1,2,Integer):=m - ++X n:SquareMatrix(2,Integer):=matrix [[2,3],[0,1]] - ++X Tn:CartesianTensor(1,2,Integer):=n - ++X Tmn:=product(Tm,Tn) - - "*": (%, %) -> % - ++ s*t is the inner product of the tensors s and t which contracts - ++ the last index of s with the first index of t, i.e. - ++ \spad{t*s = contract(t,rank t, s, 1)} - ++ \spad{t*s = sum(k=1..N, t[i1,..,iN,k]*s[k,j1,..,jM])} - ++ This is compatible with the use of \spad{M*v} to denote - ++ the matrix-vector inner product. - ++ - ++X m:SquareMatrix(2,Integer):=matrix [[1,2],[4,5]] - ++X Tm:CartesianTensor(1,2,Integer):=m - ++X v:DirectProduct(2,Integer):=directProduct [3,4] - ++X Tv:CartesianTensor(1,2,Integer):=v - ++X Tm*Tv - - contract: (%, Integer, %, Integer) -> % - ++ contract(t,i,s,j) is the inner product of tenors s and t - ++ which sums along the \spad{k1}-th index of - ++ t and the \spad{k2}-th index of s. - ++ For example, if \spad{r = contract(s,2,t,1)} for rank 3 tensors - ++ rank 3 tensors \spad{s} and \spad{t}, then \spad{r} is - ++ the rank 4 \spad{(= 3 + 3 - 2)} tensor given by - ++ \spad{r(i,j,k,l) = sum(h=1..dim,s(i,h,j)*t(h,k,l))}. - ++ - ++X m:SquareMatrix(2,Integer):=matrix [[1,2],[4,5]] - ++X Tm:CartesianTensor(1,2,Integer):=m - ++X v:DirectProduct(2,Integer):=directProduct [3,4] - ++X Tv:CartesianTensor(1,2,Integer):=v - ++X Tmv:=contract(Tm,2,Tv,1) - - contract: (%, Integer, Integer) -> % - ++ contract(t,i,j) is the contraction of tensor t which - ++ sums along the \spad{i}-th and \spad{j}-th indices. - ++ For example, if - ++ \spad{r = contract(t,1,3)} for a rank 4 tensor t, then - ++ \spad{r} is the rank 2 \spad{(= 4 - 2)} tensor given by - ++ \spad{r(i,j) = sum(h=1..dim,t(h,i,h,j))}. - ++ - ++X m:SquareMatrix(2,Integer):=matrix [[1,2],[4,5]] - ++X Tm:CartesianTensor(1,2,Integer):=m - ++X v:DirectProduct(2,Integer):=directProduct [3,4] - ++X Tv:CartesianTensor(1,2,Integer):=v - ++X Tmv:=contract(Tm,2,1) - - transpose: % -> % - ++ transpose(t) exchanges the first and last indices of t. - ++ For example, if \spad{r = transpose(t)} for a rank 4 - ++ tensor t, then \spad{r} is the rank 4 tensor given by - ++ \spad{r(i,j,k,l) = t(l,j,k,i)}. - ++ - ++X m:SquareMatrix(2,Integer):=matrix [[1,2],[4,5]] - ++X Tm:CartesianTensor(1,2,Integer):=m - ++X transpose(Tm) - - transpose: (%, Integer, Integer) -> % - ++ transpose(t,i,j) exchanges the \spad{i}-th and \spad{j}-th - ++ indices of t. For example, if \spad{r = transpose(t,2,3)} - ++ for a rank 4 tensor t, then \spad{r} is the rank 4 tensor - ++ given by - ++ \spad{r(i,j,k,l) = t(i,k,j,l)}. - ++ - ++X m:SquareMatrix(2,Integer):=matrix [[1,2],[4,5]] - ++X tm:CartesianTensor(1,2,Integer):=m - ++X tn:CartesianTensor(1,2,Integer):=[tm,tm] - ++X transpose(tn,1,2) - - reindex: (%, List Integer) -> % - ++ reindex(t,[i1,...,idim]) permutes the indices of t. - ++ For example, if \spad{r = reindex(t, [4,1,2,3])} - ++ for a rank 4 tensor t, - ++ then \spad{r} is the rank for tensor given by - ++ \spad{r(i,j,k,l) = t(l,i,j,k)}. - ++ - ++X n:SquareMatrix(2,Integer):=matrix [[2,3],[0,1]] - ++X tn:CartesianTensor(1,2,Integer):=n - ++X p:=product(tn,tn) - ++X reindex(p,[4,3,2,1]) - - kroneckerDelta: () -> % - ++ kroneckerDelta() is the rank 2 tensor defined by - ++ \spad{kroneckerDelta()(i,j)} - ++ \spad{= 1 if i = j} - ++ \spad{= 0 if i \^= j} - ++ - ++X delta:CartesianTensor(1,2,Integer):=kroneckerDelta() - - leviCivitaSymbol: () -> % - ++ leviCivitaSymbol() is the rank \spad{dim} tensor defined by - ++ \spad{leviCivitaSymbol()(i1,...idim) = +1/0/-1} - ++ if \spad{i1,...,idim} is an even/is nota /is an odd permutation - ++ of \spad{minix,...,minix+dim-1}. - ++ - ++X lcs:CartesianTensor(1,2,Integer):=leviCivitaSymbol() - - ravel: % -> List R - ++ ravel(t) produces a list of components from a tensor such that - ++ \spad{unravel(ravel(t)) = t}. - ++ - ++X n:SquareMatrix(2,Integer):=matrix [[2,3],[0,1]] - ++X tn:CartesianTensor(1,2,Integer):=n - ++X ravel tn - - unravel: List R -> % - ++ unravel(t) produces a tensor from a list of - ++ components such that - ++ \spad{unravel(ravel(t)) = t}. - - sample: () -> % - ++ sample() returns an object of type %. - - Implementation ==> add - - PERM ==> Vector Integer -- 1-based entries from 1..n - INDEX ==> Vector Integer -- 1-based entries from minix..minix+dim-1 - - - get ==> elt$Rep - set_! ==> setelt$Rep - - -- Use row-major order: - -- x[h,i,j] <-> x[(h-minix)*dim**2+(i-minix)*dim+(j-minix)] - - Rep := IndexedVector(R,0) - - n: Integer - r,s: R - x,y,z: % - - ---- Local stuff - dim2: NNI := dim**2 - dim3: NNI := dim**3 - dim4: NNI := dim**4 - - sample()==kroneckerDelta()$% - int2index(n: Integer, indv: INDEX): INDEX == - n < 0 => error "Index error (too small)" - rnk := #indv - for i in 1..rnk repeat - qr := divide(n, dim) - n := qr.quotient - indv.((rnk-i+1) pretend NNI) := qr.remainder + minix - n ^= 0 => error "Index error (too big)" - indv - - index2int(indv: INDEX): Integer == - n: I := 0 - for i in 1..#indv repeat - ix := indv.i - minix - ix<0 or ix>dim-1 => error "Index error (out of range)" - n := dim*n + ix - n - - lengthRankOrElse(v: Integer): NNI == - v = 1 => 0 - v = dim => 1 - v = dim2 => 2 - v = dim3 => 3 - v = dim4 => 4 - rx := 0 - while v ^= 0 repeat - qr := divide(v, dim) - v := qr.quotient - if v ^= 0 then - qr.remainder ^= 0 => error "Rank is not a whole number" - rx := rx + 1 - rx - - -- l must be a list of the numbers 1..#l - mkPerm(n: NNI, l: List Integer): PERM == - #l ^= n => - error "The list is not a permutation." - p: PERM := new(n, 0) - seen: Vector Boolean := new(n, false) - for i in 1..n for e in l repeat - e < 1 or e > n => error "The list is not a permutation." - p.i := e - seen.e := true - for e in 1..n repeat - not seen.e => error "The list is not a permutation." - p - - -- permute s according to p into result t. - permute_!(t: INDEX, s: INDEX, p: PERM): INDEX == - for i in 1..#p repeat t.i := s.(p.i) - t - - -- permsign!(v) = 1, 0, or -1 according as - -- v is an even, is not, or is an odd permutation of minix..minix+#v-1. - permsign_!(v: INDEX): Integer == - -- sum minix..minix+#v-1. - maxix := minix+#v-1 - psum := (((maxix+1)*maxix - minix*(minix-1)) exquo 2)::Integer - -- +/v ^= psum => 0 - n := 0 - for i in 1..#v repeat n := n + v.i - n ^= psum => 0 - -- Bubble sort! This is pretty grotesque. - totTrans: Integer := 0 - nTrans: Integer := 1 - while nTrans ^= 0 repeat - nTrans := 0 - for i in 1..#v-1 for j in 2..#v repeat - if v.i > v.j then - nTrans := nTrans + 1 - e := v.i; v.i := v.j; v.j := e - totTrans := totTrans + nTrans - for i in 1..dim repeat - if v.i ^= minix+i-1 then return 0 - odd? totTrans => -1 - 1 - - - ---- Exported functions - ravel x == - [get(x,i) for i in 0..#x-1] - - unravel l == - -- lengthRankOrElse #l gives sytnax error - nz: NNI := # l - lengthRankOrElse nz - z := new(nz, 0) - for i in 0..nz-1 for r in l repeat set_!(z, i, r) - z - - kroneckerDelta() == - z := new(dim2, 0) - for i in 1..dim for zi in 0.. by (dim+1) repeat set_!(z, zi, 1) - z - leviCivitaSymbol() == - nz := dim**dim - z := new(nz, 0) - indv: INDEX := new(dim, 0) - for i in 0..nz-1 repeat - set_!(z, i, permsign_!(int2index(i, indv))::R) - z - - -- from GradedModule - degree x == - rank x - - rank x == - n := #x - lengthRankOrElse n - - elt(x) == - #x ^= 1 => error "Index error (the rank is not 0)" - get(x,0) - elt(x, i: I) == - #x ^= dim => error "Index error (the rank is not 1)" - get(x,(i-minix)) - elt(x, i: I, j: I) == - #x ^= dim2 => error "Index error (the rank is not 2)" - get(x,(dim*(i-minix) + (j-minix))) - elt(x, i: I, j: I, k: I) == - #x ^= dim3 => error "Index error (the rank is not 3)" - get(x,(dim2*(i-minix) + dim*(j-minix) + (k-minix))) - elt(x, i: I, j: I, k: I, l: I) == - #x ^= dim4 => error "Index error (the rank is not 4)" - get(x,(dim3*(i-minix) + dim2*(j-minix) + dim*(k-minix) + (l-minix))) - - elt(x, i: List I) == - #i ^= rank x => error "Index error (wrong rank)" - n: I := 0 - for ii in i repeat - ix := ii - minix - ix<0 or ix>dim-1 => error "Index error (out of range)" - n := dim*n + ix - get(x,n) - - coerce(lr: List R): % == - #lr ^= dim => error "Incorrect number of components" - z := new(dim, 0) - for r in lr for i in 0..dim-1 repeat set_!(z, i, r) - z - coerce(lx: List %): % == - #lx ^= dim => error "Incorrect number of slices" - rx := rank first lx - for x in lx repeat - rank x ^= rx => error "Inhomogeneous slice ranks" - nx := # first lx - z := new(dim * nx, 0) - for x in lx for offz in 0.. by nx repeat - for i in 0..nx-1 repeat set_!(z, offz + i, get(x,i)) - z - - retractIfCan(x:%):Union(R,"failed") == - zero? rank(x) => x() - "failed" - Outf ==> OutputForm - - mkOutf(x:%, i0:I, rnk:NNI): Outf == - odd? rnk => - rnk1 := (rnk-1) pretend NNI - nskip := dim**rnk1 - [mkOutf(x, i0+nskip*i, rnk1) for i in 0..dim-1]::Outf - rnk = 0 => - get(x,i0)::Outf - rnk1 := (rnk-2) pretend NNI - nskip := dim**rnk1 - matrix [[mkOutf(x, i0+nskip*(dim*i + j), rnk1) - for j in 0..dim-1] for i in 0..dim-1] - coerce(x): Outf == - mkOutf(x, 0, rank x) - - 0 == 0$R::Rep - 1 == 1$R::Rep - - --coerce(n: I): % == new(1, n::R) - coerce(r: R): % == new(1,r) - - coerce(v: DP(dim,R)): % == - z := new(dim, 0) - for i in 0..dim-1 for j in minIndex v .. maxIndex v repeat - set_!(z, i, v.j) - z - coerce(m: SM(dim,R)): % == - z := new(dim**2, 0) - offz := 0 - for i in 0..dim-1 repeat - for j in 0..dim-1 repeat - set_!(z, offz + j, m(i+1,j+1)) - offz := offz + dim - z - - x = y == - #x ^= #y => false - for i in 0..#x-1 repeat - if get(x,i) ^= get(y,i) then return false - true - x + y == - #x ^= #y => error "Rank mismatch" - -- z := [xi + yi for xi in x for yi in y] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, get(x,i) + get(y,i)) - z - x - y == - #x ^= #y => error "Rank mismatch" - -- [xi - yi for xi in x for yi in y] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, get(x,i) - get(y,i)) - z - - x == - -- [-xi for xi in x] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, -get(x,i)) - z - n * x == - -- [n * xi for xi in x] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, n * get(x,i)) - z - x * n == - -- [n * xi for xi in x] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, n* get(x,i)) -- Commutative!! - z - r * x == - -- [r * xi for xi in x] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, r * get(x,i)) - z - x * r == - -- [xi*r for xi in x] - z := new(#x, 0) - for i in 0..#x-1 repeat set_!(z, i, r* get(x,i)) -- Commutative!! - z - product(x, y) == - nx := #x; ny := #y - z := new(nx * ny, 0) - for i in 0..nx-1 for ioff in 0.. by ny repeat - for j in 0..ny-1 repeat - set_!(z, ioff + j, get(x,i) * get(y,j)) - z - x * y == - rx := rank x - ry := rank y - rx = 0 => get(x,0) * y - ry = 0 => x * get(y,0) - contract(x, rx, y, 1) - - contract(x, i, j) == - rx := rank x - i < 1 or i > rx or j < 1 or j > rx or i = j => - error "Improper index for contraction" - if i > j then (i,j) := (j,i) - - rl:= (rx- j) pretend NNI; nl:= dim**rl; zol:= 1; xol:= zol - rm:= (j-i-1) pretend NNI; nm:= dim**rm; zom:= nl; xom:= zom*dim - rh:= (i - 1) pretend NNI; nh:= dim**rh; zoh:= nl*nm - xoh:= zoh*dim**2 - xok := nl*(1 + nm*dim) - z := new(nl*nm*nh, 0) - for h in 1..nh _ - for xh in 0.. by xoh for zh in 0.. by zoh repeat - for m in 1..nm _ - for xm in xh.. by xom for zm in zh.. by zom repeat - for l in 1..nl _ - for xl in xm.. by xol for zl in zm.. by zol repeat - set_!(z, zl, 0) - for k in 1..dim for xk in xl.. by xok repeat - set_!(z, zl, get(z,zl) + get(x,xk)) - z - - contract(x, i, y, j) == - rx := rank x - ry := rank y - - i < 1 or i > rx or j < 1 or j > ry => - error "Improper index for contraction" - - rly:= (ry-j) pretend NNI; nly:= dim**rly; oly:= 1; zoly:= 1 - rhy:= (j -1) pretend NNI; nhy:= dim**rhy - ohy:= nly*dim; zohy:= zoly*nly - rlx:= (rx-i) pretend NNI; nlx:= dim**rlx - olx:= 1; zolx:= zohy*nhy - rhx:= (i -1) pretend NNI; nhx:= dim**rhx - ohx:= nlx*dim; zohx:= zolx*nlx - - z := new(nlx*nhx*nly*nhy, 0) - - for dxh in 1..nhx _ - for xh in 0.. by ohx for zhx in 0.. by zohx repeat - for dxl in 1..nlx _ - for xl in xh.. by olx for zlx in zhx.. by zolx repeat - for dyh in 1..nhy _ - for yh in 0.. by ohy for zhy in zlx.. by zohy repeat - for dyl in 1..nly _ - for yl in yh.. by oly for zly in zhy.. by zoly repeat - set_!(z, zly, 0) - for k in 1..dim _ - for xk in xl.. by nlx for yk in yl.. by nly repeat - set_!(z, zly, get(z,zly)+get(x,xk)*get(y,yk)) - z - - transpose x == - transpose(x, 1, rank x) - transpose(x, i, j) == - rx := rank x - i < 1 or i > rx or j < 1 or j > rx or i = j => - error "Improper indicies for transposition" - if i > j then (i,j) := (j,i) - - rl:= (rx- j) pretend NNI; nl:= dim**rl; zol:= 1; zoi := zol*nl - rm:= (j-i-1) pretend NNI; nm:= dim**rm; zom:= nl*dim; zoj := zom*nm - rh:= (i - 1) pretend NNI; nh:= dim**rh; zoh:= nl*nm*dim**2 - z := new(#x, 0) - for h in 1..nh for zh in 0.. by zoh repeat _ - for m in 1..nm for zm in zh.. by zom repeat _ - for l in 1..nl for zl in zm.. by zol repeat _ - for p in 1..dim _ - for zp in zl.. by zoi for xp in zl.. by zoj repeat - for q in 1..dim _ - for zq in zp.. by zoj for xq in xp.. by zoi repeat - set_!(z, zq, get(x,xq)) - z - - reindex(x, l) == - nx := #x - z: % := new(nx, 0) - - rx := rank x - p := mkPerm(rx, l) - xiv: INDEX := new(rx, 0) - ziv: INDEX := new(rx, 0) - - -- Use permutation - for i in 0..#x-1 repeat - pi := index2int(permute_!(ziv, int2index(i,xiv),p)) - set_!(z, pi, get(x,i)) - z - -@ -\section{package CARTEN2 CartesianTensorFunctions2} -<>= -"CARTEN2" -> "PACKAGE" -"CartesianTensorFunctions2(a:INT,b:NNI,c:COMRING,d:DOMRING)" -> "Package" -@ -<>= -)abbrev package CARTEN2 CartesianTensorFunctions2 -++ Author: Stephen M. Watt -++ Date Created: December 1986 -++ Date Last Updated: May 30, 1991 -++ Basic Operations: reshape, map -++ Related Domains: CartesianTensor -++ Also See: -++ AMS Classifications: -++ Keywords: tensor -++ Examples: -++ References: -++ Description: -++ This package provides functions to enable conversion of tensors -++ given conversion of the components. - -CartesianTensorFunctions2(minix, dim, S, T): CTPcat == CTPdef where - minix: Integer - dim: NonNegativeInteger - S, T: CommutativeRing - CS ==> CartesianTensor(minix, dim, S) - CT ==> CartesianTensor(minix, dim, T) - - CTPcat == with - reshape: (List T, CS) -> CT - ++ reshape(lt,ts) organizes the list of components lt into - ++ a tensor with the same shape as ts. - map: (S->T, CS) -> CT - ++ map(f,ts) does a componentwise conversion of the tensor ts - ++ to a tensor with components of type T. - CTPdef == add - reshape(l, s) == unravel l - map(f, s) == unravel [f e for e in ravel 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/cden.spad.pamphlet b/src/algebra/cden.spad.pamphlet deleted file mode 100644 index 55d3e92..0000000 --- a/src/algebra/cden.spad.pamphlet +++ /dev/null @@ -1,238 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra cden.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package ICDEN InnerCommonDenominator} -<>= -)abbrev package ICDEN InnerCommonDenominator ---% InnerCommonDenominator -++ Author: Manuel Bronstein -++ Date Created: 2 May 1988 -++ Date Last Updated: 22 Nov 1989 -++ Description: InnerCommonDenominator provides functions to compute -++ the common denominator of a finite linear aggregate of elements -++ of the quotient field of an integral domain. -++ Keywords: gcd, quotient, common, denominator. -InnerCommonDenominator(R, Q, A, B): Exports == Implementation where - R: IntegralDomain - Q: QuotientFieldCategory R - A: FiniteLinearAggregate R - B: FiniteLinearAggregate Q - - Exports ==> with - commonDenominator: B -> R - ++ commonDenominator([q1,...,qn]) returns a common denominator - ++ d for q1,...,qn. - clearDenominator : B -> A - ++ clearDenominator([q1,...,qn]) returns \spad{[p1,...,pn]} such that - ++ \spad{qi = pi/d} where d is a common denominator for the qi's. - splitDenominator : B -> Record(num: A, den: R) - ++ splitDenominator([q1,...,qn]) returns - ++ \spad{[[p1,...,pn], d]} such that - ++ \spad{qi = pi/d} and d is a common denominator for the qi's. - - Implementation ==> add - import FiniteLinearAggregateFunctions2(Q, B, R, A) - - clearDenominator l == - d := commonDenominator l - map(numer(d * #1), l) - - splitDenominator l == - d := commonDenominator l - [map(numer(d * #1), l), d] - - if R has GcdDomain then - commonDenominator l == reduce(lcm, map(denom, l),1) - else - commonDenominator l == reduce("*", map(denom, l), 1) - -@ -\section{package CDEN CommonDenominator} -<>= -)abbrev package CDEN CommonDenominator ---% CommonDenominator -++ Author: Manuel Bronstein -++ Date Created: 2 May 1988 -++ Date Last Updated: 22 Nov 1989 -++ Description: CommonDenominator provides functions to compute the -++ common denominator of a finite linear aggregate of elements of -++ the quotient field of an integral domain. -++ Keywords: gcd, quotient, common, denominator. -CommonDenominator(R, Q, A): Exports == Implementation where - R: IntegralDomain - Q: QuotientFieldCategory R - A: FiniteLinearAggregate Q - - Exports ==> with - commonDenominator: A -> R - ++ commonDenominator([q1,...,qn]) returns a common denominator - ++ d for q1,...,qn. - clearDenominator : A -> A - ++ clearDenominator([q1,...,qn]) returns \spad{[p1,...,pn]} such that - ++ \spad{qi = pi/d} where d is a common denominator for the qi's. - splitDenominator : A -> Record(num: A, den: R) - ++ splitDenominator([q1,...,qn]) returns - ++ \spad{[[p1,...,pn], d]} such that - ++ \spad{qi = pi/d} and d is a common denominator for the qi's. - - Implementation ==> add - clearDenominator l == - d := commonDenominator l - map(numer(d * #1)::Q, l) - - splitDenominator l == - d := commonDenominator l - [map(numer(d * #1)::Q, l), d] - - if R has GcdDomain then - qlcm: (Q, Q) -> Q - - qlcm(a, b) == lcm(numer a, numer b)::Q - commonDenominator l == numer reduce(qlcm, map(denom(#1)::Q, l), 1) - else - commonDenominator l == numer reduce("*", map(denom(#1)::Q, l), 1) - -@ -\section{package UPCDEN UnivariatePolynomialCommonDenominator} -<>= -)abbrev package UPCDEN UnivariatePolynomialCommonDenominator ---% UnivariatePolynomialCommonDenominator -++ Author: Manuel Bronstein -++ Date Created: 2 May 1988 -++ Date Last Updated: 22 Feb 1990 -++ Description: UnivariatePolynomialCommonDenominator provides -++ functions to compute the common denominator of the coefficients of -++ univariate polynomials over the quotient field of a gcd domain. -++ Keywords: gcd, quotient, common, denominator, polynomial. - -UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where - R : IntegralDomain - Q : QuotientFieldCategory R - UP: UnivariatePolynomialCategory Q - - Exports ==> with - commonDenominator: UP -> R - ++ commonDenominator(q) returns a common denominator d for - ++ the coefficients of q. - clearDenominator : UP -> UP - ++ clearDenominator(q) returns p such that \spad{q = p/d} where d is - ++ a common denominator for the coefficients of q. - splitDenominator : UP -> Record(num: UP, den: R) - ++ splitDenominator(q) returns \spad{[p, d]} such that \spad{q = p/d} and d - ++ is a common denominator for the coefficients of q. - - Impl ==> add - import CommonDenominator(R, Q, List Q) - - commonDenominator p == commonDenominator coefficients p - - clearDenominator p == - d := commonDenominator p - map(numer(d * #1)::Q, p) - - splitDenominator p == - d := commonDenominator p - [map(numer(d * #1)::Q, p), d] - -@ -\section{package MCDEN MatrixCommonDenominator} -<>= -)abbrev package MCDEN MatrixCommonDenominator ---% MatrixCommonDenominator -++ Author: Manuel Bronstein -++ Date Created: 2 May 1988 -++ Date Last Updated: 20 Jul 1990 -++ Description: MatrixCommonDenominator provides functions to -++ compute the common denominator of a matrix of elements of the -++ quotient field of an integral domain. -++ Keywords: gcd, quotient, matrix, common, denominator. -MatrixCommonDenominator(R, Q): Exports == Implementation where - R: IntegralDomain - Q: QuotientFieldCategory R - - VR ==> Vector R - VQ ==> Vector Q - - Exports ==> with - commonDenominator: Matrix Q -> R - ++ commonDenominator(q) returns a common denominator d for - ++ the elements of q. - clearDenominator : Matrix Q -> Matrix R - ++ clearDenominator(q) returns p such that \spad{q = p/d} where d is - ++ a common denominator for the elements of q. - splitDenominator : Matrix Q -> Record(num: Matrix R, den: R) - ++ splitDenominator(q) returns \spad{[p, d]} such that \spad{q = p/d} and d - ++ is a common denominator for the elements of q. - - Implementation ==> add - import ListFunctions2(Q, R) - import MatrixCategoryFunctions2(Q,VQ,VQ,Matrix Q,R,VR,VR,Matrix R) - - clearDenominator m == - d := commonDenominator m - map(numer(d * #1), m) - - splitDenominator m == - d := commonDenominator m - [map(numer(d * #1), m), d] - - if R has GcdDomain then - commonDenominator m == lcm map(denom, parts m) - else - commonDenominator m == reduce("*",map(denom, parts m),1)$List(R) - -@ -\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/clip.spad.pamphlet b/src/algebra/clip.spad.pamphlet deleted file mode 100644 index 04f9f42..0000000 --- a/src/algebra/clip.spad.pamphlet +++ /dev/null @@ -1,341 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra clip.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package CLIP TwoDimensionalPlotClipping} -<>= -)abbrev package CLIP TwoDimensionalPlotClipping -++ Automatic clipping for 2-dimensional plots -++ Author: Clifton J. Williamson -++ Date Created: 22 December 1989 -++ Date Last Updated: 10 July 1990 -++ Keywords: plot, singularity -++ Examples: -++ References: - -TwoDimensionalPlotClipping(): Exports == Implementation where - ++ The purpose of this package is to provide reasonable plots of - ++ functions with singularities. - B ==> Boolean - L ==> List - SEG ==> Segment - RN ==> Fraction Integer - SF ==> DoubleFloat - Pt ==> Point DoubleFloat - PLOT ==> Plot - CLIPPED ==> Record(brans: L L Pt,xValues: SEG SF,yValues: SEG SF) - - Exports ==> with - clip: PLOT -> CLIPPED - ++ clip(p) performs two-dimensional clipping on a plot, p, from - ++ the domain \spadtype{Plot} for the graph of one variable, - ++ \spad{y = f(x)}; the default parameters \spad{1/4} for the fraction - ++ and \spad{5/1} for the scale are used in the \spadfun{clip} function. - clip: (PLOT,RN,RN) -> CLIPPED - ++ clip(p,frac,sc) performs two-dimensional clipping on a plot, p, - ++ from the domain \spadtype{Plot} for the graph of one variable - ++ \spad{y = f(x)}; the fraction parameter is specified by \spad{frac} - ++ and the scale parameter is specified by \spad{sc} for use in the - ++ \spadfun{clip} function. - clipParametric: PLOT -> CLIPPED - ++ clipParametric(p) performs two-dimensional clipping on a plot, - ++ p, from the domain \spadtype{Plot} for the parametric curve - ++ \spad{x = f(t)}, \spad{y = g(t)}; the default parameters \spad{1/2} - ++ for the fraction and \spad{5/1} for the scale are used in the - ++ \fakeAxiomFun{iClipParametric} subroutine, which is called by this - ++ function. - clipParametric: (PLOT,RN,RN) -> CLIPPED - ++ clipParametric(p,frac,sc) performs two-dimensional clipping on a - ++ plot, p, from the domain \spadtype{Plot} for the parametric curve - ++ \spad{x = f(t)}, \spad{y = g(t)}; the fraction parameter is - ++ specified by \spad{frac} and the scale parameter is specified - ++ by \spad{sc} for use in the \fakeAxiomFun{iClipParametric} subroutine, - ++ which is called by this function. - clipWithRanges: (L L Pt,SF,SF,SF,SF) -> CLIPPED - ++ clipWithRanges(pointLists,xMin,xMax,yMin,yMax) performs clipping - ++ on a list of lists of points, \spad{pointLists}. Clipping is - ++ done within the specified ranges of \spad{xMin}, \spad{xMax} and - ++ \spad{yMin}, \spad{yMax}. This function is used internally by - ++ the \fakeAxiomFun{iClipParametric} subroutine in this package. - clip: L Pt -> CLIPPED - ++ clip(l) performs two-dimensional clipping on a curve l, which is - ++ a list of points; the default parameters \spad{1/2} for the - ++ fraction and \spad{5/1} for the scale are used in the - ++ \fakeAxiomFun{iClipParametric} subroutine, which is called by this - ++ function. - clip: L L Pt -> CLIPPED - ++ clip(ll) performs two-dimensional clipping on a list of lists - ++ of points, \spad{ll}; the default parameters \spad{1/2} for - ++ the fraction and \spad{5/1} for the scale are used in the - ++ \fakeAxiomFun{iClipParametric} subroutine, which is called by this - ++ function. - - Implementation ==> add - import PointPackage(DoubleFloat) - import ListFunctions2(Point DoubleFloat,DoubleFloat) - - point:(SF,SF) -> Pt - intersectWithHorizLine:(SF,SF,SF,SF,SF) -> Pt - intersectWithVertLine:(SF,SF,SF,SF,SF) -> Pt - intersectWithBdry:(SF,SF,SF,SF,Pt,Pt) -> Pt - discardAndSplit: (L Pt,Pt -> B,SF,SF,SF,SF) -> L L Pt - norm: Pt -> SF - iClipParametric: (L L Pt,RN,RN) -> CLIPPED - findPt: L L Pt -> Union(Pt,"failed") - Fnan?: SF ->Boolean - Pnan?:Pt ->Boolean - - Fnan? x == x~=x - Pnan? p == any?(Fnan?,p) - - iClipParametric(pointLists,fraction,scale) == - -- error checks and special cases - (fraction < 0) or (fraction > 1) => - error "clipDraw: fraction should be between 0 and 1" - empty? pointLists => [nil(),segment(0,0),segment(0,0)] - -- put all points together , sort them according to norm - sortedList := sort(norm(#1) < norm(#2),select(not Pnan? #1,concat pointLists)) - empty? sortedList => [nil(),segment(0,0),segment(0,0)] - n := # sortedList - num := numer fraction - den := denom fraction - clipNum := (n * num) quo den - lastN := n - 1 - clipNum - firstPt := first sortedList - xMin : SF := xCoord firstPt - xMax : SF := xCoord firstPt - yMin : SF := yCoord firstPt - yMax : SF := yCoord firstPt - -- calculate min/max for the first (1-fraction)*N points - -- this contracts the range - -- this unnecessarily clips monotonic functions (step-function, x^(high power),etc.) - for k in 0..lastN for pt in rest sortedList repeat - xMin := min(xMin,xCoord pt) - xMax := max(xMax,xCoord pt) - yMin := min(yMin,yCoord pt) - yMax := max(yMax,yCoord pt) - xDiff := xMax - xMin; yDiff := yMax - yMin - xDiff = 0 => - yDiff = 0 => - [pointLists,segment(xMin-1,xMax+1),segment(yMin-1,yMax+1)] - [pointLists,segment(xMin-1,xMax+1),segment(yMin,yMax)] - yDiff = 0 => - [pointLists,segment(xMin,xMax),segment(yMin-1,yMax+1)] - numm := numer scale; denn := denom scale - -- now expand the range by scale - xMin := xMin - (numm :: SF) * xDiff / (denn :: SF) - xMax := xMax + (numm :: SF) * xDiff / (denn :: SF) - yMin := yMin - (numm :: SF) * yDiff / (denn :: SF) - yMax := yMax + (numm :: SF) * yDiff / (denn :: SF) - -- clip with the calculated range - newclip:=clipWithRanges(pointLists,xMin,xMax,yMin,yMax) - -- if we split the lists use the new clip - # (newclip.brans) > # pointLists => newclip - -- calculate extents - xs :L SF:= map (xCoord,sortedList) - ys :L SF:= map (yCoord,sortedList) - xMin :SF :=reduce (min,xs) - yMin :SF :=reduce (min,ys) - xMax :SF :=reduce (max,xs) - yMax :SF :=reduce (max,ys) - xseg:SEG SF :=xMin..xMax - yseg:SEG SF :=yMin..yMax - -- return original - [pointLists,xseg,yseg]@CLIPPED - - - - - point(xx,yy) == point(l : L SF := [xx,yy]) - - intersectWithHorizLine(x1,y1,x2,y2,yy) == - x1 = x2 => point(x1,yy) - point(x1 + (x2 - x1)*(yy - y1)/(y2 - y1),yy) - - intersectWithVertLine(x1,y1,x2,y2,xx) == - y1 = y2 => point(xx,y1) - point(xx,y1 + (y2 - y1)*(xx - x1)/(x2 - x1)) - - intersectWithBdry(xMin,xMax,yMin,yMax,pt1,pt2) == - -- pt1 is in rectangle, pt2 is not - x1 := xCoord pt1; y1 := yCoord pt1 - x2 := xCoord pt2; y2 := yCoord pt2 - if y2 > yMax then - pt2 := intersectWithHorizLine(x1,y1,x2,y2,yMax) - x2 := xCoord pt2; y2 := yCoord pt2 - if y2 < yMin then - pt2 := intersectWithHorizLine(x1,y1,x2,y2,yMin) - x2 := xCoord pt2; y2 := yCoord pt2 - if x2 > xMax then - pt2 := intersectWithVertLine(x1,y1,x2,y2,xMax) - x2 := xCoord pt2; y2 := yCoord pt2 - if x2 < xMin then - pt2 := intersectWithVertLine(x1,y1,x2,y2,xMin) - pt2 - - discardAndSplit(pointList,pred,xMin,xMax,yMin,yMax) == - ans : L L Pt := nil() - list : L Pt := nil() - lastPt? : B := false - lastPt : Pt := point(0,0) - while not empty? pointList repeat - pt := first pointList - pointList := rest pointList - pred(pt) => - if (empty? list) and lastPt? then - bdryPt := intersectWithBdry(xMin,xMax,yMin,yMax,pt,lastPt) - -- print bracket [ coerce bdryPt ,coerce pt ] - --list := cons(bdryPt,list) - list := cons(pt,list) - if not empty? list then - bdryPt := intersectWithBdry(xMin,xMax,yMin,yMax,first list,pt) - -- print bracket [ coerce bdryPt,coerce first list] - --list := cons(bdryPt,list) - ans := cons( list,ans) - lastPt := pt - lastPt? := true - list := nil() - empty? list => ans - reverse_! cons(reverse_! list,ans) - - clip(plot,fraction,scale) == --- sayBrightly([" clip: "::OutputForm]$List(OutputForm))$Lisp - (fraction < 0) or (fraction > 1/2) => - error "clipDraw: fraction should be between 0 and 1/2" - xVals := xRange plot - empty?(pointLists := listBranches plot) => - [nil(),xVals,segment(0,0)] - more?(pointLists := listBranches plot,1) => - error "clipDraw: plot has more than one branch" - empty?(pointList := first pointLists) => - [nil(),xVals,segment(0,0)] - sortedList := sort(yCoord(#1) < yCoord(#2),pointList) - n := # sortedList; num := numer fraction; den := denom fraction - clipNum := (n * num) quo den - -- throw out points with large and small y-coordinates - yMin := yCoord(sortedList.clipNum) - yMax := yCoord(sortedList.(n - 1 - clipNum)) - if Fnan? yMin then yMin : SF := 0 - if Fnan? yMax then yMax : SF := 0 - (yDiff := yMax - yMin) = 0 => - [pointLists,xRange plot,segment(yMin - 1,yMax + 1)] - numm := numer scale; denn := denom scale - xMin := lo xVals; xMax := hi xVals - yMin := yMin - (numm :: SF) * yDiff / (denn :: SF) - yMax := yMax + (numm :: SF) * yDiff / (denn :: SF) - lists := discardAndSplit(pointList,_ - (yCoord(#1) < yMax) and (yCoord(#1) > yMin),xMin,xMax,yMin,yMax) - yMin := yCoord(sortedList.clipNum) - yMax := yCoord(sortedList.(n - 1 - clipNum)) - if Fnan? yMin then yMin : SF := 0 - if Fnan? yMax then yMax : SF := 0 - for list in lists repeat - for pt in list repeat - if not Fnan?(yCoord pt) then - yMin := min(yMin,yCoord pt) - yMax := max(yMax,yCoord pt) - [lists,xVals,segment(yMin,yMax)] - - clip(plot:PLOT) == clip(plot,1/4,5/1) - - norm(pt) == - x := xCoord(pt); y := yCoord(pt) - if Fnan? x then - if Fnan? y then - r:SF := 0 - else - r:SF := y**2 - else - if Fnan? y then - r:SF := x**2 - else - r:SF := x**2 + y**2 - r - - findPt lists == - for list in lists repeat - not empty? list => - for p in list repeat - not Pnan? p => return p - "failed" - - clipWithRanges(pointLists,xMin,xMax,yMin,yMax) == - lists : L L Pt := nil() - for pointList in pointLists repeat - lists := concat(lists,discardAndSplit(pointList,_ - (xCoord(#1) <= xMax) and (xCoord(#1) >= xMin) and _ - (yCoord(#1) <= yMax) and (yCoord(#1) >= yMin), _ - xMin,xMax,yMin,yMax)) - (pt := findPt lists) case "failed" => - [nil(),segment(0,0),segment(0,0)] - firstPt := pt :: Pt - xMin : SF := xCoord firstPt; xMax : SF := xCoord firstPt - yMin : SF := yCoord firstPt; yMax : SF := yCoord firstPt - for list in lists repeat - for pt in list repeat - if not Pnan? pt then - xMin := min(xMin,xCoord pt) - xMax := max(xMax,xCoord pt) - yMin := min(yMin,yCoord pt) - yMax := max(yMax,yCoord pt) - [lists,segment(xMin,xMax),segment(yMin,yMax)] - - clipParametric(plot,fraction,scale) == - iClipParametric(listBranches plot,fraction,scale) - - clipParametric plot == clipParametric(plot,1/2,5/1) - - clip(l: L Pt) == iClipParametric(list l,1/2,5/1) - clip(l: L L Pt) == iClipParametric(l,1/2,5/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/cmplxrt.spad.pamphlet b/src/algebra/cmplxrt.spad.pamphlet deleted file mode 100644 index 5cd1072..0000000 --- a/src/algebra/cmplxrt.spad.pamphlet +++ /dev/null @@ -1,117 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra cmplxrt.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package CMPLXRT ComplexRootPackage} -<>= -)abbrev package CMPLXRT ComplexRootPackage -++ Author: P. Gianni -++ Date Created: -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: Complex, Float, Fraction, UnivariatePolynomial -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package provides functions complexZeros -++ for finding the complex zeros -++ of univariate polynomials with complex rational number coefficients. -++ The results are to any user specified precision and are returned -++ as either complex rational number or complex floating point numbers -++ depending on the type of the second argument which specifies the -++ precision. - --- Packages for the computation of complex roots of --- univariate polynomials with rational or gaussian coefficients. - --- Simplified version, the old original based on Gebauer's solver is --- in ocmplxrt spad -RN ==> Fraction Integer -I ==> Integer -NF ==> Float - -ComplexRootPackage(UP,Par) : T == C where - UP : UnivariatePolynomialCategory Complex Integer - Par : Join(Field, OrderedRing) -- will be Float or RN - CP ==> Complex Par - PCI ==> Polynomial Complex Integer - - T == with - complexZeros:(UP,Par) -> List CP - ++ complexZeros(poly, eps) finds the complex zeros of the - ++ univariate polynomial poly to precision eps with - ++ solutions returned as complex floats or rationals - ++ depending on the type of eps. - - C == add - complexZeros(p:UP,eps:Par):List CP == - x1:Symbol():=new() - x2:Symbol():=new() - vv:Symbol():=new() - lpf:=factors factor(p)$ComplexFactorization(I,UP) - ris:List CP:=empty() - for pf in lpf repeat - pp:=pf.factor pretend SparseUnivariatePolynomial Complex Integer - q:PCI :=multivariate(pp,vv) - q:=eval(q,vv,x1::PCI+complex(0,1)*(x2::PCI)) - p1:=map(real,q)$PolynomialFunctions2(Complex I,I) - p2:=map(imag,q)$PolynomialFunctions2(Complex I,I) - lz:=innerSolve([p1,p2],[],[x1,x2], - eps)$InnerNumericFloatSolvePackage(I,Par,Par) - ris:=append([complex(first z,second z) for z in lz],ris) - ris - -@ -\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/combfunc.spad.pamphlet b/src/algebra/combfunc.spad.pamphlet deleted file mode 100644 index da46ed0..0000000 --- a/src/algebra/combfunc.spad.pamphlet +++ /dev/null @@ -1,1144 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra combfunc.spad} -\author{Manuel Bronstein, Martin Rubey} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -<>= -"COMBF" -> "PACKAGE" -"CombinatorialFunction(a:Join(ORDSET,INTDOM),b:FS(a))" -> "Package" -@ -<>= -)abbrev package COMBF CombinatorialFunction -++ Provides the usual combinatorial functions -++ Author: Manuel Bronstein, Martin Rubey -++ Date Created: 2 Aug 1988 -++ Date Last Updated: 30 October 2005 -++ Description: -++ Provides combinatorial functions over an integral domain. -++ Keywords: combinatorial, function, factorial. -++ Examples: )r COMBF INPUT - -CombinatorialFunction(R, F): Exports == Implementation where - R: Join(OrderedSet, IntegralDomain) - F: FunctionSpace R - - OP ==> BasicOperator - K ==> Kernel F - SE ==> Symbol - O ==> OutputForm - SMP ==> SparseMultivariatePolynomial(R, K) - Z ==> Integer - - POWER ==> "%power"::Symbol - OPEXP ==> "exp"::Symbol - SPECIALDIFF ==> "%specialDiff" - SPECIALDISP ==> "%specialDisp" - SPECIALEQUAL ==> "%specialEqual" - - Exports ==> with - belong? : OP -> Boolean - ++ belong?(op) is true if op is a combinatorial operator; - operator : OP -> OP - ++ operator(op) returns a copy of op with the domain-dependent - ++ properties appropriate for F; - ++ error if op is not a combinatorial operator; - "**" : (F, F) -> F - ++ a ** b is the formal exponential a**b; - binomial : (F, F) -> F - ++ binomial(n, r) returns the number of subsets of r objects - ++ taken among n objects, i.e. n!/(r! * (n-r)!); -@ - -We currently simplify binomial coefficients only for non-negative integral -second argument, using the formula -$$ \binom{n}{k}=\frac{1}{k!}\prod_{i=0..k-1} (n-i),$$ -except if the second argument is symbolic: in this case [[binomial(n,n)]] is -simplified to one. - -Note that there are at least two different ways to define binomial coefficients -for negative integral second argument. One way, particular suitable for -combinatorics, is to set the binomial coefficient equal to zero for negative -second argument. This is, partially, also the approach taken in -[[combinat.spad]], where we find - -\begin{verbatim} - binomial(n, m) == - n < 0 or m < 0 or m > n => 0 - m = 0 => 1 -\end{verbatim} - -Of course, here [[n]] and [[m]] are integers. This definition agrees with the -recurrence - -$$\binom{n}{k}+\binom{n}{k+1}=\binom{n+1}{k+1}.$$ - -Alternatively, one can use the formula -$$ \binom{n}{k}=\frac{\Gamma(n+1)}{\Gamma(k+1)\Gamma(n-k+1)}, $$ -and leave the case where $k\in {\bf Z}$, $n\in {\bf Z}$ and $k \leq n < 0$ -undefined, since the limit does not exist in this case: - -Since we then have that $n-k+1\geq 1$, $\Gamma(n-k+1)$ is finite. So it is -sufficient to consider $\frac{\Gamma(n+1)}{\Gamma(k+1)}$. On the one hand, we -have -$$\lim_{n_0\to n} \lim_{k_0\to k}\frac{\Gamma(n_0+1)}{\Gamma(k_0+1)} = 0,$$ -since for any non-integral $n_0$, $\Gamma(n_0+1)$ is finite. On the other -hand, -$$\lim_{k_0\to k} \lim_{n_0\to n}\frac{\Gamma(n_0+1)}{\Gamma(k_0+1)}$$ -does not exist, since for non-integral $k_0$, $\Gamma(k_0+1)$ is finite while -$\Gamma(n_0+1)$ is unbounded. - -However, since for $k\in {\bf Z}$, $n\in {\bf Z}$ and $0 < k < n$ both -definitions agree, one could also combine them. This is what, for example, -Mathematica does. It seems that MuPAD sets [[binomial(n,n)=1]] for all -arguments [[n]], and returns [[binomial(-2, n)]] unevaluated. Provisos may help -here. - -<>= - permutation: (F, F) -> F - ++ permutation(n, r) returns the number of permutations of - ++ n objects taken r at a time, i.e. n!/(n-r)!; - factorial : F -> F - ++ factorial(n) returns the factorial of n, i.e. n!; - factorials : F -> F - ++ factorials(f) rewrites the permutations and binomials in f - ++ in terms of factorials; - factorials : (F, SE) -> F - ++ factorials(f, x) rewrites the permutations and binomials in f - ++ involving x in terms of factorials; - summation : (F, SE) -> F - ++ summation(f(n), n) returns the formal sum S(n) which verifies - ++ S(n+1) - S(n) = f(n); - summation : (F, SegmentBinding F) -> F - ++ summation(f(n), n = a..b) returns f(a) + ... + f(b) as a - ++ formal sum; - product : (F, SE) -> F - ++ product(f(n), n) returns the formal product P(n) which verifies - ++ P(n+1)/P(n) = f(n); - product : (F, SegmentBinding F) -> F - ++ product(f(n), n = a..b) returns f(a) * ... * f(b) as a - ++ formal product; - iifact : F -> F - ++ iifact(x) should be local but conditional; - iibinom : List F -> F - ++ iibinom(l) should be local but conditional; - iiperm : List F -> F - ++ iiperm(l) should be local but conditional; - iipow : List F -> F - ++ iipow(l) should be local but conditional; - iidsum : List F -> F - ++ iidsum(l) should be local but conditional; - iidprod : List F -> F - ++ iidprod(l) should be local but conditional; - ipow : List F -> F - ++ ipow(l) should be local but conditional; - - Implementation ==> add - ifact : F -> F - iiipow : List F -> F - iperm : List F -> F - ibinom : List F -> F - isum : List F -> F - idsum : List F -> F - iprod : List F -> F - idprod : List F -> F - dsum : List F -> O - ddsum : List F -> O - dprod : List F -> O - ddprod : List F -> O - equalsumprod : (K, K) -> Boolean - equaldsumprod : (K, K) -> Boolean - fourth : List F -> F - dvpow1 : List F -> F - dvpow2 : List F -> F - summand : List F -> F - dvsum : (List F, SE) -> F - dvdsum : (List F, SE) -> F - dvprod : (List F, SE) -> F - dvdprod : (List F, SE) -> F - facts : (F, List SE) -> F - K2fact : (K, List SE) -> F - smpfact : (SMP, List SE) -> F - - dummy == new()$SE :: F -@ -This macro will be used in [[product]] and [[summation]], both the $5$ and $3$ -argument forms. It is used to introduce a dummy variable in place of the -summation index within the summands. This in turn is necessary to keep the -indexing variable local, circumventing problems, for example, with -differentiation. - -This works if we don't accidently use such a symbol as a bound of summation or -product. - -Note that up to [[patch--25]] this used to read -\begin{verbatim} - dummy := new()$SE :: F -\end{verbatim} -thus introducing the same dummy variable for all products and summations, which -caused nested products and summations to fail. (Issue~\#72) - -<>= - opfact := operator("factorial"::Symbol)$CommonOperators - opperm := operator("permutation"::Symbol)$CommonOperators - opbinom := operator("binomial"::Symbol)$CommonOperators - opsum := operator("summation"::Symbol)$CommonOperators - opdsum := operator("%defsum"::Symbol)$CommonOperators - opprod := operator("product"::Symbol)$CommonOperators - opdprod := operator("%defprod"::Symbol)$CommonOperators - oppow := operator(POWER::Symbol)$CommonOperators - - factorial x == opfact x - binomial(x, y) == opbinom [x, y] - permutation(x, y) == opperm [x, y] - - import F - import Kernel F - - number?(x:F):Boolean == - if R has RetractableTo(Z) then - ground?(x) or - ((retractIfCan(x)@Union(Fraction(Z),"failed")) case Fraction(Z)) - else - ground?(x) - - x ** y == - -- Do some basic simplifications - is?(x,POWER) => - args : List F := argument first kernels x - not(#args = 2) => error "Too many arguments to **" - number?(first args) and number?(y) => - oppow [first(args)**y, second args] - oppow [first args, (second args)* y] - -- Generic case - exp : Union(Record(val:F,exponent:Z),"failed") := isPower x - exp case Record(val:F,exponent:Z) => - expr := exp::Record(val:F,exponent:Z) - oppow [expr.val, (expr.exponent)*y] - oppow [x, y] - - belong? op == has?(op, "comb") - fourth l == third rest l - dvpow1 l == second(l) * first(l) ** (second l - 1) - factorials x == facts(x, variables x) - factorials(x, v) == facts(x, [v]) - facts(x, l) == smpfact(numer x, l) / smpfact(denom x, l) - summand l == eval(first l, retract(second l)@K, third l) - - product(x:F, i:SE) == - dm := dummy - opprod [eval(x, k := kernel(i)$K, dm), dm, k::F] - - summation(x:F, i:SE) == - dm := dummy - opsum [eval(x, k := kernel(i)$K, dm), dm, k::F] - -@ -These two operations return the product or the sum as unevaluated operators. A -dummy variable is introduced to make the indexing variable \lq local\rq. - -<>= - dvsum(l, x) == - opsum [differentiate(first l, x), second l, third l] - - dvdsum(l, x) == - x = retract(y := third l)@SE => 0 - if member?(x, variables(h := third rest rest l)) or - member?(x, variables(g := third rest l)) then - error "a sum cannot be differentiated with respect to a bound" - else - opdsum [differentiate(first l, x), second l, y, g, h] - -@ -The above two operations implement differentiation of sums with and without -bounds. Note that the function -$$n\mapsto\sum_{k=1}^n f(k,n)$$ -is well defined only for integral values of $n$ greater than or equal to zero. -There is not even consensus how to define this function for $n<0$. Thus, it is -not differentiable. Therefore, we need to check whether we erroneously are -differentiating with respect to the upper bound or the lower bound, where the -same reasoning holds. - -Differentiating a sum with respect to its indexing variable correctly gives -zero. This is due to the introduction of dummy variables in the internal -representation of a sum: the operator [[%defsum]] takes 5 arguments, namely - -\begin{enumerate} -\item the summands, where each occurrence of the indexing variable is replaced - by -\item the dummy variable, -\item the indexing variable, -\item the lower bound, and -\item the upper bound. -\end{enumerate} - -Note that up to [[patch--40]] the following incorrect code was used, which -tried to parallel the known rules for integration: (Issue~\#180) - -\begin{verbatim} - dvdsum(l, x) == - x = retract(y := third l)@SE => 0 - k := retract(d := second l)@K - differentiate(h := third rest rest l,x) * eval(f := first l, k, h) - - differentiate(g := third rest l, x) * eval(f, k, g) - + opdsum [differentiate(f, x), d, y, g, h] -\end{verbatim} - -Up to [[patch--45]] a similar mistake could be found in the code for -differentiation of formal sums, which read -\begin{verbatim} - dvsum(l, x) == - k := retract(second l)@K - differentiate(third l, x) * summand l - + opsum [differentiate(first l, x), second l, third l] -\end{verbatim} - -<>= - dvprod(l, x) == - dm := retract(dummy)@SE - f := eval(first l, retract(second l)@K, dm::F) - p := product(f, dm) - - opsum [differentiate(first l, x)/first l * p, second l, third l] - - - dvdprod(l, x) == - x = retract(y := third l)@SE => 0 - if member?(x, variables(h := third rest rest l)) or - member?(x, variables(g := third rest l)) then - error "a product cannot be differentiated with respect to a bound" - else - opdsum cons(differentiate(first l, x)/first l, rest l) * opdprod l - -@ -The above two operations implement differentiation of products with and without -bounds. Note again, that we cannot even properly define products with bounds -that are not integral. - -To differentiate the product, we use Leibniz rule: -$$\frac{d}{dx}\prod_{i=a}^b f(i,x) = - \sum_{i=a}^b \frac{\frac{d}{dx} f(i,x)}{f(i,x)}\prod_{i=a}^b f(i,x) -$$ - -There is one situation where this definition might produce wrong results, -namely when the product is zero, but axiom failed to recognize it: in this -case, -$$ - \frac{d}{dx} f(i,x)/f(i,x) -$$ -is undefined for some $i$. However, I was not able to come up with an -example. The alternative definition -$$ - \frac{d}{dx}\prod_{i=a}^b f(i,x) = - \sum_{i=a}^b \left(\frac{d}{dx} f(i,x)\right)\prod_{j=a,j\neq i}^b f(j,x) -$$ -has the slight (display) problem that we would have to come up with a new index -variable, which looks very ugly. Furthermore, it seems to me that more -simplifications will occur with the first definition. - -<>= - f := operator 'f - D(product(f(i,x),i=1..m),x) -@ - -Note that up to [[patch--45]] these functions did not exist and products were -differentiated according to the usual chain rule, which gave incorrect -results. (Issue~\#211) - -<>= - dprod l == - prod(summand(l)::O, third(l)::O) - - ddprod l == - prod(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O) - - dsum l == - sum(summand(l)::O, third(l)::O) - - ddsum l == - sum(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O) - -@ -These four operations handle the conversion of sums and products to -[[OutputForm]]. Note that up to [[patch--45]] the definitions for sums and -products without bounds were missing and output was illegible. - -<>= - equalsumprod(s1, s2) == - l1 := argument s1 - l2 := argument s2 - - (eval(first l1, retract(second l1)@K, second l2) = first l2) - - equaldsumprod(s1, s2) == - l1 := argument s1 - l2 := argument s2 - - ((third rest l1 = third rest l2) and - (third rest rest l1 = third rest rest l2) and - (eval(first l1, retract(second l1)@K, second l2) = first l2)) - -@ -The preceding two operations handle the testing for equality of sums and -products. This functionality was missing up to [[patch--45]]. (Issue~\#213) The -corresponding property [[%specialEqual]] set below is checked in -[[Kernel]]. Note that we can assume that the operators are equal, since this is -checked in [[Kernel]] itself. -<>= - product(x:F, s:SegmentBinding F) == - k := kernel(variable s)$K - dm := dummy - opdprod [eval(x,k,dm), dm, k::F, lo segment s, hi segment s] - - summation(x:F, s:SegmentBinding F) == - k := kernel(variable s)$K - dm := dummy - opdsum [eval(x,k,dm), dm, k::F, lo segment s, hi segment s] - -@ -These two operations return the product or the sum as unevaluated operators. A -dummy variable is introduced to make the indexing variable \lq local\rq. - -<>= - smpfact(p, l) == - map(K2fact(#1, l), #1::F, p)$PolynomialCategoryLifting( - IndexedExponents K, K, R, SMP, F) - - K2fact(k, l) == - empty? [v for v in variables(kf := k::F) | member?(v, l)] => kf - empty?(args:List F := [facts(a, l) for a in argument k]) => kf - is?(k, opperm) => - factorial(n := first args) / factorial(n - second args) - is?(k, opbinom) => - n := first args - p := second args - factorial(n) / (factorial(p) * factorial(n-p)) - (operator k) args - - operator op == - is?(op, "factorial"::Symbol) => opfact - is?(op, "permutation"::Symbol) => opperm - is?(op, "binomial"::Symbol) => opbinom - is?(op, "summation"::Symbol) => opsum - is?(op, "%defsum"::Symbol) => opdsum - is?(op, "product"::Symbol) => opprod - is?(op, "%defprod"::Symbol) => opdprod - is?(op, POWER) => oppow - error "Not a combinatorial operator" - - iprod l == - zero? first l => 0 --- one? first l => 1 - (first l = 1) => 1 - kernel(opprod, l) - - isum l == - zero? first l => 0 - kernel(opsum, l) - - idprod l == - member?(retract(second l)@SE, variables first l) => - kernel(opdprod, l) - first(l) ** (fourth rest l - fourth l + 1) - - idsum l == - member?(retract(second l)@SE, variables first l) => - kernel(opdsum, l) - first(l) * (fourth rest l - fourth l + 1) - - ifact x == --- zero? x or one? x => 1 - zero? x or (x = 1) => 1 - kernel(opfact, x) - - ibinom l == - n := first l - ((p := second l) = 0) or (p = n) => 1 --- one? p or (p = n - 1) => n - (p = 1) or (p = n - 1) => n - kernel(opbinom, l) - - iperm l == - zero? second l => 1 - kernel(opperm, l) - - if R has RetractableTo Z then - iidsum l == - (r1:=retractIfCan(fourth l)@Union(Z,"failed")) - case "failed" or - (r2:=retractIfCan(fourth rest l)@Union(Z,"failed")) - case "failed" or - (k:=retractIfCan(second l)@Union(K,"failed")) case "failed" - => idsum l - +/[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z] - - iidprod l == - (r1:=retractIfCan(fourth l)@Union(Z,"failed")) - case "failed" or - (r2:=retractIfCan(fourth rest l)@Union(Z,"failed")) - case "failed" or - (k:=retractIfCan(second l)@Union(K,"failed")) case "failed" - => idprod l - */[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z] - - iiipow l == - (u := isExpt(x := first l, OPEXP)) case "failed" => kernel(oppow, l) - rec := u::Record(var: K, exponent: Z) - y := first argument(rec.var) - (r := retractIfCan(y)@Union(Fraction Z, "failed")) case - "failed" => kernel(oppow, l) - (operator(rec.var)) (rec.exponent * y * second l) - - if F has RadicalCategory then - ipow l == - (r := retractIfCan(second l)@Union(Fraction Z,"failed")) - case "failed" => iiipow l - first(l) ** (r::Fraction(Z)) - else - ipow l == - (r := retractIfCan(second l)@Union(Z, "failed")) - case "failed" => iiipow l - first(l) ** (r::Z) - - else - ipow l == - zero?(x := first l) => - zero? second l => error "0 ** 0" - 0 --- one? x or zero?(n := second l) => 1 - (x = 1) or zero?(n: F := second l) => 1 --- one? n => x - (n = 1) => x - (u := isExpt(x, OPEXP)) case "failed" => kernel(oppow, l) - rec := u::Record(var: K, exponent: Z) --- one?(y := first argument(rec.var)) or y = -1 => - ((y := first argument(rec.var))=1) or y = -1 => - (operator(rec.var)) (rec.exponent * y * n) - kernel(oppow, l) - - if R has CombinatorialFunctionCategory then - iifact x == - (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => ifact x - factorial(r::R)::F - - iiperm l == - (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or - (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" - => iperm l - permutation(r1::R, r2::R)::F - - if R has RetractableTo(Z) and F has Algebra(Fraction(Z)) then - iibinom l == - (s:=retractIfCan(second l)@Union(R,"failed")) case R and - (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 => - ans:=1::F - for i in 0..t-1 repeat - ans:=ans*(first l - i::R::F) - (1/factorial t) * ans - (s:=retractIfCan(first l-second l)@Union(R,"failed")) case R and - (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 => - ans:=1::F - for i in 1..t repeat - ans:=ans*(second l+i::R::F) - (1/factorial t) * ans - (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or - (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" - => ibinom l - binomial(r1::R, r2::R)::F - -@ - -[[iibinom]] checks those cases in which the binomial coefficient may be -evaluated explicitly. Note that up to [[patch--51]], the case where the second -argument is a positive integer was not checked.(Issue~\#336) Currently, the -naive iterative algorithm is used to calculate the coefficient, there is room -for improvement here. - -<>= - - else - iibinom l == - (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or - (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed" - => ibinom l - binomial(r1::R, r2::R)::F - - else - iifact x == ifact x - iibinom l == ibinom l - iiperm l == iperm l - - if R has ElementaryFunctionCategory then - iipow l == - (r1:=retractIfCan(first l)@Union(R,"failed")) case "failed" or - (r2:=retractIfCan(second l)@Union(R,"failed")) case "failed" - => ipow l - (r1::R ** r2::R)::F - else - iipow l == ipow l - - if F has ElementaryFunctionCategory then - dvpow2 l == if zero?(first l) then - 0 - else - log(first l) * first(l) ** second(l) - -@ -This operation implements the differentiation of the power operator [[%power]] -with respect to its second argument, i.e., the exponent. It uses the formula -$$\frac{d}{dx} g(y)^x = \frac{d}{dx} e^{x\log g(y)} = \log g(y) g(y)^x.$$ - -If $g(y)$ equals zero, this formula is not valid, since the logarithm is not -defined there. Although strictly speaking $0^x$ is not differentiable at zero, -we return zero for convenience. - -Note that up to [[patch--25]] this used to read -\begin{verbatim} - if F has ElementaryFunctionCategory then - dvpow2 l == log(first l) * first(l) ** second(l) -\end{verbatim} -which caused differentiating $0^x$ to fail. (Issue~\#19) - -<>= - evaluate(opfact, iifact)$BasicOperatorFunctions1(F) - evaluate(oppow, iipow) - evaluate(opperm, iiperm) - evaluate(opbinom, iibinom) - evaluate(opsum, isum) - evaluate(opdsum, iidsum) - evaluate(opprod, iprod) - evaluate(opdprod, iidprod) - derivative(oppow, [dvpow1, dvpow2]) - setProperty(opsum, SPECIALDIFF, dvsum@((List F, SE) -> F) pretend None) - setProperty(opdsum, SPECIALDIFF, dvdsum@((List F, SE)->F) pretend None) - setProperty(opprod, SPECIALDIFF, dvprod@((List F, SE)->F) pretend None) - setProperty(opdprod, SPECIALDIFF, dvdprod@((List F, SE)->F) pretend None) -@ -The last four properties define special differentiation rules for sums and -products. Note that up to [[patch--45]] the rules for products were missing. -Thus products were differentiated according the usual chain-rule, which gave -incorrect results. - -<>= - setProperty(opsum, SPECIALDISP, dsum@(List F -> O) pretend None) - setProperty(opdsum, SPECIALDISP, ddsum@(List F -> O) pretend None) - setProperty(opprod, SPECIALDISP, dprod@(List F -> O) pretend None) - setProperty(opdprod, SPECIALDISP, ddprod@(List F -> O) pretend None) - setProperty(opsum, SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None) - setProperty(opdsum, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None) - setProperty(opprod, SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None) - setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None) - -@ -Finally, we set the properties for displaying sums and products and testing for -equality. - - -\section{package FSPECF FunctionalSpecialFunction} -<>= -"FSPECF" -> "PACKAGE" -"FunctionalSpecialFunction(a:Join(ORDSET,INTDOM),b:FS(a))" -> "Package" -@ -<>= -)abbrev package FSPECF FunctionalSpecialFunction -++ Provides the special functions -++ Author: Manuel Bronstein -++ Date Created: 18 Apr 1989 -++ Date Last Updated: 4 October 1993 -++ Description: Provides some special functions over an integral domain. -++ Keywords: special, function. -FunctionalSpecialFunction(R, F): Exports == Implementation where - R: Join(OrderedSet, IntegralDomain) - F: FunctionSpace R - - OP ==> BasicOperator - K ==> Kernel F - SE ==> Symbol - SPECIALDIFF ==> "%specialDiff" - - Exports ==> with - belong? : OP -> Boolean - ++ belong?(op) is true if op is a special function operator; - operator: OP -> OP - ++ operator(op) returns a copy of op with the domain-dependent - ++ properties appropriate for F; - ++ error if op is not a special function operator - abs : F -> F - ++ abs(f) returns the absolute value operator applied to f - Gamma : F -> F - ++ Gamma(f) returns the formal Gamma function applied to f - Gamma : (F,F) -> F - ++ Gamma(a,x) returns the incomplete Gamma function applied to a and x - Beta: (F,F) -> F - ++ Beta(x,y) returns the beta function applied to x and y - digamma: F->F - ++ digamma(x) returns the digamma function applied to x - polygamma: (F,F) ->F - ++ polygamma(x,y) returns the polygamma function applied to x and y - besselJ: (F,F) -> F - ++ besselJ(x,y) returns the besselj function applied to x and y - besselY: (F,F) -> F - ++ besselY(x,y) returns the bessely function applied to x and y - besselI: (F,F) -> F - ++ besselI(x,y) returns the besseli function applied to x and y - besselK: (F,F) -> F - ++ besselK(x,y) returns the besselk function applied to x and y - airyAi: F -> F - ++ airyAi(x) returns the airyai function applied to x - airyBi: F -> F - ++ airyBi(x) returns the airybi function applied to x - -@ - -In case we want to have more special function operators here, do not forget to -add them to the list [[specop]] in [[CommonOperators]]. Otherwise they will -not have the \lq special\rq\ attribute and will not be recognised here. One -effect could be that -\begin{verbatim} -myNewSpecOp(1::Expression Integer)::Expression DoubleFloat -\end{verbatim} -might not re-evaluate the operator. - -<>= - iiGamma : F -> F - ++ iiGamma(x) should be local but conditional; - iiabs : F -> F - ++ iiabs(x) should be local but conditional; - iiBeta : List F -> F - ++ iiGamma(x) should be local but conditional; - iidigamma : F -> F - ++ iidigamma(x) should be local but conditional; - iipolygamma: List F -> F - ++ iipolygamma(x) should be local but conditional; - iiBesselJ : List F -> F - ++ iiBesselJ(x) should be local but conditional; - iiBesselY : List F -> F - ++ iiBesselY(x) should be local but conditional; - iiBesselI : List F -> F - ++ iiBesselI(x) should be local but conditional; - iiBesselK : List F -> F - ++ iiBesselK(x) should be local but conditional; - iiAiryAi : F -> F - ++ iiAiryAi(x) should be local but conditional; - iiAiryBi : F -> F - ++ iiAiryBi(x) should be local but conditional; - - Implementation ==> add - iabs : F -> F - iGamma : F -> F - iBeta : (F, F) -> F - idigamma : F -> F - iiipolygamma: (F, F) -> F - iiiBesselJ : (F, F) -> F - iiiBesselY : (F, F) -> F - iiiBesselI : (F, F) -> F - iiiBesselK : (F, F) -> F - iAiryAi : F -> F - iAiryBi : F -> F - - opabs := operator("abs"::Symbol)$CommonOperators - opGamma := operator("Gamma"::Symbol)$CommonOperators - opGamma2 := operator("Gamma2"::Symbol)$CommonOperators - opBeta := operator("Beta"::Symbol)$CommonOperators - opdigamma := operator("digamma"::Symbol)$CommonOperators - oppolygamma := operator("polygamma"::Symbol)$CommonOperators - opBesselJ := operator("besselJ"::Symbol)$CommonOperators - opBesselY := operator("besselY"::Symbol)$CommonOperators - opBesselI := operator("besselI"::Symbol)$CommonOperators - opBesselK := operator("besselK"::Symbol)$CommonOperators - opAiryAi := operator("airyAi"::Symbol)$CommonOperators - opAiryBi := operator("airyBi"::Symbol)$CommonOperators - - abs x == opabs x - Gamma(x) == opGamma(x) - Gamma(a,x) == opGamma2(a,x) - Beta(x,y) == opBeta(x,y) - digamma x == opdigamma(x) - polygamma(k,x)== oppolygamma(k,x) - besselJ(a,x) == opBesselJ(a,x) - besselY(a,x) == opBesselY(a,x) - besselI(a,x) == opBesselI(a,x) - besselK(a,x) == opBesselK(a,x) - airyAi(x) == opAiryAi(x) - airyBi(x) == opAiryBi(x) - - belong? op == has?(op, "special") - - operator op == - is?(op, "abs"::Symbol) => opabs - is?(op, "Gamma"::Symbol) => opGamma - is?(op, "Gamma2"::Symbol) => opGamma2 - is?(op, "Beta"::Symbol) => opBeta - is?(op, "digamma"::Symbol) => opdigamma - is?(op, "polygamma"::Symbol)=> oppolygamma - is?(op, "besselJ"::Symbol) => opBesselJ - is?(op, "besselY"::Symbol) => opBesselY - is?(op, "besselI"::Symbol) => opBesselI - is?(op, "besselK"::Symbol) => opBesselK - is?(op, "airyAi"::Symbol) => opAiryAi - is?(op, "airyBi"::Symbol) => opAiryBi - - error "Not a special operator" - - -- Could put more unconditional special rules for other functions here - iGamma x == --- one? x => x - (x = 1) => x - kernel(opGamma, x) - - iabs x == - zero? x => 0 - is?(x, opabs) => x - x < 0 => kernel(opabs, -x) - kernel(opabs, x) - - iBeta(x, y) == kernel(opBeta, [x, y]) - idigamma x == kernel(opdigamma, x) - iiipolygamma(n, x) == kernel(oppolygamma, [n, x]) - iiiBesselJ(x, y) == kernel(opBesselJ, [x, y]) - iiiBesselY(x, y) == kernel(opBesselY, [x, y]) - iiiBesselI(x, y) == kernel(opBesselI, [x, y]) - iiiBesselK(x, y) == kernel(opBesselK, [x, y]) - iAiryAi x == kernel(opAiryAi, x) - iAiryBi x == kernel(opAiryBi, x) - - - -- Could put more conditional special rules for other functions here - - if R has abs : R -> R then - iiabs x == - (r := retractIfCan(x)@Union(Fraction Polynomial R, "failed")) - case "failed" => iabs x - f := r::Fraction Polynomial R - (a := retractIfCan(numer f)@Union(R, "failed")) case "failed" or - (b := retractIfCan(denom f)@Union(R,"failed")) case "failed" => iabs x - abs(a::R)::F / abs(b::R)::F - - else iiabs x == iabs x - - if R has SpecialFunctionCategory then - iiGamma x == - (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iGamma x - Gamma(r::R)::F - - iiBeta l == - (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ - (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ - => iBeta(first l, second l) - Beta(r::R, s::R)::F - - iidigamma x == - (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => idigamma x - digamma(r::R)::F - - iipolygamma l == - (s:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ - (r:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ - => iiipolygamma(first l, second l) - polygamma(s::R, r::R)::F - - iiBesselJ l == - (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ - (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ - => iiiBesselJ(first l, second l) - besselJ(r::R, s::R)::F - - iiBesselY l == - (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ - (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ - => iiiBesselY(first l, second l) - besselY(r::R, s::R)::F - - iiBesselI l == - (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ - (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ - => iiiBesselI(first l, second l) - besselI(r::R, s::R)::F - - iiBesselK l == - (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _ - (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _ - => iiiBesselK(first l, second l) - besselK(r::R, s::R)::F - - iiAiryAi x == - (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryAi x - airyAi(r::R)::F - - iiAiryBi x == - (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryBi x - airyBi(r::R)::F - - else - if R has RetractableTo Integer then - iiGamma x == - (r := retractIfCan(x)@Union(Integer, "failed")) case Integer - and (r::Integer >= 1) => factorial(r::Integer - 1)::F - iGamma x - else - iiGamma x == iGamma x - - iiBeta l == iBeta(first l, second l) - iidigamma x == idigamma x - iipolygamma l == iiipolygamma(first l, second l) - iiBesselJ l == iiiBesselJ(first l, second l) - iiBesselY l == iiiBesselY(first l, second l) - iiBesselI l == iiiBesselI(first l, second l) - iiBesselK l == iiiBesselK(first l, second l) - iiAiryAi x == iAiryAi x - iiAiryBi x == iAiryBi x - - -- Default behaviour is to build a kernel - evaluate(opGamma, iiGamma)$BasicOperatorFunctions1(F) - evaluate(opabs, iiabs)$BasicOperatorFunctions1(F) --- evaluate(opGamma2 ,iiGamma2 )$BasicOperatorFunctions1(F) - evaluate(opBeta ,iiBeta )$BasicOperatorFunctions1(F) - evaluate(opdigamma ,iidigamma )$BasicOperatorFunctions1(F) - evaluate(oppolygamma ,iipolygamma)$BasicOperatorFunctions1(F) - evaluate(opBesselJ ,iiBesselJ )$BasicOperatorFunctions1(F) - evaluate(opBesselY ,iiBesselY )$BasicOperatorFunctions1(F) - evaluate(opBesselI ,iiBesselI )$BasicOperatorFunctions1(F) - evaluate(opBesselK ,iiBesselK )$BasicOperatorFunctions1(F) - evaluate(opAiryAi ,iiAiryAi )$BasicOperatorFunctions1(F) - evaluate(opAiryBi ,iiAiryBi )$BasicOperatorFunctions1(F) -@ - -\subsection{differentiation of special functions} - -In the following we define the symbolic derivatives of the special functions we -provide. The formulas we use for the Bessel functions can be found in Milton -Abramowitz and Irene A. Stegun, eds. (1965). Handbook of Mathematical -Functions with Formulas, Graphs, and Mathematical Tables. New York: Dover. ISBN -0-486-61272-4, Equations~9.1.27 and 9.6.26. Up to [[patch--50]] the formula -for $K$ missed the minus sign. (Issue~\#355) - -We do not attempt to provide formulas for the derivative with respect to the -first argument currently. Instead, we leave such derivatives unevaluated. - -<>= - import Fraction Integer - ahalf: F := recip(2::F)::F - athird: F := recip(2::F)::F - twothirds: F := 2*recip(3::F)::F -@ - -We need to get hold of the differentiation operator as modified by -[[FunctionSpace]]. Otherwise, for example, display will be ugly. We accomplish -that by differentiating an operator, which will certainly result in a single -kernel only. - -<>= - dummyArg: SE := new()$SE - opdiff := operator first kernels D((operator(new()$SE)$BasicOperator) - (dummyArg::F), dummyArg) -@ - -The differentiation operator [[opdiff]] takes three arguments corresponding to -$$ -F_{,i}(a_1,a_2,\dots,a_n): -$$ -\begin{enumerate} -\item $F(a_1,...,dm,...a_n)$, where the $i$\textsuperscript{th} argument is a - dummy variable, -\item $dm$, the dummy variable, and -\item $a_i$, the point at which the differential is evaluated. -\end{enumerate} - -In the following, it seems to be safe to use the same dummy variable -troughout. At least, this is done also in [[FunctionSpace]], and did not cause -problems. - -The operation [[symbolicGrad]] returns the first component of the gradient of -[[op l]]. - -<>= - dm := new()$SE :: F - - iBesselJ(l: List F, t: SE): F == - n := first l; x := second l - differentiate(n, t)*kernel(opdiff, [opBesselJ [dm, x], dm, n]) - + differentiate(x, t) * ahalf * (besselJ (n-1,x) - besselJ (n+1,x)) - - iBesselY(l: List F, t: SE): F == - n := first l; x := second l - differentiate(n, t)*kernel(opdiff, [opBesselY [dm, x], dm, n]) - + differentiate(x, t) * ahalf * (besselY (n-1,x) - besselY (n+1,x)) - - iBesselI(l: List F, t: SE): F == - n := first l; x := second l - differentiate(n, t)*kernel(opdiff, [opBesselI [dm, x], dm, n]) - + differentiate(x, t)* ahalf * (besselI (n-1,x) + besselI (n+1,x)) - - iBesselK(l: List F, t: SE): F == - n := first l; x := second l - differentiate(n, t)*kernel(opdiff, [opBesselK [dm, x], dm, n]) - - differentiate(x, t)* ahalf * (besselK (n-1,x) + besselK (n+1,x)) - -@ - -For the moment we throw an error if we try to differentiate [[polygamma]] with -respect to the first argument. - -<>= - ipolygamma(l: List F, x: SE): F == - member?(x, variables first l) => - error "cannot differentiate polygamma with respect to the first argument" - n := first l; y := second l - differentiate(y, x)*polygamma(n+1, y) - iBetaGrad1(l: List F): F == - x := first l; y := second l - Beta(x,y)*(digamma x - digamma(x+y)) - iBetaGrad2(l: List F): F == - x := first l; y := second l - Beta(x,y)*(digamma y - digamma(x+y)) - - if F has ElementaryFunctionCategory then - iGamma2(l: List F, t: SE): F == - a := first l; x := second l - differentiate(a, t)*kernel(opdiff, [opGamma2 [dm, x], dm, a]) - - differentiate(x, t)* x ** (a - 1) * exp(-x) - setProperty(opGamma2, SPECIALDIFF, iGamma2@((List F, SE)->F) - pretend None) -@ - -Finally, we tell Axiom to use these functions for differentiation. Note that -up to [[patch--50]], the properties for the Bessel functions were set using -[[derivative(oppolygamma, [lzero, ipolygammaGrad])]], where [[lzero]] returned -zero always. Trying to replace [[lzero]] by a function that returns the first -component of the gradient failed, it resulted in an infinite loop for -[[integrate(D(besselJ(a,x),a),a)]]. - -<>= - derivative(opabs, abs(#1) * inv(#1)) - derivative(opGamma, digamma #1 * Gamma #1) - derivative(opBeta, [iBetaGrad1, iBetaGrad2]) - derivative(opdigamma, polygamma(1, #1)) - setProperty(oppolygamma, SPECIALDIFF, ipolygamma@((List F, SE)->F) - pretend None) - setProperty(opBesselJ, SPECIALDIFF, iBesselJ@((List F, SE)->F) - pretend None) - setProperty(opBesselY, SPECIALDIFF, iBesselY@((List F, SE)->F) - pretend None) - setProperty(opBesselI, SPECIALDIFF, iBesselI@((List F, SE)->F) - pretend None) - setProperty(opBesselK, SPECIALDIFF, iBesselK@((List F, SE)->F) - pretend None) - -@ -\section{package SUMFS FunctionSpaceSum} -<>= -"SUMFS" -> "PACKAGE" -"FunctionSpaceSum(a:Join(...),b:Join(...))" -> "Package" -@ -<>= -)abbrev package SUMFS FunctionSpaceSum -++ Top-level sum function -++ Author: Manuel Bronstein -++ Date Created: ??? -++ Date Last Updated: 19 April 1991 -++ Description: computes sums of top-level expressions; -FunctionSpaceSum(R, F): Exports == Implementation where - R: Join(IntegralDomain, OrderedSet, - RetractableTo Integer, LinearlyExplicitRingOver Integer) - F: Join(FunctionSpace R, CombinatorialOpsCategory, - AlgebraicallyClosedField, TranscendentalFunctionCategory) - - SE ==> Symbol - K ==> Kernel F - - Exports ==> with - sum: (F, SE) -> F - ++ sum(a(n), n) returns A(n) such that A(n+1) - A(n) = a(n); - sum: (F, SegmentBinding F) -> F - ++ sum(f(n), n = a..b) returns f(a) + f(a+1) + ... + f(b); - - Implementation ==> add - import ElementaryFunctionStructurePackage(R, F) - import GosperSummationMethod(IndexedExponents K, K, R, - SparseMultivariatePolynomial(R, K), F) - - innersum: (F, K) -> Union(F, "failed") - notRF? : (F, K) -> Boolean - newk : () -> K - - newk() == kernel(new()$SE) - - sum(x:F, s:SegmentBinding F) == - k := kernel(variable s)@K - (u := innersum(x, k)) case "failed" => summation(x, s) - eval(u::F, k, 1 + hi segment s) - eval(u::F, k, lo segment s) - - sum(x:F, v:SE) == - (u := innersum(x, kernel(v)@K)) case "failed" => summation(x,v) - u::F - - notRF?(f, k) == - for kk in tower f repeat - member?(k, tower(kk::F)) and (symbolIfCan(kk) case "failed") => - return true - false - - innersum(x, k) == - zero? x => 0 - notRF?(f := normalize(x / (x1 := eval(x, k, k::F - 1))), k) => - "failed" - (u := GospersMethod(f, k, newk)) case "failed" => "failed" - x1 * eval(u::F, k, k::F - 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. -@ -<<*>>= -<> - --- SPAD files for the functional world should be compiled in the --- following order: --- --- op kl function funcpkgs manip algfunc --- elemntry constant funceval COMBFUNC fe - -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/combinat.spad.pamphlet b/src/algebra/combinat.spad.pamphlet deleted file mode 100644 index 55765dc..0000000 --- a/src/algebra/combinat.spad.pamphlet +++ /dev/null @@ -1,201 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra combinat.spad} -\author{Martin Brock, Robert Sutor, Michael Monagan} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package COMBINAT IntegerCombinatoricFunctions} -<>= -)abbrev package COMBINAT IntegerCombinatoricFunctions -++ Authors: Martin Brock, Robert Sutor, Michael Monagan -++ Date Created: June 1987 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: integer, combinatoric function -++ Examples: -++ References: -++ Description: -++ The \spadtype{IntegerCombinatoricFunctions} package provides some -++ standard functions in combinatorics. -Z ==> Integer -N ==> NonNegativeInteger -SUP ==> SparseUnivariatePolynomial - -IntegerCombinatoricFunctions(I:IntegerNumberSystem): with - binomial: (I, I) -> I - ++ \spad{binomial(n,r)} returns the binomial coefficient - ++ \spad{C(n,r) = n!/(r! (n-r)!)}, where \spad{n >= r >= 0}. - ++ This is the number of combinations of n objects taken r at a time. - factorial: I -> I - ++ \spad{factorial(n)} returns \spad{n!}. this is the product of all - ++ integers between 1 and n (inclusive). - ++ Note: \spad{0!} is defined to be 1. - multinomial: (I, List I) -> I - ++ \spad{multinomial(n,[m1,m2,...,mk])} returns the multinomial - ++ coefficient \spad{n!/(m1! m2! ... mk!)}. - partition: I -> I - ++ \spad{partition(n)} returns the number of partitions of the integer n. - ++ This is the number of distinct ways that n can be written as - ++ a sum of positive integers. - permutation: (I, I) -> I - ++ \spad{permutation(n)} returns \spad{!P(n,r) = n!/(n-r)!}. This is - ++ the number of permutations of n objects taken r at a time. - stirling1: (I, I) -> I - ++ \spad{stirling1(n,m)} returns the Stirling number of the first kind - ++ denoted \spad{S[n,m]}. - stirling2: (I, I) -> I - ++ \spad{stirling2(n,m)} returns the Stirling number of the second kind - ++ denoted \spad{SS[n,m]}. - == add - F : Record(Fn:I, Fv:I) := [0,1] - B : Record(Bn:I, Bm:I, Bv:I) := [0,0,0] - S : Record(Sn:I, Sp:SUP I) := [0,0] - P : IndexedFlexibleArray(I,0) := new(1,1)$IndexedFlexibleArray(I,0) - - partition n == - -- This is the number of ways of expressing n as a sum of positive - -- integers, without regard to order. For example partition 5 = 7 - -- since 5 = 1+1+1+1+1 = 1+1+1+2 = 1+2+2 = 1+1+3 = 1+4 = 2+3 = 5 . - -- Uses O(sqrt n) term recurrence from Abramowitz & Stegun pp. 825 - -- p(n) = sum (-1)**k p(n-j) where 0 < j := (3*k**2+-k) quo 2 <= n - minIndex(P) ^= 0 => error "Partition: must have minIndex of 0" - m := #P - n < 0 => error "partition is not defined for negative integers" - n < m::I => P(convert(n)@Z) - concat_!(P, new((convert(n+1)@Z - m)::N,0)$IndexedFlexibleArray(I,0)) - for i in m..convert(n)@Z repeat - s:I := 1 - t:I := 0 - for k in 1.. repeat - l := (3*k*k-k) quo 2 - l > i => leave - u := l+k - t := t + s * P(convert(i-l)@Z) - u > i => leave - t := t + s * P(convert(i-u)@Z) - s := -s - P.i := t - P(convert(n)@Z) - - factorial n == - s,f,t : I - n < 0 => error "factorial not defined for negative integers" - if n <= F.Fn then s := f := 1 else (s, f) := F - for k in convert(s+1)@Z .. convert(n)@Z by 2 repeat - if k::I = n then t := n else t := k::I * (k+1)::I - f := t * f - F.Fn := n - F.Fv := f - - binomial(n, m) == - s,b:I - n < 0 or m < 0 or m > n => 0 - m = 0 => 1 - n < 2*m => binomial(n, n-m) - (s,b) := (0,1) - if B.Bn = n then - B.Bm = m+1 => - b := (B.Bv * (m+1)) quo (n-m) - B.Bn := n - B.Bm := m - return(B.Bv := b) - if m >= B.Bm then (s := B.Bm; b := B.Bv) else (s,b) := (0,1) - for k in convert(s+1)@Z .. convert(m)@Z repeat - b := (b*(n-k::I+1)) quo k::I - B.Bn := n - B.Bm := m - B.Bv := b - - multinomial(n, m) == - for t in m repeat t < 0 => return 0 - n < _+/m => 0 - s:I := 1 - for t in m repeat s := s * factorial t - factorial n quo s - - permutation(n, m) == - t:I - m < 0 or n < m => 0 - m := n-m - p:I := 1 - for k in convert(m+1)@Z .. convert(n)@Z by 2 repeat - if k::I = n then t := n else t := (k*(k+1))::I - p := p * t - p - - stirling1(n, m) == - -- Definition: (-1)**(n-m) S[n,m] is the number of - -- permutations of n symbols which have m cycles. - n < 0 or m < 1 or m > n => 0 - m = n => 1 - S.Sn = n => coefficient(S.Sp, convert(m)@Z :: N) - x := monomial(1, 1)$SUP(I) - S.Sn := n - S.Sp := x - for k in 1 .. convert(n-1)@Z repeat S.Sp := S.Sp * (x - k::SUP(I)) - coefficient(S.Sp, convert(m)@Z :: N) - - stirling2(n, m) == - -- definition: SS[n,m] is the number of ways of partitioning - -- a set of n elements into m non-empty subsets - n < 0 or m < 1 or m > n => 0 - m = 1 or n = m => 1 - s:I := if odd? m then -1 else 1 - t:I := 0 - for k in 1..convert(m)@Z repeat - s := -s - t := t + s * binomial(m, k::I) * k::I ** (convert(n)@Z :: N) - t quo factorial m - -@ -\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/complet.spad.pamphlet b/src/algebra/complet.spad.pamphlet deleted file mode 100644 index d99c3a8..0000000 --- a/src/algebra/complet.spad.pamphlet +++ /dev/null @@ -1,153 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra complet.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package ORDCOMP2 OrderedCompletionFunctions2} -<>= -"ORDCOMP2" -> "PACKAGE" -"OrderedCompletionFunctions2(a:SETCAT,b:SETCAT)" -> "Package" -@ -<>= -)abbrev package ORDCOMP2 OrderedCompletionFunctions2 -++ Lifting of maps to ordered completions -++ Author: Manuel Bronstein -++ Description: Lifting of maps to ordered completions. -++ Date Created: 4 Oct 1989 -++ Date Last Updated: 4 Oct 1989 -OrderedCompletionFunctions2(R, S): Exports == Implementation where - R, S: SetCategory - - ORR ==> OrderedCompletion R - ORS ==> OrderedCompletion S - - Exports ==> with - map: (R -> S, ORR) -> ORS - ++ map(f, r) lifts f and applies it to r, assuming that - ++ f(plusInfinity) = plusInfinity and that - ++ f(minusInfinity) = minusInfinity. - map: (R -> S, ORR, ORS, ORS) -> ORS - ++ map(f, r, p, m) lifts f and applies it to r, assuming that - ++ f(plusInfinity) = p and that f(minusInfinity) = m. - - Implementation ==> add - map(f, r) == map(f, r, plusInfinity(), minusInfinity()) - - map(f, r, p, m) == - zero?(n := whatInfinity r) => (f retract r)::ORS --- one? n => p - (n = 1) => p - m - -@ -\section{package ONECOMP2 OnePointCompletionFunctions2} -<>= -"ONECOMP2" -> "PACKAGE" -"OnePointCompletionFunctions2(a:SETCAT,b:SETCAT)" -> "Package" -@ -<>= -)abbrev package ONECOMP2 OnePointCompletionFunctions2 -++ Lifting of maps to one-point completions -++ Author: Manuel Bronstein -++ Description: Lifting of maps to one-point completions. -++ Date Created: 4 Oct 1989 -++ Date Last Updated: 4 Oct 1989 -OnePointCompletionFunctions2(R, S): Exports == Implementation where - R, S: SetCategory - - OPR ==> OnePointCompletion R - OPS ==> OnePointCompletion S - - Exports ==> with - map: (R -> S, OPR) -> OPS - ++ map(f, r) lifts f and applies it to r, assuming that - ++ f(infinity) = infinity. - map: (R -> S, OPR, OPS) -> OPS - ++ map(f, r, i) lifts f and applies it to r, assuming that - ++ f(infinity) = i. - - Implementation ==> add - map(f, r) == map(f, r, infinity()) - - map(f, r, i) == - (u := retractIfCan r) case R => (f(u::R))::OPS - i - -@ -\section{package INFINITY Infinity} -<>= -"INFINITY" -> "PACKAGE" -"Infinity()" -> "Package" -@ -<>= -)abbrev package INFINITY Infinity -++ Top-level infinity -++ Author: Manuel Bronstein -++ Description: Default infinity signatures for the interpreter; -++ Date Created: 4 Oct 1989 -++ Date Last Updated: 4 Oct 1989 -Infinity(): with - infinity : () -> OnePointCompletion Integer - ++ infinity() returns infinity. - plusInfinity : () -> OrderedCompletion Integer - ++ plusInfinity() returns plusIinfinity. - minusInfinity: () -> OrderedCompletion Integer - ++ minusInfinity() returns minusInfinity. - == add - infinity() == infinity()$OnePointCompletion(Integer) - plusInfinity() == plusInfinity()$OrderedCompletion(Integer) - minusInfinity() == minusInfinity()$OrderedCompletion(Integer) - -@ -\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/cont.spad.pamphlet b/src/algebra/cont.spad.pamphlet deleted file mode 100644 index 5183d27..0000000 --- a/src/algebra/cont.spad.pamphlet +++ /dev/null @@ -1,357 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra cont.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package ESCONT ExpertSystemContinuityPackage} -<>= -)abbrev package ESCONT ExpertSystemContinuityPackage -++ Author: Brian Dupee -++ Date Created: May 1994 -++ Date Last Updated: June 1995 -++ Basic Operations: problemPoints, singularitiesOf, zerosOf -++ Related Constructors: -++ Description: -++ ExpertSystemContinuityPackage is a package of functions for the use of domains -++ belonging to the category \axiomType{NumericalIntegration}. - -ExpertSystemContinuityPackage(): E == I where - EF2 ==> ExpressionFunctions2 - FI ==> Fraction Integer - EFI ==> Expression Fraction Integer - PFI ==> Polynomial Fraction Integer - DF ==> DoubleFloat - LDF ==> List DoubleFloat - EDF ==> Expression DoubleFloat - VEDF ==> Vector Expression DoubleFloat - SDF ==> Stream DoubleFloat - SS ==> Stream String - EEDF ==> Equation Expression DoubleFloat - LEDF ==> List Expression DoubleFloat - KEDF ==> Kernel Expression DoubleFloat - LKEDF ==> List Kernel Expression DoubleFloat - PDF ==> Polynomial DoubleFloat - FPDF ==> Fraction Polynomial DoubleFloat - OCDF ==> OrderedCompletion DoubleFloat - SOCDF ==> Segment OrderedCompletion DoubleFloat - NIA ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF) - UP ==> UnivariatePolynomial - BO ==> BasicOperator - RS ==> Record(zeros: SDF,ones: SDF,singularities: SDF) - - E ==> with - - getlo : SOCDF -> DF - ++ getlo(u) gets the \axiomType{DoubleFloat} equivalent of - ++ the first endpoint of the range \axiom{u} - gethi : SOCDF -> DF - ++ gethi(u) gets the \axiomType{DoubleFloat} equivalent of - ++ the second endpoint of the range \axiom{u} - functionIsFracPolynomial?: NIA -> Boolean - ++ functionIsFracPolynomial?(args) tests whether the function - ++ can be retracted to \axiomType{Fraction(Polynomial(DoubleFloat))} - problemPoints:(EDF,Symbol,SOCDF) -> List DF - ++ problemPoints(f,var,range) returns a list of possible problem points - ++ by looking at the zeros of the denominator of the function \spad{f} - ++ if it can be retracted to \axiomType{Polynomial(DoubleFloat)}. - zerosOf:(EDF,List Symbol,SOCDF) -> SDF - ++ zerosOf(e,vars,range) returns a list of points - ++ (\axiomType{Doublefloat}) at which a NAG fortran version of \spad{e} - ++ will most likely produce an error. - singularitiesOf: (EDF,List Symbol,SOCDF) -> SDF - ++ singularitiesOf(e,vars,range) returns a list of points - ++ (\axiomType{Doublefloat}) at which a NAG fortran - ++ version of \spad{e} will most likely produce - ++ an error. This includes those points which evaluate to 0/0. - singularitiesOf: (Vector EDF,List Symbol,SOCDF) -> SDF - ++ singularitiesOf(v,vars,range) returns a list of points - ++ (\axiomType{Doublefloat}) at which a NAG fortran - ++ version of \spad{v} will most likely produce - ++ an error. This includes those points which evaluate to 0/0. - polynomialZeros:(PFI,Symbol,SOCDF) -> LDF - ++ polynomialZeros(fn,var,range) calculates the real zeros of the - ++ polynomial which are contained in the given interval. It returns - ++ a list of points (\axiomType{Doublefloat}) for which the univariate - ++ polynomial \spad{fn} is zero. - df2st:DF -> String - ++ df2st(n) coerces a \axiomType{DoubleFloat} to \axiomType{String} - ldf2lst:LDF -> List String - ++ ldf2lst(ln) coerces a List of \axiomType{DoubleFloat} to - ++ \axiomType{List}(\axiomType{String}) - sdf2lst:SDF -> List String - ++ sdf2lst(ln) coerces a Stream of \axiomType{DoubleFloat} to - ++ \axiomType{List}(\axiomType{String}) - - I ==> ExpertSystemToolsPackage add - - import ExpertSystemToolsPackage - - functionIsPolynomial?(args:NIA):Boolean == - -- tests whether the function can be retracted to a polynomial - (retractIfCan(args.fn)@Union(PDF,"failed"))$EDF case PDF - - isPolynomial?(f:EDF):Boolean == - -- tests whether the function can be retracted to a polynomial - (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF - - isConstant?(f:EDF):Boolean == - -- tests whether the function can be retracted to a constant (DoubleFloat) - (retractIfCan(f)@Union(DF,"failed"))$EDF case DF - - denominatorIsPolynomial?(args:NIA):Boolean == - -- tests if the denominator can be retracted to polynomial - a:= copy args - a.fn:=denominator(args.fn) - (functionIsPolynomial?(a))@Boolean - - denIsPolynomial?(f:EDF):Boolean == - -- tests if the denominator can be retracted to polynomial - (isPolynomial?(denominator f))@Boolean - - listInRange(l:LDF,range:SOCDF):LDF == - -- returns a list with only those elements internal to the range range - [t for t in l | in?(t,range)] - - loseUntil(l:SDF,a:DF):SDF == - empty?(l)$SDF => l - f := first(l)$SDF - (abs(f) <= abs(a)) => loseUntil(rest(l)$SDF,a) - l - - retainUntil(l:SDF,a:DF,b:DF,flag:Boolean):SDF == - empty?(l)$SDF => l - f := first(l)$SDF - (in?(f)$ExpertSystemContinuityPackage1(a,b)) => - concat(f,retainUntil(rest(l),a,b,false)) - flag => empty()$SDF - retainUntil(rest(l),a,b,true) - - streamInRange(l:SDF,range:SOCDF):SDF == - -- returns a stream with only those elements internal to the range range - a := getlo(range := dfRange(range)) - b := gethi(range) - explicitlyFinite?(l) => - select(in?$ExpertSystemContinuityPackage1(a,b),l)$SDF - negative?(a*b) => retainUntil(l,a,b,false) - negative?(a) => - l := loseUntil(l,b) - retainUntil(l,a,b,false) - l := loseUntil(l,a) - retainUntil(l,a,b,false) - - getStream(n:Symbol,s:String):SDF == - import RS - entry?(n,bfKeys()$BasicFunctions)$(List(Symbol)) => - c := bfEntry(n)$BasicFunctions - (s = "zeros")@Boolean => c.zeros - (s = "singularities")@Boolean => c.singularities - (s = "ones")@Boolean => c.ones - empty()$SDF - - polynomialZeros(fn:PFI,var:Symbol,range:SOCDF):LDF == - up := unmakeSUP(univariate(fn)$PFI)$UP(var,FI) - range := dfRange(range) - r:Record(left:FI,right:FI) := [df2fi(getlo(range)), df2fi(gethi(range))] - ans:List(Record(left:FI,right:FI)) := - realZeros(up,r,1/1000000000000000000)$RealZeroPackageQ(UP(var,FI)) - listInRange(dflist(ans),range) - - functionIsFracPolynomial?(args:NIA):Boolean == - -- tests whether the function can be retracted to a fraction - -- where both numerator and denominator are polynomial - (retractIfCan(args.fn)@Union(FPDF,"failed"))$EDF case FPDF - - problemPoints(f:EDF,var:Symbol,range:SOCDF):LDF == - (denIsPolynomial?(f))@Boolean => - c := retract(edf2efi(denominator(f)))@PFI - polynomialZeros(c,var,range) - empty()$LDF - - zerosOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == - (u := isQuotient(e)) case EDF => - singularitiesOf(u,vars,range) - k := kernels(e)$EDF - ((nk := # k) = 0)@Boolean => empty()$SDF -- constant found. - (nk = 1)@Boolean => -- single expression found. - ker := first(k)$LKEDF - n := name(operator(ker)$KEDF)$BO - entry?(n,vars) => -- polynomial found. - c := retract(edf2efi(e))@PFI - coerce(polynomialZeros(c,n,range))$SDF - a := first(argument(ker)$KEDF)$LEDF - (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) => - var:Symbol := first(variables(a)) - c:EDF := w.2 - c1:EDF := w.1 --- entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) => - entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) => - c2:DF := edf2df c - c3 := c2 :: OCDF - varEdf := var :: EDF - varEqn := equation(varEdf,c1-c)$EEDF - range2 := (lo(range)+c3)..(hi(range)+c3) - s := zerosOf(subst(e,varEqn)$EDF,vars,range2) - st := map(#1-c2,s)$StreamFunctions2(DF,DF) - streamInRange(st,range) - zerosOf(a,vars,range) - (t := isPlus(e)$EDF) case LEDF => -- constant + expression - # t > 2 => empty()$SDF - entry?(a,[b::EDF for b in vars]) => -- finds entries like sqrt(x) - st := getStream(n,"ones") - o := edf2df(second(t)$LEDF) --- one?(o) or one?(-o) => -- is it like (f(x) -/+ 1) - (o = 1) or (-o = 1) => -- is it like (f(x) -/+ 1) - st := map(-#1/o,st)$StreamFunctions2(DF,DF) - streamInRange(st,range) - empty()$SDF - empty()$SDF - entry?(a,[b::EDF for b in vars]) => -- finds entries like sqrt(x) - st := getStream(n,"zeros") - streamInRange(st,range) - (n = tan :: Symbol)@Boolean => - concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) - (n = sin :: Symbol)@Boolean => - concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) - empty()$SDF - (t := isPlus(e)$EDF) case LEDF => empty()$SDF -- INCOMPLETE!!! - (v := isTimes(e)$EDF) case LEDF => - concat([zerosOf(u,vars,range) for u in v]) - empty()$SDF - - singularitiesOf(e:EDF,vars:List Symbol,range:SOCDF):SDF == - (u := isQuotient(e)) case EDF => - zerosOf(u,vars,range) - (t := isPlus e) case LEDF => - concat([singularitiesOf(u,vars,range) for u in t]) - (v := isTimes e) case LEDF => - concat([singularitiesOf(u,vars,range) for u in v]) - (k := mainKernel e) case KEDF => - n := name(operator k) - entry?(n,vars) => coerce(problemPoints(e,n,range))$SDF - a:EDF := (argument k).1 - (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) => - var:Symbol := first(variables(a)) - c:EDF := w.2 - c1:EDF := w.1 --- entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) => - entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) => - c2:DF := edf2df c - c3 := c2 :: OCDF - varEdf := var :: EDF - varEqn := equation(varEdf,c1-c)$EEDF - range2 := (lo(range)+c3)..(hi(range)+c3) - s := singularitiesOf(subst(e,varEqn)$EDF,vars,range2) - st := map(#1-c2,s)$StreamFunctions2(DF,DF) - streamInRange(st,range) - singularitiesOf(a,vars,range) - entry?(a,[b::EDF for b in vars]) => - st := getStream(n,"singularities") - streamInRange(st,range) - (n = log :: Symbol)@Boolean => - concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)]) - singularitiesOf(a,vars,range) - empty()$SDF - - singularitiesOf(v:VEDF,vars:List Symbol,range:SOCDF):SDF == - ls := [singularitiesOf(u,vars,range) for u in entries(v)$VEDF] - concat(ls)$SDF - -@ -\section{package ESCONT1 ExpertSystemContinuityPackage1} -<>= -)abbrev package ESCONT1 ExpertSystemContinuityPackage1 -++ Author: Brian Dupee -++ Date Created: May 1994 -++ Date Last Updated: June 1995 -++ Basic Operations: problemPoints, singularitiesOf, zerosOf -++ Related Constructors: -++ Description: -++ ExpertSystemContinuityPackage1 exports a function to check range inclusion - -ExpertSystemContinuityPackage1(A:DF,B:DF): E == I where - EF2 ==> ExpressionFunctions2 - FI ==> Fraction Integer - EFI ==> Expression Fraction Integer - PFI ==> Polynomial Fraction Integer - DF ==> DoubleFloat - LDF ==> List DoubleFloat - EDF ==> Expression DoubleFloat - VEDF ==> Vector Expression DoubleFloat - SDF ==> Stream DoubleFloat - SS ==> Stream String - EEDF ==> Equation Expression DoubleFloat - LEDF ==> List Expression DoubleFloat - KEDF ==> Kernel Expression DoubleFloat - LKEDF ==> List Kernel Expression DoubleFloat - PDF ==> Polynomial DoubleFloat - FPDF ==> Fraction Polynomial DoubleFloat - OCDF ==> OrderedCompletion DoubleFloat - SOCDF ==> Segment OrderedCompletion DoubleFloat - NIA ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF) - UP ==> UnivariatePolynomial - BO ==> BasicOperator - RS ==> Record(zeros: SDF,ones: SDF,singularities: SDF) - - E ==> with - - in?:DF -> Boolean - ++ in?(p) tests whether point p is internal to the range [\spad{A..B}] - - I ==> add - - in?(p:DF):Boolean == - a:Boolean := (p < B)$DF - b:Boolean := (A < p)$DF - (a and b)@Boolean - -@ -\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/contfrac.spad.pamphlet b/src/algebra/contfrac.spad.pamphlet deleted file mode 100644 index f39c28a..0000000 --- a/src/algebra/contfrac.spad.pamphlet +++ /dev/null @@ -1,100 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra contfrac.spad} -\author{Stephen M. Watt, Clifton J. Williamson, Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package NCNTFRAC NumericContinuedFraction} -<>= -"NCNTFRAC" -> "PACKAGE" -"NumericContinuedFraction(a:FloatingPointSystem)" -> "Package" -@ -<>= -)abbrev package NCNTFRAC NumericContinuedFraction -++ Author: Clifton J. Williamson -++ Date Created: 12 April 1990 -++ Change History: -++ Basic Operations: continuedFraction -++ Related Constructors: ContinuedFraction, Float -++ Also See: Fraction -++ AMS Classifications: 11J70 11A55 11K50 11Y65 30B70 40A15 -++ Keywords: continued fraction -++ References: -++ Description: \spadtype{NumericContinuedFraction} provides functions -++ for converting floating point numbers to continued fractions. - -NumericContinuedFraction(F): Exports == Implementation where - F : FloatingPointSystem - CFC ==> ContinuedFraction Integer - I ==> Integer - ST ==> Stream I - - Exports ==> with - continuedFraction: F -> CFC - ++ continuedFraction(f) converts the floating point number - ++ \spad{f} to a reduced continued fraction. - - Implementation ==> add - - cfc: F -> ST - cfc(a) == delay - aa := wholePart a - zero?(b := a - (aa :: F)) => concat(aa,empty()$ST) - concat(aa,cfc inv b) - - continuedFraction a == - aa := wholePart a - zero?(b := a - (aa :: F)) => - reducedContinuedFraction(aa,empty()$ST) - if negative? b then (aa := aa - 1; b := b + 1) - reducedContinuedFraction(aa,cfc inv b) - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/coordsys.spad.pamphlet b/src/algebra/coordsys.spad.pamphlet deleted file mode 100644 index 1dc9196..0000000 --- a/src/algebra/coordsys.spad.pamphlet +++ /dev/null @@ -1,240 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra coordsys.spad} -\author{Jim Wen, Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package COORDSYS CoordinateSystems} -<>= -)abbrev package COORDSYS CoordinateSystems -++ Author: Jim Wen -++ Date Created: 12 March 1990 -++ Date Last Updated: 19 June 1990, Clifton J. Williamson -++ Basic Operations: cartesian, polar, cylindrical, spherical, parabolic, elliptic, -++ parabolicCylindrical, paraboloidal, ellipticCylindrical, prolateSpheroidal, -++ oblateSpheroidal, bipolar, bipolarCylindrical, toroidal, conical -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: CoordinateSystems provides coordinate transformation functions -++ for plotting. Functions in this package return conversion functions -++ which take points expressed in other coordinate systems and return points -++ with the corresponding Cartesian coordinates. - -CoordinateSystems(R): Exports == Implementation where - - R : Join(Field,TranscendentalFunctionCategory,RadicalCategory) - Pt ==> Point R - - Exports ==> with - cartesian : Pt -> Pt - ++ cartesian(pt) returns the Cartesian coordinates of point pt. - polar: Pt -> Pt - ++ polar(pt) transforms pt from polar coordinates to Cartesian - ++ coordinates: the function produced will map the point \spad{(r,theta)} - ++ to \spad{x = r * cos(theta)} , \spad{y = r * sin(theta)}. - cylindrical: Pt -> Pt - ++ cylindrical(pt) transforms pt from polar coordinates to Cartesian - ++ coordinates: the function produced will map the point \spad{(r,theta,z)} - ++ to \spad{x = r * cos(theta)}, \spad{y = r * sin(theta)}, \spad{z}. - spherical: Pt -> Pt - ++ spherical(pt) transforms pt from spherical coordinates to Cartesian - ++ coordinates: the function produced will map the point \spad{(r,theta,phi)} - ++ to \spad{x = r*sin(phi)*cos(theta)}, \spad{y = r*sin(phi)*sin(theta)}, - ++ \spad{z = r*cos(phi)}. - parabolic: Pt -> Pt - ++ parabolic(pt) transforms pt from parabolic coordinates to Cartesian - ++ coordinates: the function produced will map the point \spad{(u,v)} to - ++ \spad{x = 1/2*(u**2 - v**2)}, \spad{y = u*v}. - parabolicCylindrical: Pt -> Pt - ++ parabolicCylindrical(pt) transforms pt from parabolic cylindrical - ++ coordinates to Cartesian coordinates: the function produced will - ++ map the point \spad{(u,v,z)} to \spad{x = 1/2*(u**2 - v**2)}, - ++ \spad{y = u*v}, \spad{z}. - paraboloidal: Pt -> Pt - ++ paraboloidal(pt) transforms pt from paraboloidal coordinates to - ++ Cartesian coordinates: the function produced will map the point - ++ \spad{(u,v,phi)} to \spad{x = u*v*cos(phi)}, \spad{y = u*v*sin(phi)}, - ++ \spad{z = 1/2 * (u**2 - v**2)}. - elliptic: R -> (Pt -> Pt) - ++ elliptic(a) transforms from elliptic coordinates to Cartesian - ++ coordinates: \spad{elliptic(a)} is a function which will map the - ++ point \spad{(u,v)} to \spad{x = a*cosh(u)*cos(v)}, \spad{y = a*sinh(u)*sin(v)}. - ellipticCylindrical: R -> (Pt -> Pt) - ++ ellipticCylindrical(a) transforms from elliptic cylindrical coordinates - ++ to Cartesian coordinates: \spad{ellipticCylindrical(a)} is a function - ++ which will map the point \spad{(u,v,z)} to \spad{x = a*cosh(u)*cos(v)}, - ++ \spad{y = a*sinh(u)*sin(v)}, \spad{z}. - prolateSpheroidal: R -> (Pt -> Pt) - ++ prolateSpheroidal(a) transforms from prolate spheroidal coordinates to - ++ Cartesian coordinates: \spad{prolateSpheroidal(a)} is a function - ++ which will map the point \spad{(xi,eta,phi)} to - ++ \spad{x = a*sinh(xi)*sin(eta)*cos(phi)}, \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, - ++ \spad{z = a*cosh(xi)*cos(eta)}. - oblateSpheroidal: R -> (Pt -> Pt) - ++ oblateSpheroidal(a) transforms from oblate spheroidal coordinates to - ++ Cartesian coordinates: \spad{oblateSpheroidal(a)} is a function which - ++ will map the point \spad{(xi,eta,phi)} to \spad{x = a*sinh(xi)*sin(eta)*cos(phi)}, - ++ \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, \spad{z = a*cosh(xi)*cos(eta)}. - bipolar: R -> (Pt -> Pt) - ++ bipolar(a) transforms from bipolar coordinates to Cartesian coordinates: - ++ \spad{bipolar(a)} is a function which will map the point \spad{(u,v)} to - ++ \spad{x = a*sinh(v)/(cosh(v)-cos(u))}, \spad{y = a*sin(u)/(cosh(v)-cos(u))}. - bipolarCylindrical: R -> (Pt -> Pt) - ++ bipolarCylindrical(a) transforms from bipolar cylindrical coordinates - ++ to Cartesian coordinates: \spad{bipolarCylindrical(a)} is a function which - ++ will map the point \spad{(u,v,z)} to \spad{x = a*sinh(v)/(cosh(v)-cos(u))}, - ++ \spad{y = a*sin(u)/(cosh(v)-cos(u))}, \spad{z}. - toroidal: R -> (Pt -> Pt) - ++ toroidal(a) transforms from toroidal coordinates to Cartesian - ++ coordinates: \spad{toroidal(a)} is a function which will map the point - ++ \spad{(u,v,phi)} to \spad{x = a*sinh(v)*cos(phi)/(cosh(v)-cos(u))}, - ++ \spad{y = a*sinh(v)*sin(phi)/(cosh(v)-cos(u))}, \spad{z = a*sin(u)/(cosh(v)-cos(u))}. - conical: (R,R) -> (Pt -> Pt) - ++ conical(a,b) transforms from conical coordinates to Cartesian coordinates: - ++ \spad{conical(a,b)} is a function which will map the point \spad{(lambda,mu,nu)} to - ++ \spad{x = lambda*mu*nu/(a*b)}, - ++ \spad{y = lambda/a*sqrt((mu**2-a**2)*(nu**2-a**2)/(a**2-b**2))}, - ++ \spad{z = lambda/b*sqrt((mu**2-b**2)*(nu**2-b**2)/(b**2-a**2))}. - - Implementation ==> add - - cartesian pt == - -- we just want to interpret the cartesian coordinates - -- from the first N elements of the point - so the - -- identity function will do - pt - - polar pt0 == - pt := copy pt0 - r := elt(pt0,1); theta := elt(pt0,2) - pt.1 := r * cos(theta); pt.2 := r * sin(theta) - pt - - cylindrical pt0 == polar pt0 - -- apply polar transformation to first 2 coordinates - - spherical pt0 == - pt := copy pt0 - r := elt(pt0,1); theta := elt(pt0,2); phi := elt(pt0,3) - pt.1 := r * sin(phi) * cos(theta); pt.2 := r * sin(phi) * sin(theta) - pt.3 := r * cos(phi) - pt - - parabolic pt0 == - pt := copy pt0 - u := elt(pt0,1); v := elt(pt0,2) - pt.1 := (u*u - v*v)/(2::R) ; pt.2 := u*v - pt - - parabolicCylindrical pt0 == parabolic pt0 - -- apply parabolic transformation to first 2 coordinates - - paraboloidal pt0 == - pt := copy pt0 - u := elt(pt0,1); v := elt(pt0,2); phi := elt(pt0,3) - pt.1 := u*v*cos(phi); pt.2 := u*v*sin(phi); pt.3 := (u*u - v*v)/(2::R) - pt - - elliptic a == - pt := copy(#1) - u := elt(#1,1); v := elt(#1,2) - pt.1 := a*cosh(u)*cos(v); pt.2 := a*sinh(u)*sin(v) - pt - - ellipticCylindrical a == elliptic a - -- apply elliptic transformation to first 2 coordinates - - prolateSpheroidal a == - pt := copy(#1) - xi := elt(#1,1); eta := elt(#1,2); phi := elt(#1,3) - pt.1 := a*sinh(xi)*sin(eta)*cos(phi) - pt.2 := a*sinh(xi)*sin(eta)*sin(phi) - pt.3 := a*cosh(xi)*cos(eta) - pt - - oblateSpheroidal a == - pt := copy(#1) - xi := elt(#1,1); eta := elt(#1,2); phi := elt(#1,3) - pt.1 := a*sinh(xi)*sin(eta)*cos(phi) - pt.2 := a*cosh(xi)*cos(eta)*sin(phi) - pt.3 := a*sinh(xi)*sin(eta) - pt - - bipolar a == - pt := copy(#1) - u := elt(#1,1); v := elt(#1,2) - pt.1 := a*sinh(v)/(cosh(v)-cos(u)) - pt.2 := a*sin(u)/(cosh(v)-cos(u)) - pt - - bipolarCylindrical a == bipolar a - -- apply bipolar transformation to first 2 coordinates - - toroidal a == - pt := copy(#1) - u := elt(#1,1); v := elt(#1,2); phi := elt(#1,3) - pt.1 := a*sinh(v)*cos(phi)/(cosh(v)-cos(u)) - pt.2 := a*sinh(v)*sin(phi)/(cosh(v)-cos(u)) - pt.3 := a*sin(u)/(cosh(v)-cos(u)) - pt - - conical(a,b) == - pt := copy(#1) - lambda := elt(#1,1); mu := elt(#1,2); nu := elt(#1,3) - pt.1 := lambda*mu*nu/(a*b) - pt.2 := lambda/a*sqrt((mu**2-a**2)*(nu**2-a**2)/(a**2-b**2)) - pt.3 := lambda/b*sqrt((mu**2-b**2)*(nu**2-b**2)/(b**2-a**2)) - pt - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/cra.spad.pamphlet b/src/algebra/cra.spad.pamphlet deleted file mode 100644 index 640170d..0000000 --- a/src/algebra/cra.spad.pamphlet +++ /dev/null @@ -1,131 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra cra.spad} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package CRAPACK CRApackage} -<>= -)abbrev package CRAPACK CRApackage - -++ This package \undocumented{} -CRApackage(R:EuclideanDomain): Exports == Implementation where - Exports == with - modTree: (R,List R) -> List R - ++ modTree(r,l) \undocumented{} - chineseRemainder: (List R, List R) -> R - ++ chineseRemainder(lv,lm) returns a value \axiom{v} such that, if - ++ x is \axiom{lv.i} modulo \axiom{lm.i} for all \axiom{i}, then - ++ x is \axiom{v} modulo \axiom{lm(1)*lm(2)*...*lm(n)}. - chineseRemainder: (List List R, List R) -> List R - ++ chineseRemainder(llv,lm) returns a list of values, each of which - ++ corresponds to the Chinese remainder of the associated element of - ++ \axiom{llv} and axiom{lm}. This is more efficient than applying - ++ chineseRemainder several times. - multiEuclideanTree: (List R, R) -> List R - ++ multiEuclideanTree(l,r) \undocumented{} - Implementation == add - - BB:=BalancedBinaryTree(R) - x:BB - - -- Definition for modular reduction mapping with several moduli - modTree(a,lm) == - t := balancedBinaryTree(#lm, 0$R) - setleaves_!(t,lm) - mapUp_!(t,"*") - leaves mapDown_!(t, a, "rem") - - chineseRemainder(lv:List(R), lm:List(R)):R == - #lm ^= #lv => error "lists of moduli and values not of same length" - x := balancedBinaryTree(#lm, 0$R) - x := setleaves_!(x, lm) - mapUp_!(x,"*") - y := balancedBinaryTree(#lm, 1$R) - y := mapUp_!(copy y,x,#1 * #4 + #2 * #3) - (u := extendedEuclidean(value y, value x,1)) case "failed" => - error "moduli not relatively prime" - inv := u . coef1 - linv := modTree(inv, lm) - l := [(u*v) rem m for v in lv for u in linv for m in lm] - y := setleaves_!(y,l) - value(mapUp_!(y, x, #1 * #4 + #2 * #3)) rem value(x) - - chineseRemainder(llv:List List(R), lm:List(R)):List(R) == - x := balancedBinaryTree(#lm, 0$R) - x := setleaves_!(x, lm) - mapUp_!(x,"*") - y := balancedBinaryTree(#lm, 1$R) - y := mapUp_!(copy y,x,#1 * #4 + #2 * #3) - (u := extendedEuclidean(value y, value x,1)) case "failed" => - error "moduli not relatively prime" - inv := u . coef1 - linv := modTree(inv, lm) - retVal:List(R) := [] - for lv in llv repeat - l := [(u3*v) rem m for v in lv for u3 in linv for m in lm] - y := setleaves!(y,l) - retVal := cons(value(mapUp!(y, x, #1*#4+#2*#3)) rem value(x),retVal) - reverse retVal - - extEuclidean: (R, R, R) -> List R - extEuclidean(a, b, c) == - u := extendedEuclidean(a, b, c) - u case "failed" => error [c, " not spanned by ", a, " and ",b] - [u.coef2, u.coef1] - - multiEuclideanTree(fl, rhs) == - x := balancedBinaryTree(#fl, rhs) - x := setleaves_!(x, fl) - mapUp_!(x,"*") - leaves mapDown_!(x, rhs, extEuclidean) - -@ -\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/crfp.spad.pamphlet b/src/algebra/crfp.spad.pamphlet deleted file mode 100644 index d3bb5b8..0000000 --- a/src/algebra/crfp.spad.pamphlet +++ /dev/null @@ -1,643 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra crfp.spad} -\author{Johannes Grabmeier} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package CRFP ComplexRootFindingPackage} -<>= -)abbrev package CRFP ComplexRootFindingPackage -++ Author: J. Grabmeier -++ Date Created: 31 January 1991 -++ Date Last Updated: 12 April 1991 -++ Basic Operations: factor, pleskenSplit -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: complex zeros, roots -++ References: J. Grabmeier: On Plesken's root finding algorithm, -++ in preparation -++ A. Schoenhage: The fundamental theorem of algebra in terms of computational -++ complexity, preliminary report, Univ. Tuebingen, 1982 -++ Description: -++ \spadtype{ComplexRootFindingPackage} provides functions to -++ find all roots of a polynomial p over the complex number by -++ using Plesken's idea to calculate in the polynomial ring -++ modulo f and employing the Chinese Remainder Theorem. -++ In this first version, the precision (see \spadfunFrom{digits}{Float}) -++ is not increased when this is necessary to -++ avoid rounding errors. Hence it is the user's responsibility to -++ increase the precision if necessary. -++ Note also, if this package is called with e.g. \spadtype{Fraction Integer}, -++ the precise calculations could require a lot of time. -++ Also note that evaluating the zeros is not necessarily a good check -++ whether the result is correct: already evaluation can cause -++ rounding errors. -ComplexRootFindingPackage(R, UP): public == private where - -- R : Join(Field, OrderedRing, CharacteristicZero) - -- Float not in CharacteristicZero !| - R : Join(Field, OrderedRing) - UP : UnivariatePolynomialCategory Complex R - - C ==> Complex R - FR ==> Factored - I ==> Integer - L ==> List - FAE ==> Record(factors : L UP, error : R) - NNI ==> NonNegativeInteger - OF ==> OutputForm - ICF ==> IntegerCombinatoricFunctions(I) - - public ==> with - complexZeros : UP -> L C - ++ complexZeros(p) tries to determine all complex zeros - ++ of the polynomial p with accuracy given by the package - ++ constant {\em globalEps} which you may change by - ++ {\em setErrorBound}. - complexZeros : (UP, R) -> L C - ++ complexZeros(p, eps) tries to determine all complex zeros - ++ of the polynomial p with accuracy given by {\em eps}. - divisorCascade : (UP,UP, Boolean) -> L FAE - ++ divisorCascade(p,tp) assumes that degree of polynomial {\em tp} - ++ is smaller than degree of polynomial p, both monic. - ++ A sequence of divisions are calculated - ++ using the remainder, made monic, as divisor - ++ for the the next division. The result contains also the error of the - ++ factorizations, i.e. the norm of the remainder polynomial. - ++ If {\em info} is {\em true}, then information messages are issued. - divisorCascade : (UP,UP) -> L FAE - ++ divisorCascade(p,tp) assumes that degree of polynomial {\em tp} - ++ is smaller than degree of polynomial p, both monic. - ++ A sequence of divisions is calculated - ++ using the remainder, made monic, as divisor - ++ for the the next division. The result contains also the error of the - ++ factorizations, i.e. the norm of the remainder polynomial. - factor: (UP,R,Boolean) -> FR UP - ++ factor(p, eps, info) tries to factor p into linear factors - ++ with error atmost {\em eps}. An overall error bound - ++ {\em eps0} is determined and iterated tree-like calls - ++ to {\em pleskenSplit} are used to get the factorization. - ++ If {\em info} is {\em true}, then information messages are given. - factor: (UP,R) -> FR UP - ++ factor(p, eps) tries to factor p into linear factors - ++ with error atmost {\em eps}. An overall error bound - ++ {\em eps0} is determined and iterated tree-like calls - ++ to {\em pleskenSplit} are used to get the factorization. - factor: UP -> FR UP - ++ factor(p) tries to factor p into linear factors - ++ with error atmost {\em globalEps}, the internal error bound, - ++ which can be set by {\em setErrorBound}. An overall error bound - ++ {\em eps0} is determined and iterated tree-like calls - ++ to {\em pleskenSplit} are used to get the factorization. - graeffe : UP -> UP - ++ graeffe p determines q such that \spad{q(-z**2) = p(z)*p(-z)}. - ++ Note that the roots of q are the squares of the roots of p. - norm : UP -> R - ++ norm(p) determines sum of absolute values of coefficients - ++ Note: this function depends on \spadfunFrom{abs}{Complex}. - pleskenSplit: (UP, R, Boolean) -> FR UP - ++ pleskenSplit(poly,eps,info) determines a start polynomial {\em start} - ++ by using "startPolynomial then it increases the exponent - ++ n of {\em start ** n mod poly} to get an approximate factor of - ++ {\em poly}, in general of degree "degree poly -1". Then a divisor - ++ cascade is calculated and the best splitting is chosen, as soon - ++ as the error is small enough. - --++ In a later version we plan - --++ to use the whole information to get a split into more than 2 - --++ factors. - ++ If {\em info} is {\em true}, then information messages are issued. - pleskenSplit: (UP, R) -> FR UP - ++ pleskenSplit(poly, eps) determines a start polynomial {\em start}\ - ++ by using "startPolynomial then it increases the exponent - ++ n of {\em start ** n mod poly} to get an approximate factor of - ++ {\em poly}, in general of degree "degree poly -1". Then a divisor - ++ cascade is calculated and the best splitting is chosen, as soon - ++ as the error is small enough. - --++ In a later version we plan - --++ to use the whole information to get a split into more than 2 - --++ factors. - reciprocalPolynomial: UP -> UP - ++ reciprocalPolynomial(p) calulates a polynomial which has exactly - ++ the inverses of the non-zero roots of p as roots, and the same - ++ number of 0-roots. - rootRadius: (UP,R) -> R - ++ rootRadius(p,errQuot) calculates the root radius of p with a - ++ maximal error quotient of {\em errQuot}. - rootRadius: UP -> R - ++ rootRadius(p) calculates the root radius of p with a - ++ maximal error quotient of {\em 1+globalEps}, where - ++ {\em globalEps} is the internal error bound, which can be - ++ set by {\em setErrorBound}. - schwerpunkt: UP -> C - ++ schwerpunkt(p) determines the 'Schwerpunkt' of the roots of the - ++ polynomial p of degree n, i.e. the center of gravity, which is - ++ {\em coeffient of \spad{x**(n-1)}} divided by - ++ {\em n times coefficient of \spad{x**n}}. - setErrorBound : R -> R - ++ setErrorBound(eps) changes the internal error bound, - -- by default being {\em 10 ** (-20)} to eps, if R is - ++ by default being {\em 10 ** (-3)} to eps, if R is - ++ a member in the category \spadtype{QuotientFieldCategory Integer}. - ++ The internal {\em globalDigits} is set to - -- {\em ceiling(1/r)**2*10} being {\em 10**41} by default. - ++ {\em ceiling(1/r)**2*10} being {\em 10**7} by default. - startPolynomial: UP -> Record(start: UP, factors: FR UP) - ++ startPolynomial(p) uses the ideas of Schoenhage's - ++ variant of Graeffe's method to construct circles which separate - ++ roots to get a good start polynomial, i.e. one whose - ++ image under the Chinese Remainder Isomorphism has both entries - ++ of norm smaller and greater or equal to 1. In case the - ++ roots are found during internal calculations. - ++ The corresponding factors - ++ are in {\em factors} which are otherwise 1. - - private ==> add - - - Rep := ModMonic(C, UP) - - -- constants - c : C - r : R - --globalDigits : I := 10 ** 41 - globalDigits : I := 10 ** 7 - globalEps : R := - --a : R := (1000000000000000000000 :: I) :: R - a : R := (1000 :: I) :: R - 1/a - emptyLine : OF := " " - dashes : OF := center "---------------------------------------------------" - dots : OF := center "..................................................." - one : R := 1$R - two : R := 2 * one - ten : R := 10 * one - eleven : R := 11 * one - weakEps := eleven/ten - --invLog2 : R := 1/log10 (2*one) - - -- signatures of local functions - - absC : C -> R - -- - absR : R -> R - -- - calculateScale : UP -> R - -- - makeMonic : UP -> UP - -- 'makeMonic p' divides 'p' by the leading coefficient, - -- to guarantee new leading coefficient to be 1$R we cannot - -- simply divide the leading monomial by the leading coefficient - -- because of possible rounding errors - min: (FAE, FAE) -> FAE - -- takes factorization with smaller error - nthRoot : (R, NNI) -> R - -- nthRoot(r,n) determines an approximation to the n-th - -- root of r, if \spadtype{R} has {\em ?**?: (R,Fraction Integer)->R} - -- we use this, otherwise we use {\em approxNthRoot} via - -- \spadtype{Integer} - shift: (UP,C) -> UP - -- shift(p,c) changes p(x) into p(x+c), thereby modifying the - -- roots u_j of p to the roots (u_j - c) of shift(p,c) - scale: (UP,C) -> UP - -- scale(p,c) changes p(x) into p(cx), thereby modifying the - -- roots u_j of p to the roots ((1/c) u_j) of scale(p,c) - - - -- implementation of exported functions - - - complexZeros(p,eps) == - --r1 : R := rootRadius(p,weakEps) - --eps0 : R = r1 * nthRoot(eps, degree p) - -- right now we are content with - eps0 : R := eps/(ten ** degree p) - facs : FR UP := factor(p,eps0) - [-coefficient(linfac.factor,0) for linfac in factors facs] - - complexZeros p == complexZeros(p,globalEps) - setErrorBound r == - r <= 0 => error "setErrorBound: need error bound greater 0" - globalEps := r - if R has QuotientFieldCategory Integer then - rd : Integer := ceiling(1/r) - globalDigits := rd * rd * 10 - lof : List OF := _ - ["setErrorBound: internal digits set to",globalDigits::OF] - print hconcat lof - messagePrint "setErrorBound: internal error bound set to" - globalEps - - pleskenSplit(poly,eps,info) == - p := makeMonic poly - fp : FR UP - if not zero? (md := minimumDegree p) then - fp : FR UP := irreducibleFactor(monomial(1,1)$UP,md)$(FR UP) - p := p quo monomial(1,md)$UP - sP : Record(start: UP, factors: FR UP) := startPolynomial p - fp : FR UP := sP.factors --- if not one? fp then - if not (fp = 1) then - qr: Record(quotient: UP, remainder: UP):= divide(p,makeMonic expand fp) - p := qr.quotient - st := sP.start - zero? degree st => fp - -- we calculate in ModMonic(C, UP), - -- next line defines the polynomial, which is used for reducing - setPoly p - nm : R := eps - split : FAE - sR : Rep := st :: Rep - psR : Rep := sR ** (degree poly) - - notFoundSplit : Boolean := true - while notFoundSplit repeat - -- if info then - -- lof : L OF := ["not successfull, new exponent:", nn::OF] - -- print hconcat lof - psR := psR * psR * sR -- exponent (2*d +1) - -- be careful, too large exponent results in rounding errors - -- tp is the first approximation of a divisor of poly: - tp : UP := lift psR - zero? degree tp => - if info then print "we leave as we got constant factor" - nilFactor(poly,1)$(FR UP) - -- this was the case where we don't find a non-trivial factorization - -- we refine tp by repeated polynomial division and hope that - -- the norm of the remainder gets small from time to time - splits : L FAE := divisorCascade(p, makeMonic tp, info) - split := reduce(min,splits) - notFoundSplit := (eps <= split.error) - - for fac in split.factors repeat - fp := --- one? degree fac => fp * nilFactor(fac,1)$(FR UP) - (degree fac = 1) => fp * nilFactor(fac,1)$(FR UP) - fp * irreducibleFactor(fac,1)$(FR UP) - fp - - startPolynomial p == -- assume minimumDegree is 0 - --print (p :: OF) - fp : FR UP := 1 --- one? degree p => - (degree p = 1) => - p := makeMonic p - [p,irreducibleFactor(p,1)] - startPoly : UP := monomial(1,1)$UP - eps : R := weakEps -- 10 per cent errors allowed - r1 : R := rootRadius(p, eps) - rd : R := 1/rootRadius(reciprocalPolynomial p, eps) - (r1 > (2::R)) and (rd < 1/(2::R)) => [startPoly,fp] -- unit circle splitting! - -- otherwise the norms of the roots are too closed so we - -- take the center of gravity as new origin: - u : C := schwerpunkt p - startPoly := startPoly-monomial(u,0) - p := shift(p,-u) - -- determine new rootRadius: - r1 : R := rootRadius(p, eps) - startPoly := startPoly/(r1::C) - -- use one of the 4 points r1*zeta, where zeta is a 4th root of unity - -- as new origin, this could be changed to an arbitrary list - -- of elements of norm 1. - listOfCenters : L C := [complex(r1,0), complex(0,r1), _ - complex(-r1,0), complex(0,-r1)] - lp : L UP := [shift(p,v) for v in listOfCenters] - -- next we check if one of these centers is a root - centerIsRoot : Boolean := false - for i in 1..maxIndex lp repeat - if (mD := minimumDegree lp.i) > 0 then - pp : UP := monomial(1,1)-monomial(listOfCenters.i-u,0) - centerIsRoot := true - fp := fp * irreducibleFactor(pp,mD) - centerIsRoot => - p := shift(p,u) quo expand fp - --print (p::OF) - zero? degree p => [p,fp] - sP:= startPolynomial(p) - [sP.start,fp] - -- choose the best one w.r.t. maximal quotient of norm of largest - -- root and norm of smallest root - lpr1 : L R := [rootRadius(q,eps) for q in lp] - lprd : L R := [1/rootRadius(reciprocalPolynomial q,eps) for q in lp] - -- later we should check here of an rd is smaller than globalEps - lq : L R := [] - for i in 1..maxIndex lpr1 repeat - lq := cons(lpr1.i/lprd.i, lq) - --lq : L R := [(l/s)::R for l in lpr1 for s in lprd]) - lq := reverse lq - po := position(reduce(max,lq),lq) - --p := lp.po - --lrr : L R := [rootRadius(p,i,1+eps) for i in 2..(degree(p)-1)] - --lrr := concat(concat(lpr1.po,lrr),lprd.po) - --lu : L R := [(lrr.i + lrr.(i+1))/2 for i in 1..(maxIndex(lrr)-1)] - [startPoly - monomial(listOfCenters.po,0),fp] - - norm p == - -- reduce(_+$R,map(absC,coefficients p)) - nm : R := 0 - for c in coefficients p repeat - nm := nm + absC c - nm - - pleskenSplit(poly,eps) == pleskenSplit(poly,eps,false) - - graeffe p == - -- If p = ao x**n + a1 x**(n-1) + ... + a x + an - -- and q = bo x**n + b1 x**(n-1) + ... + b x + bn - -- are such that q(-x**2) = p(x)p(-x), then - -- bk := ak**2 + 2 * ((-1) * a*a + ... + - -- (-1)**l * a*a) where l = min(k, n-k). - -- graeffe(p) constructs q using these identities. - n : NNI := degree p - aForth : L C := [] - for k in 0..n repeat -- aForth = [a0, a1, ..., a, an] - aForth := cons(coefficient(p, k::NNI), aForth) - aBack : L C := [] -- after k steps - -- aBack = [ak, a, ..., a1, a0] - gp : UP := 0$UP - for k in 0..n repeat - ak : C := first aForth - aForth := rest aForth - aForthCopy : L C := aForth -- we iterate over aForth and - aBackCopy : L C := aBack -- aBack but do not want to - -- destroy them - sum : C := 0 - const : I := -1 -- after i steps const = (-1)**i - for aminus in aBack for aplus in aForth repeat - -- after i steps aminus = a and aplus = a - sum := sum + const * aminus * aplus - aForthCopy := rest aForthCopy - aBackCopy := rest aBackCopy - const := -const - gp := gp + monomial(ak*ak + 2 * sum, (n-k)::NNI) - aBack := cons(ak, aBack) - gp - - - - rootRadius(p,errorQuotient) == - errorQuotient <= 1$R => - error "rootRadius: second Parameter must be greater than 1" - pp : UP := p - rho : R := calculateScale makeMonic pp - rR : R := rho - pp := makeMonic scale(pp,complex(rho,0$R)) - expo : NNI := 1 - d : NNI := degree p - currentError: R := nthRoot(2::R, 2) - currentError := d*20*currentError - while nthRoot(currentError, expo) >= errorQuotient repeat - -- if info then print (expo :: OF) - pp := graeffe pp - rho := calculateScale pp - expo := 2 * expo - rR := nthRoot(rho, expo) * rR - pp := makeMonic scale(pp,complex(rho,0$R)) - rR - - rootRadius(p) == rootRadius(p, 1+globalEps) - - schwerpunkt p == - zero? p => 0$C - zero? (d := degree p) => error _ - "schwerpunkt: non-zero const. polynomial has no roots and no schwerpunkt" - -- coeffient of x**d and x**(d-1) - lC : C := coefficient(p,d) -- ^= 0 - nC : C := coefficient(p,(d-1) pretend NNI) - (denom := recip ((d::I::C)*lC)) case "failed" => error "schwerpunkt: _ - degree * leadingCoefficient not invertible in ring of coefficients" - - (nC*(denom::C)) - - reciprocalPolynomial p == - zero? p => 0 - d : NNI := degree p - md : NNI := d+minimumDegree p - lm : L UP := [monomial(coefficient(p,i),(md-i) :: NNI) for i in 0..d] - sol := reduce(_+, lm) - - divisorCascade(p, tp, info) == - lfae : L FAE := nil() - for i in 1..degree tp while (degree tp > 0) repeat - -- USE monicDivide !!! - qr : Record(quotient: UP, remainder: UP) := divide(p,tp) - factor1 : UP := tp - factor2 : UP := makeMonic qr.quotient - -- refinement of tp: - tp := qr.remainder - nm : R := norm tp - listOfFactors : L UP := cons(factor2,nil()$(L UP)) - listOfFactors := cons(factor1,listOfFactors) - lfae := cons( [listOfFactors,nm], lfae) - if info then - --lof : L OF := [i :: OF,"-th division:"::OF] - --print center box hconcat lof - print emptyLine - lof : L OF := ["error polynomial has degree " ::OF,_ - (degree tp)::OF, " and norm " :: OF, nm :: OF] - print center hconcat lof - lof : L OF := ["degrees of factors:" ::OF,_ - (degree factor1)::OF," ", (degree factor2)::OF] - print center hconcat lof - if info then print emptyLine - reverse lfae - - divisorCascade(p, tp) == divisorCascade(p, tp, false) - - factor(poly,eps) == factor(poly,eps,false) - factor(p) == factor(p, globalEps) - - factor(poly,eps,info) == - result : FR UP := coerce monomial(leadingCoefficient poly,0) - d : NNI := degree poly - --should be - --den : R := (d::I)::R * two**(d::Integer) * norm poly - --eps0 : R := eps / den - -- for now only - eps0 : R := eps / (ten*ten) --- one? d => irreducibleFactor(poly,1)$(FR UP) - (d = 1) => irreducibleFactor(poly,1)$(FR UP) - listOfFactors : L Record(factor: UP,exponent: I) :=_ - list [makeMonic poly,1] - if info then - lof : L OF := [dashes,dots,"list of Factors:",dots,listOfFactors::OF, _ - dashes, "list of Linear Factors:", dots, result::OF, _ - dots,dashes] - print vconcat lof - while not null listOfFactors repeat - p : UP := (first listOfFactors).factor - exponentOfp : I := (first listOfFactors).exponent - listOfFactors := rest listOfFactors - if info then - lof : L OF := ["just now we try to split the polynomial:",p::OF] - print vconcat lof - split : FR UP := pleskenSplit(p, eps0, info) --- one? numberOfFactors split => - (numberOfFactors split = 1) => - -- in a later version we will change error bound and - -- accuracy here to deal this case as well - lof : L OF := ["factor: couldn't split factor",_ - center(p :: OF), "with required error bound"] - print vconcat lof - result := result * nilFactor(p, exponentOfp) - -- now we got 2 good factors of p, we drop p and continue - -- with the factors, if they are not linear, or put a - -- linear factor to the result - for rec in factors(split)$(FR UP) repeat - newFactor : UP := rec.factor - expOfFactor := exponentOfp * rec.exponent --- one? degree newFactor => - (degree newFactor = 1) => - result := result * nilFactor(newFactor,expOfFactor) - listOfFactors:=cons([newFactor,expOfFactor],_ - listOfFactors) - result - - -- implementation of local functions - - absC c == nthRoot(norm(c)$C,2) - absR r == - r < 0 => -r - r - min(fae1,fae2) == - fae2.error < fae1.error => fae2 - fae1 - calculateScale p == - d := degree p - maxi :R := 0 - for j in 1..d for cof in rest coefficients p repeat - -- here we need abs: R -> R - rc : R := absR real cof - ic : R := absR imag cof - locmax: R := max(rc,ic) - maxi := max( nthRoot( locmax/(binomial(d,j)$ICF::R), j), maxi) - -- Maybe I should use some type of logarithm for the following: - maxi = 0$R => error("Internal Error: scale cannot be 0") - rho :R := one - rho < maxi => - while rho < maxi repeat rho := ten * rho - rho / ten - while maxi < rho repeat rho := rho / ten - rho = 0 => one - rho - makeMonic p == - p = 0 => p - monomial(1,degree p)$UP + (reductum p)/(leadingCoefficient p) - - scale(p, c) == - -- eval(p,cx) is missing !! - eq : Equation UP := equation(monomial(1,1), monomial(c,1)) - eval(p,eq) - -- improvement?: direct calculation of the new coefficients - - shift(p,c) == - rhs : UP := monomial(1,1) + monomial(c,0) - eq : Equation UP := equation(monomial(1,1), rhs) - eval(p,eq) - -- improvement?: direct calculation of the new coefficients - - nthRoot(r,n) == - R has RealNumberSystem => r ** (1/n) - R has QuotientFieldCategory Integer => - den : I := approxNthRoot(globalDigits * denom r ,n)$IntegerRoots(I) - num : I := approxNthRoot(globalDigits * numer r ,n)$IntegerRoots(I) - num/den - -- the following doesn't compile - --R has coerce: % -> Fraction Integer => - -- q : Fraction Integer := coerce(r)@Fraction(Integer) - -- den : I := approxNthRoot(globalDigits * denom q ,n)$IntegerRoots(I) - -- num : I := approxNthRoot(globalDigits * numer q ,n)$IntegerRoots(I) - -- num/den - r -- this is nonsense, perhaps a Newton iteration for x**n-r here - -)fin - -- for late use: - - graeffe2 p == - -- substitute x by -x : - eq : Equation UP := equation(monomial(1,1), monomial(-1$C,1)) - pp : UP := p*eval(p,eq) - gp : UP := 0$UP - while pp ^= 0 repeat - i:NNI := (degree pp) quo (2::NNI) - coef:C:= - even? i => leadingCoefficient pp - - leadingCoefficient pp - gp := gp + monomial(coef,i) - pp := reductum pp - gp - shift2(p,c) == - d := degree p - cc : C := 1 - coef := List C := [cc := c * cc for i in 1..d] - coef := cons(1,coef) - coef := [coefficient(p,i)*coef.(1+i) for i in 0..d] - res : UP := 0 - for j in 0..d repeat - cc := 0 - for i in j..d repeat - cc := cc + coef.i * (binomial(i,j)$ICF :: R) - res := res + monomial(cc,j)$UP - res - scale2(p,c) == - d := degree p - cc : C := 1 - coef := List C := [cc := c * cc for i in 1..d] - coef := cons(1,coef) - coef := [coefficient(p,i)*coef.(i+1) for i in 0..d] - res : UP := 0 - for i in 0..d repeat res := res + monomial(coef.(i+1),i)$UP - res - scale2: (UP,C) -> UP - shift2: (UP,C) -> UP - graeffe2 : UP -> UP - ++ graeffe2 p determines q such that \spad{q(-z**2) = p(z)*p(-z)}. - ++ Note that the roots of q are the squares of the roots of p. - -@ -\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/curve.spad.pamphlet b/src/algebra/curve.spad.pamphlet deleted file mode 100644 index ea91bfe..0000000 --- a/src/algebra/curve.spad.pamphlet +++ /dev/null @@ -1,279 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra curve.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package MMAP MultipleMap} -<>= -"MMAP" [color=orange,style=filled]; -"MultipleMap(a:INTDOM,b:UPOLYC(a),c:UPOLYC(FRAC(b)),d:INTDOM,e:UPOLYC(d),f:UPOLYC(FRAC(e)))" - [color=orange,style=filled]; -"MMAP" -> "PACKAGE" -"MultipleMap(a:INTDOM,b:UPOLYC(a),c:UPOLYC(FRAC(b)),d:INTDOM,e:UPOLYC(d),f:UPOLYC(FRAC(e)))" - -> "Package" -@ -<>= -)abbrev package MMAP MultipleMap -++ Lifting a map through 2 levels of polynomials -++ Author: Manuel Bronstein -++ Date Created: May 1988 -++ Date Last Updated: 11 Jul 1990 -++ Description: Lifting of a map through 2 levels of polynomials; -MultipleMap(R1,UP1,UPUP1,R2,UP2,UPUP2): Exports == Implementation where - R1 : IntegralDomain - UP1 : UnivariatePolynomialCategory R1 - UPUP1: UnivariatePolynomialCategory Fraction UP1 - R2 : IntegralDomain - UP2 : UnivariatePolynomialCategory R2 - UPUP2: UnivariatePolynomialCategory Fraction UP2 - - Q1 ==> Fraction UP1 - Q2 ==> Fraction UP2 - - Exports ==> with - map: (R1 -> R2, UPUP1) -> UPUP2 - ++ map(f, p) lifts f to the domain of p then applies it to p. - - Implementation ==> add - import UnivariatePolynomialCategoryFunctions2(R1, UP1, R2, UP2) - - rfmap: (R1 -> R2, Q1) -> Q2 - - rfmap(f, q) == map(f, numer q) / map(f, denom q) - - map(f, p) == - map(rfmap(f, #1), - p)$UnivariatePolynomialCategoryFunctions2(Q1, UPUP1, Q2, UPUP2) - -@ -\section{package FFCAT2 FunctionFieldCategoryFunctions2} -<>= -"FFCAT2" [color=orange,style=filled]; -"FunctionFieldCategoryFunctions2(a:UFD,b:UPOLYC(a),c:UPOLYC(FRAC(b)),d:FFCAT(a,b,c),e:UFD,f:UPOLYC(e),g:UPOLYC(FRAC(f)),h:FFCAT(e,f,g))" - [color=orange,style=filled]; -"FFCAT2" -> "PACKAGE" -"FunctionFieldCategoryFunctions2(a:UFD,b:UPOLYC(a),c:UPOLYC(FRAC(b)),d:FFCAT(a,b,c),e:UFD,f:UPOLYC(e),g:UPOLYC(FRAC(f)),h:FFCAT(e,f,g))" --> "Package" -@ -<>= -)abbrev package FFCAT2 FunctionFieldCategoryFunctions2 -++ Lifts a map from rings to function fields over them -++ Author: Manuel Bronstein -++ Date Created: May 1988 -++ Date Last Updated: 26 Jul 1988 -++ Description: Lifts a map from rings to function fields over them. -FunctionFieldCategoryFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2): - Exports == Implementation where - R1 : UniqueFactorizationDomain - UP1 : UnivariatePolynomialCategory R1 - UPUP1: UnivariatePolynomialCategory Fraction UP1 - F1 : FunctionFieldCategory(R1, UP1, UPUP1) - R2 : UniqueFactorizationDomain - UP2 : UnivariatePolynomialCategory R2 - UPUP2: UnivariatePolynomialCategory Fraction UP2 - F2 : FunctionFieldCategory(R2, UP2, UPUP2) - - Exports ==> with - map: (R1 -> R2, F1) -> F2 - ++ map(f, p) lifts f to F1 and applies it to p. - - Implementation ==> add - map(f, f1) == - reduce(map(f, lift f1)$MultipleMap(R1, UP1, UPUP1, R2, UP2, UPUP2)) - -@ -\section{package CHVAR ChangeOfVariable} -<>= -"CHVAR" [color=orange,style=filled]; -"ChangeOfVariable(a:UFD,b:UPOLYC(a),c:UPOLYC(FRAC(b)))" - [color=orange,style=filled]; -"CHVAR" -> "PACKAGE" -"ChangeOfVariable(a:UFD,b:UPOLYC(a),c:UPOLYC(FRAC(b)))" -> "Package" -@ -<>= -)abbrev package CHVAR ChangeOfVariable -++ Sends a point to infinity -++ Author: Manuel Bronstein -++ Date Created: 1988 -++ Date Last Updated: 22 Feb 1990 -++ Description: -++ Tools to send a point to infinity on an algebraic curve. -ChangeOfVariable(F, UP, UPUP): Exports == Implementation where - F : UniqueFactorizationDomain - UP : UnivariatePolynomialCategory F - UPUP: UnivariatePolynomialCategory Fraction UP - - N ==> NonNegativeInteger - Z ==> Integer - Q ==> Fraction Z - RF ==> Fraction UP - - Exports ==> with - mkIntegral: UPUP -> Record(coef:RF, poly:UPUP) - ++ mkIntegral(p(x,y)) returns \spad{[c(x), q(x,z)]} such that - ++ \spad{z = c * y} is integral. - ++ The algebraic relation between x and y is \spad{p(x, y) = 0}. - ++ The algebraic relation between x and z is \spad{q(x, z) = 0}. - radPoly : UPUP -> Union(Record(radicand:RF, deg:N), "failed") - ++ radPoly(p(x, y)) returns \spad{[c(x), n]} if p is of the form - ++ \spad{y**n - c(x)}, "failed" otherwise. - rootPoly : (RF, N) -> Record(exponent: N, coef:RF, radicand:UP) - ++ rootPoly(g, n) returns \spad{[m, c, P]} such that - ++ \spad{c * g ** (1/n) = P ** (1/m)} - ++ thus if \spad{y**n = g}, then \spad{z**m = P} - ++ where \spad{z = c * y}. - goodPoint : (UPUP,UPUP) -> F - ++ goodPoint(p, q) returns an integer a such that a is neither - ++ a pole of \spad{p(x,y)} nor a branch point of \spad{q(x,y) = 0}. - eval : (UPUP, RF, RF) -> UPUP - ++ eval(p(x,y), f(x), g(x)) returns \spad{p(f(x), y * g(x))}. - chvar : (UPUP,UPUP) -> Record(func:UPUP,poly:UPUP,c1:RF,c2:RF,deg:N) - ++ chvar(f(x,y), p(x,y)) returns - ++ \spad{[g(z,t), q(z,t), c1(z), c2(z), n]} - ++ such that under the change of variable - ++ \spad{x = c1(z)}, \spad{y = t * c2(z)}, - ++ one gets \spad{f(x,y) = g(z,t)}. - ++ The algebraic relation between x and y is \spad{p(x, y) = 0}. - ++ The algebraic relation between z and t is \spad{q(z, t) = 0}. - - Implementation ==> add - import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) - - algPoly : UPUP -> Record(coef:RF, poly:UPUP) - RPrim : (UP, UP, UPUP) -> Record(coef:RF, poly:UPUP) - good? : (F, UP, UP) -> Boolean - infIntegral?: (UPUP, UPUP) -> Boolean - - eval(p, x, y) == map(#1 x, p) monomial(y, 1) - good?(a, p, q) == p(a) ^= 0 and q(a) ^= 0 - - algPoly p == - ground?(a:= retract(leadingCoefficient(q:=clearDenominator p))@UP) - => RPrim(1, a, q) - c := d := squareFreePart a - q := clearDenominator q monomial(inv(d::RF), 1) - while not ground?(a := retract(leadingCoefficient q)@UP) repeat - c := c * (d := gcd(a, d)) - q := clearDenominator q monomial(inv(d::RF), 1) - RPrim(c, a, q) - - RPrim(c, a, q) == --- one? a => [c::RF, q] - (a = 1) => [c::RF, q] - [(a * c)::RF, clearDenominator q monomial(inv(a::RF), 1)] - --- always makes the algebraic integral, but does not send a point to infinity --- if the integrand does not have a pole there (in the case of an nth-root) - chvar(f, modulus) == - r1 := mkIntegral modulus - f1 := f monomial(r1inv := inv(r1.coef), 1) - infIntegral?(f1, r1.poly) => - [f1, r1.poly, monomial(1,1)$UP :: RF,r1inv,degree(retract(r1.coef)@UP)] - x := (a:= goodPoint(f1,r1.poly))::UP::RF + inv(monomial(1,1)::RF) - r2c:= retract((r2 := mkIntegral map(#1 x, r1.poly)).coef)@UP - t := inv((monomial(1, 1)$UP - a::UP)::RF) - [- inv(monomial(1, 2)$UP :: RF) * eval(f1, x, inv(r2.coef)), - r2.poly, t, r1.coef * r2c t, degree r2c] - --- returns true if y is an n-th root, and it can be guaranteed that p(x,y)dx --- is integral at infinity --- expects y to be integral. - infIntegral?(p, modulus) == - (r := radPoly modulus) case "failed" => false - ninv := inv(r.deg::Q) - degy:Q := degree(retract(r.radicand)@UP) * ninv - degp:Q := 0 - while p ^= 0 repeat - c := leadingCoefficient p - degp := max(degp, - (2 + degree(numer c)::Z - degree(denom c)::Z)::Q + degree(p) * degy) - p := reductum p - degp <= ninv - - mkIntegral p == - (r := radPoly p) case "failed" => algPoly p - rp := rootPoly(r.radicand, r.deg) - [rp.coef, monomial(1, rp.exponent)$UPUP - rp.radicand::RF::UPUP] - - goodPoint(p, modulus) == - q := - (r := radPoly modulus) case "failed" => - retract(resultant(modulus, differentiate modulus))@UP - retract(r.radicand)@UP - d := commonDenominator p - for i in 0.. repeat - good?(a := i::F, q, d) => return a - good?(-a, q, d) => return -a - - radPoly p == - (r := retractIfCan(reductum p)@Union(RF, "failed")) case "failed" - => "failed" - [- (r::RF), degree p] - --- we have y**m = g(x) = n(x)/d(x), so if we can write --- (n(x) * d(x)**(m-1)) ** (1/m) = c(x) * P(x) ** (1/n) --- then z**q = P(x) where z = (d(x) / c(x)) * y - rootPoly(g, m) == - zero? g => error "Should not happen" - pr := nthRoot(squareFree((numer g) * (d := denom g) ** (m-1)::N), - m)$FactoredFunctions(UP) - [pr.exponent, d / pr.coef, */(pr.radicand)] - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- SPAD files for the integration world should be compiled in the --- following order: --- --- intaux rderf intrf CURVE curvepkg divisor pfo --- intalg intaf efstruc rdeef intef irexpand integrat - -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/cycles.spad.pamphlet b/src/algebra/cycles.spad.pamphlet deleted file mode 100644 index ccc8311..0000000 --- a/src/algebra/cycles.spad.pamphlet +++ /dev/null @@ -1,1230 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra cycles.spad} -\author{William Burge} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package CYCLES CycleIndicators} -<>= --- cycles.spad.pamphlet CycleIndicators.input -)spool CycleIndicators.output -)set message test on -)set message auto off -)clear all ---S 1 of 47 -complete 1 ---R ---R ---R (1) (1) ---R Type: SymmetricPolynomial Fraction Integer ---E 1 - ---S 2 of 47 -complete 2 ---R ---R ---R 1 1 2 ---R (2) - (2) + - (1 ) ---R 2 2 ---R Type: SymmetricPolynomial Fraction Integer ---E 2 - ---S 3 of 47 -complete 3 ---R ---R ---R 1 1 1 3 ---R (3) - (3) + - (2 1) + - (1 ) ---R 3 2 6 ---R Type: SymmetricPolynomial Fraction Integer ---E 3 - ---S 4 of 47 -complete 7 ---R ---R ---R (4) ---R 1 1 1 1 2 1 1 1 3 ---R - (7) + - (6 1) + -- (5 2) + -- (5 1 ) + -- (4 3) + - (4 2 1) + -- (4 1 ) ---R 7 6 10 10 12 8 24 ---R + ---R 1 2 1 2 1 2 1 4 1 3 1 2 3 ---R -- (3 1) + -- (3 2 ) + -- (3 2 1 ) + -- (3 1 ) + -- (2 1) + -- (2 1 ) ---R 18 24 12 72 48 48 ---R + ---R 1 5 1 7 ---R --- (2 1 ) + ---- (1 ) ---R 240 5040 ---R Type: SymmetricPolynomial Fraction Integer ---E 4 - ---S 5 of 47 -elementary 7 ---R ---R ---R (5) ---R 1 1 1 1 2 1 1 1 3 ---R - (7) - - (6 1) - -- (5 2) + -- (5 1 ) - -- (4 3) + - (4 2 1) - -- (4 1 ) ---R 7 6 10 10 12 8 24 ---R + ---R 1 2 1 2 1 2 1 4 1 3 1 2 3 ---R -- (3 1) + -- (3 2 ) - -- (3 2 1 ) + -- (3 1 ) - -- (2 1) + -- (2 1 ) ---R 18 24 12 72 48 48 ---R + ---R 1 5 1 7 ---R - --- (2 1 ) + ---- (1 ) ---R 240 5040 ---R Type: SymmetricPolynomial Fraction Integer ---E 5 - ---S 6 of 47 -alternating 7 ---R ---R ---R (6) ---R 2 1 2 1 1 2 1 2 1 4 1 2 3 ---R - (7) + - (5 1 ) + - (4 2 1) + - (3 1) + -- (3 2 ) + -- (3 1 ) + -- (2 1 ) ---R 7 5 4 9 12 36 24 ---R + ---R 1 7 ---R ---- (1 ) ---R 2520 ---R Type: SymmetricPolynomial Fraction Integer ---E 6 - ---S 7 of 47 -cyclic 7 ---R ---R ---R 6 1 7 ---R (7) - (7) + - (1 ) ---R 7 7 ---R Type: SymmetricPolynomial Fraction Integer ---E 7 - ---S 8 of 47 -dihedral 7 ---R ---R ---R 3 1 3 1 7 ---R (8) - (7) + - (2 1) + -- (1 ) ---R 7 2 14 ---R Type: SymmetricPolynomial Fraction Integer ---E 8 - ---S 9 of 47 -graphs 5 ---R ---R ---R (9) ---R 1 1 2 1 2 1 3 1 4 2 1 3 4 1 10 ---R - (6 3 1) + - (5 ) + - (4 2) + - (3 1) + - (2 1 ) + -- (2 1 ) + --- (1 ) ---R 6 5 4 6 8 12 120 ---R Type: SymmetricPolynomial Fraction Integer ---E 9 - ---S 10 of 47 -cap(complete 2**2, complete 2*complete 1**2) ---R ---R ---R (10) 4 ---R Type: Fraction Integer ---E 10 - ---S 11 of 47 -cap(elementary 2**2, complete 2*complete 1**2) ---R ---R ---R (11) 2 ---R Type: Fraction Integer ---E 11 - ---S 12 of 47 -cap(complete 3*complete 2*complete 1,complete 2**2*complete 1**2) ---R ---R ---R (12) 24 ---R Type: Fraction Integer ---E 12 - ---S 13 of 47 -cap(elementary 3*elementary 2*elementary 1,complete 2**2*complete 1**2) ---R ---R ---R (13) 8 ---R Type: Fraction Integer ---E 13 - ---S 14 of 47 -cap(complete 3*complete 2*complete 1,elementary 2**2*elementary 1**2) ---R ---R ---R (14) 8 ---R Type: Fraction Integer ---E 14 - ---S 15 of 47 -eval(cup(complete 3*complete 2*complete 1, cup(complete 2**2*complete 1**2,complete 2**3))) ---R ---R ---R (15) 1500 ---R Type: Fraction Integer ---E 15 - ---S 16 of 47 -square:=dihedral 4 ---R ---R ---R 1 3 2 1 2 1 4 ---R (16) - (4) + - (2 ) + - (2 1 ) + - (1 ) ---R 4 8 4 8 ---R Type: SymmetricPolynomial Fraction Integer ---E 16 - ---S 17 of 47 -cap(complete 2**2,square) ---R ---R ---R (17) 2 ---R Type: Fraction Integer ---E 17 - ---S 18 of 47 -cap(complete 3*complete 2**2,dihedral 7) ---R ---R ---R (18) 18 ---R Type: Fraction Integer ---E 18 - ---S 19 of 47 -cap(graphs 5,complete 7*complete 3) ---R ---R ---R (19) 4 ---R Type: Fraction Integer ---E 19 - ---S 20 of 47 -s(x) == powerSum(x) ---R ---R Type: Void ---E 20 - ---S 21 of 47 -cube:=(1/24)*(s 1**8+9*s 2**4 + 8*s 3**2*s 1**2+6*s 4**2) ---R ---R Compiling function s with type PositiveInteger -> ---R SymmetricPolynomial Fraction Integer ---R ---R 1 2 1 2 2 3 4 1 8 ---R (21) - (4 ) + - (3 1 ) + - (2 ) + -- (1 ) ---R 4 3 8 24 ---R Type: SymmetricPolynomial Fraction Integer ---E 21 - ---S 22 of 47 -cap(complete 4**2,cube) ---R ---R ---R (22) 7 ---R Type: Fraction Integer ---E 22 - ---S 23 of 47 -cap(complete 2**3*complete 1**2,wreath(elementary 4,elementary 2)) ---R ---R ---R (23) 7 ---R Type: Fraction Integer ---E 23 - ---S 24 of 47 -cap(complete 2**3*complete 1**2,wreath(elementary 4,complete 2)) ---R ---R ---R (24) 17 ---R Type: Fraction Integer ---E 24 - ---S 25 of 47 -cap(complete 2**3*complete 1**2,wreath(complete 4,elementary 2)) ---R ---R ---R (25) 10 ---R Type: Fraction Integer ---E 25 - ---S 26 of 47 -cap(complete 2**3*complete 1**2,wreath(complete 4,complete 2)) ---R ---R ---R (26) 23 ---R Type: Fraction Integer ---E 26 - ---S 27 of 47 -x: ULS(FRAC INT,'x,0) := 'x ---R ---R ---R (27) x ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 27 - ---S 28 of 47 -ZeroOrOne: INT -> ULS(FRAC INT, 'x, 0) ---R ---R Type: Void ---E 28 - ---S 29 of 47 -Integers: INT -> ULS(FRAC INT, 'x, 0) ---R ---R Type: Void ---E 29 - ---S 30 of 47 -ZeroOrOne n == 1+x**n ---R ---R Type: Void ---E 30 - ---S 31 of 47 -ZeroOrOne 5 ---R ---R Compiling function ZeroOrOne with type Integer -> ---R UnivariateLaurentSeries(Fraction Integer,x,0) ---R ---R 5 ---R (31) 1 + x ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 31 - ---S 32 of 47 -Integers n == 1/(1-x**n) ---R ---R Type: Void ---E 32 - ---S 33 of 47 -Integers 5 ---R ---R Compiling function Integers with type Integer -> ---R UnivariateLaurentSeries(Fraction Integer,x,0) ---R ---R 5 10 11 ---R (33) 1 + x + x + O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 33 - ---S 34 of 47 -)expose EVALCYC ---R ---I EvaluateCycleIndicators is now explicitly exposed in frame frame0 ---E 34 - ---S 35 of 47 -eval(ZeroOrOne, graphs 5) ---R ---R ---R 2 3 4 5 6 7 8 9 10 11 ---R (34) 1 + x + 2x + 4x + 6x + 6x + 6x + 4x + 2x + x + x + O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 35 - ---S 36 of 47 -eval(ZeroOrOne,dihedral 8) ---R ---R ---R 2 3 4 5 6 7 8 ---R (35) 1 + x + 4x + 5x + 8x + 5x + 4x + x + x ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 36 - ---S 37 of 47 -eval(Integers,complete 4) ---R ---R ---R (36) ---R 2 3 4 5 6 7 8 9 10 11 ---R 1 + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x + O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 37 - ---S 38 of 47 -eval(Integers,elementary 4) ---R ---R ---R (37) ---R 6 7 8 9 10 11 12 13 14 15 16 ---R x + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x ---R + ---R 17 ---R O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 38 - ---S 39 of 47 -eval(ZeroOrOne,cube) ---R ---R ---R 2 3 4 5 6 7 8 ---R (38) 1 + x + 3x + 3x + 7x + 3x + 3x + x + x ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 39 - ---S 40 of 47 -eval(Integers,cube) ---R ---R ---R (39) ---R 2 3 4 5 6 7 8 9 10 ---R 1 + x + 4x + 7x + 21x + 37x + 85x + 151x + 292x + 490x + 848x ---R + ---R 11 ---R O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 40 - ---S 41 of 47 -eval(Integers,graphs 5) ---R ---R ---R (40) ---R 2 3 4 5 6 7 8 9 10 ---R 1 + x + 3x + 7x + 17x + 35x + 76x + 149x + 291x + 539x + 974x ---R + ---R 11 ---R O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 41 - ---S 42 of 47 -eval(ZeroOrOne ,graphs 15) ---R ---R ---R (41) ---R 2 3 4 5 6 7 8 9 10 ---R 1 + x + 2x + 5x + 11x + 26x + 68x + 177x + 496x + 1471x + 4583x ---R + ---R 11 ---R O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 42 - ---S 43 of 47 -cap(dihedral 30,complete 7*complete 8*complete 5*complete 10) ---R ---R ---R (42) 49958972383320 ---R Type: Fraction Integer ---E 43 - ---S 44 of 47 -sf3221:= SFunction [3,2,2,1] ---R ---R ---R (43) ---R 1 1 2 1 2 1 1 4 1 2 ---R -- (6 2) - -- (6 1 ) - -- (4 ) + -- (4 3 1) + -- (4 1 ) - -- (3 2) ---R 12 12 16 12 24 36 ---R + ---R 1 2 2 1 2 1 3 1 5 1 4 1 3 2 ---R -- (3 1 ) - -- (3 2 1) - -- (3 2 1 ) - -- (3 1 ) - --- (2 ) + -- (2 1 ) ---R 36 24 36 72 192 48 ---R + ---R 1 2 4 1 6 1 8 ---R -- (2 1 ) - --- (2 1 ) + --- (1 ) ---R 96 144 576 ---R Type: SymmetricPolynomial Fraction Integer ---E 44 - ---S 45 of 47 -cap(sf3221,complete 2**4) ---R ---R ---R (44) 3 ---R Type: Fraction Integer ---E 45 - ---S 46 of 47 -cap(sf3221, powerSum 1**8) ---R ---R ---R (45) 70 ---R Type: Fraction Integer ---E 46 - ---S 47 of 47 -eval(Integers, sf3221) ---R ---R ---R (46) ---R 9 10 11 12 13 14 15 16 17 18 ---R x + 3x + 7x + 14x + 27x + 47x + 79x + 126x + 196x + 294x ---R + ---R 19 20 ---R 432x + O(x ) ---R Type: UnivariateLaurentSeries(Fraction Integer,x,0) ---E 47 -)spool -)lisp (bye) -@ -<>= -==================================================================== -CycleIndicators examples -==================================================================== - -This section is based upon the paper J. H. Redfield, ``The Theory of -Group-Reduced Distributions'', American J. Math.,49 (1927) 433-455, -and is an application of group theory to enumeration problems. It is -a development of the work by P. A. MacMahon on the application of -symmetric functions and Hammond operators to combinatorial theory. - -The theory is based upon the power sum symmetric functions s(i) which -are the sum of the i-th powers of the variables. The cycle index of a -permutation is an expression that specifies the sizes of the cycles of -a permutation, and may be represented as a partition. A partition of -a non-negative integer n is a collection of positive integers called -its parts whose sum is n. For example, the partition (3^2 2 1^2) will -be used to represent s^2_3 s_2 s^2_1 and will indicate that the -permutation has two cycles of length 3, one of length 2 and two of -length 1. The cycle index of a permutation group is the sum of the -cycle indices of its permutations divided by the number of -permutations. The cycle indices of certain groups are provided. - -The operation complete returns the cycle index of the symmetric group -of order n for argument n. Alternatively, it is the n-th complete -homogeneous symmetric function expressed in terms of power sum -symmetric functions. - - complete 1 - (1) - Type: SymmetricPolynomial Fraction Integer - - complete 2 - 1 1 2 - - (2) + - (1 ) - 2 2 - Type: SymmetricPolynomial Fraction Integer - - complete 3 - 1 1 1 3 - - (3) + - (2 1) + - (1 ) - 3 2 6 - Type: SymmetricPolynomial Fraction Integer - - complete 7 - 1 1 1 1 2 1 1 1 3 - - (7) + - (6 1) + -- (5 2) + -- (5 1 ) + -- (4 3) + - (4 2 1) + -- (4 1 ) - 7 6 10 10 12 8 24 - + - 1 2 1 2 1 2 1 4 1 3 1 2 3 - -- (3 1) + -- (3 2 ) + -- (3 2 1 ) + -- (3 1 ) + -- (2 1) + -- (2 1 ) - 18 24 12 72 48 48 - + - 1 5 1 7 - --- (2 1 ) + ---- (1 ) - 240 5040 - Type: SymmetricPolynomial Fraction Integer - -The operation elementary computes the n-th elementary symmetric -function for argument n. - - elementary 7 - 1 1 1 1 2 1 1 1 3 - - (7) - - (6 1) - -- (5 2) + -- (5 1 ) - -- (4 3) + - (4 2 1) - -- (4 1 ) - 7 6 10 10 12 8 24 - + - 1 2 1 2 1 2 1 4 1 3 1 2 3 - -- (3 1) + -- (3 2 ) - -- (3 2 1 ) + -- (3 1 ) - -- (2 1) + -- (2 1 ) - 18 24 12 72 48 48 - + - 1 5 1 7 - - --- (2 1 ) + ---- (1 ) - 240 5040 - Type: SymmetricPolynomial Fraction Integer - -The operation alternating returns the cycle index of the alternating -group having an even number of even parts in each cycle partition. - - alternating 7 - 2 1 2 1 1 2 1 2 1 4 1 2 3 - - (7) + - (5 1 ) + - (4 2 1) + - (3 1) + -- (3 2 ) + -- (3 1 ) + -- (2 1 ) - 7 5 4 9 12 36 24 - + - 1 7 - ---- (1 ) - 2520 - Type: SymmetricPolynomial Fraction Integer - -The operation cyclic returns the cycle index of the cyclic group. - - cyclic 7 - 6 1 7 - - (7) + - (1 ) - 7 7 - Type: SymmetricPolynomial Fraction Integer - -The operation dihedral is the cycle index of the dihedral group. - - dihedral 7 - 3 1 3 1 7 - - (7) + - (2 1) + -- (1 ) - 7 2 14 - Type: SymmetricPolynomial Fraction Integer - -The operation graphs for argument n returns the cycle index of the -group of permutations on the edges of the complete graph with n nodes -induced by applying the symmetric group to the nodes. - - graphs 5 - 1 1 2 1 2 1 3 1 4 2 1 3 4 1 10 - - (6 3 1) + - (5 ) + - (4 2) + - (3 1) + - (2 1 ) + -- (2 1 ) + --- (1 ) - 6 5 4 6 8 12 120 - Type: SymmetricPolynomial Fraction Integer - -The cycle index of a direct product of two groups is the product of -the cycle indices of the groups. Redfield provided two operations on -two cycle indices which will be called "cup" and "cap" here. The cup -of two cycle indices is a kind of scalar product that combines -monomials for permutations with the same cycles. The cap operation -provides the sum of the coefficients of the result of the cup -operation which will be an integer that enumerates what Redfield -called group-reduced distributions. - -We can, for example, represent complete 2 * complete 2 as the set of -objects a a b b and complete 2 * complete 1 * complete 1 as c c d e. - -This integer is the number of different sets of four pairs. - - cap(complete 2**2, complete 2*complete 1**2) - 4 - Type: Fraction Integer - -For example, - a a b b a a b b a a b b a a b b - c c d e c d c e c e c d d e c c - -This integer is the number of different sets of four pairs no two -pairs being equal. - - cap(elementary 2**2, complete 2*complete 1**2) - 2 - Type: Fraction Integer - -For example, - - a a b b a a b b - c d c e c e c d - -In this case the configurations enumerated are easily constructed, -however the theory merely enumerates them providing little help in -actually constructing them. - -Here are the number of 6-pairs, first from a a a b b c, second -from d d e e f g. - - cap(complete 3*complete 2*complete 1,complete 2**2*complete 1**2) - 24 - Type: Fraction Integer - -Here it is again, but with no equal pairs. - - cap(elementary 3*elementary 2*elementary 1,complete 2**2*complete 1**2) - 8 - Type: Fraction Integer - - cap(complete 3*complete 2*complete 1,elementary 2**2*elementary 1**2) - 8 - Type: Fraction Integer - -The number of 6-triples, first from a a a b b c, second from -d d e e f g, third from h h i i j j. - - eval(cup(complete 3*complete 2*complete 1, cup(complete 2**2*complete 1**2,complete 2**3))) - 1500 - Type: Fraction Integer - -The cycle index of vertices of a square is dihedral 4. - - square:=dihedral 4 - 1 3 2 1 2 1 4 - - (4) + - (2 ) + - (2 1 ) + - (1 ) - 4 8 4 8 - Type: SymmetricPolynomial Fraction Integer - -The number of different squares with 2 red vertices and 2 blue vertices. - - cap(complete 2**2,square) - 2 - Type: Fraction Integer - -The number of necklaces with 3 red beads, 2 blue beads and 2 green beads. - - cap(complete 3*complete 2**2,dihedral 7) - 18 - Type: Fraction Integer - -The number of graphs with 5 nodes and 7 edges. - - cap(graphs 5,complete 7*complete 3) - 4 - Type: Fraction Integer - -The cycle index of rotations of vertices of a cube. - - s(x) == powerSum(x) - Type: Void - - cube:=(1/24)*(s 1**8+9*s 2**4 + 8*s 3**2*s 1**2+6*s 4**2) - 1 2 1 2 2 3 4 1 8 - - (4 ) + - (3 1 ) + - (2 ) + -- (1 ) - 4 3 8 24 - Type: SymmetricPolynomial Fraction Integer - -The number of cubes with 4 red vertices and 4 blue vertices. - - cap(complete 4**2,cube) - 7 - Type: Fraction Integer - -The number of labeled graphs with degree sequence 2 2 2 1 1 with no -loops or multiple edges. - - cap(complete 2**3*complete 1**2,wreath(elementary 4,elementary 2)) - 7 - Type: Fraction Integer - -Again, but with loops allowed but not multiple edges. - - cap(complete 2**3*complete 1**2,wreath(elementary 4,complete 2)) - 17 - Type: Fraction Integer - -Again, but with multiple edges allowed, but not loops - - cap(complete 2**3*complete 1**2,wreath(complete 4,elementary 2)) - 10 - Type: Fraction Integer - -Again, but with both multiple edges and loops allowed - - cap(complete 2**3*complete 1**2,wreath(complete 4,complete 2)) - 23 - Type: Fraction Integer - -Having constructed a cycle index for a configuration we are at liberty -to evaluate the s_i components any way we please. For example we can -produce enumerating generating functions. This is done by providing a -function f on an integer i to the value required of s_i, and then -evaluating eval(f, cycleindex). - - x: ULS(FRAC INT,'x,0) := 'x - x - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - - ZeroOrOne: INT -> ULS(FRAC INT, 'x, 0) - Type: Void - - Integers: INT -> ULS(FRAC INT, 'x, 0) - Type: Void - -For the integers 0 and 1, or two colors. - - ZeroOrOne n == 1+x**n - Type: Void - - ZeroOrOne 5 - 5 - 1 + x - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -For the integers 0, 1, 2, ... we have this. - - Integers n == 1/(1-x**n) - Type: Void - - Integers 5 - 5 10 11 - 1 + x + x + O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of graphs with 5 nodes and n edges. - -Note that there is an eval function that takes two arguments. It has the -signature: - - ((Integer -> D1),SymmetricPolynomial Fraction Integer) -> D1 - from EvaluateCycleIndicators D1 if D1 has ALGEBRA FRAC INT - -This function is not normally exposed (it will not normally be considered -in the list of eval functions) as it is only useful for this particular -domain. To use it we ask that it be considered thus: - - )expose EVALCYC - -and now we can use it: - - eval(ZeroOrOne, graphs 5) - 2 3 4 5 6 7 8 9 10 11 - 1 + x + 2x + 4x + 6x + 6x + 6x + 4x + 2x + x + x + O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of necklaces with n red beads -and n-8 green beads. - - eval(ZeroOrOne,dihedral 8) - 2 3 4 5 6 7 8 - 1 + x + 4x + 5x + 8x + 5x + 4x + x + x - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of partitions of n into 4 or fewer parts. - - eval(Integers,complete 4) - 2 3 4 5 6 7 8 9 10 11 - 1 + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x + O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of partitions of n into 4 boxes -containing ordered distinct parts. - - eval(Integers,elementary 4) - 6 7 8 9 10 11 12 13 14 15 16 - x + x + 2x + 3x + 5x + 6x + 9x + 11x + 15x + 18x + 23x - + - 17 - O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of different cubes with n red -vertices and 8-n green ones. - - eval(ZeroOrOne,cube) - 2 3 4 5 6 7 8 - 1 + x + 3x + 3x + 7x + 3x + 3x + x + x - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of different cubes with integers -on the vertices whose sum is n. - - eval(Integers,cube) - 2 3 4 5 6 7 8 9 10 - 1 + x + 4x + 7x + 21x + 37x + 85x + 151x + 292x + 490x + 848x - + - 11 - O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The coefficient of x^n is the number of graphs with 5 nodes and with -integers on the edges whose sum is n. In other words, the enumeration -is of multigraphs with 5 nodes and n edges. - - eval(Integers,graphs 5) - 2 3 4 5 6 7 8 9 10 - 1 + x + 3x + 7x + 17x + 35x + 76x + 149x + 291x + 539x + 974x - + - 11 - O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -Graphs with 15 nodes enumerated with respect to number of edges. - - eval(ZeroOrOne ,graphs 15) - 2 3 4 5 6 7 8 9 10 - 1 + x + 2x + 5x + 11x + 26x + 68x + 177x + 496x + 1471x + 4583x - + - 11 - O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -Necklaces with 7 green beads, 8 white beads, 5 yellow beads and 10 -red beads. - - cap(dihedral 30,complete 7*complete 8*complete 5*complete 10) - 49958972383320 - Type: Fraction Integer - -The operation SFunction is the S-function or Schur function of a -partition written as a descending list of integers expressed in terms -of power sum symmetric functions. - -In this case the argument partition represents a tableau shape. For -example 3,2,2,1 represents a tableau with three boxes in the first -row, two boxes in the second and third rows, and one box in the fourth -row. SFunction [3,2,2,1] counts the number of different tableaux of -shape 3, 2, 2, 1 filled with objects with an ascending order in the -columns and a non-descending order in the rows. - - sf3221:= SFunction [3,2,2,1] - 1 1 2 1 2 1 1 4 1 2 - -- (6 2) - -- (6 1 ) - -- (4 ) + -- (4 3 1) + -- (4 1 ) - -- (3 2) - 12 12 16 12 24 36 - + - 1 2 2 1 2 1 3 1 5 1 4 1 3 2 - -- (3 1 ) - -- (3 2 1) - -- (3 2 1 ) - -- (3 1 ) - --- (2 ) + -- (2 1 ) - 36 24 36 72 192 48 - + - 1 2 4 1 6 1 8 - -- (2 1 ) - --- (2 1 ) + --- (1 ) - 96 144 576 - Type: SymmetricPolynomial Fraction Integer - -This is the number filled with a a b b c c d d. - - cap(sf3221,complete 2**4) - 3 - Type: Fraction Integer - -The configurations enumerated above are: - - a a b a a c a a d - b c b b b b - c d c d c c - d d d - -This is the number of tableaux filled with 1..8. - - cap(sf3221, powerSum 1**8) - 70 - Type: Fraction Integer - -The coefficient of x^n is the number of column strict reverse plane -partitions of n of shape 3 2 2 1. - - eval(Integers, sf3221) - 9 10 11 12 13 14 15 16 17 - x + 3x + 7x + 14x + 27x + 47x + 79x + 126x + 196x - + - 18 19 20 - 294x + 432x + O(x ) - Type: UnivariateLaurentSeries(Fraction Integer,x,0) - -The smallest is - - 0 0 0 - 1 1 - 2 2 - 3 - -See Also: -o )show CycleIndicators -o $AXIOM/doc/src/algebra/cycles.spad.dvi - -@ -<>= -)abbrev package CYCLES CycleIndicators -++ Polya-Redfield enumeration by cycle indices. -++ Author: William H. Burge -++ Date Created: 1986 -++ Date Last Updated: 11 Feb 1992 -++ Keywords:Polya, Redfield, enumeration -++ Examples: -++ References: J.H.Redfield, 'The Theory of Group-Reduced Distributions', -++ American J. Math., 49 (1927) 433-455. -++ G.Polya, 'Kombinatorische Anzahlbestimmungen fur Gruppen, -++ Graphen und chemische Verbindungen', Acta Math. 68 -++ (1937) 145-254. -++ Description: Enumeration by cycle indices. -CycleIndicators: Exports == Implementation where - I ==> Integer - L ==> List - B ==> Boolean - SPOL ==> SymmetricPolynomial - PTN ==> Partition - RN ==> Fraction Integer - FR ==> Factored Integer - h ==> complete - s ==> powerSum - --a ==> elementary - alt ==> alternating - cyc ==> cyclic - dih ==> dihedral - ev == eval - Exports ==> with - - complete: I -> SPOL RN - ++\spad{complete n} is the \spad{n} th complete homogeneous - ++ symmetric function expressed in terms of power sums. - ++ Alternatively it is the cycle index of the symmetric - ++ group of degree n. - - powerSum: I -> SPOL RN - ++\spad{powerSum n} is the \spad{n} th power sum symmetric - ++ function. - - elementary: I -> SPOL RN - ++\spad{elementary n} is the \spad{n} th elementary symmetric - ++ function expressed in terms of power sums. - - -- s2h: I -> SPOL RN--s to h - - alternating: I -> SPOL RN - ++\spad{alternating n} is the cycle index of the - ++ alternating group of degree n. - - cyclic: I -> SPOL RN --cyclic group - ++\spad{cyclic n} is the cycle index of the - ++ cyclic group of degree n. - - dihedral: I -> SPOL RN --dihedral group - ++\spad{dihedral n} is the cycle index of the - ++ dihedral group of degree n. - - graphs: I -> SPOL RN - ++\spad{graphs n} is the cycle index of the group induced on - ++ the edges of a graph by applying the symmetric function to the - ++ n nodes. - - cap: (SPOL RN,SPOL RN) -> RN - ++\spad{cap(s1,s2)}, introduced by Redfield, - ++ is the scalar product of two cycle indices. - - cup: (SPOL RN,SPOL RN) -> SPOL RN - ++\spad{cup(s1,s2)}, introduced by Redfield, - ++ is the scalar product of two cycle indices, in which the - ++ power sums are retained to produce a cycle index. - - eval: SPOL RN -> RN - ++\spad{eval s} is the sum of the coefficients of a cycle index. - - wreath: (SPOL RN,SPOL RN) -> SPOL RN - ++\spad{wreath(s1,s2)} is the cycle index of the wreath product - ++ of the two groups whose cycle indices are \spad{s1} and - ++ \spad{s2}. - - SFunction:L I -> SPOL RN - ++\spad{SFunction(li)} is the S-function of the partition \spad{li} - ++ expressed in terms of power sum symmetric functions. - - skewSFunction:(L I,L I) -> SPOL RN - ++\spad{skewSFunction(li1,li2)} is the S-function - ++ of the partition difference \spad{li1 - li2} - ++ expressed in terms of power sum symmetric functions. - - Implementation ==> add - import PartitionsAndPermutations - import IntegerNumberTheoryFunctions - - trm: PTN -> SPOL RN - trm pt == monomial(inv(pdct(pt) :: RN),pt) - - list: Stream L I -> L L I - list st == entries complete st - - complete i == - if i=0 - then 1 - else if i<0 - then 0 - else - _+/[trm(partition pt) for pt in list(partitions i)] - - - even?: L I -> B - even? li == even?( #([i for i in li | even? i])) - - alt i == - 2 * _+/[trm(partition li) for li in list(partitions i) | even? li] - elementary i == - if i=0 - then 1 - else if i<0 - then 0 - else - _+/[(spol := trm(partition pt); even? pt => spol; -spol) - for pt in list(partitions i)] - - divisors: I -> L I - divisors n == - b := factors(n :: FR) - c := concat(1,"append"/ - [[a.factor**j for j in 1..a.exponent] for a in b]); - if #(b) = 1 then c else concat(n,c) - - ss: (I,I) -> SPOL RN - ss(n,m) == - li : L I := [n for j in 1..m] - monomial(1,partition li) - - s n == ss(n,1) - - cyc n == - n = 1 => s 1 - _+/[(eulerPhi(i) / n) * ss(i,numer(n/i)) for i in divisors n] - - dih n == - k := n quo 2 - odd? n => (1/2) * cyc n + (1/2) * ss(2,k) * s 1 - (1/2) * cyc n + (1/4) * ss(2,k) + (1/4) * ss(2,k-1) * ss(1,2) - - trm2: L I -> SPOL RN - trm2 li == - lli := powers(li)$PTN - xx := 1/(pdct partition li) - prod : SPOL RN := 1 - for ll in lli repeat - ll0 := first ll; ll1 := second ll - k := ll0 quo 2 - c := - odd? ll0 => ss(ll0,ll1 * k) - ss(k,ll1) * ss(ll0,ll1 * (k - 1)) - c := c * ss(ll0,ll0 * ((ll1*(ll1 - 1)) quo 2)) - prod2 : SPOL RN := 1 - for r in lli | first(r) < ll0 repeat - r0 := first r; r1 := second r - prod2 := ss(lcm(r0,ll0),gcd(r0,ll0) * r1 * ll1) * prod2 - prod := c * prod2 * prod - xx * prod - - graphs n == _+/[trm2 li for li in list(partitions n)] - - cupp: (PTN,SPOL RN) -> SPOL RN - cupp(pt,spol) == - zero? spol => 0 - (dg := degree spol) < pt => 0 - dg = pt => (pdct pt) * monomial(leadingCoefficient spol,dg) - cupp(pt,reductum spol) - - cup(spol1,spol2) == - zero? spol1 => 0 - p := leadingCoefficient(spol1) * cupp(degree spol1,spol2) - p + cup(reductum spol1,spol2) - - ev spol == - zero? spol => 0 - leadingCoefficient(spol) + ev(reductum spol) - - cap(spol1,spol2) == ev cup(spol1,spol2) - - mtpol: (I,SPOL RN) -> SPOL RN - mtpol(n,spol)== - zero? spol => 0 - deg := partition [n*k for k in (degree spol)::L(I)] - monomial(leadingCoefficient spol,deg) + mtpol(n,reductum spol) - - fn2: I -> SPOL RN - evspol: ((I -> SPOL RN),SPOL RN) -> SPOL RN - evspol(fn2,spol) == - zero? spol => 0 - lc := leadingCoefficient spol - prod := _*/[fn2 i for i in (degree spol)::L(I)] - lc * prod + evspol(fn2,reductum spol) - - wreath(spol1,spol2) == evspol(mtpol(#1,spol2),spol1) - - hh: I -> SPOL RN --symmetric group - hh n == if n=0 then 1 else if n<0 then 0 else h n - SFunction li== - a:Matrix SPOL RN:=matrix [[hh(k -j+i) for k in li for j in 1..#li] - for i in 1..#li] - determinant a - - roundup:(L I,L I)-> L I - roundup(li1,li2)== - #li1 > #li2 => roundup(li1,concat(li2,0)) - li2 - - skewSFunction(li1,li2)== - #li1 < #li2 => - error "skewSFunction: partition1 does not include partition2" - li2:=roundup (li1,li2) - a:Matrix SPOL RN:=matrix [[hh(k-li2.i-j+i) - for k in li1 for j in 1..#li1] for i in 1..#li1] - determinant a - -@ -\section{package EVALCYC EvaluateCycleIndicators} -<>= -)abbrev package EVALCYC EvaluateCycleIndicators -++ Author: William H. Burge -++ Date Created: 1986 -++ Date Last Updated: Feb 1992 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: This package is to be used in conjuction with -++ the CycleIndicators package. It provides an evaluation -++ function for SymmetricPolynomials. -EvaluateCycleIndicators(F):T==C where - F:Algebra Fraction Integer - I==>Integer - L==>List - SPOL==SymmetricPolynomial - RN==>Fraction Integer - PR==>Polynomial(RN) - PTN==>Partition() - lc ==> leadingCoefficient - red ==> reductum - T== with - eval:((I->F),SPOL RN)->F - ++\spad{eval(f,s)} evaluates the cycle index s by applying - ++ the function f to each integer in a monomial partition, - ++ forms their product and sums the results over all monomials. - C== add - evp:((I->F),PTN)->F - fn:I->F - pt:PTN - spol:SPOL RN - i:I - evp(fn, pt)== _*/[fn i for i in pt::(L I)] - - eval(fn,spol)== - if spol=0 - then 0 - else ((lc spol)* evp(fn,degree spol)) + eval(fn,red spol) - -@ -\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/cyclotom.spad.pamphlet b/src/algebra/cyclotom.spad.pamphlet deleted file mode 100644 index 1d8c77d..0000000 --- a/src/algebra/cyclotom.spad.pamphlet +++ /dev/null @@ -1,109 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra cyclotom.spad} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package CYCLOTOM CyclotomicPolynomialPackage} -<>= -)abbrev package CYCLOTOM CyclotomicPolynomialPackage -++ This package \undocumented{} -CyclotomicPolynomialPackage: public == private where - SUP ==> SparseUnivariatePolynomial(Integer) - LSUP ==> List(SUP) - NNI ==> NonNegativeInteger - FR ==> Factored SUP - IFP ==> IntegerFactorizationPackage Integer - - public == with - cyclotomicDecomposition: Integer -> LSUP - ++ cyclotomicDecomposition(n) \undocumented{} - cyclotomic: Integer -> SUP - ++ cyclotomic(n) \undocumented{} - cyclotomicFactorization: Integer -> FR - ++ cyclotomicFactorization(n) \undocumented{} - - private == add - cyclotomic(n:Integer): SUP == - x,y,z,l: SUP - g := factors factor(n)$IFP - --Now, for each prime in the factorization apply recursion - l := monomial(1,1) - monomial(1,0) - for u in g repeat - l := (monicDivide(multiplyExponents(l,u.factor::NNI),l)).quotient - if u.exponent>1 then - l := multiplyExponents(l,((u.factor)**((u.exponent-1)::NNI))::NNI) - l - - cyclotomicDecomposition(n:Integer):LSUP == - x,y,z: SUP - l,ll,m: LSUP - rr: Integer - g := factors factor(n)$IFP - l := [monomial(1,1) - monomial(1,0)] - --Now, for each prime in the factorization apply recursion - for u in g repeat - m := [(monicDivide( - multiplyExponents(z,u.factor::NNI),z)).quotient for z in l] - for rr in 1..(u.exponent-1) repeat - l := append(l,m) - m := [multiplyExponents(z,u.factor::NNI) for z in m] - l := append(l,m) - l - - cyclotomicFactorization(n:Integer):FR == - f : SUP - fr : FR := 1$FR - for f in cyclotomicDecomposition(n) repeat - fr := fr * primeFactor(f,1$Integer) - fr - -@ -\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}