diff --git a/books/bookvol10.1.pamphlet b/books/bookvol10.1.pamphlet index 328585c..97562f7 100644 --- a/books/bookvol10.1.pamphlet +++ b/books/bookvol10.1.pamphlet @@ -1998,6 +1998,434 @@ constructing the divisors $\delta_j$ and the $u_j$'s as in that case. Again, the details are quite technical and can be found in \cite{2,12,13}. +\chapter{Singular Value Decomposition} +\section{Singular Value Decomposition Tutorial} + +When you browse standard web sources like Wikipedia to learn about +Singular Value Decomposition or SVD you find many equations, but +not an intuitive explanation of what it is or how it works. SVD +is a way of factoring matrices into a series of linear approximations +that expose the underlying structure of the matrix. Two important +properties are that the linear factoring is exact and optimal. Exact +means that the series of linear factors, added together, exactly +equal the original matrix. Optimal means that, for the standard +means of measuring matrix similarity (the Frobenius norm), these +factors give the best possible linear approximation at each step +in the series. + +SVD is extraordinarily useful and has many applications such as +data analysis, signal processing, pattern recognition, image +compression, weather prediction, and Latent Sematic Analysis or +LSA (also referred to as Latent Semantic Indexing). Why is SVD +so useful and how does it work? + +As a simple example, let's look at golf scores. Suppose Phil, +Tiger, and Vijay play together for 9 holes and they each make +par on every hole. Their scorecard, which can also be viewed as +a (hole x player) matrix might look like this. + +\begin{tabular}{|c|c|c|c|c|} +Hole & Par & Phil & Tiger & Vijay\\ +\hline +1 & 4 & 4 & 4 & 4\\ +2 & 5 & 5 & 5 & 5\\ +3 & 3 & 3 & 3 & 3\\ +4 & 4 & 4 & 4 & 4\\ +5 & 4 & 4 & 4 & 4\\ +6 & 4 & 4 & 4 & 4\\ +7 & 4 & 4 & 4 & 4\\ +8 & 3 & 3 & 3 & 3\\ +9 & 5 & 5 & 5 & 5\\ +\end{tabular} + +Let's look at the problem of trying to predict what score each +player will make on a given hole. One idea is give each hole a +HoleDifficulty factor, and each player a PlayerAbility factor. +The actual score is predicted by multiplying these two factors +together. + +PredictedScore = HoleDifficulty * PlayerAbility + +For the first attempt, let's make the HoleDifficulty be the par +score for the hole, and let's make the player ability equal to 1. +So on the first hole, which is par 4, we would expect a player +of ability 1 to get a score of 4. + +PredictedScore = HoleDifficulty * PlayerAbility = 4 * 1 = 4 + +For our entire scorecard or matrix, all we have to do is multiply +the PlayerAbility (assumed to be 1 for all players) by the +HoleDifficulty (ranges from par 3 to par 5) and we can exactly +predict all the scores in our example. + +In fact, this is the one dimensional (1-D) SVD factorization of +the scorecard. We can represent our scorecard or matrix as the +product of two vectors, the HoleDifficulty vector and the +PlayerAbility vector. To predict any score, simply multiply the +appropriate HoleDifficulty factor by the appropriate PlayerAbility +factor. Following normal vector multiplication rules, we can + +generate the matrix of scores by multiplying the HoleDifficulty +vector by the PlayerAbility vector, according to the following +equation. + +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +4 & 4 & 4\\ +5 & 5 & 5\\ +3 & 3 & 3\\ +4 & 4 & 4\\ +4 & 4 & 4\\ +4 & 4 & 4\\ +4 & 4 & 4\\ +3 & 3 & 3\\ +5 & 5 & 5\\ +\end{tabular} + = +\begin{tabular}{|c|} +4\\ +5\\ +3\\ +4\\ +4\\ +4\\ +4\\ +3\\ +5\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +1 & 1 & 1\\ +\end{tabular} + +which is HoleDifficulty * PlayerAbility + +Mathematicians like to keep everything orderly, so the convention +is that all vectors should be scaled so they have length 1. For +example, the PlayerAbility vector is modified so that the sum of +the squares of its elements add to 1, instead of the current +$12 + 12 + 12 = 3$. To do this, we have to divide each element by +the square root of 3, so that when we square it, it becomes +and the three elements add to 1. Similarly, we have to divide +each HoleDifficulty element by the square root of 148. The square +root of 3 times the square root of 148 is our scaling factor 21.07. +The complete 1-D SVD factorization (to 2 decimal places) is: + +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +4 & 4 & 4\\ +5 & 5 & 5\\ +3 & 3 & 3\\ +4 & 4 & 4\\ +4 & 4 & 4\\ +4 & 4 & 4\\ +4 & 4 & 4\\ +3 & 3 & 3\\ +5 & 5 & 5\\ +\end{tabular} + = +\begin{tabular}{|c|} +0.33\\ +0.41\\ +0.25\\ +0.33\\ +0.33\\ +0.33\\ +0.33\\ +0.25\\ +0.41\\ +\end{tabular} + * +\begin{tabular}{|c|} +21.07\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +0.58 & 0.58 & 0.58\\ +\end{tabular} + +which is HoleDifficulty * ScaleFactor * PlayerAbility + +Our HoleDifficulty vector, that starts with 0.33, is called the +Left Singular Vector. The ScaleFactor is the Singular Value, and +our PlayerAbility vector, that starts with 0.58 is the Right +Singular Vector. If we represent these 3 parts exactly, and multiply +them together, we get the exact original scores. This means our +matrix is a rank 1 matrix, another way of saying it has a simple +and predictable pattern. + +More complicated matrices cannot be completely predicted just by +using one set of factors as we have done. In that case, we have to +introduce a second set of factors to refine our predictions. To do +that, we subtract our predicted scores from the actual scores, +getting the residual scores. Then we find a second set of +HoleDifficulty2 and PlayerAbility2 numbers that best predict the +residual scores. + +Rather than guessing HoleDifficulty and PlayerAbility factors and +subtracting predicted scores, there exist powerful algorithms than +can calculate SVD factorizations for you. Let's look at the actual +scores from the first 9 holes of the 2007 Players Championship as +played by Phil, Tiger, and Vijay. + +\begin{tabular}{|c|c|c|c|c|} +Hole & Par & Phil & Tiger & Vijay\\ +\hline +1 & 4 & 4 & 4 & 5\\ +2 & 5 & 4 & 5 & 5\\ +3 & 3 & 3 & 3 & 2\\ +4 & 4 & 4 & 5 & 4\\ +5 & 4 & 4 & 4 & 4\\ +6 & 4 & 3 & 5 & 4\\ +7 & 4 & 4 & 4 & 3\\ +8 & 3 & 2 & 4 & 4\\ +9 & 5 & 5 & 5 & 5\\ +\end{tabular} + +The 1-D SVD factorization of the scores is shown below. To make +this example easier to understand, I have incorporated the ScaleFactor +into the PlayerAbility and HoleDifficulty vectors so we can ignore +the ScaleFactor for this example. + +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +3.95 & 4.64 & 4.34\\ +4.27 & 5.02 & 4.69\\ +2.42 & 2.85 & 2.66\\ +3.97 & 4.67 & 4.36\\ +3.64 & 4.28 & 4.00\\ +3.69 & 4.33 & 4.05\\ +3.33 & 3.92 & 3.66\\ +3.08 & 3.63 & 3.39\\ +4.55 & 5.35 & 5.00\\ +\end{tabular} + = +\begin{tabular}{|c|} +4.34\\ +4.69\\ +2.66\\ +4.36\\ +4.00\\ +4.05\\ +3.66\\ +3.39\\ +5.00\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +0.91 & 1.07 & 1.00\\ +\end{tabular} + +which is HoleDifficulty * PlayerAbility + +Notice that the HoleDifficulty factor is almost the average of that +hole for the 3 players. For example hole 5, where everyone scored 4, +does have a factor of 4.00. However hole 6, where the average score +is also 4, has a factor of 4.05 instead of 4.00. Similarly, the +PlayerAbility is almost the percentage of par that the player +achieved, For example Tiger shot 39 with par being 36, and +$39/36 = 1.08$ which is almost his PlayerAbility factor (for these +9 holes) of 1.07. + +Why don't the hole averages and par percentages exactly match the +1-D SVD factors? The answer is that SVD further refines those +numbers in a cycle. For example, we can start by assuming +HoleDifficulty is the hole average and then ask what PlayerAbility +best matches the scores, given those HoleDifficulty numbers? Once +we have that answer we can go back and ask what HoleDifficulty best +matches the scores given those PlayerAbility numbers? We keep +iterating this way until we converge to a set of factors that best +predict the score. SVD shortcuts this process and immediately give +us the factors that we would have converged to if we carried out +the process. + +One very useful property of SVD is that it always finds the optimal +set of factors that best predict the scores, according to the +standard matrix similarity measure (the Frobenius norm). That is, +if we use SVD to find the factors of a matrix, those are the best +factors that can be found. This optimality property means that we +don't have to wonder if a different set of numbers might predict +scores better. + +Now let's look at the difference between the actual scores and our +1-D approximation. A plus difference means that the actual score is +higher than the predicted score, a minus difference means the actual +score is lower than the prediction. For example, on the first hole +Tiger got a 4 and the predicted score was 4.64 so we get +$4 - 4.64 = -0.64$. In other words, we must add -0.64 to our prediction +to get the actual score. + +Once these differences have been found, we can do the same thing +again and predict these differences using the formula +HoleDifficulty2 * PlayerAbility2. Since these factors are trying +to predict the differences, they are the 2-D factors and we have +put a 2 after their names (ex. HoleDifficulty2) to show they are +the second set of factors. + +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +0.05 & -0.64 & 0.66\\ +-0.28 & -0.02 & 0.31\\ +0.58 & 0.15 & -0.66\\ +0.03 & 0.33 & -0.36\\ +0.36 & -0.28 & 0.00\\ +-0.69 & 0.67 & -0.05\\ +0.67 & 0.08 & -0.66\\ +-1.08 & 0.37 & 0.61\\ +0.45 & -0.35 & 0.00\\ +\end{tabular} + = +\begin{tabular}{|c|} +-0.18\\ +-0.38\\ +0.80\\ +0.15\\ +0.35\\ +-0.67\\ +0.89\\ +-1.29\\ +0.44\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +0.82 & -0.20 & -0.53\\ +\end{tabular} + +which is HoleDifficulty(2) * PlayerAbility(2) + +There are some interesting observations we can make about these +factors. Notice that hole 8 has the most significant HoleDifficulty2 +factor (1.29). That means that it is the hardest hole to predict. +Indeed, it was the only hole on which none of the 3 players made +par. It was especially hard to predict because it was the most +difficult hole relative to par +$(HoleDifficulty - par) = (3.39 - 3) = 0.39$, and yet Phil birdied +it making his score more than a stroke below his predicted score +(he scored 2 versus his predicted score of 3.08). Other holes that +were hard to predict were holes 3 (0.80) and 7 (0.89) because Vijay +beat Phil on those holes even though, in general, Phil was playing +better. + +The full SVD for this example matrix (9 holes by 3 players) has 3 +sets of factors. In general, a m x n matrix where m >= n can have +at most n factors, so our $9 x 3$ matrix cannot have more than 3 sets +of factors. Here is the full SVD factorization (to two decimal places). + +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +4 & 4 & 5\\ +4 & 5 & 5\\ +3 & 3 & 2\\ +4 & 5 & 4\\ +4 & 4 & 4\\ +3 & 5 & 4\\ +4 & 4 & 3\\ +2 & 4 & 4\\ +5 & 5 & 5\\ +\end{tabular} + = +\begin{tabular}{|c|c|c|} +4.34 & -0.18 & -0.90\\ +4.69 & -0.38 & -0.15\\ +2.66 & 0.80 & 0.40\\ +4.36 & 0.15 & 0.47\\ +4.00 & 0.35 & -0.29\\ +4.05 & -0.67 & 0.68\\ +3.66 & 0.89 & 0.33\\ +3.39 & -1.29 & 0.14\\ +5.00 & 0.44 & -0.36\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +0.91 & 1.07 & 1.00\\ +0.82 & -0.20 & -0.53\\ +-0.21 & 0.76 & -0.62\\ +\end{tabular} + +which is HoleDifficulty(1-3) * PlayerAbility(1-3) + +By SVD convention, the HoleDifficulty and PlayerAbility vectors +should all have length 1, so the conventional SVD factorization +is: + +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +4 & 4 & 5\\ +4 & 5 & 5\\ +3 & 3 & 2\\ +4 & 5 & 4\\ +4 & 4 & 4\\ +3 & 5 & 4\\ +4 & 4 & 3\\ +2 & 4 & 4\\ +5 & 5 & 5\\ +\end{tabular} + = +\begin{tabular}{|c|c|c|} +0.35 & 0.09 & -0.64\\ +0.38 & 0.19 & -0.10\\ +0.22 & -0.40 & 0.28\\ +0.36 & -0.08 & 0.33\\ +0.33 & -0.18 & -0.20\\ +0.33 & 0.33 & 0.48\\ +0.30 & -0.44 & 0.23\\ +0.28 & 0.64 & 0.10\\ +0.41 & -0.22 & -0.25\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +21.07 & 0 & 0\\ +0 & 2.01 & 0\\ +0 & 0 & 1.42\\ +\end{tabular} + * +\begin{tabular}{|c|c|c|} +Phil & Tiger & Vijay\\ +\hline +0.53 & 0.62 & 0.58\\ +-0.82 & 0.20 & 0.53\\ +-0.21 & 0.76 & -0.62\\ +\end{tabular} + +which is HoleDifficulty(1-3)* ScaleFactor(1-3) * PlayerAbility(1-3) + +We hope that you have some idea of what SVD is and how it can be +used. The next section covers applying SVD to Latent Sematic +Analysis or LSA. Although the domain is different, the concepts +are the same. We are trying to predict patterns of how words occur +in documents instead of trying to predict patterns of how players +score on holes. +\chapter{Groebner Basis} +Groebner Basis +\chapter{Greatest Common Divisor} +Greatest Common Divisor +\chapter{Polynomial Factorization} +Polynomial Factorization +\chapter{Cylindrical Algebraic Decomposition} +Cylindrical Algebraic Decomposition +\chapter{Pade approximant} +Pade approximant +\chapter{Schwartz-Zippel lemma and testing polynomial identities} +Schwartz-Zippel lemma and testing polynomial identities +\chapter{Chinese Remainder Theorem} +Chinese Remainder Theorem +\chapter{Gaussian Elimination} +Gaussian Elimination +\chapter{Diophantine Equations} +Diophantine Equations \begin{thebibliography}{99} \bibitem{1} Laurent Bertrand. Computing a hyperelliptic integral using arithmetic in the jacobian of the curve. {\sl Applicable Algebra in @@ -2085,6 +2513,7 @@ Literate Programming''\\ {\bf http://www.eecs.harvard.edu/ $\tilde{}$nr/noweb} \bibitem{31} Daly, Timothy, "The Axiom Literate Documentation"\\ {\bf http://axiom.axiom-developer.org/axiom-website/documentation.html} +\bibitem{32} {\bf http://www.puffinwarellc.com/p3a.htm} \end{thebibliography} \printindex \end{document} diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 0d1cee4..9b3fdea 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -6717,6 +6717,7 @@ AssociatedLieAlgebra(R:CommutativeRing,A:NonAssociativeAlgebra R): \section{domain ALIST AssociationList} <>= -- list.spad.pamphlet AssociationList.input +)sys rm AssociationList.output )spool AssociationList.output )set message test on )set message auto off @@ -7443,6 +7444,7 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with \section{domain BBTREE BalancedBinaryTree} <>= -- tree.spad.pamphlet BalancedBinaryTree.input +)sys rm BalancedBinaryTree.output )spool BalancedBinaryTree.output )set message test on )set message auto off @@ -8150,6 +8152,7 @@ BasicFunctions(): E == I where \section{domain BOP BasicOperator} <>= -- op.spad.pamphlet BasicOperator.input +)sys rm BasicOperator.output )spool BasicOperator.output )set message test on )set message auto off @@ -8684,6 +8687,7 @@ BasicOperator(): Exports == Implementation where \section{domain BINARY BinaryExpansion} <>= -- radix.spad.pamphlet BinaryExpansion.input +)sys rm BinaryExpansion.output )spool BinaryExpansion.output )set message test on )set message auto off @@ -9118,6 +9122,7 @@ BinaryFile: Cat == Def where \section{domain BSTREE BinarySearchTree} <>= -- tree.spad.pamphlet BinarySearchTree.input +)sys rm BinarySearchTree.output )spool BinarySearchTree.output )set message test on )set message auto off @@ -9924,6 +9929,7 @@ Boolean(): Join(OrderedSet, Finite, Logic, ConvertibleTo InputForm) with \section{domain CARD CardinalNumber} <>= -- card.spad.pamphlet CardinalNumber.input +)sys rm CardinalNumber.output )spool CardinalNumber.output )set message test on )set message auto off @@ -10470,6 +10476,7 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid, \section{domain CARTEN CartesianTensor} <>= -- carten.spad.pamphlet CartesianTensor.input +)sys rm CartesianTensor.output )spool CartesianTensor.output )set message test on )set message auto off @@ -12064,6 +12071,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where \section{domain CHAR Character} <>= -- string.spad.pamphlet Character.input +)sys rm Character.output )spool Character.output )set message test on )set message auto off @@ -12454,6 +12462,7 @@ Character: OrderedFinite() with \section{domain CCLASS CharacterClass} <>= -- string.spad.pamphlet CharacterClass.input +)sys rm CharacterClass.output )spool CharacterClass.output )set message test on )set message auto off @@ -13066,6 +13075,7 @@ $\mathbb{R}_{m,m}$ & --------$>$ & $\mathbb{R}^{4^m}$ \\ \end{tabular} <>= -- clifford.spad.pamphlet CliffordAlgebra.input +)sys rm CliffordAlgebra.output )spool CliffordAlgebra.output )set message test on )set message auto off @@ -14120,6 +14130,7 @@ Commutator: Export == Implement where \section{domain COMPLEX Complex} <>= -- gaussian.spad.pamphlet Complex.input +)sys rm Complex.output )spool Complex.output )set message test on )set message auto off @@ -14636,6 +14647,7 @@ Complex(R:CommutativeRing): ComplexCategory(R) with \section{domain CONTFRAC ContinuedFraction} <>= -- contfrac.spad.pamphlet ContinuedFraction.input +)sys rm ContinuedFraction.output )spool ContinuedFraction.output )set message test on )set message auto off @@ -15806,6 +15818,7 @@ DataList(S:OrderedSet) : Exports == Implementation where \section{domain DECIMAL DecimalExpansion} <>= -- radix.spad.pamphlet DecimalExpansion.input +)sys rm DecimalExpansion.output )spool DecimalExpansion.output )set message test on )set message auto off @@ -17980,6 +17993,7 @@ Dequeue(S:SetCategory): DequeueAggregate S with \section{domain DERHAM DeRhamComplex} <>= -- derham.spad.pamphlet DeRhamComplex.input +)sys rm DeRhamComplex.output )spool DeRhamComplex.output )set message test on )set message auto off @@ -19318,6 +19332,7 @@ DirectProductModule(n, R, S): DPcategory == DPcapsule where \section{domain DMP DistributedMultivariatePolynomial} <>= -- gdpoly.spad.pamphlet DistributedMultivariatePolynomial.input +)sys rm DistributedMultivariatePolynomial.output )spool DistributedMultivariatePolynomial.output )set message test on )set message auto off @@ -19807,6 +19822,7 @@ complex number.) \end{quote} <>= -- sf.spad.pamphlet DoubleFloat.input +)sys rm DoubleFloat.output )spool DoubleFloat.output )set message test on )set message auto off @@ -22409,6 +22425,7 @@ d03fafAnnaType():PartialDifferentialEquationsSolverCategory == Result add \section{domain EQ Equation} <>= -- equation2.spad.pamphlet Equation.input +)sys rm Equation.output )spool Equation.output )set message test on )set message auto off @@ -22865,6 +22882,7 @@ Equation(S: Type): public == private where \section{domain EQTBL EqTable} <>= -- table.spad.pamphlet EqTable.input +)sys rm EqTable.output )spool EqTable.output )set message test on )set message auto off @@ -23228,6 +23246,7 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, \section{domain EXIT Exit} <>= -- void.spad.pamphlet Exit.input +)sys rm Exit.output )spool Exit.output )set message test on )set message auto off @@ -23620,6 +23639,7 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where \section{domain EXPR Expression} <>= -- expr.spad.pamphlet Expression.input +)sys rm Expression.output )spool Expression.output )set message test on )set message auto off @@ -25826,6 +25846,7 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add \section{domain FR Factored} <>= -- fr.spad.pamphlet Factored.input +)sys rm Factored.output )spool Factored.output )set message test on )set message auto off @@ -27066,6 +27087,7 @@ Factored(R: IntegralDomain): Exports == Implementation where \section{domain FILE File} <>= -- files.spad.pamphlet File.input +)sys rm File.output )spool File.output )set message test on )set message auto off @@ -27377,6 +27399,7 @@ File(S:SetCategory): FileCategory(FileName, S) with \section{domain FNAME FileName} <>= -- fname.spad.pamphlet FileName.input +)sys rm FileName.output )spool FileName.output )set message test on )set message auto off @@ -29978,6 +30001,7 @@ divisor of the order of the multiplicative group" \section{domain FARRAY FlexibleArray} <>= -- array1.spad.pamphlet FlexibleArray.input +)sys rm FlexibleArray.output )spool FlexibleArray.output )set message test on )set message auto off @@ -30385,6 +30409,7 @@ of shift for negative arguments will cause bugs in other parts of Axiom. <>= -- float.spad.pamphlet Float.input +)sys rm Float.output )spool Float.output )set message test on )set message auto off @@ -34273,6 +34298,7 @@ FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), \section{domain FRAC Fraction} <>= -- fraction.spad.pamphlet Fraction.input +)sys rm Fraction.output )spool Fraction.output )set message test on )set message auto off @@ -36208,6 +36234,7 @@ FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where \section{domain FPARFRAC FullPartialFractionExpansion} <>= -- fparfrac.spad.pamphlet FullPartialFractionExpansion.input +)sys rm FullPartialFractionExpansion.output )spool FullPartialFractionExpansion.output )set message test on )set message auto off @@ -36923,6 +36950,7 @@ FunctionCalled(f:Symbol): SetCategory with \section{domain GDMP GeneralDistributedMultivariatePolynomial} <>= -- gdpoly.spad.pamphlet GeneralDistributedMultivariatePolynomial.input +)sys rm GeneralDistributedMultivariatePolynomial.output )spool GeneralDistributedMultivariatePolynomial.output )set message test on )set message auto off @@ -38142,6 +38170,7 @@ GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where \section{domain GSTBL GeneralSparseTable} <>= -- table.spad.pamphlet GeneralSparseTable.input +)sys rm GeneralSparseTable.output )spool GeneralSparseTable.output )set message test on )set message auto off @@ -39510,6 +39539,7 @@ HashTable(Key, Entry, hashfn): Exports == Implementation where \section{domain HEAP Heap} <>= -- bags.spad.pamphlet Heap.input +)sys rm Heap.output )spool Heap.output )set message test on )set message auto off @@ -39775,6 +39805,7 @@ Heap(S:OrderedSet): Exports == Implementation where \section{domain HEXADEC HexadecimalExpansion} <>= -- radix.spad.pamphlet HexadecimalExpansion.input +)sys rm HexadecimalExpansion.output )spool HexadecimalExpansion.output )set message test on )set message auto off @@ -40183,6 +40214,7 @@ HomogeneousDirectProduct(dim,S) : T == C where \section{domain HDMP HomogeneousDistributedMultivariatePolynomial} <>= -- gdpoly.spad.pamphlet HomogeneousDistributedMultivariatePolynomial.input +)sys rm HomogeneousDistributedMultivariatePolynomial.output )spool HomogeneousDistributedMultivariatePolynomial.output )set message test on )set message auto off @@ -45930,6 +45962,7 @@ The NAG version called a lisp primitive that exists only in Codemist Common Lisp and is not defined in Common Lisp. <>= -- integer.spad.pamphlet Integer.input +)sys rm Integer.output )spool Integer.output )set message test on )set message auto off @@ -47870,6 +47903,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa \section{domain KERNEL Kernel} <>= -- kl.spad.pamphlet Kernel.input +)sys rm Kernel.output )spool Kernel.output )set message test on )set message auto off @@ -48358,6 +48392,7 @@ Kernel(S:OrderedSet): Exports == Implementation where \section{domain KAFILE KeyedAccessFile} <>= -- files.spad.pamphlet KeyedAccessFile.input +)sys rm KeyedAccessFile.output )spool KeyedAccessFile.output )set message test on )set message auto off @@ -48927,6 +48962,7 @@ LaurentPolynomial(R, UP): Exports == Implementation where \section{domain LIB Library} <>= -- files.spad.pamphlet Library.input +)sys rm Library.output )spool Library.output )set message test on )set message auto off @@ -49109,6 +49145,7 @@ Library(): TableAggregate(String, Any) with \section{domain LEXP LieExponentials} <>= -- xlpoly.spad.pamphlet LieExponentials.input +)sys rm LieExponentials.output )spool LieExponentials.output )set message test on )set message auto off @@ -49503,6 +49540,7 @@ LieExponentials(VarSet, R, Order): XDPcat == XDPdef where \section{domain LPOLY LiePolynomial} <>= -- xlpoly.spad.pamphlet LiePolynomial.input +)sys rm LiePolynomial.output )spool LiePolynomial.output )set message test on )set message auto off @@ -50381,6 +50419,7 @@ LieSquareMatrix(n,R): Exports == Implementation where \section{domain LODO LinearOrdinaryDifferentialOperator} <>= -- lodo.spad.pamphlet LinearOrdinaryDifferentialOperator.input +)sys rm LinearOrdinaryDifferentialOperator.output )spool LinearOrdinaryDifferentialOperator.output )set message test on )set message auto off @@ -50971,6 +51010,7 @@ LinearOrdinaryDifferentialOperator(A:Ring, diff: A -> A): \section{domain LODO1 LinearOrdinaryDifferentialOperator1} <>= -- lodo.spad.pamphlet LinearOrdinaryDifferentialOperator1.input +)sys rm LinearOrdinaryDifferentialOperator1.output )spool LinearOrdinaryDifferentialOperator1.output )set message test on )set message auto off @@ -51450,6 +51490,7 @@ LinearOrdinaryDifferentialOperator1(A:DifferentialRing) == \section{domain LODO2 LinearOrdinaryDifferentialOperator2} <>= -- lodo.spad.pamphlet LinearOrdinaryDifferentialOperator2.input +)sys rm LinearOrdinaryDifferentialOperator2.output )spool LinearOrdinaryDifferentialOperator2.output )set message test on )set message auto off @@ -52068,6 +52109,7 @@ LinearOrdinaryDifferentialOperator2(A, M): Exports == Implementation where \section{domain LIST List} <>= -- list.spad.pamphlet List.input +)sys rm List.output )spool List.output )set message test on )set message auto off @@ -53479,6 +53521,7 @@ Localize(M:Module R, \section{domain LWORD LyndonWord} <>= -- xlpoly.spad.pamphlet LyndonWord.input +)sys rm LyndonWord.output )spool LyndonWord.output )set message test on )set message auto off @@ -54774,6 +54817,7 @@ MachineInteger(): Exports == Implementation where \section{domain MAGMA Magma} <>= -- xlpoly.spad.pamphlet Magma.input +)sys rm Magma.output )spool Magma.output )set message test on )set message auto off @@ -55322,6 +55366,7 @@ MakeCachableSet(S:SetCategory): Exports == Implementation where \section{domain MATRIX Matrix} <>= -- matrix.spad.pamphlet Matrix.input +)sys rm Matrix.output )spool Matrix.output )set message test on )set message auto off @@ -57876,6 +57921,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where \section{domain MSET Multiset} <>= -- mset.spad.pamphlet Multiset.input +)sys rm Multiset.output )spool Multiset.output )set message test on )set message auto off @@ -58436,6 +58482,7 @@ Multiset(S: SetCategory): MultisetAggregate S with \section{domain MPOLY MultivariatePolynomial} <>= -- multpoly.spad.pamphlet MultivariatePolynomial.input +)sys rm MultivariatePolynomial.output )spool MultivariatePolynomial.output )set message test on )set message auto off @@ -60048,6 +60095,7 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where \section{domain NONE None} <>= -- any.spad.pamphlet None.input +)sys rm None.output )spool None.output )set message test on )set message auto off @@ -60620,6 +60668,7 @@ associative, since $I*(J*K) \ne (I*J)*K$. \includegraphics{ps/v103octoniongraph.eps} <>= -- oct.spad.pamphlet Octonion.input +)sys rm Octonion.output )spool Octonion.output )set message test on )set message auto off @@ -61089,6 +61138,7 @@ ODEIntensityFunctionsTable(): E == I where \section{domain ARRAY1 OneDimensionalArray} <>= -- array1.spad.pamphlet OneDimensionalArray.input +)sys rm OneDimensionalArray.output )spool OneDimensionalArray.output )set message test on )set message auto off @@ -62019,6 +62069,7 @@ OpenMathErrorKind() : SetCategory with \section{domain OP Operator} <>= -- opalg.spad.pamphlet Operator.input +)sys rm Operator.output )spool Operator.output )set message test on )set message auto off @@ -63060,6 +63111,7 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where \section{domain OVAR OrderedVariableList} <>= -- variable.spad.pamphlet OrderedVariableList.input +)sys rm OrderedVariableList.output )spool OrderedVariableList.output )set message test on )set message auto off @@ -63221,6 +63273,7 @@ OrderedVariableList(VariableList:List Symbol): \pageto{SequentialDifferentialPolynomial}{SDPOL} <>= -- dpolcat.spad.pamphlet OrderlyDifferentialPolynomial.input +)sys rm OrderlyDifferentialPolynomial.output )spool OrderlyDifferentialPolynomial.output )set message test on )set message auto off @@ -65638,6 +65691,7 @@ ParametricSurface(ComponentFunction): Exports == Implementation where \section{domain PFR PartialFraction} <>= -- pfr.spad.pamphlet PartialFraction.input +)sys rm PartialFraction.output )spool PartialFraction.output )set message test on )set message auto off @@ -67400,6 +67454,7 @@ domain. <>= -- perm.spad.pamphlet Permutation.input +)sys rm Permutation.output )spool Permutation.output )set message test on )set message auto off @@ -68741,6 +68796,7 @@ Pi(): Exports == Implementation where \section{domain ACPLOT PlaneAlgebraicCurvePlot} <>= -- acplot.spad.pamphlet PlaneAlgebraicCurvePlot.input +)sys rm PlaneAlgebraicCurvePlot.output )spool PlaneAlgebraicCurvePlot.output )set message test on )set message auto off @@ -70005,6 +70061,7 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ \section{domain PLOT Plot} <>= -- plot.spad.pamphlet Plot.input +)sys rm Plot.output )spool Plot.output )set message test on )set message auto off @@ -71491,6 +71548,7 @@ Point(R:Ring) : Exports == Implementation where \section{domain POLY Polynomial} <>= -- multpoly.spad.pamphlet Polynomial.input +)sys rm Polynomial.output )spool Polynomial.output )set message test on )set message auto off @@ -74002,6 +74060,7 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T \section{domain QUAT Quaternion} <>= -- quat.spad.pamphlet Quaternion.input +)sys rm Quaternion.output )spool Quaternion.output )set message test on )set message auto off @@ -74819,6 +74878,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where \section{domain RADIX RadixExpansion} <>= -- radix.spad.pamphlet RadixExpansion.input +)sys rm RadixExpansion.output )spool RadixExpansion.output )set message test on )set message auto off @@ -75488,6 +75548,7 @@ computations are done excatly. They can thus be quite time consuming when depending on several "real roots". <>= -- reclos.spad.pamphlet RealClosure.input +)sys rm RealClosure.output )spool RealClosure.output )set message test on )set message auto off @@ -77453,6 +77514,7 @@ systems. This method is refined in the package {\bf LazardSetSolvingPackage} in order to produce decompositions by means of Lazard triangular sets. <>= -- regset.spad.pamphlet RegularTriangularSet.input +)sys rm RegularTriangularSet.output )spool RegularTriangularSet.output )set message test on )set message auto off @@ -80253,6 +80315,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where \section{domain ROMAN RomanNumeral} <>= -- integer.spad.pamphlet RomanNumeral.input +)sys rm RomanNumeral.output )spool RomanNumeral.output )set message test on )set message auto off @@ -81703,6 +81766,7 @@ ScriptFormulaFormat(): public == private where \section{domain SEG Segment} <>= -- seg.spad.pamphlet Segment.input +)sys rm Segment.output )spool Segment.output )set message test on )set message auto off @@ -81983,6 +82047,7 @@ Segment(S:Type): SegmentCategory(S) with \section{domain SEGBIND SegmentBinding} <>= -- seg.spad.pamphlet SegmentBinding.input +)sys rm SegmentBinding.output )spool SegmentBinding.output )set message test on )set message auto off @@ -82164,6 +82229,7 @@ SegmentBinding(S:Type): Type with \section{domain SET Set} <>= -- sets.spad.pamphlet Set.input +)sys rm Set.output )spool Set.output )set message test on )set message auto off @@ -83651,6 +83717,7 @@ as it relies on calling {\bf ONEP} which is a function specific to Codemist Common Lisp but is not defined in Common Lisp. <>= -- si.spad.pamphlet SingleInteger.input +)sys rm SingleInteger.output )spool SingleInteger.output )set message test on )set message auto off @@ -85214,6 +85281,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ \section{domain STBL SparseTable} <>= -- table.spad.pamphlet SparseTable.input +)sys rm SparseTable.output )spool SparseTable.output )set message test on )set message auto off @@ -87952,6 +88020,7 @@ SplittingTree(V,C) : Exports == Implementation where \section{domain SREGSET SquareFreeRegularTriangularSet} <>= -- sregset.spad.pamphlet SquareFreeRegularTriangularSet.input +)sys rm SquareFreeRegularTriangularSet.output )spool SquareFreeRegularTriangularSet.output )set message test on )set message auto off @@ -88927,6 +88996,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where \section{domain SQMATRIX SquareMatrix} <>= -- matrix.spad.pamphlet SquareMatrix.input +)sys rm SquareMatrix.output )spool SquareMatrix.output )set message test on )set message auto off @@ -89401,6 +89471,7 @@ Stack(S:SetCategory): StackAggregate S with \section{domain STREAM Stream} <>= -- stream.spad.pamphlet Stream.input +)sys rm Stream.output )spool Stream.output )set message test on )set message auto off @@ -90348,6 +90419,7 @@ Stream(S): Exports == Implementation where \section{domain STRING String} <>= -- string.spad.pamphlet String.input +)sys rm String.output )spool String.output )set message test on )set message auto off @@ -90993,6 +91065,7 @@ String(): StringCategory == IndexedString(MINSTRINGINDEX) add \section{domain STRTBL StringTable} <>= -- table.spad.pamphlet StringTable.input +)sys rm StringTable.output )spool StringTable.output )set message test on )set message auto off @@ -91924,6 +91997,7 @@ Switch():public == private where \section{domain SYMBOL Symbol} <>= -- symbol.spad.pamphlet Symbol.input +)sys rm Symbol.output )spool Symbol.output )set message test on )set message auto off @@ -92968,6 +93042,7 @@ SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add \section{domain TABLE Table} <>= -- table.spad.pamphlet Table.input +)sys rm Table.output )spool Table.output )set message test on )set message auto off @@ -94243,6 +94318,7 @@ TexFormat(): public == private where \section{domain TEXTFILE TextFile} <>= -- files.spad.pamphlet TextFile.input +)sys rm TextFile.output )spool TextFile.output )set message test on )set message auto off @@ -97018,6 +97094,7 @@ Tuple(S:Type): CoercibleTo(PrimitiveArray S) with \section{domain ARRAY2 TwoDimensionalArray} <>= -- array2.spad.pamphlet TwoDimensionalArray.input +)sys rm TwoDimensionalArray.output )spool TwoDimensionalArray.output )set message test on )set message auto off @@ -99398,6 +99475,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ \section{domain UP UnivariatePolynomial} <>= -- poly.spad.pamphlet UnivariatePolynomial.input +)sys rm UnivariatePolynomial.output )spool UnivariatePolynomial.output )set message test on )set message auto off @@ -101740,6 +101818,7 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where \section{domain UNISEG UniversalSegment} <>= -- seg.spad.pamphlet UniversalSegment.input +)sys rm UniversalSegment.output )spool UniversalSegment.output )set message test on )set message auto off @@ -102084,6 +102163,7 @@ Variable(sym:Symbol): Join(SetCategory, CoercibleTo Symbol) with \section{domain VECTOR Vector} <>= -- vector.spad.pamphlet Vector.input +)sys rm Vector.output )spool Vector.output )set message test on )set message auto off @@ -102397,6 +102477,7 @@ Vector(R:Type): Exports == Implementation where \section{domain VOID Void} <>= -- void.spad.pamphlet Void.input +)sys rm Void.output )spool Void.output )set message test on )set message auto off @@ -102682,6 +102763,7 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup, \section{domain WUTSET WuWenTsunTriangularSet} <>= -- triset.spad.pamphlet WuWenTsunTriangularSet.input +)sys rm WuWenTsunTriangularSet.output )spool WuWenTsunTriangularSet.output )set message test on )set message auto off @@ -103512,6 +103594,7 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where \section{domain XPBWPOLY XPBWPolynomial} <>= -- xlpoly.spad.pamphlet XPBWPolynomial.input +)sys rm XPBWPolynomial.output )spool XPBWPolynomial.output )set message test on )set message auto off @@ -104648,6 +104731,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where \section{domain XPOLY XPolynomial} <>= -- xpoly.spad.pamphlet XPolynomial.input +)sys rm XPolynomial.output )spool XPolynomial.output )set message test on )set message auto off @@ -104981,6 +105065,7 @@ XPolynomial(R:Ring) == XRecursivePolynomial(Symbol, R) \section{domain XPR XPolynomialRing} <>= -- xpoly.spad.pamphlet XPolynomialRing.input +)sys rm XPolynomialRing.output )spool XPolynomialRing.output )set message test on )set message auto off diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index bc21eea..73f8cfd 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -518,6 +518,503 @@ AlgebraicFunction(R, F): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTHERAL AlgebraicHermiteIntegration} +\pagehead{AlgebraicHermiteIntegration}{INTHERAL} +\pagepic{ps/v104algebraichermiteintegration.ps}{INTHERAL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTHERAL AlgebraicHermiteIntegration +++ Hermite integration, algebraic case +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 25 July 1990 +++ Description: algebraic Hermite redution. +AlgebraicHermiteIntegration(F,UP,UPUP,R):Exports == Implementation where + F : Field + UP : UnivariatePolynomialCategory F + UPUP: UnivariatePolynomialCategory Fraction UP + R : FunctionFieldCategory(F, UP, UPUP) + + N ==> NonNegativeInteger + RF ==> Fraction UP + + Exports ==> with + HermiteIntegrate: (R, UP -> UP) -> Record(answer:R, logpart:R) + ++ HermiteIntegrate(f, ') returns \spad{[g,h]} such that + ++ \spad{f = g' + h} and h has a only simple finite normal poles. + + Implementation ==> add + localsolve: (Matrix UP, Vector UP, UP) -> Vector UP + +-- the denominator of f should have no prime factor P s.t. P | P' +-- (which happens only for P = t in the exponential case) + HermiteIntegrate(f, derivation) == + ratform:R := 0 + n := rank() + m := transpose((mat:= integralDerivationMatrix derivation).num) + inum := (cform := integralCoordinates f).num + if ((iden := cform.den) exquo (e := mat.den)) case "failed" then + iden := (coef := (e exquo gcd(e, iden))::UP) * iden + inum := coef * inum + for trm in factors squareFree iden | (j:= trm.exponent) > 1 repeat + u':=(u:=(iden exquo (v:=trm.factor)**(j::N))::UP) * derivation v + sys := ((u * v) exquo e)::UP * m + nn := minRowIndex sys - minIndex inum + while j > 1 repeat + j := j - 1 + p := - j * u' + sol := localsolve(sys + scalarMatrix(n, p), inum, v) + ratform := ratform + integralRepresents(sol, v ** (j::N)) + inum := [((qelt(inum, i) - p * qelt(sol, i) - + dot(row(sys, i - nn), sol)) + exquo v)::UP - u * derivation qelt(sol, i) + for i in minIndex inum .. maxIndex inum] + iden := u * v + [ratform, integralRepresents(inum, iden)] + + localsolve(mat, vec, modulus) == + ans:Vector(UP) := new(nrows mat, 0) + diagonal? mat => + for i in minIndex ans .. maxIndex ans + for j in minRowIndex mat .. maxRowIndex mat + for k in minColIndex mat .. maxColIndex mat repeat + (bc := extendedEuclidean(qelt(mat, j, k), modulus, + qelt(vec, i))) case "failed" => return new(0, 0) + qsetelt_!(ans, i, bc.coef1) + ans + sol := particularSolution(map(#1::RF, mat)$MatrixCategoryFunctions2(UP, + Vector UP, Vector UP, Matrix UP, RF, + Vector RF, Vector RF, Matrix RF), + map(#1::RF, vec)$VectorFunctions2(UP, + RF))$LinearSystemMatrixPackage(RF, + Vector RF, Vector RF, Matrix RF) + sol case "failed" => new(0, 0) + for i in minIndex ans .. maxIndex ans repeat + (bc := extendedEuclidean(denom qelt(sol, i), modulus, 1)) + case "failed" => return new(0, 0) + qsetelt_!(ans, i, (numer qelt(sol, i) * bc.coef1) rem modulus) + ans + +@ +<>= +"INTHERAL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTHERAL"] +"FFCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FFCAT"] +"INTHERAL" -> "FFCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTALG AlgebraicIntegrate} +\pagehead{AlgebraicIntegrate}{INTALG} +\pagepic{ps/v104algebraicintegrate.ps}{INTALG}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTALG AlgebraicIntegrate +++ Integration of an algebraic function +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 19 May 1993 +++ Description: +++ This package provides functions for integrating a function +++ on an algebraic curve. +AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where + R0 : Join(OrderedSet, IntegralDomain, RetractableTo Integer) + F : Join(AlgebraicallyClosedField, FunctionSpace R0) + UP : UnivariatePolynomialCategory F + UPUP : UnivariatePolynomialCategory Fraction UP + R : FunctionFieldCategory(F, UP, UPUP) + + SE ==> Symbol + Z ==> Integer + Q ==> Fraction Z + SUP ==> SparseUnivariatePolynomial F + QF ==> Fraction UP + GP ==> LaurentPolynomial(F, UP) + K ==> Kernel F + IR ==> IntegrationResult R + UPQ ==> SparseUnivariatePolynomial Q + UPR ==> SparseUnivariatePolynomial R + FRQ ==> Factored UPQ + FD ==> FiniteDivisor(F, UP, UPUP, R) + FAC ==> Record(factor:UPQ, exponent:Z) + LOG ==> Record(scalar:Q, coeff:UPR, logand:UPR) + DIV ==> Record(num:R, den:UP, derivden:UP, gd:UP) + FAIL0 ==> error "integrate: implementation incomplete (constant residues)" + FAIL1==> error "integrate: implementation incomplete (non-algebraic residues)" + FAIL2 ==> error "integrate: implementation incomplete (residue poly has multiple non-linear factors)" + FAIL3 ==> error "integrate: implementation incomplete (has polynomial part)" + NOTI ==> error "Not integrable (provided residues have no relations)" + + Exports ==> with + algintegrate : (R, UP -> UP) -> IR + ++ algintegrate(f, d) integrates f with respect to the derivation d. + palgintegrate : (R, UP -> UP) -> IR + ++ palgintegrate(f, d) integrates f with respect to the derivation d. + ++ Argument f must be a pure algebraic function. + palginfieldint: (R, UP -> UP) -> Union(R, "failed") + ++ palginfieldint(f, d) returns an algebraic function g + ++ such that \spad{dg = f} if such a g exists, "failed" otherwise. + ++ Argument f must be a pure algebraic function. + + Implementation ==> add + import FD + import DoubleResultantPackage(F, UP, UPUP, R) + import PointsOfFiniteOrder(R0, F, UP, UPUP, R) + import AlgebraicHermiteIntegration(F, UP, UPUP, R) + import InnerCommonDenominator(Z, Q, List Z, List Q) + import FunctionSpaceUnivariatePolynomialFactor(R0, F, UP) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R0, SparseMultivariatePolynomial(R0, K), F) + + F2R : F -> R + F2UPR : F -> UPR + UP2SUP : UP -> SUP + SUP2UP : SUP -> UP + UPQ2F : UPQ -> UP + univ : (F, K) -> QF + pLogDeriv : (LOG, R -> R) -> R + nonLinear : List FAC -> Union(FAC, "failed") + mkLog : (UP, Q, R, F) -> List LOG + R2UP : (R, K) -> UPR + alglogint : (R, UP -> UP) -> Union(List LOG, "failed") + palglogint : (R, UP -> UP) -> Union(List LOG, "failed") + trace00 : (DIV, UP, List LOG) -> Union(List LOG,"failed") + trace0 : (DIV, UP, Q, FD) -> Union(List LOG, "failed") + trace1 : (DIV, UP, List Q, List FD, Q) -> Union(List LOG, "failed") + nonQ : (DIV, UP) -> Union(List LOG, "failed") + rlift : (F, K, K) -> R + varRoot? : (UP, F -> F) -> Boolean + algintexp : (R, UP -> UP) -> IR + algintprim : (R, UP -> UP) -> IR + + dummy:R := 0 + + dumx := kernel(new()$SE)$K + dumy := kernel(new()$SE)$K + + F2UPR f == F2R(f)::UPR + F2R f == f::UP::QF::R + + algintexp(f, derivation) == + d := (c := integralCoordinates f).den + v := c.num + vp:Vector(GP) := new(n := #v, 0) + vf:Vector(QF) := new(n, 0) + for i in minIndex v .. maxIndex v repeat + r := separate(qelt(v, i) / d)$GP + qsetelt_!(vf, i, r.fracPart) + qsetelt_!(vp, i, r.polyPart) + ff := represents(vf, w := integralBasis()) + h := HermiteIntegrate(ff, derivation) + p := represents(map(convert(#1)@QF, vp)$VectorFunctions2(GP, QF), w) + zero?(h.logpart) and zero? p => h.answer::IR + (u := alglogint(h.logpart, derivation)) case "failed" => + mkAnswer(h.answer, empty(), [[p + h.logpart, dummy]]) + zero? p => mkAnswer(h.answer, u::List(LOG), empty()) + FAIL3 + + algintprim(f, derivation) == + h := HermiteIntegrate(f, derivation) + zero?(h.logpart) => h.answer::IR + (u := alglogint(h.logpart, derivation)) case "failed" => + mkAnswer(h.answer, empty(), [[h.logpart, dummy]]) + mkAnswer(h.answer, u::List(LOG), empty()) + + -- checks whether f = +/[ci (ui)'/(ui)] + -- f dx must have no pole at infinity + palglogint(f, derivation) == + rec := algSplitSimple(f, derivation) + ground?(r := doubleResultant(f, derivation)) => "failed" +-- r(z) has roots which are the residues of f at all its poles + (u := qfactor r) case "failed" => nonQ(rec, r) + (fc := nonLinear(lf := factors(u::FRQ))) case "failed" => FAIL2 +-- at this point r(z) = fc(z) (z - b1)^e1 .. (z - bk)^ek +-- where the ri's are rational numbers, and fc(z) is arbitrary +-- (fc can be linear too) +-- la = [b1....,bk] (all rational residues) + la := [- coefficient(q.factor, 0) for q in remove_!(fc::FAC, lf)] +-- ld = [D1,...,Dk] where Di is the sum of places where f has residue bi + ld := [divisor(rec.num, rec.den, rec.derivden, rec.gd, b::F) for b in la] + pp := UPQ2F(fc.factor) +-- bb = - sum of all the roots of fc (i.e. the other residues) + zero?(bb := coefficient(fc.factor, + (degree(fc.factor) - 1)::NonNegativeInteger)) => + -- cd = [[a1,...,ak], d] such that bi = ai/d + cd := splitDenominator la + -- g = gcd(a1,...,ak), so bi = (g/d) ci with ci = bi / g + -- so [g/d] is a basis for [a1,...,ak] over the integers + g := gcd(cd.num) + -- dv0 is the divisor +/[ci Di] corresponding to all the residues + -- of f except the ones which are root of fc(z) + dv0 := +/[(a quo g) * dv for a in cd.num for dv in ld] + trace0(rec, pp, g / cd.den, dv0) + trace1(rec, pp, la, ld, bb) + + + UPQ2F p == + map(#1::F, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP) + + UP2SUP p == + map(#1, p)$UnivariatePolynomialCategoryFunctions2(F, UP, F, SUP) + + SUP2UP p == + map(#1, p)$UnivariatePolynomialCategoryFunctions2(F, SUP, F, UP) + + varRoot?(p, derivation) == + for c in coefficients primitivePart p repeat + derivation(c) ^= 0 => return true + false + + pLogDeriv(log, derivation) == + map(derivation, log.coeff) ^= 0 => + error "can only handle logs with constant coefficients" +-- one?(n := degree(log.coeff)) => + ((n := degree(log.coeff)) = 1) => + c := - (leadingCoefficient reductum log.coeff) + / (leadingCoefficient log.coeff) + ans := (log.logand) c + (log.scalar)::R * c * derivation(ans) / ans + numlog := map(derivation, log.logand) + (diflog := extendedEuclidean(log.logand, log.coeff, numlog)) case + "failed" => error "this shouldn't happen" + algans := diflog.coef1 + ans:R := 0 + for i in 0..n-1 repeat + algans := (algans * monomial(1, 1)) rem log.coeff + ans := ans + coefficient(algans, i) + (log.scalar)::R * ans + + R2UP(f, k) == + x := dumx :: F + g := (map(#1 x, lift f)$UnivariatePolynomialCategoryFunctions2(QF, + UPUP, F, UP)) (y := dumy::F) + map(rlift(#1, dumx, dumy), univariate(g, k, + minPoly k))$UnivariatePolynomialCategoryFunctions2(F,SUP,R,UPR) + + univ(f, k) == + g := univariate(f, k) + (SUP2UP numer g) / (SUP2UP denom g) + + rlift(f, kx, ky) == + reduce map(univ(#1, kx), retract(univariate(f, + ky))@SUP)$UnivariatePolynomialCategoryFunctions2(F,SUP,QF,UPUP) + + nonQ(rec, p) == + empty? rest(lf := factors ffactor primitivePart p) => + trace00(rec, first(lf).factor, empty()$List(LOG)) + FAIL1 + +-- case when the irreducible factor p has roots which sum to 0 +-- p is assumed doubly transitive for now + trace0(rec, q, r, dv0) == + lg:List(LOG) := + zero? dv0 => empty() + (rc0 := torsionIfCan dv0) case "failed" => NOTI + mkLog(1, r / (rc0.order::Q), rc0.function, 1) + trace00(rec, q, lg) + + trace00(rec, pp, lg) == + p0 := divisor(rec.num, rec.den, rec.derivden, rec.gd, + alpha0 := zeroOf UP2SUP pp) + q := (pp exquo (monomial(1, 1)$UP - alpha0::UP))::UP + alpha := rootOf UP2SUP q + dvr := divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha) - p0 + (rc := torsionIfCan dvr) case "failed" => + degree(pp) <= 2 => "failed" + NOTI + concat(lg, mkLog(q, inv(rc.order::Q), rc.function, alpha)) + +-- case when the irreducible factor p has roots which sum <> 0 +-- the residues of f are of the form [a1,...,ak] rational numbers +-- plus all the roots of q(z), which is squarefree +-- la is the list of residues la := [a1,...,ak] +-- ld is the list of divisors [D1,...Dk] where Di is the sum of all the +-- places where f has residue ai +-- q(z) is assumed doubly transitive for now. +-- let [alpha_1,...,alpha_m] be the roots of q(z) +-- in this function, b = - alpha_1 - ... - alpha_m is <> 0 +-- which implies only one generic log term + trace1(rec, q, la, ld, b) == +-- cd = [[b1,...,bk], d] such that ai / b = bi / d + cd := splitDenominator [a / b for a in la] +-- then, a basis for all the residues of f over the integers is +-- [beta_1 = - alpha_1 / d,..., beta_m = - alpha_m / d], since: +-- alpha_i = - d beta_i +-- ai = (ai / b) * b = (bi / d) * b = b1 * beta_1 + ... + bm * beta_m +-- linear independence is a consequence of the doubly transitive assumption +-- v0 is the divisor +/[bi Di] corresponding to the residues [a1,...,ak] + v0 := +/[a * dv for a in cd.num for dv in ld] +-- alpha is a generic root of q(z) + alpha := rootOf UP2SUP q +-- v is the divisor corresponding to all the residues + v := v0 - cd.den * divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha) + (rc := torsionIfCan v) case "failed" => -- non-torsion case + degree(q) <= 2 => "failed" -- guaranteed doubly-transitive + NOTI -- maybe doubly-transitive + mkLog(q, inv((- rc.order * cd.den)::Q), rc.function, alpha) + + mkLog(q, scalr, lgd, alpha) == + degree(q) <= 1 => + [[scalr, monomial(1, 1)$UPR - F2UPR alpha, lgd::UPR]] + [[scalr, + map(F2R, q)$UnivariatePolynomialCategoryFunctions2(F,UP,R,UPR), + R2UP(lgd, retract(alpha)@K)]] + +-- return the non-linear factor, if unique +-- or any linear factor if they are all linear + nonLinear l == + found:Boolean := false + ans := first l + for q in l repeat + if degree(q.factor) > 1 then + found => return "failed" + found := true + ans := q + ans + +-- f dx must be locally integral at infinity + palginfieldint(f, derivation) == + h := HermiteIntegrate(f, derivation) + zero?(h.logpart) => h.answer + "failed" + +-- f dx must be locally integral at infinity + palgintegrate(f, derivation) == + h := HermiteIntegrate(f, derivation) + zero?(h.logpart) => h.answer::IR + (not integralAtInfinity?(h.logpart)) or + ((u := palglogint(h.logpart, derivation)) case "failed") => + mkAnswer(h.answer, empty(), [[h.logpart, dummy]]) + zero?(difFirstKind := h.logpart - +/[pLogDeriv(lg, + differentiate(#1, derivation)) for lg in u::List(LOG)]) => + mkAnswer(h.answer, u::List(LOG), empty()) + mkAnswer(h.answer, u::List(LOG), [[difFirstKind, dummy]]) + +-- for mixed functions. f dx not assumed locally integral at infinity + algintegrate(f, derivation) == + zero? degree(x' := derivation(x := monomial(1, 1)$UP)) => + algintprim(f, derivation) + ((xx := x' exquo x) case UP) and + (retractIfCan(xx::UP)@Union(F, "failed") case F) => + algintexp(f, derivation) + error "should not happen" + + alglogint(f, derivation) == + varRoot?(doubleResultant(f, derivation), + retract(derivation(#1::UP))@F) => "failed" + FAIL0 + +@ +<>= +"INTALG" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTALG"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"FFCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FFCAT"] +"INTALG" -> "ACF" +"INTALG" -> "FS" +"INTALG" -> "FFCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTAF AlgebraicIntegration} +\pagehead{AlgebraicIntegration}{INTAF} +\pagepic{ps/v104algebraicintegration.ps}{INTAF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTAF AlgebraicIntegration +++ Mixed algebraic integration; +++ Author: Manuel Bronstein +++ Date Created: 12 October 1988 +++ Date Last Updated: 4 June 1988 +++ Description: +++ This package provides functions for the integration of +++ algebraic integrands over transcendental functions; +AlgebraicIntegration(R, F): Exports == Implementation where + R : Join(OrderedSet, IntegralDomain) + F : Join(AlgebraicallyClosedField, FunctionSpace R) + + SY ==> Symbol + N ==> NonNegativeInteger + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + UPUP==> SparseUnivariatePolynomial RF + IR ==> IntegrationResult F + IR2 ==> IntegrationResultFunctions2(curve, F) + ALG ==> AlgebraicIntegrate(R, F, UP, UPUP, curve) + FAIL==> error "failed - cannot handle that integrand" + + Exports ==> with + algint: (F, K, K, UP -> UP) -> IR + ++ algint(f, x, y, d) returns the integral of \spad{f(x,y)dx} + ++ where y is an algebraic function of x; + ++ d is the derivation to use on \spad{k[x]}. + + Implementation ==> add + import ChangeOfVariable(F, UP, UPUP) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R, P, F) + + rootintegrate: (F, K, K, UP -> UP) -> IR + algintegrate : (F, K, K, UP -> UP) -> IR + UPUP2F : (UPUP, RF, K, K) -> F + F2UPUP : (F, K, K, UP) -> UPUP + UP2UPUP : (UP, K) -> UPUP + + F2UPUP(f, kx, k, p) == UP2UPUP(univariate(f, k, p), kx) + + rootintegrate(f, t, k, derivation) == + r1 := mkIntegral(modulus := UP2UPUP(p := minPoly k, t)) + f1 := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1) + r := radPoly(r1.poly)::Record(radicand:RF, deg:N) + q := retract(r.radicand) + curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) + map(UPUP2F(lift #1, r1.coef, t, k), + algintegrate(reduce f1, derivation)$ALG)$IR2 + + algintegrate(f, t, k, derivation) == + r1 := mkIntegral(modulus := UP2UPUP(p := minPoly k, t)) + f1 := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1) + modulus:= UP2UPUP(p := minPoly k, t) + curve := AlgebraicFunctionField(F, UP, UPUP, r1.poly) + map(UPUP2F(lift #1, r1.coef, t, k), + algintegrate(reduce f1, derivation)$ALG)$IR2 + + UP2UPUP(p, k) == + map(univariate(#1,k),p)$SparseUnivariatePolynomialFunctions2(F,RF) + + UPUP2F(p, cf, t, k) == + map(multivariate(#1, t), + p)$SparseUnivariatePolynomialFunctions2(RF, F) + (multivariate(cf, t) * k::F) + + algint(f, t, y, derivation) == + is?(y, "nthRoot"::SY) => rootintegrate(f, t, y, derivation) + is?(y, "rootOf"::SY) => algintegrate(f, t, y, derivation) + FAIL + +@ +<>= +"INTAF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTAF"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"INTAF" -> "ACF" +"INTAF" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package ALGFACT AlgFactor} \pagehead{AlgFactor}{ALGFACT} \pagepic{ps/v104algfactor.ps}{ALGFACT}{1.00} @@ -3641,6 +4138,75 @@ CharacteristicPolynomialPackage(R:CommutativeRing):C == T where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package CVMP CoerceVectorMatrixPackage} +\pagehead{CoerceVectorMatrixPackage}{CVMP} +\pagepic{ps/v104coercevectormatrixpackage.ps}{CVMP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package CVMP CoerceVectorMatrixPackage +++ Authors: J. Grabmeier +++ Date Created: 26 June 1991 +++ Date Last Updated: 26 June 1991 +++ Basic Operations: coerceP, coerce +++ Related Constructors: GenericNonAssociativeAlgebra +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Reference: +++ Description: +++ CoerceVectorMatrixPackage: an unexposed, technical package +++ for data conversions +CoerceVectorMatrixPackage(R : CommutativeRing): public == private where + M2P ==> MatrixCategoryFunctions2(R, Vector R, Vector R, Matrix R, _ + Polynomial R, Vector Polynomial R, Vector Polynomial R, Matrix Polynomial R) + M2FP ==> MatrixCategoryFunctions2(R, Vector R, Vector R, Matrix R, _ + Fraction Polynomial R, Vector Fraction Polynomial R, _ + Vector Fraction Polynomial R, Matrix Fraction Polynomial R) + public ==> with + coerceP: Vector Matrix R -> Vector Matrix Polynomial R + ++ coerceP(v) coerces a vector v with entries in \spadtype{Matrix R} + ++ as vector over \spadtype{Matrix Polynomial R} + coerce: Vector Matrix R -> Vector Matrix Fraction Polynomial R + ++ coerce(v) coerces a vector v with entries in \spadtype{Matrix R} + ++ as vector over \spadtype{Matrix Fraction Polynomial R} + private ==> add + + imbedFP : R -> Fraction Polynomial R + imbedFP r == (r:: Polynomial R) :: Fraction Polynomial R + + imbedP : R -> Polynomial R + imbedP r == (r:: Polynomial R) + + coerceP(g:Vector Matrix R) : Vector Matrix Polynomial R == + m2 : Matrix Polynomial R + lim : List Matrix R := entries g + l: List Matrix Polynomial R := [] + for m in lim repeat + m2 := map(imbedP,m)$M2P + l := cons(m2,l) + vector reverse l + + coerce(g:Vector Matrix R) : Vector Matrix Fraction Polynomial R == + m3 : Matrix Fraction Polynomial R + lim : List Matrix R := entries g + l: List Matrix Fraction Polynomial R := [] + for m in lim repeat + m3 := map(imbedFP,m)$M2FP + l := cons(m3,l) + vector reverse l + +@ +<>= +"CVMP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=CVMP"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"CVMP" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package COMBF CombinatorialFunction} \pagehead{CombinatorialFunction}{COMBF} \pagepic{ps/v104combinatorialfunction.ps}{COMBF}{1.00} @@ -5753,6 +6319,7 @@ CRApackage(R:EuclideanDomain): Exports == Implementation where \section{package CYCLES CycleIndicators} <>= -- cycles.spad.pamphlet CycleIndicators.input +)sys rm CycleIndicators.output )spool CycleIndicators.output )set message test on )set message auto off @@ -7653,6 +8220,73 @@ DistinctDegreeFactorize(F,FP): C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package DBLRESP DoubleResultantPackage} +\pagehead{DoubleResultantPackage}{DBLRESP} +\pagepic{ps/v104doubleresultantpackage.ps}{DBLRESP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package DBLRESP DoubleResultantPackage +++ Residue resultant +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 12 July 1990 +++ Description: +++ This package provides functions for computing the residues +++ of a function on an algebraic curve. +DoubleResultantPackage(F, UP, UPUP, R): Exports == Implementation where + F : Field + UP : UnivariatePolynomialCategory F + UPUP: UnivariatePolynomialCategory Fraction UP + R : FunctionFieldCategory(F, UP, UPUP) + + RF ==> Fraction UP + UP2 ==> SparseUnivariatePolynomial UP + UP3 ==> SparseUnivariatePolynomial UP2 + + Exports ==> with + doubleResultant: (R, UP -> UP) -> UP + ++ doubleResultant(f, ') returns p(x) whose roots are + ++ rational multiples of the residues of f at all its + ++ finite poles. Argument ' is the derivation to use. + + Implementation ==> add + import CommuteUnivariatePolynomialCategory(F, UP, UP2) + import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) + + UP22 : UP -> UP2 + UP23 : UPUP -> UP3 + remove0: UP -> UP -- removes the power of x dividing p + + remove0 p == + primitivePart((p exquo monomial(1, minimumDegree p))::UP) + + UP22 p == + map(#1::UP, p)$UnivariatePolynomialCategoryFunctions2(F,UP,UP,UP2) + + UP23 p == + map(UP22(retract(#1)@UP), + p)$UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP2, UP3) + + doubleResultant(h, derivation) == + cd := splitDenominator lift h + d := (cd.den exquo (g := gcd(cd.den, derivation(cd.den))))::UP + r := swap primitivePart swap resultant(UP23(cd.num) + - ((monomial(1, 1)$UP :: UP2) * UP22(g * derivation d))::UP3, + UP23 definingPolynomial()) + remove0 resultant(r, UP22 d) + +@ +<>= +"DBLRESP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=DBLRESP"] +"FFCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FFCAT"] +"DBLRESP" -> "FFCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package DRAWCX DrawComplex} \pagehead{DrawComplex}{DRAWCX} \pagepic{ps/v104drawcomplex.ps}{DRAWCX}{1.00} @@ -11428,6 +12062,404 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTEF ElementaryIntegration} +\pagehead{ElementaryIntegration}{INTEF} +\pagepic{ps/v104elementaryintegration.ps}{INTEF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTEF ElementaryIntegration +++ Integration of elementary functions +++ Author: Manuel Bronstein +++ Date Created: 1 February 1988 +++ Date Last Updated: 24 October 1995 +++ Description: +++ This package provides functions for integration, limited integration, +++ extended integration and the risch differential equation for +++ elemntary functions. +++ Keywords: elementary, function, integration. +++ Examples: )r INTEF INPUT +ElementaryIntegration(R, F): Exports == Implementation where + R : Join(GcdDomain, OrderedSet, CharacteristicZero, + RetractableTo Integer, LinearlyExplicitRingOver Integer) + F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory, + FunctionSpace R) + + SE ==> Symbol + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + IR ==> IntegrationResult F + FF ==> Record(ratpart:RF, coeff:RF) + LLG ==> List Record(coeff:F, logand:F) + U2 ==> Union(Record(ratpart:F, coeff:F), "failed") + U3 ==> Union(Record(mainpart:F, limitedlogs:LLG), "failed") + ANS ==> Record(special:F, integrand:F) + FAIL==> error "failed - cannot handle that integrand" + ALGOP ==> "%alg" + OPDIFF ==> "%diff"::SE + + Exports ==> with + lfextendedint: (F, SE, F) -> U2 + ++ lfextendedint(f, x, g) returns functions \spad{[h, c]} such that + ++ \spad{dh/dx = f - cg}, if (h, c) exist, "failed" otherwise. + lflimitedint : (F, SE, List F) -> U3 + ++ lflimitedint(f,x,[g1,...,gn]) returns functions \spad{[h,[[ci, gi]]]} + ++ such that the gi's are among \spad{[g1,...,gn]}, and + ++ \spad{d(h+sum(ci log(gi)))/dx = f}, if possible, "failed" otherwise. + lfinfieldint : (F, SE) -> Union(F, "failed") + ++ lfinfieldint(f, x) returns a function g such that \spad{dg/dx = f} + ++ if g exists, "failed" otherwise. + lfintegrate : (F, SE) -> IR + ++ lfintegrate(f, x) = g such that \spad{dg/dx = f}. + lfextlimint : (F, SE, K, List K) -> U2 + ++ lfextlimint(f,x,k,[k1,...,kn]) returns functions \spad{[h, c]} + ++ such that \spad{dh/dx = f - c dk/dx}. Value h is looked for in a field + ++ containing f and k1,...,kn (the ki's must be logs). + + Implementation ==> add + import IntegrationTools(R, F) + import ElementaryRischDE(R, F) + import RationalIntegration(F, UP) + import AlgebraicIntegration(R, F) + import AlgebraicManipulations(R, F) + import ElementaryRischDESystem(R, F) + import TranscendentalIntegration(F, UP) + import PureAlgebraicIntegration(R, F, F) + import IntegrationResultFunctions2(F, F) + import IntegrationResultFunctions2(RF, F) + import FunctionSpacePrimitiveElement(R, F) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R, P, F) + + alglfint : (F, K, List K, SE) -> IR + alglfextint : (F, K, List K, SE, F) -> U2 + alglflimint : (F, K, List K, SE, List F) -> U3 + primextint : (F, SE, K, F) -> U2 + expextint : (F, SE, K, F) -> U2 + primlimint : (F, SE, K, List F) -> U3 + explimint : (F, SE, K, List F) -> U3 + algprimint : (F, K, K, SE) -> IR + algexpint : (F, K, K, SE) -> IR + primint : (F, SE, K) -> IR + expint : (F, SE, K) -> IR + tanint : (F, SE, K) -> IR + prim? : (K, SE) -> Boolean + isx? : (F, SE) -> Boolean + addx : (IR, F) -> IR + cfind : (F, LLG) -> F + lfintegrate0: (F, SE) -> IR + unknownint : (F, SE) -> IR + unkextint : (F, SE, F) -> U2 + unklimint : (F, SE, List F) -> U3 + tryChangeVar: (F, K, SE) -> Union(IR, "failed") + droponex : (F, F, K, F) -> Union(F, "failed") + + prim?(k, x) == is?(k, "log"::SE) or has?(operator k, "prim") + + tanint(f, x, k) == + eta' := differentiate(eta := first argument k, x) + r1 := tanintegrate(univariate(f, k), differentiate(#1, + differentiate(#1, x), monomial(eta', 2) + eta'::UP), + rischDEsys(#1, 2 * eta, #2, #3, x, lflimitedint(#1, x, #2), + lfextendedint(#1, x, #2))) + map(multivariate(#1, k), r1.answer) + lfintegrate(r1.a0, x) + +-- tries various tricks since the integrand contains something not elementary + unknownint(f, x) == + ((r := retractIfCan(f)@Union(K, "failed")) case K) and + is?(k := r::K, OPDIFF) and + ((ka:=retractIfCan(a:=second(l:=argument k))@Union(K,"failed"))case K) + and ((z := retractIfCan(zz := third l)@Union(SE, "failed")) case SE) + and (z::SE = x) + and ((u := droponex(first l, a, ka, zz)) case F) => u::F::IR + (da := differentiate(a := denom(f)::F, x)) ^= 0 and + zero? differentiate(c := numer(f)::F / da, x) => (c * log a)::IR + mkAnswer(0, empty(), [[f, x::F]]) + + droponex(f, a, ka, x) == + (r := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed" + is?(op := operator(k := r::K), OPDIFF) => + (z := third(arg := argument k)) = a => op [first arg, second arg, x] + (u := droponex(first arg, a, ka, x)) case "failed" => "failed" + op [u::F, second arg, z] + eval(f, [ka], [x]) + + unklimint(f, x, lu) == + for u in lu | u ^= 0 repeat + zero? differentiate(c := f * u / differentiate(u, x), x) => [0,[[c,u]]] + "failed" + + unkextint(f, x, g) == + zero?(g' := differentiate(g, x)) => "failed" + zero? differentiate(c := f / g', x) => [0, c] + "failed" + + isx?(f, x) == + (k := retractIfCan(f)@Union(K, "failed")) case "failed" => false + (r := symbolIfCan(k::K)) case "failed" => false + r::SE = x + + alglfint(f, k, l, x) == + xf := x::F + symbolIfCan(kx := ksec(k,l,x)) case SE => addx(palgint(f, kx, k), xf) + is?(kx, "exp"::SE) => addx(algexpint(f, kx, k, x), xf) + prim?(kx, x) => addx(algprimint(f, kx, k, x), xf) + has?(operator kx, ALGOP) => + rec := primitiveElement(kx::F, k::F) + y := rootOf(rec.prim) + map(eval(#1, retract(y)@K, rec.primelt), + lfintegrate(eval(f, [kx,k], [(rec.pol1) y, (rec.pol2) y]), x)) + unknownint(f, x) + + alglfextint(f, k, l, x, g) == + symbolIfCan(kx := ksec(k,l,x)) case SE => palgextint(f, kx, k, g) + has?(operator kx, ALGOP) => + rec := primitiveElement(kx::F, k::F) + y := rootOf(rec.prim) + lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F) + (u := lfextendedint(eval(f, [kx, k], lrhs), x, + eval(g, [kx, k], lrhs))) case "failed" => "failed" + ky := retract(y)@K + r := u::Record(ratpart:F, coeff:F) + [eval(r.ratpart,ky,rec.primelt), eval(r.coeff,ky,rec.primelt)] + is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL + unkextint(f, x, g) + + alglflimint(f, k, l, x, lu) == + symbolIfCan(kx := ksec(k,l,x)) case SE => palglimint(f, kx, k, lu) + has?(operator kx, ALGOP) => + rec := primitiveElement(kx::F, k::F) + y := rootOf(rec.prim) + lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F) + (u := lflimitedint(eval(f, [kx, k], lrhs), x, + map(eval(#1, [kx, k], lrhs), lu))) case "failed" => "failed" + ky := retract(y)@K + r := u::Record(mainpart:F, limitedlogs:LLG) + [eval(r.mainpart, ky, rec.primelt), + [[eval(rc.coeff, ky, rec.primelt), + eval(rc.logand,ky, rec.primelt)] for rc in r.limitedlogs]] + is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL + unklimint(f, x, lu) + + if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) + and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then + import PatternMatchIntegration(R, F) + lfintegrate(f, x) == intPatternMatch(f, x, lfintegrate0, pmintegrate) + + else lfintegrate(f, x) == lfintegrate0(f, x) + + lfintegrate0(f, x) == + zero? f => 0 + xf := x::F + empty?(l := varselect(kernels f, x)) => (xf * f)::IR + symbolIfCan(k := kmax l) case SE => + map(multivariate(#1, k), integrate univariate(f, k)) + is?(k, "tan"::SE) => addx(tanint(f, x, k), xf) + is?(k, "exp"::SE) => addx(expint(f, x, k), xf) + prim?(k, x) => addx(primint(f, x, k), xf) + has?(operator k, ALGOP) => alglfint(f, k, l, x) + unknownint(f, x) + + addx(i, x) == + elem? i => i + mkAnswer(ratpart i, logpart i, + [[ne.integrand, x] for ne in notelem i]) + + tryChangeVar(f, t, x) == + z := new()$Symbol + g := subst(f / differentiate(t::F, x), [t], [z::F]) + freeOf?(g, x) => -- can we do change of variables? + map(eval(#1, kernel z, t::F), lfintegrate(g, z)) + "failed" + + algexpint(f, t, y, x) == + (u := tryChangeVar(f, t, x)) case IR => u::IR + algint(f, t, y, differentiate(#1, differentiate(#1, x), + monomial(differentiate(first argument t, x), 1))) + + algprimint(f, t, y, x) == + (u := tryChangeVar(f, t, x)) case IR => u::IR + algint(f, t, y, differentiate(#1, differentiate(#1, x), + differentiate(t::F, x)::UP)) + +@ +Bug \#100 is an infinite loop that eventually kills Axiom +from the input +\begin{verbatim} + integrate((z^a+1)^b,z) +\end{verbatim} + +Line 2 of this function used to read: +\begin{verbatim} + symbolIfCan(k := kmax(l := union(l, varselect(kernels g, x)))) +\end{verbatim} + +The loop occurs when the call to union causes +\begin{verbatim} + a log(z) + %e +\end{verbatim} +to get added to the list every time. This gives the argument to kmax +\begin{verbatim} + a log(z) + arg1= [z,%e ] +\end{verbatim} +and the result being +\begin{verbatim} + a log(z) + %e +\end{verbatim} +We keep coming back to process this term, which ends up +putting the same term back on the list and we loop. +Waldek's solution is to remove the union call. + +The original patch fixed the infinite regression mentioned above +but caused Axiom to return a closed form of the integral: +\[integrate(asech(x)/x,x)\] +which should not have a closed form. This is referenced in +the FriCAS SVN revision 279. + +Essentially this new patch uses only logarithms of rational functions +when integrating rational functions. It is unclear whether this is +the correct fix. + +<>= + lfextendedint(f, x, g) == + empty?(l := varselect(kernels f, x)) => [x::F * f, 0] + symbolIfCan(k := kmax(l)) + case SE => + g1 := + empty?(l1 := varselect(kernels g,x)) => 0::F + kmax(l1) = k => g + 0::F + map(multivariate(#1, k), extendedint(univariate(f, k), + univariate(g1, k))) + is?(k, "exp"::SE) => expextint(f, x, k, g) + prim?(k, x) => primextint(f, x, k, g) + has?(operator k, ALGOP) => alglfextint(f, k, l, x, g) + unkextint(f, x, g) + +@ +This is part of the fix for bug 100. Line 2 of this function used to read: +\begin{verbatim} + symbolIfCan(k := kmax(l := union(l, vark(lu, x)))) case SE => +\end{verbatim} +See the above discussion for why this causes an infinite loop. +<>= + lflimitedint(f, x, lu) == + empty?(l := varselect(kernels f, x)) => [x::F * f, empty()] + symbolIfCan(k := kmax(l)) case SE => + map(multivariate(#1, k), limitedint(univariate(f, k), + [univariate(u, k) for u in lu])) + is?(k, "exp"::SE) => explimint(f, x, k, lu) + prim?(k, x) => primlimint(f, x, k, lu) + has?(operator k, ALGOP) => alglflimint(f, k, l, x, lu) + unklimint(f, x, lu) + + lfinfieldint(f, x) == + (u := lfextendedint(f, x, 0)) case "failed" => "failed" + u.ratpart + + primextint(f, x, k, g) == + lk := varselect([a for a in tower f + | k ^= a and is?(a, "log"::SE)], x) + (u1 := primextendedint(univariate(f, k), differentiate(#1, + differentiate(#1, x), differentiate(k::F, x)::UP), + lfextlimint(#1, x, k, lk), univariate(g, k))) case "failed" + => "failed" + u1 case FF => + [multivariate(u1.ratpart, k), multivariate(u1.coeff, k)] + (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed" + [multivariate(u1.answer, k) + u2.ratpart, u2.coeff] + + expextint(f, x, k, g) == + (u1 := expextendedint(univariate(f, k), differentiate(#1, + differentiate(#1, x), + monomial(differentiate(first argument k, x), 1)), + rischDE(#1, first argument k, #2, x, lflimitedint(#1, x, #2), + lfextendedint(#1, x, #2)), univariate(g, k))) + case "failed" => "failed" + u1 case FF => + [multivariate(u1.ratpart, k), multivariate(u1.coeff, k)] + (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed" + [multivariate(u1.answer, k) + u2.ratpart, u2.coeff] + + primint(f, x, k) == + lk := varselect([a for a in tower f + | k ^= a and is?(a, "log"::SE)], x) + r1 := primintegrate(univariate(f, k), differentiate(#1, + differentiate(#1, x), differentiate(k::F, x)::UP), + lfextlimint(#1, x, k, lk)) + map(multivariate(#1, k), r1.answer) + lfintegrate(r1.a0, x) + + lfextlimint(f, x, k, lk) == + not((u1 := lfextendedint(f, x, differentiate(k::F, x))) + case "failed") => u1 + twr := tower f + empty?(lg := [kk for kk in lk | not member?(kk, twr)]) => "failed" + is?(k, "log"::SE) => + (u2 := lflimitedint(f, x, + [first argument u for u in union(lg, [k])])) case "failed" + => "failed" + cf := cfind(first argument k, u2.limitedlogs) + [u2.mainpart - cf * k::F + + +/[c.coeff * log(c.logand) for c in u2.limitedlogs], cf] + "failed" + + cfind(f, l) == + for u in l repeat + f = u.logand => return u.coeff + 0 + + expint(f, x, k) == + eta := first argument k + r1 := expintegrate(univariate(f, k), differentiate(#1, + differentiate(#1, x), monomial(differentiate(eta, x), 1)), + rischDE(#1, eta, #2, x, lflimitedint(#1, x, #2), + lfextendedint(#1, x, #2))) + map(multivariate(#1, k), r1.answer) + lfintegrate(r1.a0, x) + + primlimint(f, x, k, lu) == + lk := varselect([a for a in tower f + | k ^= a and is?(a, "log"::SE)], x) + (u1 := primlimitedint(univariate(f, k), differentiate(#1, + differentiate(#1, x), differentiate(k::F, x)::UP), + lfextlimint(#1, x, k, lk), [univariate(u, k) for u in lu])) + case "failed" => "failed" + l := [[multivariate(lg.coeff, k),multivariate(lg.logand, k)] + for lg in u1.answer.limitedlogs]$LLG + (u2 := lflimitedint(u1.a0, x, lu)) case "failed" => "failed" + [multivariate(u1.answer.mainpart, k) + u2.mainpart, + concat(u2.limitedlogs, l)] + + explimint(f, x, k, lu) == + eta := first argument k + (u1 := explimitedint(univariate(f, k), differentiate(#1, + differentiate(#1, x), monomial(differentiate(eta, x), 1)), + rischDE(#1, eta, #2, x, + lflimitedint(#1, x, #2), lfextendedint(#1, x, #2)), + [univariate(u, k) for u in lu])) case "failed" => "failed" + l := [[multivariate(lg.coeff, k),multivariate(lg.logand, k)] + for lg in u1.answer.limitedlogs]$LLG + (u2 := lflimitedint(u1.a0, x, lu)) case "failed" => "failed" + [multivariate(u1.answer.mainpart, k) + u2.mainpart, + concat(u2.limitedlogs, l)] + +@ +<>= +"INTEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTEF"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"INTEF" -> "ACF" +"INTEF" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package ELFUTS EllipticFunctionsUnivariateTaylorSeries} \pagehead{EllipticFunctionsUnivariateTaylorSeries}{ELFUTS} \pagepic{ps/v104ellipticfunctionsunivariatetaylorseries.ps}{ELFUTS}{1.00} @@ -11635,6 +12667,7 @@ ErrorFunctions() : Exports == Implementation where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package GBEUCLID EuclideanGroebnerBasisPackage} <>= +)sys rm EuclideanGroebnerBasisPackage.output )spool EuclideanGroebnerBasisPackage.output )set message test on )set message auto off @@ -12752,6 +13785,7 @@ o )show EuclideanGroebnerBasisPackage o )show DistributedMultivariatePolynomial o )show HomogeneousDistributedMultivariatePolynomial o )show GeneralDistributedMultivariatePolynomial +o )show GroebnerPackage @ \pagehead{EuclideanGroebnerBasisPackage}{GBEUCLID} @@ -14636,6 +15670,7 @@ e04AgentsPackage(): E == I where \section{package FR2 FactoredFunctions2} <>= -- fr.spad.pamphlet FactoredFunctions2.input +)sys rm FactoredFunctions2.output )spool FactoredFunctions2.output )set message test on )set message auto off @@ -18714,6 +19749,143 @@ FunctionFieldCategoryFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2): @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package FFINTBAS FunctionFieldIntegralBasis} +\pagehead{FunctionFieldIntegralBasis}{FFINTBAS} +\pagepic{ps/v104functionfieldintegralbasis.ps}{FFINTBAS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package FFINTBAS FunctionFieldIntegralBasis +++ Integral bases for function fields of dimension one +++ Author: Victor Miller +++ Date Created: 9 April 1990 +++ Date Last Updated: 20 September 1994 +++ Keywords: +++ Examples: +++ References: +++ Description: +++ In this package R is a Euclidean domain and F is a framed algebra +++ over R. The package provides functions to compute the integral +++ closure of R in the quotient field of F. It is assumed that +++ \spad{char(R/P) = char(R)} for any prime P of R. A typical instance of +++ this is when \spad{R = K[x]} and F is a function field over R. + + +FunctionFieldIntegralBasis(R,UP,F): Exports == Implementation where + R : EuclideanDomain with + squareFree: $ -> Factored $ + ++ squareFree(x) returns a square-free factorisation of x + UP : UnivariatePolynomialCategory R + F : FramedAlgebra(R,UP) + + I ==> Integer + Mat ==> Matrix R + NNI ==> NonNegativeInteger + + Exports ==> with + integralBasis : () -> Record(basis: Mat, basisDen: R, basisInv:Mat) + ++ \spad{integralBasis()} returns a record + ++ \spad{[basis,basisDen,basisInv]} containing information regarding + ++ the integral closure of R in the quotient field of F, where + ++ F is a framed algebra with R-module basis \spad{w1,w2,...,wn}. + ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ the \spad{i}th element of the integral basis is + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of \spad{basis} contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + localIntegralBasis : R -> Record(basis: Mat, basisDen: R, basisInv:Mat) + ++ \spad{integralBasis(p)} returns a record + ++ \spad{[basis,basisDen,basisInv]} containing information regarding + ++ the local integral closure of R at the prime \spad{p} in the quotient + ++ field of F, where F is a framed algebra with R-module basis + ++ \spad{w1,w2,...,wn}. + ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ the \spad{i}th element of the local integral basis is + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of \spad{basis} contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + + Implementation ==> add + import IntegralBasisTools(R, UP, F) + import ModularHermitianRowReduction(R) + import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) + + squaredFactors: R -> R + squaredFactors px == + */[(if ffe.exponent > 1 then ffe.factor else 1$R) + for ffe in factors squareFree px] + + iIntegralBasis: (Mat,R,R) -> Record(basis: Mat, basisDen: R, basisInv:Mat) + iIntegralBasis(tfm,disc,sing) == + -- tfm = trace matrix of current order + n := rank()$F; tfm0 := copy tfm; disc0 := disc + rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) + -- rb = basis matrix of current order + -- rbinv = inverse basis matrix of current order + -- these are wrt the original basis for F + rbden : R := 1; index : R := 1; oldIndex : R := 1 + -- rbden = denominator for current basis matrix + -- index = index of original order in current order + not sizeLess?(1, sing) => [rb, rbden, rbinv] + repeat + -- compute the p-radical + idinv := transpose squareTop rowEchelon(tfm, sing) + -- [u1,..,un] are the coordinates of an element of the p-radical + -- iff [u1,..,un] * idinv is in sing * R^n + id := rowEchelon LowTriBddDenomInv(idinv, sing) + -- id = basis matrix of the p-radical + idinv := UpTriBddDenomInv(id, sing) + -- id * idinv = sing * identity + -- no need to check for inseparability in this case + rbinv := idealiser(id * rb, rbinv * idinv, sing * rbden) + index := diagonalProduct rbinv + rb := rowEchelon LowTriBddDenomInv(rbinv, rbden * sing) + g := matrixGcd(rb,sing,n) + if sizeLess?(1,g) then rb := (rb exquo g) :: Mat + rbden := rbden * (sing quo g) + rbinv := UpTriBddDenomInv(rb, rbden) + disc := disc0 quo (index * index) + indexChange := index quo oldIndex; oldIndex := index + sing := gcd(indexChange, squaredFactors disc) + not sizeLess?(1, sing) => return [rb, rbden, rbinv] + tfm := ((rb * tfm0 * transpose rb) exquo (rbden * rbden)) :: Mat + + integralBasis() == + n := rank()$F; p := characteristic()$F + (not zero? p) and (n >= p) => + error "integralBasis: possible wild ramification" + tfm := traceMatrix()$F; disc := determinant tfm + sing := squaredFactors disc -- singularities of relative Spec + iIntegralBasis(tfm,disc,sing) + + localIntegralBasis prime == + n := rank()$F; p := characteristic()$F + (not zero? p) and (n >= p) => + error "integralBasis: possible wild ramification" + tfm := traceMatrix()$F; disc := determinant tfm + (disc exquo (prime * prime)) case "failed" => + [scalarMatrix(n,1),1,scalarMatrix(n,1)] + iIntegralBasis(tfm,disc,prime) + +@ +<>= +"FFINTBAS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=FFINTBAS"] +"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"] +"FFINTBAS" -> "FRAMALG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package PMASSFS FunctionSpaceAssertions} \pagehead{FunctionSpaceAssertions}{PMASSFS} \pagepic{ps/v104functionspaceassertions.ps}{PMASSFS}{1.00} @@ -18865,6 +20037,95 @@ FunctionSpaceAttachPredicates(R, F, D): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package FSCINT FunctionSpaceComplexIntegration} +\pagehead{FunctionSpaceComplexIntegration}{FSCINT} +\pagepic{ps/v104functionspacecomplexintegration.ps}{FSCINT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package FSCINT FunctionSpaceComplexIntegration +++ Top-level complex function integration +++ Author: Manuel Bronstein +++ Date Created: 4 February 1988 +++ Date Last Updated: 11 June 1993 +++ Description: +++ \spadtype{FunctionSpaceComplexIntegration} provides functions for the +++ indefinite integration of complex-valued functions. +++ Keywords: function, integration. +FunctionSpaceComplexIntegration(R, F): Exports == Implementation where + R : Join(EuclideanDomain, OrderedSet, CharacteristicZero, + RetractableTo Integer, LinearlyExplicitRingOver Integer) + F : Join(TranscendentalFunctionCategory, + AlgebraicallyClosedFunctionSpace R) + + SE ==> Symbol + G ==> Complex R + FG ==> Expression G + IR ==> IntegrationResult F + + Exports ==> with + internalIntegrate : (F, SE) -> IR + ++ internalIntegrate(f, x) returns the integral of \spad{f(x)dx} + ++ where x is viewed as a complex variable. + internalIntegrate0: (F, SE) -> IR + ++ internalIntegrate0 should be a local function, but is conditional. + complexIntegrate : (F, SE) -> F + ++ complexIntegrate(f, x) returns the integral of \spad{f(x)dx} + ++ where x is viewed as a complex variable. + + Implementation ==> add + import IntegrationTools(R, F) + import ElementaryIntegration(R, F) + import ElementaryIntegration(G, FG) + import AlgebraicManipulations(R, F) + import AlgebraicManipulations(G, FG) + import TrigonometricManipulations(R, F) + import IntegrationResultToFunction(R, F) + import IntegrationResultFunctions2(FG, F) + import ElementaryFunctionStructurePackage(R, F) + import ElementaryFunctionStructurePackage(G, FG) + import InnerTrigonometricManipulations(R, F, FG) + + K2KG: Kernel F -> Kernel FG + + K2KG k == retract(tan F2FG first argument k)@Kernel(FG) + + complexIntegrate(f, x) == + removeConstantTerm(complexExpand internalIntegrate(f, x), x) + + if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) + and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then + import PatternMatchIntegration(R, F) + internalIntegrate0(f, x) == + intPatternMatch(f, x, lfintegrate, pmComplexintegrate) + + else internalIntegrate0(f, x) == lfintegrate(f, x) + + internalIntegrate(f, x) == + f := distribute(f, x::F) + any?(has?(operator #1, "rtrig"), + [k for k in tower(g := realElementary(f, x)) + | member?(x, variables(k::F))]$List(Kernel F))$List(Kernel F) => + h := trigs2explogs(F2FG g, [K2KG k for k in tower f + | is?(k, "tan"::SE) or is?(k, "cot"::SE)], [x]) + real?(g := FG2F h) => + internalIntegrate0(rootSimp(rischNormalize(g, x).func), x) + real?(g := FG2F(h := rootSimp(rischNormalize(h, x).func))) => + internalIntegrate0(g, x) + map(FG2F, lfintegrate(h, x)) + internalIntegrate0(rootSimp(rischNormalize(g, x).func), x) + +@ +<>= +"FSCINT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=FSCINT"] +"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"] +"FSCINT" -> "ACFS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package FS2 FunctionSpaceFunctions2} \pagehead{FunctionSpaceFunctions2}{FS2} \pagepic{ps/v104functionspacefunctions2.ps}{FS2}{1.00} @@ -18917,6 +20178,153 @@ FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package FSINT FunctionSpaceIntegration} +\pagehead{FunctionSpaceIntegration}{FSINT} +\pagepic{ps/v104functionspaceintegration.ps}{FSINT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package FSINT FunctionSpaceIntegration +++ Top-level real function integration +++ Author: Manuel Bronstein +++ Date Created: 4 February 1988 +++ Date Last Updated: 11 June 1993 +++ Keywords: function, integration. +++ Description: +++ \spadtype{FunctionSpaceIntegration} provides functions for the +++ indefinite integration of real-valued functions. +++ Examples: )r INTEF INPUT +FunctionSpaceIntegration(R, F): Exports == Implementation where + R : Join(EuclideanDomain, OrderedSet, CharacteristicZero, + RetractableTo Integer, LinearlyExplicitRingOver Integer) + F : Join(TranscendentalFunctionCategory, PrimitiveFunctionCategory, + AlgebraicallyClosedFunctionSpace R) + + B ==> Boolean + G ==> Complex R + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + SE ==> Symbol + IR ==> IntegrationResult F + FG ==> Expression G + ALGOP ==> "%alg" + TANTEMP ==> "%temptan"::SE + + Exports ==> with + integrate: (F, SE) -> Union(F, List F) + ++ integrate(f, x) returns the integral of \spad{f(x)dx} + ++ where x is viewed as a real variable. + + Implementation ==> add + import IntegrationTools(R, F) + import ElementaryIntegration(R, F) + import ElementaryIntegration(G, FG) + import AlgebraicManipulations(R, F) + import TrigonometricManipulations(R, F) + import IntegrationResultToFunction(R, F) + import TranscendentalManipulations(R, F) + import IntegrationResultFunctions2(FG, F) + import FunctionSpaceComplexIntegration(R, F) + import ElementaryFunctionStructurePackage(R, F) + import InnerTrigonometricManipulations(R, F, FG) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R, SparseMultivariatePolynomial(R, K), F) + + K2KG : K -> Kernel FG + postSubst : (F, List F, List K, B, List K, SE) -> F + rinteg : (IR, F, SE, B, B) -> Union(F, List F) + mkPrimh : (F, SE, B, B) -> F + trans? : F -> B + goComplex?: (B, List K, List K) -> B + halfangle : F -> F + Khalf : K -> F + tan2temp : K -> K + + optemp:BasicOperator := operator(TANTEMP, 1) + + K2KG k == retract(tan F2FG first argument k)@Kernel(FG) + tan2temp k == kernel(optemp, argument k, height k)$K + + trans? f == + any?(is?(#1,"log"::SE) or is?(#1,"exp"::SE) or is?(#1,"atan"::SE), + operators f)$List(BasicOperator) + + mkPrimh(f, x, h, comp) == + f := real f + if comp then f := removeSinSq f + g := mkPrim(f, x) + h and trans? g => htrigs g + g + + rinteg(i, f, x, h, comp) == + not elem? i => integral(f, x)$F + empty? rest(l := [mkPrimh(f, x, h, comp) for f in expand i]) => first l + l + +-- replace tan(a/2)**2 by (1-cos a)/(1+cos a) if tan(a/2) is in ltan + halfangle a == + a := 2 * a + (1 - cos a) / (1 + cos a) + + Khalf k == + a := 2 * first argument k + sin(a) / (1 + cos a) + +-- ltan = list of tangents in the integrand after real normalization + postSubst(f, lv, lk, comp, ltan, x) == + for v in lv for k in lk repeat + if ((u := retractIfCan(v)@Union(K, "failed")) case K) then + if has?(operator(kk := u::K), ALGOP) then + f := univariate(f, kk, minPoly kk) (kk::F) + f := eval(f, [u::K], [k::F]) + if not(comp or empty? ltan) then + ltemp := [tan2temp k for k in ltan] + f := eval(f, ltan, [k::F for k in ltemp]) + f := eval(f, TANTEMP, 2, halfangle) + f := eval(f, ltemp, [Khalf k for k in ltemp]) + removeConstantTerm(f, x) + +-- can handle a single unnested tangent directly, otherwise go complex for now +-- l is the list of all the kernels containing x +-- ltan is the list of all the tangents in l + goComplex?(rt, l, ltan) == + empty? ltan => rt + not empty? rest rest l + + integrate(f, x) == + not real? f => complexIntegrate(f, x) + f := distribute(f, x::F) + tf := [k for k in tower f | member?(x, variables(k::F)@List(SE))]$List(K) + ltf := select(is?(operator #1, "tan"::SE), tf) + ht := any?(has?(operator #1, "htrig"), tf) + rec := rischNormalize(realElementary(f, x), x) + g := rootSimp(rec.func) + tg := [k for k in tower g | member?(x, variables(k::F))]$List(K) + ltg := select(is?(operator #1, "tan"::SE), tg) + rtg := any?(has?(operator #1, "rtrig"), tg) + el := any?(has?(operator #1, "elem"), tg) + i:IR + if (comp := goComplex?(rtg, tg, ltg)) then + i := map(FG2F, lfintegrate(trigs2explogs(F2FG g, + [K2KG k for k in tf | is?(k, "tan"::SE) or + is?(k, "cot"::SE)], [x]), x)) + else i := lfintegrate(g, x) + ltg := setDifference(ltg, ltf) -- tan's added by normalization + (u := rinteg(i, f, x, el and ht, comp)) case F => + postSubst(u::F, rec.vals, rec.kers, comp, ltg, x) + [postSubst(h, rec.vals, rec.kers, comp, ltg, x) for h in u::List(F)] + +@ +<>= +"FSINT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=FSINT"] +"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"] +"FSINT" -> "ACFS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package SUMFS FunctionSpaceSum} \pagehead{FunctionSpaceSum}{SUMFS} \pagepic{ps/v104functionspacesum.ps}{SUMFS}{1.00} @@ -21917,6 +23325,168 @@ GaussianFactorizationPackage() : C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GHENSEL GeneralHenselPackage} +\pagehead{GeneralHenselPackage}{GHENSEL} +\pagepic{ps/v104generalhenselpackage.ps}{GHENSEL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GHENSEL GeneralHenselPackage +++ Author : P.Gianni +++ General Hensel Lifting +++ Used for Factorization of bivariate polynomials over a finite field. +GeneralHenselPackage(RP,TP):C == T where + RP : EuclideanDomain + TP : UnivariatePolynomialCategory RP + + PI ==> PositiveInteger + + C == with + HenselLift: (TP,List(TP),RP,PI) -> Record(plist:List(TP), modulo:RP) + ++ HenselLift(pol,lfacts,prime,bound) lifts lfacts, + ++ that are the factors of pol mod prime, + ++ to factors of pol mod prime**k > bound. No recombining is done . + + completeHensel: (TP,List(TP),RP,PI) -> List TP + ++ completeHensel(pol,lfact,prime,bound) lifts lfact, + ++ the factorization mod prime of pol, + ++ to the factorization mod prime**k>bound. + ++ Factors are recombined on the way. + + reduction : (TP,RP) -> TP + ++ reduction(u,pol) computes the symmetric reduction of u mod pol + + T == add + GenExEuclid: (List(FP),List(FP),FP) -> List(FP) + HenselLift1: (TP,List(TP),List(FP),List(FP),RP,RP,F) -> List(TP) + mQuo: (TP,RP) -> TP + + reduceCoef(c:RP,p:RP):RP == + zero? p => c + RP is Integer => symmetricRemainder(c,p) + c rem p + + reduction(u:TP,p:RP):TP == + zero? p => u + RP is Integer => map(symmetricRemainder(#1,p),u) + map(#1 rem p,u) + + merge(p:RP,q:RP):Union(RP,"failed") == + p = q => p + p = 0 => q + q = 0 => p + "failed" + + modInverse(c:RP,p:RP):RP == + (extendedEuclidean(c,p,1)::Record(coef1:RP,coef2:RP)).coef1 + + exactquo(u:TP,v:TP,p:RP):Union(TP,"failed") == + invlcv:=modInverse(leadingCoefficient v,p) + r:=monicDivide(u,reduction(invlcv*v,p)) + reduction(r.remainder,p) ^=0 => "failed" + reduction(invlcv*r.quotient,p) + + FP:=EuclideanModularRing(RP,TP,RP,reduction,merge,exactquo) + + mQuo(poly:TP,n:RP) : TP == map(#1 quo n,poly) + + GenExEuclid(fl:List FP,cl:List FP,rhs:FP) :List FP == + [clp*rhs rem flp for clp in cl for flp in fl] + + -- generate the possible factors + genFact(fln:List TP,factlist:List List TP) : List List TP == + factlist=[] => [[pol] for pol in fln] + maxd := +/[degree f for f in fln] quo 2 + auxfl:List List TP := [] + for poly in fln while factlist^=[] repeat + factlist := [term for term in factlist | ^member?(poly,term)] + dp := degree poly + for term in factlist repeat + (+/[degree f for f in term]) + dp > maxd => "next term" + auxfl := cons(cons(poly,term),auxfl) + auxfl + + HenselLift1(poly:TP,fln:List TP,fl1:List FP,cl1:List FP, + prime:RP,Modulus:RP,cinv:RP):List TP == + lcp := leadingCoefficient poly + rhs := reduce(mQuo(poly - lcp * */fln,Modulus),prime) + zero? rhs => fln + lcinv:=reduce(cinv::TP,prime) + vl := GenExEuclid(fl1,cl1,lcinv*rhs) + [flp + Modulus*(vlp::TP) for flp in fln for vlp in vl] + + HenselLift(poly:TP,tl1:List TP,prime:RP,bound:PI) == + -- convert tl1 + constp:TP:=0 + if degree first tl1 = 0 then + constp:=tl1.first + tl1 := rest tl1 + fl1:=[reduce(ttl,prime) for ttl in tl1] + cl1 := multiEuclidean(fl1,1)::List FP + Modulus:=prime + fln :List TP := [ffl1::TP for ffl1 in fl1] + lcinv:RP:=retract((inv + (reduce((leadingCoefficient poly)::TP,prime)))::TP) + while euclideanSize(Modulus) leave "finished" + fln := nfln + Modulus := prime*Modulus + if constp^=0 then fln:=cons(constp,fln) + [fln,Modulus] + + completeHensel(m:TP,tl1:List TP,prime:RP,bound:PI) == + hlift:=HenselLift(m,tl1,prime,bound) + Modulus:RP:=hlift.modulo + fln:List TP:=hlift.plist + nm := degree m + u:Union(TP,"failed") + aux,auxl,finallist:List TP + auxfl,factlist:List List TP + factlist := [] + dfn :NonNegativeInteger := nm + lcm1 := leadingCoefficient m + mm := lcm1*m + while dfn>0 and (factlist := genFact(fln,factlist))^=[] repeat + auxfl := [] + while factlist^=[] repeat + auxl := factlist.first + factlist := factlist.rest + tc := reduceCoef((lcm1 * */[coefficient(poly,0) + for poly in auxl]), Modulus) + coefficient(mm,0) exquo tc case "failed" => + auxfl := cons(auxl,auxfl) + pol := */[poly for poly in auxl] + poly :=reduction(lcm1*pol,Modulus) + u := mm exquo poly + u case "failed" => auxfl := cons(auxl,auxfl) + poly1: TP := primitivePart poly + m := mQuo((u::TP),leadingCoefficient poly1) + lcm1 := leadingCoefficient(m) + mm := lcm1*m + finallist := cons(poly1,finallist) + dfn := degree m + aux := [] + for poly in fln repeat + ^member?(poly,auxl) => aux := cons(poly,aux) + auxfl := [term for term in auxfl | ^member?(poly,term)] + factlist := [term for term in factlist |^member?(poly,term)] + fln := aux + factlist := auxfl + if dfn > 0 then finallist := cons(m,finallist) + finallist + +@ +<>= +"GHENSEL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GHENSEL"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"GHENSEL" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package GENMFACT GeneralizedMultivariateFactorize} \pagehead{GeneralizedMultivariateFactorize}{GENMFACT} \pagepic{ps/v104generalizedmultivariatefactorize.ps}{GENMFACT}{1.00} @@ -21980,6 +23550,4231 @@ GeneralizedMultivariateFactorize(OV,E,S,R,P) : C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GENPGCD GeneralPolynomialGcdPackage} +\pagehead{GeneralPolynomialGcdPackage}{GENPGCD} +\pagepic{ps/v104generalpolynomialgcdpackage.ps}{GENPGCD}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GENPGCD GeneralPolynomialGcdPackage +++ Description: +++ This package provides operations for GCD computations +++ on polynomials +GeneralPolynomialGcdPackage(E,OV,R,P):C == T where + R : PolynomialFactorizationExplicit + P : PolynomialCategory(R,E,OV) + OV : OrderedSet + E : OrderedAbelianMonoidSup + + SUPP ==> SparseUnivariatePolynomial P +--JHD ContPrim ==> Record(cont:P,prim:P) + + C == with + gcdPolynomial : (SUPP,SUPP) -> SUPP + ++ gcdPolynomial(p,q) returns the GCD of p and q + randomR : () ->R + ++ randomR() should be local but conditional +--JHD gcd : (P,P) -> P +--JHD gcd : List P -> P +--JHD gcdprim : (P,P) -> P +--JHD gcdprim : List P -> P + +--JHD gcdcofact : List P -> List P +--JHD gcdcofactprim : List P -> List P + +--JHD primitate : (P,OV) -> P +--JHD primitate : SUPP -> SUPP + +--JHD content : P -> P +--JHD content : List P -> List P +--JHD contprim : List P -> List ContPrim + +--JHD monomContent : (P,OV) -> P +--JHD monomContent : SUPP -> SUPP + + + T == add + + SUPR ==> SparseUnivariatePolynomial R +--JHD SUPLGcd ==> Record(locgcd:SUPP,goodint:List R) +--JHD LGcd ==> Record(locgcd:P,goodint:List R) +--JHD UTerm ==> Record(lpol:List SUPR,lint:List R,mpol:P) +--JHD--JHD pmod:R := (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R + +--JHD import MultivariateLifting(E,OV,R,P,pmod) + import UnivariatePolynomialCategoryFunctions2(R,SUPR,P,SUPP) + import UnivariatePolynomialCategoryFunctions2(P,SUPP,R,SUPR) + -------- Local Functions -------- + +--JHD abs : P -> P + better : (P,P) -> Boolean +--JHD failtest : (P,P,P) -> Boolean +--JHD gcdMonom : (P,P,OV) -> P +--JHD gcdTermList : (P,P) -> P +--JHD gcdPrim : (P,P,OV) -> P +--JHD gcdSameMainvar : (P,P,OV) -> P +--JHD internal : (P,P,OV) -> P +--JHD good : (P,List OV) -> Record(upol:SUPR,inval:List R) +--JHD gcdPrs : (P,P,NNI,OV) -> Union(P,"failed") +--JHD +--JHD chooseVal : (P,P,List OV) -> UTerm +--JHD localgcd : (P,P,List OV) -> LGcd +--JHD notCoprime : (P,P, List NNI,List OV) -> P +--JHD imposelc : (List SUPR,List OV,List R,List P) -> List SUPR + +--JHD lift? :(P,P,UTerm,List NNI,List OV) -> Union("failed",P) +-- lift :(P,SUPR,SUPR,P,List OV,List NNI,List R) -> P + lift : (SUPR,SUPP,SUPR,List OV,List R) -> Union(SUPP,"failed") + -- lifts first and third arguments as factors of the second + -- fourth is number of variables. +--JHD monomContent : (P,OV) -> P + monomContentSup : SUPP -> SUPP +-- +--JHD gcdcofact : List P -> List P + + gcdTrivial : (SUPP,SUPP) -> SUPP + gcdSameVariables: (SUPP,SUPP,List OV) -> SUPP + recursivelyGCDCoefficients: (SUPP,List OV,SUPP,List OV) -> SUPP + flatten : (SUPP,List OV) -> SUPP + -- evaluates out all variables in the second + -- argument, leaving a polynomial of the same + -- degree +-- eval : (SUPP,List OV,List R) -> SUPP + variables : SUPP -> List OV + ---- JHD's exported functions --- + gcdPolynomial(p1:SUPP,p2:SUPP) == + zero? p1 => p2 + zero? p2 => p1 + 0=degree p1 => gcdTrivial(p1,p2) + 0=degree p2 => gcdTrivial(p2,p1) + if degree p1 < degree p2 then (p1,p2):=(p2,p1) + p1 exquo p2 case SUPP => (unitNormal p2).canonical + c1:= monomContentSup(p1) + c2:= monomContentSup(p2) + p1:= (p1 exquo c1)::SUPP + p2:= (p2 exquo c2)::SUPP + (p1 exquo p2) case SUPP => (unitNormal p2).canonical * gcd(c1,c2) + vp1:=variables p1 + vp2:=variables p2 + v1:=setDifference(vp1,vp2) + v2:=setDifference(vp2,vp1) + #v1 = 0 and #v2 = 0 => gcdSameVariables(p1,p2,vp1)*gcd(c1,c2) + -- all variables are in common + v:=setDifference(vp1,v1) + pp1:=flatten(p1,v1) + pp2:=flatten(p2,v2) + g:=gcdSameVariables(pp1,pp2,v) +-- one? g => gcd(c1,c2)::SUPP + (g = 1) => gcd(c1,c2)::SUPP + (#v1 = 0 or not (p1 exquo g) case "failed") and + -- if #vi = 0 then pp1 = p1, so we know g divides + (#v2 = 0 or not (p2 exquo g) case "failed") + => g*gcd(c1,c2) -- divdes them both, so is the gcd + -- OK, so it's not the gcd: try again + v:=variables g -- there can be at most these variables in answer + v1:=setDifference(vp1,v) + v2:=setDifference(vp2,v) + if (#v1 = 0) then g:= gcdSameVariables(g,flatten(p2,v2),v) + else if (#v2=0) then g:=gcdSameVariables(g,flatten(p1,v1),v) + else g:=gcdSameVariables(g,flatten(p1,v1)-flatten(p2,v2),v) +-- one? g => gcd(c1,c2)::SUPP + (g = 1) => gcd(c1,c2)::SUPP + (#v1 = 0 or not (p1 exquo g) case "failed") and + (#v2 = 0 or not (p2 exquo g) case "failed") + => g*gcd(c1,c2)::SUPP -- divdes them both, so is the gcd + v:=variables g -- there can be at most these variables in answer + v1:=setDifference(vp1,v) + if #v1 ^= 0 then + g:=recursivelyGCDCoefficients(g,v,p1,v1) +-- one? g => return gcd(c1,c2)::SUPP + (g = 1) => return gcd(c1,c2)::SUPP + v:=variables g -- there can be at most these variables in answer + v2:=setDifference(vp2,v) + recursivelyGCDCoefficients(g,v,p2,v2)*gcd(c1,c2) + if R has StepThrough then + randomCount:R := init() + randomR() == + (v:=nextItem(randomCount)) case R => + randomCount:=v + v + SAY("Taking next stepthrough range in GeneralPolynomialGcdPackage")$Lisp + randomCount:=init() + randomCount + else + randomR() == (random$Integer() rem 100)::R + ---- JHD's local functions --- + gcdSameVariables(p1:SUPP,p2:SUPP,lv:List OV) == + -- two non-trivial primitive (or, at least, we don't care + -- about content) + -- polynomials with precisely the same degree + #lv = 0 => map(#1::P,gcdPolynomial(map(ground,p1), + map(ground,p2))) + degree p2 = 1 => + p1 exquo p2 case SUPP => p2 + 1 + gcdLC:=gcd(leadingCoefficient p1,leadingCoefficient p2) + lr:=[randomR() for vv in lv] + count:NonNegativeInteger:=0 + while count<10 repeat + while zero? eval(gcdLC,lv,lr) and count<10 repeat + lr:=[randomR() for vv in lv] + count:=count+1 + count = 10 => error "too many evaluations in GCD code" + up1:SUPR:=map(ground eval(#1,lv,lr),p1) + up2:SUPR:=map(ground eval(#1,lv,lr),p2) + u:=gcdPolynomial(up1,up2) + degree u = 0 => return 1 + -- let's pick a second one, just to check + lrr:=[randomR() for vv in lv] + while zero? eval(gcdLC,lv,lrr) and count<10 repeat + lrr:=[randomR() for vv in lv] + count:=count+1 + count = 10 => error "too many evaluations in GCD code" + vp1:SUPR:=map(ground eval(#1,lv,lrr),p1) + vp2:SUPR:=map(ground eval(#1,lv,lrr),p2) + v:=gcdPolynomial(vp1,vp2) + degree v = 0 => return 1 + if degree v < degree u then + u:=v + up1:=vp1 + up2:=vp2 + lr:=lrr + up1:=(up1 exquo u)::SUPR + degree gcd(u,up1) = 0 => + ans:=lift(u,p1,up1,lv,lr) + ans case SUPP => return ans + "next" + up2:=(up2 exquo u)::SUPR + degree gcd(u,up2) = 0 => + ans:=lift(u,p2,up2,lv,lr) + ans case SUPP => return ans + "next" + -- so neither cofactor is relatively prime + count:=0 + while count < 10 repeat + r:=randomR() + uu:=up1+r*up2 + degree gcd(u,uu)=0 => + ans:= lift(u,p1+r::P *p2,uu,lv,lr) + ans case SUPP => return ans + "next" + error "too many evaluations in GCD code" + count >= 10 => error "too many evaluations in GCD code" + lift(gR:SUPR,p:SUPP,cfR:SUPR,lv:List OV,lr:List R) == + -- lift the coprime factorisation gR*cfR = (univariate of p) + -- where the variables lv have been evaluated at lr + lcp:=leadingCoefficient p + g:=monomial(lcp,degree gR)+map(#1::P,reductum gR) + cf:=monomial(lcp,degree cfR)+map(#1::P,reductum cfR) + p:=lcp*p -- impose leaidng coefficient of p on each factor + while lv ^= [] repeat + v:=first lv + r:=first lr + lv:=rest lv + lr:=rest lr + thisp:=map(eval(#1,lv,lr),p) + d:="max"/[degree(c,v) for c in coefficients p] + prime:=v::P - r::P + pn:=prime + origFactors:=[g,cf]::List SUPP + for n in 1..d repeat + Ecart:=(thisp- g*cf) exquo pn + Ecart case "failed" => + error "failed lifting in hensel in Complex Polynomial GCD" + zero? Ecart => leave + step:=solveLinearPolynomialEquation(origFactors, + map(eval(#1,v,r),Ecart::SUPP)) + step case "failed" => return "failed" + g:=g+pn*first step + cf:=cf+pn*second step + pn:=pn*prime + thisp ^= g*cf => return "failed" + g + recursivelyGCDCoefficients(g:SUPP,v:List OV,p:SUPP,pv:List OV) == + mv:=first pv -- take each coefficient w.r.t. mv + pv:=rest pv -- and recurse on pv as necessary + d:="max"/[degree(u,mv) for u in coefficients p] + for i in 0..d repeat + p1:=map(coefficient(#1,mv,i),p) + oldg:=g + if pv = [] then g:=gcdSameVariables(g,p1,v) + else g:=recursivelyGCDCoefficients(p,v,p1,pv) +-- one? g => return 1 + (g = 1) => return 1 + g^=oldg => + oldv:=v + v:=variables g + pv:=setUnion(pv,setDifference(v,oldv)) + g + flatten(p1:SUPP,lv:List OV) == + #lv = 0 => p1 + lr:=[ randomR() for vv in lv] + dg:=degree p1 + while dg ^= degree (ans:= map(eval(#1,lv,lr),p1)) repeat + lr:=[ randomR() for vv in lv] + ans +-- eval(p1:SUPP,lv:List OV,lr:List R) == map(eval(#1,lv,lr),p1) + variables(p1:SUPP) == + removeDuplicates ("concat"/[variables u for u in coefficients p1]) + gcdTrivial(p1:SUPP,p2:SUPP) == + -- p1 is non-zero, but has degree zero + -- p2 is non-zero + cp1:=leadingCoefficient p1 +-- one? cp1 => 1 + (cp1 = 1) => 1 + degree p2 = 0 => gcd(cp1,leadingCoefficient p2)::SUPP + un?:=unit? cp1 + while not zero? p2 and not un? repeat + cp1:=gcd(leadingCoefficient p2,cp1) + un?:=unit? cp1 + p2:=reductum p2 + un? => 1 + cp1::SUPP + + ---- Local functions ---- +--JHD -- test if something wrong happened in the gcd +--JHD failtest(f:P,p1:P,p2:P) : Boolean == +--JHD (p1 exquo f) case "failed" or (p2 exquo f) case "failed" +--JHD +--JHD -- Choose the integers +--JHD chooseVal(p1:P,p2:P,lvar:List OV):UTerm == +--JHD x:OV:=lvar.first +--JHD lvr:=lvar.rest +--JHD d1:=degree(p1,x) +--JHD d2:=degree(p2,x) +--JHD dd:NNI:=0$NNI +--JHD nvr:NNI:=#lvr +--JHD lval:List R :=[] +--JHD range:I:=8 +--JHD for i in 1.. repeat +--JHD range:=2*range +--JHD lval:=[(random()$I rem (2*range) - range)::R for i in 1..nvr] +--JHD uf1:SUPR:=univariate eval(p1,lvr,lval) +--JHD degree uf1 ^= d1 => "new point" +--JHD uf2:SUPR:=univariate eval(p2,lvr,lval) +--JHD degree uf2 ^= d2 => "new point" +--JHD u:=gcd(uf1,uf2) +--JHD du:=degree u +--JHD --the univariate gcd is 1 +--JHD if du=0 then return [[1$SUPR],lval,0$P]$UTerm +--JHD +--JHD ugcd:List SUPR:=[u,(uf1 exquo u)::SUPR,(uf2 exquo u)::SUPR] +--JHD uterm:=[ugcd,lval,0$P]$UTerm +--JHD dd=0 => dd:=du +--JHD +--JHD --the degree is not changed +--JHD du=dd => +--JHD +--JHD --test if one of the polynomials is the gcd +--JHD dd=d1 => +--JHD if ^((f:=p2 exquo p1) case "failed") then +--JHD return [[u],lval,p1]$UTerm +--JHD if dd^=d2 then dd:=(dd-1)::NNI +--JHD +--JHD dd=d2 => +--JHD if ^((f:=p1 exquo p2) case "failed") then +--JHD return [[u],lval,p2]$UTerm +--JHD dd:=(dd-1)::NNI +--JHD return uterm +--JHD +--JHD --the new gcd has degree less +--JHD du
dd:=du +--JHD +--JHD good(f:P,lvr:List OV):Record(upol:SUPR,inval:List R) == +--JHD nvr:NNI:=#lvr +--JHD range:I:=1 +--JHD ltry:List List R:=[] +--JHD while true repeat +--JHD range:=2*range +--JHD lval:=[(random()$I rem (2*range) -range)::R for i in 1..nvr] +--JHD member?(lval,ltry) => "new point" +--JHD ltry:=cons(lval,ltry) +--JHD uf:=univariate eval(f,lvr,lval) +--JHD if degree gcd(uf,differentiate uf)=0 then return [uf,lval] +--JHD +--JHD -- impose the right lc +--JHD imposelc(lipol:List SUPR, +--JHD lvar:List OV,lval:List R,leadc:List P):List SUPR == +--JHD result:List SUPR :=[] +--JHD lvar:=lvar.rest +--JHD for pol in lipol for leadpol in leadc repeat +--JHD p1:= univariate eval(leadpol,lvar,lval) * pol +--JHD result:= cons((p1 exquo leadingCoefficient pol)::SUPR,result) +--JHD reverse result +--JHD +--JHD --Compute the gcd between not coprime polynomials +--JHD notCoprime(g:P,p2:P,ldeg:List NNI,lvar:List OV) : P == +--JHD x:OV:=lvar.first +--JHD lvar1:List OV:=lvar.rest +--JHD lg1:=gcdcofact([g,differentiate(g,x)]) +--JHD g1:=lg1.1 +--JHD lg:LGcd:=localgcd(g1,p2,lvar) +--JHD (l,lval):=(lg.locgcd,lg.goodint) +--JHD p2:=(p2 exquo l)::P +--JHD (gd1,gd2):=(l,l) +--JHD ul:=univariate(eval(l,lvar1,lval)) +--JHD dl:=degree ul +--JHD if degree gcd(ul,differentiate ul) ^=0 then +--JHD newchoice:=good(l,lvar.rest) +--JHD ul:=newchoice.upol +--JHD lval:=newchoice.inval +--JHD ug1:=univariate(eval(g1,lvar1,lval)) +--JHD ulist:=[ug1,univariate eval(p2,lvar1,lval)] +--JHD lcpol:=[leadingCoefficient univariate(g1,x), +--JHD leadingCoefficient univariate(p2,x)] +--JHD while true repeat +--JHD d:SUPR:=gcd(cons(ul,ulist)) +--JHD if degree d =0 then return gd1 +--JHD lquo:=(ul exquo d)::SUPR +--JHD if degree lquo ^=0 then +--JHD lgcd:=gcd(cons(leadingCoefficient univariate(l,x),lcpol)) +--JHD gd2:=lift(l,d,lquo,lgcd,lvar,ldeg,lval) +--JHD l:=gd2 +--JHD ul:=univariate(eval(l,lvar1,lval)) +--JHD dl:=degree ul +--JHD gd1:=gd1*gd2 +--JHD ulist:=[(uf exquo d)::SUPR for uf in ulist] +--JHD +--JHD -- we suppose that the poly have the same mainvar, deg p1#2,setUnion(variables p1,variables p2)) +--JHD d1:=degree(p1,x) +--JHD d2:=degree(p2,x) +--JHD result: P:=localgcd(p1,p2,lvar).locgcd +--JHD -- special cases +--JHD result=1 => 1$P +--JHD (dr:=degree(result,x))=d1 or dr=d2 => result +--JHD while failtest(result,p1,p2) repeat +--JHD SAY$Lisp "retrying gcd" +--JHD result:=localgcd(p1,p2,lvar).locgcd +--JHD result +--JHD +--JHD --local function for the gcd : it returns the evaluation point too +--JHD localgcd(p1:P,p2:P,lvar:List(OV)) : LGcd == +--JHD x:OV:=lvar.first +--JHD uterm:=chooseVal(p1,p2,lvar) +--JHD listpol:= uterm.lpol +--JHD ud:=listpol.first +--JHD dd:= degree ud +--JHD +--JHD --the univariate gcd is 1 +--JHD dd=0 => [1$P,uterm.lint]$LGcd +--JHD +--JHD --one of the polynomials is the gcd +--JHD dd=degree(p1,x) or dd=degree(p2,x) => +--JHD [uterm.mpol,uterm.lint]$LGcd +--JHD ldeg:List NNI:=map(min,degree(p1,lvar),degree(p2,lvar)) +--JHD +--JHD -- if there is a polynomial g s.t. g/gcd and gcd are coprime ... +--JHD -- I can lift +--JHD (h:=lift?(p1,p2,uterm,ldeg,lvar)) case "failed" => +--JHD [notCoprime(p1,p2,ldeg,lvar),uterm.lint]$LGcd +--JHD [h::P,uterm.lint]$LGcd +--JHD +--JHD +--JHD -- content, internal functions return the poly if it is a monomial +--JHD monomContent(p:P,var:OV):P == +--JHD ground? p => 1$P +--JHD md:= minimumDegree(p,var) +--JHD ((var::P)**md)*(gcd sort(better,coefficients univariate(p,var))) + + monomContentSup(u:SUPP):SUPP == + degree(u) = 0$NonNegativeInteger => 1$SUPP + md:= minimumDegree u + gcd(sort(better,coefficients u)) * monomial(1$P,md)$SUPP + +--JHD -- change the polynomials to have positive lc +--JHD abs(p:P): P == unitNormal(p).canonical + + -- Ordering for gcd purposes + better(p1:P,p2:P):Boolean == + ground? p1 => true + ground? p2 => false + degree(p1,mainVariable(p1)::OV) < degree(p2,mainVariable(p2)::OV) + + -- PRS algorithm + -- gcdPrs(p1:P,p2:P,d:NNI,var:OV):Union(P,"failed") == + -- u1:= univariate(p1,var) + -- u2:= univariate(p2,var) + -- finished:Boolean:= false + -- until finished repeat + -- dd:NNI:=(degree u1 - degree u2)::NNI + -- lc1:SUPP:=leadingCoefficient u2 * reductum u1 + -- lc2:SUPP:=leadingCoefficient u1 * reductum u2 + -- u3:SUPP:= primitate((lc1-lc2)*monomial(1$P,dd))$% + -- (d3:=degree(u3)) <= d => finished:= true + -- u1:= u2 + -- u2:= u3 + -- if d3 > degree(u1) then (u1,u2):= (u2,u1) + -- g:= (u2 exquo u3) + -- g case SUPP => abs multivariate(u3,var) + -- "failed" + + -- Gcd between polynomial p1 and p2 with + -- mainVariable p1 < x=mainVariable p2 +--JHD gcdTermList(p1:P,p2:P) : P == +--JHD termList:=sort(better, +--JHD cons(p1,coefficients univariate(p2,(mainVariable p2)::OV))) +--JHD q:P:=termList.first +--JHD for term in termList.rest until q = 1$P repeat q:= gcd(q,term) +--JHD q +--JHD +--JHD -- Gcd between polynomials with the same mainVariable +--JHD gcdSameMainvar(p1:P,p2:P,mvar:OV): P == +--JHD if degree(p1,mvar) < degree(p2,mvar) then (p1,p2):= (p2,p1) +--JHD (p1 exquo p2) case P => abs p2 +--JHD c1:= monomContent(p1,mvar)$% +--JHD c1 = p1 => gcdMonom(p1,p2,mvar) +--JHD c2:= monomContent(p2,mvar)$% +--JHD c2 = p2 => gcdMonom(p2,p1,mvar) +--JHD p1:= (p1 exquo c1)::P +--JHD p2:= (p2 exquo c2)::P +--JHD if degree(p1,mvar) < degree(p2,mvar) then (p1,p2):= (p2,p1) +--JHD (p1 exquo p2) case P => abs(p2) * gcd(c1,c2) +--JHD abs(gcdPrim(p1,p2,mvar)) * gcd(c1,c2) +--JHD +--JHD -- make the polynomial primitive with respect to var +--JHD primitate(p:P,var:OV):P == (p exquo monomContent(p,var))::P +--JHD +--JHD primitate(u:SUPP):SUPP == (u exquo monomContentSup u)::SUPP +--JHD +--JHD -- gcd between primitive polynomials with the same mainVariable +--JHD gcdPrim(p1:P,p2:P,mvar:OV):P == +--JHD vars:= removeDuplicates append(variables p1,variables p2) +--JHD #vars=1 => multivariate(gcd(univariate p1,univariate p2),mvar) +--JHD vars:=delete(vars,position(mvar,vars)) +--JHD --d:= degModGcd(p1,p2,mvar,vars) +--JHD --d case "failed" => internal(p2,p1,mvar) +--JHD --deg:= d:NNI +--JHD --deg = 0$NNI => 1$P +--JHD --deg = degree(p1,mvar) => +--JHD -- (p2 exquo p1) case P => abs(p1) -- already know that +--JHD -- ^(p1 exquo p2) +--JHD -- internal(p2,p1,mvar) +--JHD --cheapPrs?(p1,p2,deg,mvar) => +--JHD -- g:= gcdPrs(p1,p2,deg,mvar) +--JHD -- g case P => g::P +--JHD -- internal(p2,p1,mvar) +--JHD internal(p2,p1,mvar) +--JHD +--JHD -- gcd between a monomial and a polynomial +--JHD gcdMonom(m:P,p:P,var:OV):P == +--JHD ((var::P) ** min(minimumDegree(m,var),minimumDegree(p,var))) * +--JHD gcdTermList(leadingCoefficient(univariate(m,var)),p) +--JHD +--JHD --If there is a pol s.t. pol/gcd and gcd are coprime I can lift +--JHD lift?(p1:P,p2:P,uterm:UTerm,ldeg:List NNI, +--JHD lvar:List OV) : Union("failed",P) == +--JHD x:OV:=lvar.first +--JHD leadpol:Boolean:=false +--JHD (listpol,lval):=(uterm.lpol,uterm.lint) +--JHD d:=listpol.first +--JHD listpol:=listpol.rest +--JHD nolift:Boolean:=true +--JHD for uf in listpol repeat +--JHD --note uf and d not necessarily primitive +--JHD degree gcd(uf,d) =0 => nolift:=false +--JHD nolift => "failed" +--JHD f:P:=([p1,p2]$List(P)).(position(uf,listpol)) +--JHD lgcd:=gcd(leadingCoefficient univariate(p1,x), +--JHD leadingCoefficient univariate(p2,x)) +--JHD lift(f,d,uf,lgcd,lvar,ldeg,lval) +--JHD +--JHD -- interface with the general "lifting" function +--JHD lift(f:P,d:SUPR,uf:SUPR,lgcd:P,lvar:List OV, +--JHD ldeg:List NNI,lval:List R):P == +--JHD x:OV:=lvar.first +--JHD leadpol:Boolean:=false +--JHD lcf:P +--JHD lcf:=leadingCoefficient univariate(f,x) +--JHD df:=degree(f,x) +--JHD leadlist:List(P):=[] +--JHD +--JHD if lgcd^=1$P then +--JHD leadpol:=true +--JHD f:=lgcd*f +--JHD ldeg:=[n0+n1 for n0 in ldeg for n1 in degree(lgcd,lvar)] +--JHD lcd:R:=leadingCoefficient d +--JHD if ground? lgcd then d:=((retract lgcd) *d exquo lcd)::SUPR +--JHD else d:=(retract(eval(lgcd,lvar.rest,lval)) * d exquo lcd)::SUPR +--JHD uf:=lcd*uf +--JHD leadlist:=[lgcd,lcf] +--JHD lg:=imposelc([d,uf],lvar,lval,leadlist) +--JHD plist:=lifting(univariate(f,x),lvar,lg,lval,leadlist,ldeg)::List P +--JHD (p0:P,p1:P):=(plist.first,plist.2) +--JHD if univariate eval(p0,rest lvar,lval) ^= lg.first then +--JHD (p0,p1):=(p1,p0) +--JHD ^leadpol => p0 +--JHD cprim:=contprim([p0]) +--JHD cprim.first.prim +--JHD +--JHD -- Gcd for two multivariate polynomials +--JHD gcd(p1:P,p2:P) : P == +--JHD (p1:= abs(p1)) = (p2:= abs(p2)) => p1 +--JHD ground? p1 => +--JHD p1 = 1$P => p1 +--JHD p1 = 0$P => p2 +--JHD ground? p2 => gcd((retract p1)@R,(retract p2)@R)::P +--JHD gcdTermList(p1,p2) +--JHD ground? p2 => +--JHD p2 = 1$P => p2 +--JHD p2 = 0$P => p1 +--JHD gcdTermList(p2,p1) +--JHD mv1:= mainVariable(p1)::OV +--JHD mv2:= mainVariable(p2)::OV +--JHD mv1 = mv2 => gcdSameMainvar(p1,p2,mv1) +--JHD mv1 < mv2 => gcdTermList(p1,p2) +--JHD gcdTermList(p2,p1) +--JHD +--JHD -- Gcd for a list of multivariate polynomials +--JHD gcd(listp:List P) : P == +--JHD lf:=sort(better,listp) +--JHD f:=lf.first +--JHD for g in lf.rest repeat +--JHD f:=gcd(f,g) +--JHD if f=1$P then return f +--JHD f +--JHD -- Gcd and cofactors for a list of polynomials +--JHD gcdcofact(listp : List P) : List P == +--JHD h:=gcd listp +--JHD cons(h,[(f exquo h) :: P for f in listp]) +--JHD +--JHD -- Gcd for primitive polynomials +--JHD gcdprim(p1:P,p2:P):P == +--JHD (p1:= abs(p1)) = (p2:= abs(p2)) => p1 +--JHD ground? p1 => +--JHD ground? p2 => gcd((retract p1)@R,(retract p2)@R)::P +--JHD p1 = 0$P => p2 +--JHD 1$P +--JHD ground? p2 => +--JHD p2 = 0$P => p1 +--JHD 1$P +--JHD mv1:= mainVariable(p1)::OV +--JHD mv2:= mainVariable(p2)::OV +--JHD mv1 = mv2 => +--JHD md:=min(minimumDegree(p1,mv1),minimumDegree(p2,mv1)) +--JHD mp:=1$P +--JHD if md>1 then +--JHD mp:=(mv1::P)**md +--JHD p1:=(p1 exquo mp)::P +--JHD p2:=(p2 exquo mp)::P +--JHD mp*gcdPrim(p1,p2,mv1) +--JHD 1$P +--JHD +--JHD -- Gcd for a list of primitive multivariate polynomials +--JHD gcdprim(listp:List P) : P == +--JHD lf:=sort(better,listp) +--JHD f:=lf.first +--JHD for g in lf.rest repeat +--JHD f:=gcdprim(f,g) +--JHD if f=1$P then return f +--JHD f +--JHD -- Gcd and cofactors for a list of primitive polynomials +--JHD gcdcofactprim(listp : List P) : List P == +--JHD h:=gcdprim listp +--JHD cons(h,[(f exquo h) :: P for f in listp]) +--JHD +--JHD -- content of a polynomial (with respect to its main var) +--JHD content(f:P):P == +--JHD ground? f => f +--JHD x:OV:=(mainVariable f)::OV +--JHD gcd sort(better,coefficients univariate(f,x)) +--JHD +--JHD -- contents of a list of polynomials +--JHD content(listf:List P) : List P == [content f for f in listf] +--JHD +--JHD -- contents and primitive parts of a list of polynomials +--JHD contprim(listf:List P) : List ContPrim == +--JHD prelim :List P := content listf +--JHD [[q,(f exquo q)::P]$ContPrim for q in prelim for f in listf] +--JHD + +@ +<>= +"GENPGCD" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GENPGCD"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"GENPGCD" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GENUPS GenerateUnivariatePowerSeries} +\pagehead{GenerateUnivariatePowerSeries}{GENUPS} +\pagepic{ps/v104generateunivariatepowerseries.ps}{GENUPS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GENUPS GenerateUnivariatePowerSeries +++ Author: Clifton J. Williamson +++ Date Created: 29 April 1990 +++ Date Last Updated: 31 May 1990 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: series, Taylor, Laurent, Puiseux +++ Examples: +++ References: +++ Description: +++ \spadtype{GenerateUnivariatePowerSeries} provides functions that create +++ power series from explicit formulas for their \spad{n}th coefficient. +GenerateUnivariatePowerSeries(R,FE): Exports == Implementation where + R : Join(IntegralDomain,OrderedSet,RetractableTo Integer,_ + LinearlyExplicitRingOver Integer) + FE : Join(AlgebraicallyClosedField,TranscendentalFunctionCategory,_ + FunctionSpace R) + ANY1 ==> AnyFunctions1 + EQ ==> Equation + I ==> Integer + NNI ==> NonNegativeInteger + RN ==> Fraction Integer + SEG ==> UniversalSegment + ST ==> Stream + SY ==> Symbol + UTS ==> UnivariateTaylorSeries + ULS ==> UnivariateLaurentSeries + UPXS ==> UnivariatePuiseuxSeries + + Exports ==> with + taylor: (I -> FE,EQ FE) -> Any + ++ \spad{taylor(n +-> a(n),x = a)} returns + ++ \spad{sum(n = 0..,a(n)*(x-a)**n)}. + taylor: (FE,SY,EQ FE) -> Any + ++ \spad{taylor(a(n),n,x = a)} returns \spad{sum(n = 0..,a(n)*(x-a)**n)}. + taylor: (I -> FE,EQ FE,SEG NNI) -> Any + ++ \spad{taylor(n +-> a(n),x = a,n0..)} returns + ++ \spad{sum(n=n0..,a(n)*(x-a)**n)}; + ++ \spad{taylor(n +-> a(n),x = a,n0..n1)} returns + ++ \spad{sum(n = n0..,a(n)*(x-a)**n)}. + taylor: (FE,SY,EQ FE,SEG NNI) -> Any + ++ \spad{taylor(a(n),n,x = a,n0..)} returns + ++ \spad{sum(n = n0..,a(n)*(x-a)**n)}; + ++ \spad{taylor(a(n),n,x = a,n0..n1)} returns + ++ \spad{sum(n = n0..,a(n)*(x-a)**n)}. + + laurent: (I -> FE,EQ FE,SEG I) -> Any + ++ \spad{laurent(n +-> a(n),x = a,n0..)} returns + ++ \spad{sum(n = n0..,a(n) * (x - a)**n)}; + ++ \spad{laurent(n +-> a(n),x = a,n0..n1)} returns + ++ \spad{sum(n = n0..n1,a(n) * (x - a)**n)}. + laurent: (FE,SY,EQ FE,SEG I) -> Any + ++ \spad{laurent(a(n),n,x=a,n0..)} returns + ++ \spad{sum(n = n0..,a(n) * (x - a)**n)}; + ++ \spad{laurent(a(n),n,x=a,n0..n1)} returns + ++ \spad{sum(n = n0..n1,a(n) * (x - a)**n)}. + + puiseux: (RN -> FE,EQ FE,SEG RN,RN) -> Any + ++ \spad{puiseux(n +-> a(n),x = a,r0..,r)} returns + ++ \spad{sum(n = r0,r0 + r,r0 + 2*r..., a(n) * (x - a)**n)}; + ++ \spad{puiseux(n +-> a(n),x = a,r0..r1,r)} returns + ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)**n)}. + puiseux: (FE,SY,EQ FE,SEG RN,RN) -> Any + ++ \spad{puiseux(a(n),n,x = a,r0..,r)} returns + ++ \spad{sum(n = r0,r0 + r,r0 + 2*r..., a(n) * (x - a)**n)}; + ++ \spad{puiseux(a(n),n,x = a,r0..r1,r)} returns + ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)**n)}. + + series: (I -> FE,EQ FE) -> Any + ++ \spad{series(n +-> a(n),x = a)} returns + ++ \spad{sum(n = 0..,a(n)*(x-a)**n)}. + series: (FE,SY,EQ FE) -> Any + ++ \spad{series(a(n),n,x = a)} returns + ++ \spad{sum(n = 0..,a(n)*(x-a)**n)}. + series: (I -> FE,EQ FE,SEG I) -> Any + ++ \spad{series(n +-> a(n),x = a,n0..)} returns + ++ \spad{sum(n = n0..,a(n) * (x - a)**n)}; + ++ \spad{series(n +-> a(n),x = a,n0..n1)} returns + ++ \spad{sum(n = n0..n1,a(n) * (x - a)**n)}. + series: (FE,SY,EQ FE,SEG I) -> Any + ++ \spad{series(a(n),n,x=a,n0..)} returns + ++ \spad{sum(n = n0..,a(n) * (x - a)**n)}; + ++ \spad{series(a(n),n,x=a,n0..n1)} returns + ++ \spad{sum(n = n0..n1,a(n) * (x - a)**n)}. + series: (RN -> FE,EQ FE,SEG RN,RN) -> Any + ++ \spad{series(n +-> a(n),x = a,r0..,r)} returns + ++ \spad{sum(n = r0,r0 + r,r0 + 2*r..., a(n) * (x - a)**n)}; + ++ \spad{series(n +-> a(n),x = a,r0..r1,r)} returns + ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)**n)}. + series: (FE,SY,EQ FE,SEG RN,RN) -> Any + ++ \spad{series(a(n),n,x = a,r0..,r)} returns + ++ \spad{sum(n = r0,r0 + r,r0 + 2*r..., a(n) * (x - a)**n)}; + ++ \spad{series(a(n),n,x = a,r0..r1,r)} returns + ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)**n)}. + + Implementation ==> add + + genStream: (I -> FE,I) -> ST FE + genStream(f,n) == delay concat(f(n),genStream(f,n + 1)) + + genFiniteStream: (I -> FE,I,I) -> ST FE + genFiniteStream(f,n,m) == delay + n > m => empty() + concat(f(n),genFiniteStream(f,n + 1,m)) + + taylor(f,eq) == + (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => + error "taylor: left hand side must be a variable" + x := xx :: SY; a := rhs eq + coerce(series(genStream(f,0))$UTS(FE,x,a))$ANY1(UTS(FE,x,a)) + + taylor(an:FE,n:SY,eq:EQ FE) == + taylor(eval(an,(n :: FE) = (#1 :: FE)),eq) + + taylor(f:I -> FE,eq:EQ FE,seg:SEG NNI) == + (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => + error "taylor: left hand side must be a variable" + x := xx :: SY; a := rhs eq + hasHi seg => + n0 := lo seg; n1 := hi seg + if n1 < n0 then (n0,n1) := (n1,n0) + uts := series(genFiniteStream(f,n0,n1))$UTS(FE,x,a) + uts := uts * monomial(1,n0)$UTS(FE,x,a) + coerce(uts)$ANY1(UTS(FE,x,a)) + n0 := lo seg + uts := series(genStream(f,n0))$UTS(FE,x,a) + uts := uts * monomial(1,n0)$UTS(FE,x,a) + coerce(uts)$ANY1(UTS(FE,x,a)) + + taylor(an,n,eq,seg) == + taylor(eval(an,(n :: FE) = (#1 :: FE)),eq,seg) + + laurent(f,eq,seg) == + (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => + error "taylor: left hand side must be a variable" + x := xx :: SY; a := rhs eq + hasHi seg => + n0 := lo seg; n1 := hi seg + if n1 < n0 then (n0,n1) := (n1,n0) + uts := series(genFiniteStream(f,n0,n1))$UTS(FE,x,a) + coerce(laurent(n0,uts)$ULS(FE,x,a))$ANY1(ULS(FE,x,a)) + n0 := lo seg + uts := series(genStream(f,n0))$UTS(FE,x,a) + coerce(laurent(n0,uts)$ULS(FE,x,a))$ANY1(ULS(FE,x,a)) + + laurent(an,n,eq,seg) == + laurent(eval(an,(n :: FE) = (#1 :: FE)),eq,seg) + + modifyFcn:(RN -> FE,I,I,I,I) -> FE + modifyFcn(f,n0,nn,q,m) == (zero?((m - n0) rem nn) => f(m/q); 0) + + puiseux(f,eq,seg,r) == + (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" => + error "puiseux: left hand side must be a variable" + x := xx :: SY; a := rhs eq + not positive? r => error "puiseux: last argument must be positive" + hasHi seg => + r0 := lo seg; r1 := hi seg + if r1 < r0 then (r0,r1) := (r1,r0) + p0 := numer r0; q0 := denom r0 + p1 := numer r1; q1 := denom r1 + p2 := numer r; q2 := denom r + q := lcm(lcm(q0,q1),q2) + n0 := p0 * (q quo q0); n1 := p1 * (q quo q1) + nn := p2 * (q quo q2) + ulsUnion := laurent(modifyFcn(f,n0,nn,q,#1),eq,segment(n0,n1)) + uls := retract(ulsUnion)$ANY1(ULS(FE,x,a)) + coerce(puiseux(1/q,uls)$UPXS(FE,x,a))$ANY1(UPXS(FE,x,a)) + p0 := numer(r0 := lo seg); q0 := denom r0 + p2 := numer r; q2 := denom r + q := lcm(q0,q2) + n0 := p0 * (q quo q0); nn := p2 * (q quo q2) + ulsUnion := laurent(modifyFcn(f,n0,nn,q,#1),eq,segment n0) + uls := retract(ulsUnion)$ANY1(ULS(FE,x,a)) + coerce(puiseux(1/q,uls)$UPXS(FE,x,a))$ANY1(UPXS(FE,x,a)) + + puiseux(an,n,eq,r0,m) == + puiseux(eval(an,(n :: FE) = (#1 :: FE)),eq,r0,m) + + series(f:I -> FE,eq:EQ FE) == puiseux(f(numer #1),eq,segment 0,1) + series(an:FE,n:SY,eq:EQ FE) == puiseux(an,n,eq,segment 0,1) + series(f:I -> FE,eq:EQ FE,seg:SEG I) == + ratSeg : SEG RN := map(#1::RN,seg)$UniversalSegmentFunctions2(I,RN) + puiseux(f(numer #1),eq,ratSeg,1) + series(an:FE,n:SY,eq:EQ FE,seg:SEG I) == + ratSeg : SEG RN := map(#1::RN,seg)$UniversalSegmentFunctions2(I,RN) + puiseux(an,n,eq,ratSeg,1) + series(f:RN -> FE,eq:EQ FE,seg:SEG RN,r:RN) == puiseux(f,eq,seg,r) + series(an:FE,n:SY,eq:EQ FE,seg:SEG RN,r:RN) == puiseux(an,n,eq,seg,r) + +@ +<>= +"GENUPS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GENUPS"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"GENUPS" -> "ACF" +"GENUPS" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GENEEZ GenExEuclid} +\pagehead{GenExEuclid}{GENEEZ} +\pagepic{ps/v104genexeuclid.ps}{GENEEZ}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GENEEZ GenExEuclid +++ Author : P.Gianni. +++ January 1990 +++ The equation \spad{Af+Bg=h} and its generalization to n polynomials +++ is solved for solutions over the R, euclidean domain. +++ A table containing the solutions of \spad{Af+Bg=x**k} is used. +++ The operations are performed modulus a prime +++ which are in principle big enough, +++ but the solutions are tested and, in case of failure, a hensel +++ lifting process is used to get to the right solutions. +++ It will be used in the factorization of multivariate polynomials +++ over finite field, with \spad{R=F[x]}. + +GenExEuclid(R,BP) : C == T + where + R : EuclideanDomain + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + BP : UnivariatePolynomialCategory R + L ==> List + + C == with + reduction: (BP,R) -> BP + ++ reduction(p,prime) reduces the polynomial p modulo prime of R. + ++ Note: this function is exported only because it's conditional. + compBound: (BP,L BP) -> NNI + ++ compBound(p,lp) + ++ computes a bound for the coefficients of the solution + ++ polynomials. + ++ Given a polynomial right hand side p, + ++ and a list lp of left hand side polynomials. + ++ Exported because it depends on the valuation. + tablePow : (NNI,R,L BP) -> Union(Vector(L BP),"failed") + ++ tablePow(maxdeg,prime,lpol) constructs the table with the + ++ coefficients of the Extended Euclidean Algorithm for lpol. + ++ Here the right side is \spad{x**k}, for k less or equal to maxdeg. + ++ The operation returns "failed" when the elements + ++ are not coprime modulo prime. + solveid : (BP,R,Vector L BP) -> Union(L BP,"failed") + ++ solveid(h,table) computes the coefficients of the + ++ extended euclidean algorithm for a list of polynomials + ++ whose tablePow is table and with right side h. + + testModulus : (R, L BP) -> Boolean + ++ testModulus(p,lp) returns true if the the prime p + ++ is valid for the list of polynomials lp, i.e. preserves + ++ the degree and they remain relatively prime. + + T == add + if R has multiplicativeValuation then + compBound(m:BP,listpolys:L BP) : NNI == + ldeg:=[degree f for f in listpolys] + n:NNI:= (+/[df for df in ldeg]) + normlist:=[ +/[euclideanSize(u)**2 for u in coefficients f] + for f in listpolys] + nm:= +/[euclideanSize(u)**2 for u in coefficients m] + normprod := */[g**((n-df)::NNI) for g in normlist for df in ldeg] + 2*(approxSqrt(normprod * nm)$IntegerRoots(Integer))::NNI + else if R has additiveValuation then + -- a fairly crude Hadamard-style bound for the solution + -- based on regarding the problem as a system of linear equations. + compBound(m:BP,listpolys:L BP) : NNI == + "max"/[euclideanSize u for u in coefficients m] + + +/["max"/[euclideanSize u for u in coefficients p] + for p in listpolys] + else + compBound(m:BP,listpolys:L BP) : NNI == + error "attempt to use compBound without a well-understood valuation" + if R has IntegerNumberSystem then + reduction(u:BP,p:R):BP == + p = 0 => u + map(symmetricRemainder(#1,p),u) + else reduction(u:BP,p:R):BP == + p = 0 => u + map(#1 rem p,u) + + merge(p:R,q:R):Union(R,"failed") == + p = q => p + p = 0 => q + q = 0 => p + "failed" + + modInverse(c:R,p:R):R == + (extendedEuclidean(c,p,1)::Record(coef1:R,coef2:R)).coef1 + + exactquo(u:BP,v:BP,p:R):Union(BP,"failed") == + invlcv:=modInverse(leadingCoefficient v,p) + r:=monicDivide(u,reduction(invlcv*v,p)) + reduction(r.remainder,p) ^=0 => "failed" + reduction(invlcv*r.quotient,p) + + FP:=EuclideanModularRing(R,BP,R,reduction,merge,exactquo) + + --make table global variable! + table:Vector L BP + import GeneralHenselPackage(R,BP) + + --local functions + makeProducts : L BP -> L BP + liftSol: (L BP,BP,R,R,Vector L BP,BP,NNI) -> Union(L BP,"failed") + + reduceList(lp:L BP,lmod:R): L FP ==[reduce(ff,lmod) for ff in lp] + + coerceLFP(lf:L FP):L BP == [fm::BP for fm in lf] + + liftSol(oldsol:L BP,err:BP,lmod:R,lmodk:R, + table:Vector L BP,m:BP,bound:NNI):Union(L BP,"failed") == + euclideanSize(lmodk) > bound => "failed" + d:=degree err + ftab:Vector L FP := + map(reduceList(#1,lmod),table)$VectorFunctions2(List BP,List FP) + sln:L FP:=[0$FP for xx in ftab.1 ] + for i in 0 .. d |(cc:=coefficient(err,i)) ^=0 repeat + sln:=[slp+reduce(cc::BP,lmod)*pp + for pp in ftab.(i+1) for slp in sln] + nsol:=[f-lmodk*reduction(g::BP,lmod) for f in oldsol for g in sln] + lmodk1:=lmod*lmodk + nsol:=[reduction(slp,lmodk1) for slp in nsol] + lpolys:L BP:=table.(#table) + (fs:=+/[f*g for f in lpolys for g in nsol]) = m => nsol + a:BP:=((fs-m) exquo lmodk1)::BP + liftSol(nsol,a,lmod,lmodk1,table,m,bound) + + makeProducts(listPol:L BP):L BP == + #listPol < 2 => listPol + #listPol = 2 => reverse listPol + f:= first listPol + ll := rest listPol + [*/ll,:[f*g for g in makeProducts ll]] + + testModulus(pmod, listPol) == + redListPol := reduceList(listPol, pmod) + for pol in listPol for rpol in redListPol repeat + degree(pol) ^= degree(rpol::BP) => return false + while not empty? redListPol repeat + rpol := first redListPol + redListPol := rest redListPol + for rpol2 in redListPol repeat + gcd(rpol, rpol2) ^= 1 => return false + true + + if R has Field then + tablePow(mdeg:NNI,pmod:R,listPol:L BP) == + multiE:=multiEuclidean(listPol,1$BP) + multiE case "failed" => "failed" + ptable:Vector L BP :=new(mdeg+1,[]) + ptable.1:=multiE + x:BP:=monomial(1,1) + for i in 2..mdeg repeat ptable.i:= + [tpol*x rem fpol for tpol in ptable.(i-1) for fpol in listPol] + ptable.(mdeg+1):=makeProducts listPol + ptable + + solveid(m:BP,pmod:R,table:Vector L BP) : Union(L BP,"failed") == + -- Actually, there's no possibility of failure + d:=degree m + sln:L BP:=[0$BP for xx in table.1] + for i in 0 .. d | coefficient(m,i)^=0 repeat + sln:=[slp+coefficient(m,i)*pp + for pp in table.(i+1) for slp in sln] + sln + + else + + tablePow(mdeg:NNI,pmod:R,listPol:L BP) == + listP:L FP:= [reduce(pol,pmod) for pol in listPol] + multiE:=multiEuclidean(listP,1$FP) + multiE case "failed" => "failed" + ftable:Vector L FP :=new(mdeg+1,[]) + fl:L FP:= [ff::FP for ff in multiE] + ftable.1:=[fpol for fpol in fl] + x:FP:=reduce(monomial(1,1),pmod) + for i in 2..mdeg repeat ftable.i:= + [tpol*x rem fpol for tpol in ftable.(i-1) for fpol in listP] + ptable:= map(coerceLFP,ftable)$VectorFunctions2(List FP,List BP) + ptable.(mdeg+1):=makeProducts listPol + ptable + + solveid(m:BP,pmod:R,table:Vector L BP) : Union(L BP,"failed") == + d:=degree m + ftab:Vector L FP:= + map(reduceList(#1,pmod),table)$VectorFunctions2(List BP,List FP) + lpolys:L BP:=table.(#table) + sln:L FP:=[0$FP for xx in ftab.1] + for i in 0 .. d | coefficient(m,i)^=0 repeat + sln:=[slp+reduce(coefficient(m,i)::BP,pmod)*pp + for pp in ftab.(i+1) for slp in sln] + soln:=[slp::BP for slp in sln] + (fs:=+/[f*g for f in lpolys for g in soln]) = m=> soln + -- Compute bound + bound:=compBound(m,lpolys) + a:BP:=((fs-m) exquo pmod)::BP + liftSol(soln,a,pmod,pmod,table,m,bound) + +@ +<>= +"GENEEZ" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GENEEZ"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"GENEEZ" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GENUFACT GenUFactorize} +\pagehead{GenUFactorize}{GENUFACT} +\pagepic{ps/v104genufactorize.ps}{GENUFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GENUFACT GenUFactorize +++ Description +++ This package provides operations for the factorization +++ of univariate polynomials with integer +++ coefficients. The factorization is done by "lifting" the +++ finite "berlekamp's" factorization +GenUFactorize(R) : public == private where + R : EuclideanDomain + PR ==> SparseUnivariatePolynomial R -- with factor + -- should be UnivariatePolynomialCategory + NNI ==> NonNegativeInteger + SUP ==> SparseUnivariatePolynomial + + + public == with + factor : PR -> Factored PR + ++ factor(p) returns the factorisation of p + + private == add + + -- Factorisation currently fails when algebraic extensions have multiple + -- generators. + factorWarning(f:OutputForm):Void == + import AnyFunctions1(String) + import AnyFunctions1(OutputForm) + outputList(["WARNING (genufact): No known algorithm to factor "::Any, _ + f::Any, _ + ", trying square-free."::Any])$OutputPackage + + factor(f:PR) : Factored PR == + R is Integer => (factor f)$GaloisGroupFactorizer(PR) + + R is Fraction Integer => + (factor f)$RationalFactorize(PR) + +-- R has Field and R has Finite => + R has FiniteFieldCategory => + (factor f)$DistinctDegreeFactorize(R,PR) + + R is (Complex Integer) => (factor f)$ComplexFactorization(Integer,PR) + + R is (Complex Fraction Integer) => + (factor f)$ComplexFactorization(Fraction Integer,PR) + + R is AlgebraicNumber => (factor f)$AlgFactor(PR) + + -- following is to handle SAE + R has generator : () -> R => + var := symbol(convert(generator()::OutputForm)@InputForm) + up:=UnivariatePolynomial(var,Fraction Integer) + R has MonogenicAlgebra(Fraction Integer, up) => + factor(f)$SimpleAlgebraicExtensionAlgFactor(up, R, PR) + upp:=UnivariatePolynomial(var,Fraction Polynomial Integer) + R has MonogenicAlgebra(Fraction Polynomial Integer, upp) => + factor(f)$SAERationalFunctionAlgFactor(upp, R, PR) + factorWarning(f::OutputForm) + squareFree f + factorWarning(f::OutputForm) + squareFree f + +@ +<>= +"GENUFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GENUFACT"] +"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"GENUFACT" -> "COMPCAT" +"GENUFACT" -> "ACF" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTG0 GenusZeroIntegration} +\pagehead{GenusZeroIntegration}{INTG0} +\pagepic{ps/v104genuszerointegration.ps}{INTG0}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTG0 GenusZeroIntegration +++ Rationalization of several types of genus 0 integrands; +++ Author: Manuel Bronstein +++ Date Created: 11 October 1988 +++ Date Last Updated: 24 June 1994 +++ Description: +++ This internal package rationalises integrands on curves of the form: +++ \spad{y\^2 = a x\^2 + b x + c} +++ \spad{y\^2 = (a x + b) / (c x + d)} +++ \spad{f(x, y) = 0} where f has degree 1 in x +++ The rationalization is done for integration, limited integration, +++ extended integration and the risch differential equation; +GenusZeroIntegration(R, F, L): Exports == Implementation where + R: Join(GcdDomain, RetractableTo Integer, OrderedSet, CharacteristicZero, + LinearlyExplicitRingOver Integer) + F: Join(FunctionSpace R, AlgebraicallyClosedField, + TranscendentalFunctionCategory) + L: SetCategory + + SY ==> Symbol + Q ==> Fraction Integer + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + UPUP ==> SparseUnivariatePolynomial RF + IR ==> IntegrationResult F + LOG ==> Record(coeff:F, logand:F) + U1 ==> Union(F, "failed") + U2 ==> Union(Record(ratpart:F, coeff:F),"failed") + U3 ==> Union(Record(mainpart:F, limitedlogs:List LOG), "failed") + REC ==> Record(coeff:F, var:List K, val:List F) + ODE ==> Record(particular: Union(F, "failed"), basis: List F) + LODO==> LinearOrdinaryDifferentialOperator1 RF + + Exports ==> with + palgint0 : (F, K, K, F, UP) -> IR + ++ palgint0(f, x, y, d, p) returns the integral of \spad{f(x,y)dx} + ++ where y is an algebraic function of x satisfying + ++ \spad{d(x)\^2 y(x)\^2 = P(x)}. + palgint0 : (F, K, K, K, F, RF) -> IR + ++ palgint0(f, x, y, z, t, c) returns the integral of \spad{f(x,y)dx} + ++ where y is an algebraic function of x satisfying + ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. + ++ Argument z is a dummy variable not appearing in \spad{f(x,y)}. + palgextint0: (F, K, K, F, F, UP) -> U2 + ++ palgextint0(f, x, y, g, d, p) returns functions \spad{[h, c]} such + ++ that \spad{dh/dx = f(x,y) - c g}, where y is an algebraic function + ++ of x satisfying \spad{d(x)\^2 y(x)\^2 = P(x)}, + ++ or "failed" if no such functions exist. + palgextint0: (F, K, K, F, K, F, RF) -> U2 + ++ palgextint0(f, x, y, g, z, t, c) returns functions \spad{[h, d]} such + ++ that \spad{dh/dx = f(x,y) - d g}, where y is an algebraic function + ++ of x satisfying \spad{f(x,y)dx = c f(t,y) dy}, and c and t are + ++ rational functions of y. + ++ Argument z is a dummy variable not appearing in \spad{f(x,y)}. + ++ The operation returns "failed" if no such functions exist. + palglimint0: (F, K, K, List F, F, UP) -> U3 + ++ palglimint0(f, x, y, [u1,...,un], d, p) returns functions + ++ \spad{[h,[[ci, ui]]]} such that the ui's are among \spad{[u1,...,un]} + ++ and \spad{d(h + sum(ci log(ui)))/dx = f(x,y)} if such functions exist, + ++ and "failed" otherwise. + ++ Argument y is an algebraic function of x satisfying + ++ \spad{d(x)\^2y(x)\^2 = P(x)}. + palglimint0: (F, K, K, List F, K, F, RF) -> U3 + ++ palglimint0(f, x, y, [u1,...,un], z, t, c) returns functions + ++ \spad{[h,[[ci, ui]]]} such that the ui's are among \spad{[u1,...,un]} + ++ and \spad{d(h + sum(ci log(ui)))/dx = f(x,y)} if such functions exist, + ++ and "failed" otherwise. + ++ Argument y is an algebraic function of x satisfying + ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. + palgRDE0 : (F, F, K, K, (F, F, SY) -> U1, F, UP) -> U1 + ++ palgRDE0(f, g, x, y, foo, d, p) returns a function \spad{z(x,y)} + ++ such that \spad{dz/dx + n * df/dx z(x,y) = g(x,y)} if such a z exists, + ++ and "failed" otherwise. + ++ Argument y is an algebraic function of x satisfying + ++ \spad{d(x)\^2y(x)\^2 = P(x)}. + ++ Argument foo, called by \spad{foo(a, b, x)}, is a function that solves + ++ \spad{du/dx + n * da/dx u(x) = u(x)} + ++ for an unknown \spad{u(x)} not involving y. + palgRDE0 : (F, F, K, K, (F, F, SY) -> U1, K, F, RF) -> U1 + ++ palgRDE0(f, g, x, y, foo, t, c) returns a function \spad{z(x,y)} + ++ such that \spad{dz/dx + n * df/dx z(x,y) = g(x,y)} if such a z exists, + ++ and "failed" otherwise. + ++ Argument y is an algebraic function of x satisfying + ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. + ++ Argument \spad{foo}, called by \spad{foo(a, b, x)}, is a function that + ++ solves \spad{du/dx + n * da/dx u(x) = u(x)} + ++ for an unknown \spad{u(x)} not involving y. + univariate: (F, K, K, UP) -> UPUP + ++ univariate(f,k,k,p) \undocumented + multivariate: (UPUP, K, F) -> F + ++ multivariate(u,k,f) \undocumented + lift: (UP, K) -> UPUP + ++ lift(u,k) \undocumented + if L has LinearOrdinaryDifferentialOperatorCategory F then + palgLODE0 : (L, F, K, K, F, UP) -> ODE + ++ palgLODE0(op, g, x, y, d, p) returns the solution of \spad{op f = g}. + ++ Argument y is an algebraic function of x satisfying + ++ \spad{d(x)\^2y(x)\^2 = P(x)}. + palgLODE0 : (L, F, K, K, K, F, RF) -> ODE + ++ palgLODE0(op,g,x,y,z,t,c) returns the solution of \spad{op f = g} + ++ Argument y is an algebraic function of x satisfying + ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. + + Implementation ==> add + import RationalIntegration(F, UP) + import AlgebraicManipulations(R, F) + import IntegrationResultFunctions2(RF, F) + import ElementaryFunctionStructurePackage(R, F) + import SparseUnivariatePolynomialFunctions2(F, RF) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R, P, F) + + mkRat : (F, REC, List K) -> RF + mkRatlx : (F, K, K, F, K, RF) -> RF + quadsubst: (K, K, F, UP) -> Record(diff:F, subs:REC, newk:List K) + kerdiff : (F, F) -> List K + checkroot: (F, List K) -> F + univ : (F, List K, K) -> RF + + dummy := kernel(new()$SY)@K + + kerdiff(sa, a) == setDifference(kernels sa, kernels a) + checkroot(f, l) == (empty? l => f; rootNormalize(f, first l)) + univ(c, l, x) == univariate(checkroot(c, l), x) + univariate(f, x, y, p) == lift(univariate(f, y, p), x) + lift(p, k) == map(univariate(#1, k), p) + + palgint0(f, x, y, den, radi) == + -- y is a square root so write f as f1 y + f0 and integrate separately + ff := univariate(f, x, y, minPoly y) + f0 := reductum ff + pr := quadsubst(x, y, den, radi) + map(#1(x::F), integrate(retract(f0)@RF)) + + map(#1(pr.diff), + integrate + mkRat(multivariate(leadingMonomial ff,x,y::F), pr.subs, pr.newk)) + +-- the algebraic relation is (den * y)**2 = p where p is a * x**2 + b * x + c +-- if p is squarefree, then parametrize in the following form: +-- u = y - x \sqrt{a} +-- x = (u^2 - c) / (b - 2 u \sqrt{a}) = h(u) +-- dx = h'(u) du +-- y = (u + a h(u)) / den = g(u) +-- if a is a perfect square, +-- u = (y - \sqrt{c}) / x +-- x = (b - 2 u \sqrt{c}) / (u^2 - a) = h(u) +-- dx = h'(u) du +-- y = (u h(u) + \sqrt{c}) / den = g(u) +-- otherwise. +-- if p is a square p = a t^2, then we choose only one branch for now: +-- u = x +-- x = u = h(u) +-- dx = du +-- y = t \sqrt{a} / den = g(u) +-- returns [u(x,y), [h'(u), [x,y], [h(u), g(u)], l] in both cases, +-- where l is empty if no new square root was needed, +-- l := [k] if k is the new square root kernel that was created. + quadsubst(x, y, den, p) == + u := dummy::F + b := coefficient(p, 1) + c := coefficient(p, 0) + sa := rootSimp sqrt(a := coefficient(p, 2)) + zero?(b * b - 4 * a * c) => -- case where p = a (x + b/(2a))^2 + [x::F, [1, [x, y], [u, sa * (u + b / (2*a)) / eval(den,x,u)]], empty()] + empty? kerdiff(sa, a) => + bm2u := b - 2 * u * sa + q := eval(den, x, xx := (u**2 - c) / bm2u) + yy := (ua := u + xx * sa) / q + [y::F - x::F * sa, [2 * ua / bm2u, [x, y], [xx, yy]], empty()] + u2ma:= u**2 - a + sc := rootSimp sqrt c + q := eval(den, x, xx := (b - 2 * u * sc) / u2ma) + yy := (ux := xx * u + sc) / q + [(y::F - sc) / x::F, [- 2 * ux / u2ma, [x ,y], [xx, yy]], kerdiff(sc, c)] + + mkRatlx(f,x,y,t,z,dx) == + rat := univariate(eval(f, [x, y], [t, z::F]), z) * dx + numer(rat) / denom(rat) + + mkRat(f, rec, l) == + rat:=univariate(checkroot(rec.coeff * eval(f,rec.var,rec.val), l), dummy) + numer(rat) / denom(rat) + + palgint0(f, x, y, z, xx, dx) == + map(multivariate(#1, y), integrate mkRatlx(f, x, y, xx, z, dx)) + + palgextint0(f, x, y, g, z, xx, dx) == + map(multivariate(#1, y), + extendedint(mkRatlx(f,x,y,xx,z,dx), mkRatlx(g,x,y,xx,z,dx))) + + palglimint0(f, x, y, lu, z, xx, dx) == + map(multivariate(#1, y), limitedint(mkRatlx(f, x, y, xx, z, dx), + [mkRatlx(u, x, y, xx, z, dx) for u in lu])) + + palgRDE0(f, g, x, y, rischde, z, xx, dx) == + (u := rischde(eval(f, [x, y], [xx, z::F]), + multivariate(dx, z) * eval(g, [x, y], [xx, z::F]), + symbolIfCan(z)::SY)) case "failed" => "failed" + eval(u::F, z, y::F) + +-- given p = sum_i a_i(X) Y^i, returns sum_i a_i(x) y^i + multivariate(p, x, y) == + (map(multivariate(#1, x), + p)$SparseUnivariatePolynomialFunctions2(RF, F)) + (y) + + palgextint0(f, x, y, g, den, radi) == + pr := quadsubst(x, y, den, radi) + map(#1(pr.diff), + extendedint(mkRat(f, pr.subs, pr.newk), mkRat(g, pr.subs, pr.newk))) + + palglimint0(f, x, y, lu, den, radi) == + pr := quadsubst(x, y, den, radi) + map(#1(pr.diff), + limitedint(mkRat(f, pr.subs, pr.newk), + [mkRat(u, pr.subs, pr.newk) for u in lu])) + + palgRDE0(f, g, x, y, rischde, den, radi) == + pr := quadsubst(x, y, den, radi) + (u := rischde(checkroot(eval(f, pr.subs.var, pr.subs.val), pr.newk), + checkroot(pr.subs.coeff * eval(g, pr.subs.var, pr.subs.val), + pr.newk), symbolIfCan(dummy)::SY)) case "failed" + => "failed" + eval(u::F, dummy, pr.diff) + + if L has LinearOrdinaryDifferentialOperatorCategory F then + import RationalLODE(F, UP) + + palgLODE0(eq, g, x, y, den, radi) == + pr := quadsubst(x, y, den, radi) + d := monomial(univ(inv(pr.subs.coeff), pr.newk, dummy), 1)$LODO + di:LODO := 1 -- will accumulate the powers of d + op:LODO := 0 -- will accumulate the new LODO + for i in 0..degree eq repeat + op := op + univ(eval(coefficient(eq, i), pr.subs.var, pr.subs.val), + pr.newk, dummy) * di + di := d * di + rec := ratDsolve(op,univ(eval(g,pr.subs.var,pr.subs.val),pr.newk,dummy)) + bas:List(F) := [b(pr.diff) for b in rec.basis] + rec.particular case "failed" => ["failed", bas] + [((rec.particular)::RF) (pr.diff), bas] + + palgLODE0(eq, g, x, y, kz, xx, dx) == + d := monomial(univariate(inv multivariate(dx, kz), kz), 1)$LODO + di:LODO := 1 -- will accumulate the powers of d + op:LODO := 0 -- will accumulate the new LODO + lk:List(K) := [x, y] + lv:List(F) := [xx, kz::F] + for i in 0..degree eq repeat + op := op + univariate(eval(coefficient(eq, i), lk, lv), kz) * di + di := d * di + rec := ratDsolve(op, univariate(eval(g, lk, lv), kz)) + bas:List(F) := [multivariate(b, y) for b in rec.basis] + rec.particular case "failed" => ["failed", bas] + [multivariate((rec.particular)::RF, y), bas] + +@ +<>= +"INTG0" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTG0"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"INTG0" -> "FS" +"INTG0" -> "ACF" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GRDEF GraphicsDefaults} +\pagehead{GraphicsDefaults}{GRDEF} +\pagepic{ps/v104graphicsdefaults.ps}{GRDEF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GRDEF GraphicsDefaults +++ Author: Clifton J. Williamson +++ Date Created: 8 January 1990 +++ Date Last Updated: 8 January 1990 +++ Basic Operations: clipPointsDefault, drawToScale, adaptive, maxPoints, +++ minPoints, screenResolution +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: TwoDimensionalPlotSettings sets global flags and constants +++ for 2-dimensional plotting. + +GraphicsDefaults(): Exports == Implementation where + B ==> Boolean + I ==> Integer + SF ==> DoubleFloat + maxWidth ==> 1000 + maxHeight ==> 1000 + + Exports ==> with + clipPointsDefault: () -> B + ++ clipPointsDefault() determines whether or not automatic clipping is + ++ to be done. + drawToScale: () -> B + ++ drawToScale() determines whether or not plots are to be drawn to scale. + + clipPointsDefault: B -> B + ++ clipPointsDefault(true) turns on automatic clipping; + ++ \spad{clipPointsDefault(false)} turns off automatic clipping. + ++ The default setting is true. + drawToScale: B -> B + ++ drawToScale(true) causes plots to be drawn to scale. + ++ \spad{drawToScale(false)} causes plots to be drawn so that they + ++ fill up the viewport window. + ++ The default setting is false. + +--% settings from the two-dimensional plot package + + adaptive: () -> B + ++ adaptive() determines whether plotting will be done adaptively. + maxPoints: () -> I + ++ maxPoints() returns the maximum number of points in a plot. + minPoints: () -> I + ++ minPoints() returns the minimum number of points in a plot. + screenResolution: () -> I + ++ screenResolution() returns the screen resolution n. + + adaptive: B -> B + ++ adaptive(true) turns adaptive plotting on; + ++ \spad{adaptive(false)} turns adaptive plotting off. + maxPoints: I -> I + ++ maxPoints() sets the maximum number of points in a plot. + minPoints: I -> I + ++ minPoints() sets the minimum number of points in a plot. + screenResolution: I -> I + ++ screenResolution(n) sets the screen resolution to n. + + Implementation ==> add + +--% global flags and constants + + CLIPPOINTSDEFAULT : B := true + TOSCALE : B := false + +--% functions + + clipPointsDefault() == CLIPPOINTSDEFAULT + drawToScale() == TOSCALE + + clipPointsDefault b == CLIPPOINTSDEFAULT := b + drawToScale b == TOSCALE := b + +--% settings from the two-dimensional plot package + + adaptive() == adaptive?()$Plot + minPoints() == minPoints()$Plot + maxPoints() == maxPoints()$Plot + screenResolution() == screenResolution()$Plot + + adaptive b == setAdaptive(b)$Plot + minPoints n == setMinPoints(n)$Plot + maxPoints n == setMaxPoints(n)$Plot + screenResolution n == setScreenResolution(n)$Plot + +@ +<>= +"GRDEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GRDEF"] +"Package" [color="#FF4488"] +"GRDEF" -> "Package" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GBF GroebnerFactorizationPackage} +<>= +-- groebf.spad.pamphlet GroebnerFactorizationPackage.input +)sys rm GroebnerFactorizationPackage.output +)spool GroebnerFactorizationPackage.output +)set message test on +)set message auto off +)clear all +--S 1 of 3 +mfzn : SQMATRIX(6,DMP([x,y,z],Fraction INT)) := [ [0,1,1,1,1,1], [1,0,1,8/3,x,8/3], [1,1,0,1,8/3,y], [1,8/3,1,0,1,8/3], [1,x,8/3,1,0,1], [1,8/3,y,8/3,1,0] ] +--R +--R +--R +0 1 1 1 1 1+ +--R | | +--R | 8 8| +--R |1 0 1 - x -| +--R | 3 3| +--R | | +--R | 8 | +--R |1 1 0 1 - y| +--R | 3 | +--R | | +--R (1) | 8 8| +--R |1 - 1 0 1 -| +--R | 3 3| +--R | | +--R | 8 | +--R |1 x - 1 0 1| +--R | 3 | +--R | | +--R | 8 8 | +--R |1 - y - 1 0| +--R + 3 3 + +--RType: SquareMatrix(6,DistributedMultivariatePolynomial([x,y,z],Fraction Integer)) +--E 1 + +--S 2 of 3 +eq := determinant mfzn +--R +--R +--R (2) +--R 2 2 22 2 25 2 22 2 388 250 25 2 250 14575 +--R - x y + -- x y - -- x + -- x y - --- x y - --- x - -- y - --- y + ----- +--R 3 9 3 9 27 9 27 81 +--R Type: DistributedMultivariatePolynomial([x,y,z],Fraction Integer) +--E 2 + +--S 3 of 3 +groebnerFactorize [eq,eval(eq, [x,y,z],[y,z,x]), eval(eq,[x,y,z],[z,x,y])] +--R +--R +--R (3) +--R [ +--R 22 22 22 121 +--R [x y + x z - -- x + y z - -- y - -- z + ---, +--R 3 3 3 3 +--R 2 22 25 2 22 25 22 2 388 250 +--R x z - -- x z + -- x + y z - -- y z + -- y - -- z + --- z + ---, +--R 3 9 3 9 3 9 27 +--R 2 2 22 2 25 2 22 2 388 250 25 2 250 14575 +--R y z - -- y z + -- y - -- y z + --- y z + --- y + -- z + --- z - -----] +--R 3 9 3 9 27 9 27 81 +--R , +--R 21994 2 21994 4427 463 +--R [x + y - -----,y - ----- y + ----,z - ---], +--R 5625 5625 675 87 +--R 2 1 11 5 265 2 38 265 +--R [x - - x z - -- x - - z + ---,y - z,z - -- z + ---], +--R 2 2 6 18 3 9 +--R 25 11 11 11 11 11 5 5 5 +--R [x - --,y - --,z - --], [x - --,y - --,z - --], [x + -,y + -,z + -], +--R 9 3 3 3 3 3 3 3 3 +--R 19 5 5 +--R [x - --,y + -,z + -]] +--R 3 3 3 +--R Type: List List DistributedMultivariatePolynomial([x,y,z],Fraction Integer) +--E 3 +)spool +)lisp (bye) +@ +<>= +==================================================================== +GroebnerFactorizationPackage examples +==================================================================== + +Solving systems of polynomial equations with the Groebner basis +algorithm can often be very time consuming because, in general, the +algorithm has exponential run-time. These systems, which often come +from concrete applications, frequently have symmetries which are not +taken advantage of by the algorithm. However, it often happens in +this case that the polynomials which occur during the Groebner +calculations are reducible. Since Axiom has an excellent polynomial +factorization algorithm, it is very natural to combine the Groebner +and factorization algorithms. + +GroebnerFactorizationPackage exports the groebnerFactorize operation +which implements a modified Groebner basis algorithm. In this +algorithm, each polynomial that is to be put into the partial list of +the basis is first factored. The remaining calculation is split into +as many parts as there are irreducible factors. Call these factors +p1,...,pN. In the branches corresponding to p2,...,pN, the factor p1 +can be divided out, and so on. This package also contains operations +that allow you to specify the polynomials that are not zero on the +common roots of the final Groebner basis. + +Here is an example from chemistry. In a theoretical model of the +cyclohexan C6H12, the six carbon atoms each sit in the center of +gravity of a tetrahedron that has two hydrogen atoms and two carbon +atoms at its corners. We first normalize and set the length of each +edge to 1. Hence, the distances of one fixed carbon atom to each of +its immediate neighbours is 1. We will denote the distances to the +other three carbon atoms by x, y and z. + +A. Dress developed a theory to decide whether a set of points +and distances between them can be realized in an n-dimensional space. +Here, of course, we have n = 3. + + mfzn : SQMATRIX(6,DMP([x,y,z],Fraction INT)) := _ + [ [0,1,1,1,1,1], [1,0,1,8/3,x,8/3], [1,1,0,1,8/3,y], _ + [1,8/3,1,0,1,8/3], [1,x,8/3,1,0,1], [1,8/3,y,8/3,1,0] ] + +0 1 1 1 1 1+ + | | + | 8 8| + |1 0 1 - x -| + | 3 3| + | | + | 8 | + |1 1 0 1 - y| + | 3 | + | | + | 8 8| + |1 - 1 0 1 -| + | 3 3| + | | + | 8 | + |1 x - 1 0 1| + | 3 | + | | + | 8 8 | + |1 - y - 1 0| + + 3 3 + +Type: SquareMatrix(6,DistributedMultivariatePolynomial([x,y,z], + Fraction Integer)) + +For the cyclohexan, the distances have to satisfy this equation. + + eq := determinant mfzn + 2 2 22 2 25 2 22 2 388 250 25 2 250 14575 + - x y + -- x y - -- x + -- x y - --- x y - --- x - -- y - --- y + ----- + 3 9 3 9 27 9 27 81 + Type: DistributedMultivariatePolynomial([x,y,z],Fraction Integer) + +They also must satisfy the equations given by cyclic shifts of the +indeterminates. + + groebnerFactorize [eq,eval(eq, [x,y,z],[y,z,x]), eval(eq,[x,y,z],[z,x,y])] + [ + 22 22 22 121 + [x y + x z - -- x + y z - -- y - -- z + ---, + 3 3 3 3 + 2 22 25 2 22 25 22 2 388 250 + x z - -- x z + -- x + y z - -- y z + -- y - -- z + --- z + ---, + 3 9 3 9 3 9 27 + 2 2 22 2 25 2 22 2 388 250 25 2 250 14575 + y z - -- y z + -- y - -- y z + --- y z + --- y + -- z + --- z - -----] + 3 9 3 9 27 9 27 81 + , + 21994 2 21994 4427 463 + [x + y - -----,y - ----- y + ----,z - ---], + 5625 5625 675 87 + 2 1 11 5 265 2 38 265 + [x - - x z - -- x - - z + ---,y - z,z - -- z + ---], + 2 2 6 18 3 9 + 25 11 11 11 11 11 5 5 5 + [x - --,y - --,z - --], [x - --,y - --,z - --], [x + -,y + -,z + -], + 9 3 3 3 3 3 3 3 3 + 19 5 5 + [x - --,y + -,z + -]] + 3 3 3 + Type: List List DistributedMultivariatePolynomial([x,y,z],Fraction Integer) + +The union of the solutions of this list is the solution of our original +problem. If we impose positivity conditions, we get two relevant ideals. +One ideal is zero-dimensional, namely x = y = z =11/3, and this determines +the "boat" form of the cyclohexan. The other ideal is one-dimensional, +which means that we have a solution space given by one parameter. This +gives the "chair" form of the cyclohexan. The parameter describes the +angle of the "back of the chair." + +groebnerFactorize has an optional Boolean-valued second argument. +When it is true partial results are displayed, since it may happen +that the calculation does not terminate in a reasonable time. See the +source code for GroebnerFactorizationPackage in groebf.spad.pamphlet +for more details about the algorithms used. + +See Also: +o )display operations groebnerFactorize +o )show GroebnerFactorizationPackage +o) show GroebnerPackage +o )show EuclideanGroebnerBasisPackage + +@ +\pagehead{GroebnerFactorizationPackage}{GBF} +\pagepic{ps/v104groebnerfactorizationpackage.ps}{GBF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GBF GroebnerFactorizationPackage +++ Author: H. Michael Moeller, Johannes Grabmeier +++ Date Created: 24 August 1989 +++ Date Last Updated: 01 January 1992 +++ Basic Operations: groebnerFactorize factorGroebnerBasis +++ Related Constructors: +++ Also See: GroebnerPackage, Ideal, IdealDecompositionPackage +++ AMS Classifications: +++ Keywords: groebner basis, groebner factorization, ideal decomposition +++ References: +++ Description: +++ \spadtype{GroebnerFactorizationPackage} provides the function +++ groebnerFactor" which uses the factorization routines of \Language{} to +++ factor each polynomial under consideration while doing the groebner basis +++ algorithm. Then it writes the ideal as an intersection of ideals +++ determined by the irreducible factors. Note that the whole ring may +++ occur as well as other redundancies. We also use the fact, that from the +++ second factor on we can assume that the preceding factors are +++ not equal to 0 and we divide all polynomials under considerations +++ by the elements of this list of "nonZeroRestrictions". +++ The result is a list of groebner bases, whose union of solutions +++ of the corresponding systems of equations is the solution of +++ the system of equation corresponding to the input list. +++ The term ordering is determined by the polynomial type used. +++ Suggested types include +++ \spadtype{DistributedMultivariatePolynomial}, +++ \spadtype{HomogeneousDistributedMultivariatePolynomial}, +++ \spadtype{GeneralDistributedMultivariatePolynomial}. + +GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where + + Dom : Join(EuclideanDomain,CharacteristicZero) + Expon : OrderedAbelianMonoidSup + VarSet : OrderedSet + Dpol: PolynomialCategory(Dom, Expon, VarSet) + MF ==> MultivariateFactorize(VarSet,Expon,Dom,Dpol) + sugarPol ==> Record(totdeg: NonNegativeInteger, pol : Dpol) + critPair ==> Record(lcmfij: Expon,totdeg: NonNegativeInteger, poli: Dpol, polj: Dpol ) + L ==> List + B ==> Boolean + NNI ==> NonNegativeInteger + OUT ==> OutputForm + + T ==> with + + factorGroebnerBasis : L Dpol -> L L Dpol + ++ factorGroebnerBasis(basis) checks whether the basis contains + ++ reducible polynomials and uses these to split the basis. + factorGroebnerBasis : (L Dpol, Boolean) -> L L Dpol + ++ factorGroebnerBasis(basis,info) checks whether the basis contains + ++ reducible polynomials and uses these to split the basis. + ++ If argument {\em info} is true, information is printed about + ++ partial results. + groebnerFactorize : (L Dpol, L Dpol) -> L L Dpol + ++ groebnerFactorize(listOfPolys, nonZeroRestrictions) returns + ++ a list of groebner basis. The union of their solutions + ++ is the solution of the system of equations given by {\em listOfPolys} + ++ under the restriction that the polynomials of {\em nonZeroRestrictions} + ++ don't vanish. + ++ At each stage the polynomial p under consideration (either from + ++ the given basis or obtained from a reduction of the next S-polynomial) + ++ is factorized. For each irreducible factors of p, a + ++ new {\em createGroebnerBasis} is started + ++ doing the usual updates with the factor + ++ in place of p. + groebnerFactorize : (L Dpol, L Dpol, Boolean) -> L L Dpol + ++ groebnerFactorize(listOfPolys, nonZeroRestrictions, info) returns + ++ a list of groebner basis. The union of their solutions + ++ is the solution of the system of equations given by {\em listOfPolys} + ++ under the restriction that the polynomials of {\em nonZeroRestrictions} + ++ don't vanish. + ++ At each stage the polynomial p under consideration (either from + ++ the given basis or obtained from a reduction of the next S-polynomial) + ++ is factorized. For each irreducible factors of p a + ++ new {\em createGroebnerBasis} is started + ++ doing the usual updates with the factor in place of p. + ++ If argument {\em info} is true, information is printed about + ++ partial results. + groebnerFactorize : L Dpol -> L L Dpol + ++ groebnerFactorize(listOfPolys) returns + ++ a list of groebner bases. The union of their solutions + ++ is the solution of the system of equations given by {\em listOfPolys}. + ++ At each stage the polynomial p under consideration (either from + ++ the given basis or obtained from a reduction of the next S-polynomial) + ++ is factorized. For each irreducible factors of p, a + ++ new {\em createGroebnerBasis} is started + ++ doing the usual updates with the factor + ++ in place of p. + ++ + ++X mfzn : SQMATRIX(6,DMP([x,y,z],Fraction INT)) := _ + ++X [ [0,1,1,1,1,1], [1,0,1,8/3,x,8/3], [1,1,0,1,8/3,y], _ + ++X [1,8/3,1,0,1,8/3], [1,x,8/3,1,0,1], [1,8/3,y,8/3,1,0] ] + ++X eq := determinant mfzn + ++X groebnerFactorize _ + ++X [eq,eval(eq, [x,y,z],[y,z,x]), eval(eq,[x,y,z],[z,x,y])] + groebnerFactorize : (L Dpol, Boolean) -> L L Dpol + ++ groebnerFactorize(listOfPolys, info) returns + ++ a list of groebner bases. The union of their solutions + ++ is the solution of the system of equations given by {\em listOfPolys}. + ++ At each stage the polynomial p under consideration (either from + ++ the given basis or obtained from a reduction of the next S-polynomial) + ++ is factorized. For each irreducible factors of p, a + ++ new {\em createGroebnerBasis} is started + ++ doing the usual updates with the factor + ++ in place of p. + ++ If {\em info} is true, information is printed about partial results. + + C ==> add + + import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol) + -- next to help compiler to choose correct signatures: + info: Boolean + -- signatures of local functions + + newPairs : (L sugarPol, Dpol) -> L critPair + -- newPairs(lp, p) constructs list of critical pairs from the list of + -- {\em lp} of input polynomials and a given further one p. + -- It uses criteria M and T to reduce the list. + updateCritPairs : (L critPair, L critPair, Dpol) -> L critPair + -- updateCritPairs(lcP1,lcP2,p) applies criterion B to {\em lcP1} using + -- p. Then this list is merged with {\em lcP2}. + updateBasis : (L sugarPol, Dpol, NNI) -> L sugarPol + -- updateBasis(li,p,deg) every polynomial in {\em li} is dropped if + -- its leading term is a multiple of the leading term of p. + -- The result is this list enlarged by p. + createGroebnerBases : (L sugarPol, L Dpol, L Dpol, L Dpol, L critPair,_ + L L Dpol, Boolean) -> L L Dpol + -- createGroebnerBases(basis, redPols, nonZeroRestrictions, inputPolys, + -- lcP,listOfBases): This function is used to be called from + -- groebnerFactorize. + -- basis: part of a Groebner basis, computed so far + -- redPols: Polynomials from the ideal to be used for reducing, + -- we don't throw away polynomials + -- nonZeroRestrictions: polynomials not zero in the common zeros + -- of the polynomials in the final (Groebner) basis + -- inputPolys: assumed to be in descending order + -- lcP: list of critical pairs built from polynomials of the + -- actual basis + -- listOfBases: Collects the (Groebner) bases constructed by this + -- recursive algorithm at different stages. + -- we print info messages if info is true + createAllFactors: Dpol -> L Dpol + -- factor reduced critpair polynomial + + -- implementation of local functions + + + createGroebnerBases(basis, redPols, nonZeroRestrictions, inputPolys,_ + lcP, listOfBases, info) == + doSplitting? : B := false + terminateWithBasis : B := false + allReducedFactors : L Dpol := [] + nP : Dpol -- actual polynomial under consideration + p : Dpol -- next polynomial from input list + h : Dpol -- next polynomial from critical pairs + stopDividing : Boolean + -- STEP 1 do the next polynomials until a splitting is possible + -- In the first step we take the first polynomial of "inputPolys" + -- if empty, from list of critical pairs "lcP" and do the following: + -- Divide it, if possible, by the polynomials from "nonZeroRestrictions". + -- We factorize it and reduce each irreducible factor with respect to + -- "basis". If 0$Dpol occurs in the list we update the list and continue + -- with next polynomial. + -- If there are at least two (irreducible) factors + -- in the list of factors we finish STEP 1 and set a boolean variable + -- to continue with STEP 2, the splitting step. + -- If there is just one of it, we do the following: + -- If it is 1$Dpol we stop the whole calculation and put + -- [1$Dpol] into the listOfBases + -- Otherwise we update the "basis" and the other lists and continue + -- with next polynomial. + + while (not doSplitting?) and (not terminateWithBasis) repeat + terminateWithBasis := (null inputPolys and null lcP) + not terminateWithBasis => -- still polynomials left + -- determine next polynomial "nP" + nP := + not null inputPolys => + p := first inputPolys + inputPolys := rest inputPolys + -- we know that p is not equal to 0 or 1, but, although, + -- the inputPolys and the basis are ordered, we cannot assume + -- that p is reduced w.r.t. basis, as the ordering is only quasi + -- and we could have equal leading terms, and due to factorization + -- polynomials of smaller leading terms, hence reduce p first: + hMonic redPol(p,redPols) + -- now we have inputPolys empty and hence lcP is not empty: + -- create S-Polynomial from first critical pair: + h := sPol first lcP + lcP := rest lcP + hMonic redPol(h,redPols) + + nP = 1$Dpol => + basis := [[0,1$Dpol]$sugarPol] + terminateWithBasis := true + + -- if "nP" ^= 0, then we continue, otherwise we determine next "nP" + nP ^= 0$Dpol => + -- now we divide "nP", if possible, by the polynomials + -- from "nonZeroRestrictions" + for q in nonZeroRestrictions repeat + stopDividing := false + until stopDividing repeat + nPq := nP exquo q + stopDividing := (nPq case "failed") + if not stopDividing then nP := autoCoerce nPq + stopDividing := stopDividing or zero? degree nP + + zero? degree nP => + basis := [[0,1$Dpol]$sugarPol] + terminateWithBasis := true -- doSplitting? is still false + + -- a careful analysis has to be done, when and whether the + -- following reduction and case nP=1 is necessary + + nP := hMonic redPol(nP,redPols) + zero? degree nP => + basis := [[0,1$Dpol]$sugarPol] + terminateWithBasis := true -- doSplitting? is still false + + -- if "nP" ^= 0, then we continue, otherwise we determine next "nP" + nP ^= 0$Dpol => + -- now we factorize "nP", which is not constant + irreducibleFactors : L Dpol := createAllFactors(nP) + -- if there are more than 1 factors we reduce them and split + (doSplitting? := not null rest irreducibleFactors) => + -- and reduce and normalize the factors + for fnP in irreducibleFactors repeat + fnP := hMonic redPol(fnP,redPols) + -- no factor reduces to 0, as then "fP" would have been + -- reduced to zero, + -- but 1 may occur, which we will drop in a later version. + allReducedFactors := cons(fnP, allReducedFactors) + -- end of "for fnP in irreducibleFactors repeat" + + -- we want that the smaller factors are dealt with first + allReducedFactors := reverse allReducedFactors + -- now the case of exactly 1 factor, but certainly not + -- further reducible with respect to "redPols" + nP := first irreducibleFactors + -- put "nP" into "basis" and update "lcP" and "redPols": + lcP : L critPair := updateCritPairs(lcP,newPairs(basis,nP),nP) + basis := updateBasis(basis,nP,virtualDegree nP) + redPols := concat(redPols,nP) + -- end of "while not doSplitting? and not terminateWithBasis repeat" + + -- STEP 2 splitting step + + doSplitting? => + for fnP in allReducedFactors repeat + if fnP ^= 1$Dpol + then + newInputPolys : L Dpol := _ + sort( degree #1 > degree #2 ,cons(fnP,inputPolys)) + listOfBases := createGroebnerBases(basis, redPols, _ + nonZeroRestrictions,newInputPolys,lcP,listOfBases,info) + -- update "nonZeroRestrictions" + nonZeroRestrictions := cons(fnP,nonZeroRestrictions) + else + if info then + messagePrint("we terminated with [1]")$OUT + listOfBases := cons([1$Dpol],listOfBases) + + -- we finished with all the branches on one level and hence + -- finished this call of createGroebnerBasis. Therefore + -- we terminate with the actual "listOfBasis" as + -- everything is done in the recursions + listOfBases + -- end of "doSplitting? =>" + + -- STEP 3 termination step + + -- we found a groebner basis and put it into the list "listOfBases" + -- (auto)reduce each basis element modulo the others + newBasis := minGbasis(sort(degree #1 > degree #2,[p.pol for p in basis])) + -- now check whether the normalized basis again has reducible + -- polynomials, in this case continue splitting! + if info then + messagePrint("we found a groebner basis and check whether it ")$OUT + messagePrint("contains reducible polynomials")$OUT + print(newBasis::OUT)$OUT + -- here we should create an output form which is reusable by the system + -- print(convert(newBasis::OUT)$InputForm :: OUT)$OUT + removeDuplicates append(factorGroebnerBasis(newBasis, info), listOfBases) + + createAllFactors(p: Dpol) == + loF : L Dpol := [el.fctr for el in factorList factor(p)$MF] + sort(degree #1 < degree #2, loF) + newPairs(lp : L sugarPol,p : Dpol) == + totdegreeOfp : NNI := virtualDegree p + -- next list lcP contains all critPair constructed from + -- p and and the polynomials q in lp + lcP: L critPair := _ + --[[sup(degree q, degreeOfp), q, p]$critPair for q in lp] + [makeCrit(q, p, totdegreeOfp) for q in lp] + -- application of the criteria to reduce the list lcP + critMTonD1 sort(critpOrder,lcP) + updateCritPairs(oldListOfcritPairs, newListOfcritPairs, p)== + updatD (newListOfcritPairs, critBonD(p,oldListOfcritPairs)) + updateBasis(lp, p, deg) == updatF(p,deg,lp) + + -- exported functions + + factorGroebnerBasis basis == factorGroebnerBasis(basis, false) + + factorGroebnerBasis (basis, info) == + foundAReducible : Boolean := false + for p in basis while not foundAReducible repeat + -- we use fact that polynomials have content 1 + foundAReducible := 1 < #[el.fctr for el in factorList factor(p)$MF] + not foundAReducible => + if info then messagePrint("factorGroebnerBasis: no reducible polynomials in this basis")$OUT + [basis] + -- improve! Use the fact that the irreducible ones already + -- build part of the basis, use the done factorizations, etc. + if info then messagePrint("factorGroebnerBasis:_ + we found reducible polynomials and continue splitting")$OUT + createGroebnerBases([],[],[],basis,[],[],info) + + groebnerFactorize(basis, nonZeroRestrictions) == + groebnerFactorize(basis, nonZeroRestrictions, false) + + groebnerFactorize(basis, nonZeroRestrictions, info) == + basis = [] => [basis] + basis := remove(#1 = 0$Dpol,basis) + basis = [] => [[0$Dpol]] + -- normalize all input polynomial + basis := [hMonic p for p in basis] + member?(1$Dpol,basis) => [[1$Dpol]] + basis := sort(degree #1 > degree #2, basis) + createGroebnerBases([],[],nonZeroRestrictions,basis,[],[],info) + + groebnerFactorize(basis) == groebnerFactorize(basis, [], false) + groebnerFactorize(basis,info) == groebnerFactorize(basis, [], info) + +@ +<>= +"GBF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GBF"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"GBF" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GBINTERN GroebnerInternalPackage} +\pagehead{GroebnerInternalPackage}{GBINTERN} +\pagepic{ps/v104groebnerinternalpackage.ps}{GBINTERN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GBINTERN GroebnerInternalPackage +++ Author: +++ Date Created: +++ Date Last Updated: +++ Keywords: +++ Description +++ This package provides low level tools for Groebner basis computations +GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where + Dom: GcdDomain + Expon: OrderedAbelianMonoidSup + VarSet: OrderedSet + Dpol: PolynomialCategory(Dom, Expon, VarSet) + NNI ==> NonNegativeInteger + ------ Definition of Record critPair and Prinp + + critPair ==> Record( lcmfij: Expon, totdeg: NonNegativeInteger, + poli: Dpol, polj: Dpol ) + sugarPol ==> Record( totdeg: NonNegativeInteger, pol : Dpol) + Prinp ==> Record( ci:Dpol,tci:Integer,cj:Dpol,tcj:Integer,c:Dpol, + tc:Integer,rc:Dpol,trc:Integer,tF:Integer,tD:Integer) + Prinpp ==> Record( ci:Dpol,tci:Integer,cj:Dpol,tcj:Integer,c:Dpol, + tc:Integer,rc:Dpol,trc:Integer,tF:Integer,tDD:Integer, + tDF:Integer) + T== with + + credPol: (Dpol, List(Dpol)) -> Dpol + ++ credPol \undocumented + redPol: (Dpol, List(Dpol)) -> Dpol + ++ redPol \undocumented + gbasis: (List(Dpol), Integer, Integer) -> List(Dpol) + ++ gbasis \undocumented + critT: critPair -> Boolean + ++ critT \undocumented + critM: (Expon, Expon) -> Boolean + ++ critM \undocumented + critB: (Expon, Expon, Expon, Expon) -> Boolean + ++ critB \undocumented + critBonD: (Dpol, List(critPair)) -> List(critPair) + ++ critBonD \undocumented + critMTonD1: (List(critPair)) -> List(critPair) + ++ critMTonD1 \undocumented + critMonD1: (Expon, List(critPair)) -> List(critPair) + ++ critMonD1 \undocumented + redPo: (Dpol, List(Dpol) ) -> Record(poly:Dpol, mult:Dom) + ++ redPo \undocumented + hMonic: Dpol -> Dpol + ++ hMonic \undocumented + updatF: (Dpol, NNI, List(sugarPol) ) -> List(sugarPol) + ++ updatF \undocumented + sPol: critPair -> Dpol + ++ sPol \undocumented + updatD: (List(critPair), List(critPair)) -> List(critPair) + ++ updatD \undocumented + minGbasis: List(Dpol) -> List(Dpol) + ++ minGbasis \undocumented + lepol: Dpol -> Integer + ++ lepol \undocumented + prinshINFO : Dpol -> Void + ++ prinshINFO \undocumented + prindINFO: (critPair, Dpol, Dpol,Integer,Integer,Integer) -> Integer + ++ prindINFO \undocumented + fprindINFO: (critPair, Dpol, Dpol, Integer,Integer,Integer + ,Integer) -> Integer + ++ fprindINFO \undocumented + prinpolINFO: List(Dpol) -> Void + ++ prinpolINFO \undocumented + prinb: Integer-> Void + ++ prinb \undocumented + critpOrder: (critPair, critPair) -> Boolean + ++ critpOrder \undocumented + makeCrit: (sugarPol, Dpol, NonNegativeInteger) -> critPair + ++ makeCrit \undocumented + virtualDegree : Dpol -> NonNegativeInteger + ++ virtualDegree \undocumented + + C== add + Ex ==> OutputForm + import OutputForm + + ------ Definition of intermediate functions + if Dpol has totalDegree: Dpol -> NonNegativeInteger then + virtualDegree p == totalDegree p + else + virtualDegree p == 0 + + ------ ordering of critpairs + + critpOrder(cp1,cp2) == + cp1.totdeg < cp2.totdeg => true + cp2.totdeg < cp1.totdeg => false + cp1.lcmfij < cp2.lcmfij + + ------ creating a critical pair + + makeCrit(sp1, p2, totdeg2) == + p1 := sp1.pol + deg := sup(degree(p1), degree(p2)) + e1 := subtractIfCan(deg, degree(p1))::Expon + e2 := subtractIfCan(deg, degree(p2))::Expon + tdeg := max(sp1.totdeg + virtualDegree(monomial(1,e1)), + totdeg2 + virtualDegree(monomial(1,e2))) + [deg, tdeg, p1, p2]$critPair + + ------ calculate basis + + gbasis(Pol: List(Dpol), xx1: Integer, xx2: Integer ) == + D, D1: List(critPair) + --------- create D and Pol + + Pol1:= sort(degree #1 > degree #2, Pol) + basPols:= updatF(hMonic(first Pol1),virtualDegree(first Pol1),[]) + Pol1:= rest(Pol1) + D:= nil + while _^ null Pol1 repeat + h:= hMonic(first(Pol1)) + Pol1:= rest(Pol1) + toth := virtualDegree h + D1:= [makeCrit(x,h,toth) for x in basPols] + D:= updatD(critMTonD1(sort(critpOrder, D1)), + critBonD(h,D)) + basPols:= updatF(h,toth,basPols) + D:= sort(critpOrder, D) + xx:= xx2 + -------- loop + + redPols := [x.pol for x in basPols] + while _^ null D repeat + D0:= first D + s:= hMonic(sPol(D0)) + D:= rest(D) + h:= hMonic(redPol(s,redPols)) + if xx1 = 1 then + prinshINFO(h) + h = 0 => + if xx2 = 1 then + prindINFO(D0,s,h,# basPols, # D,xx) + xx:= 2 + " go to top of while " + degree(h) = 0 => + D:= nil + if xx2 = 1 then + prindINFO(D0,s,h,# basPols, # D,xx) + xx:= 2 + basPols:= updatF(h,0,[]) + leave "out of while" + D1:= [makeCrit(x,h,D0.totdeg) for x in basPols] + D:= updatD(critMTonD1(sort(critpOrder, D1)), + critBonD(h,D)) + basPols:= updatF(h,D0.totdeg,basPols) + redPols := concat(redPols,h) + if xx2 = 1 then + prindINFO(D0,s,h,# basPols, # D,xx) + xx:= 2 + Pol := [x.pol for x in basPols] + if xx2 = 1 then + prinpolINFO(Pol) + messagePrint(" THE GROEBNER BASIS POLYNOMIALS") + if xx1 = 1 and xx2 ^= 1 then + messagePrint(" THE GROEBNER BASIS POLYNOMIALS") + Pol + + -------------------------------------- + + --- erase multiple of e in D2 using crit M + + critMonD1(e: Expon, D2: List(critPair))== + null D2 => nil + x:= first(D2) + critM(e, x.lcmfij) => critMonD1(e, rest(D2)) + cons(x, critMonD1(e, rest(D2))) + + ---------------------------- + + --- reduce D1 using crit T and crit M + + critMTonD1(D1: List(critPair))== + null D1 => nil + f1:= first(D1) + s1:= #(D1) + cT1:= critT(f1) + s1= 1 and cT1 => nil + s1= 1 => D1 + e1:= f1.lcmfij + r1:= rest(D1) + e1 = (first r1).lcmfij => + cT1 => critMTonD1(cons(f1, rest(r1))) + critMTonD1(r1) + D1 := critMonD1(e1, r1) + cT1 => critMTonD1(D1) + cons(f1, critMTonD1(D1)) + + ----------------------------- + + --- erase elements in D fullfilling crit B + + critBonD(h:Dpol, D: List(critPair))== + null D => nil + x:= first(D) + critB(degree(h), x.lcmfij, degree(x.poli), degree(x.polj)) => + critBonD(h, rest(D)) + cons(x, critBonD(h, rest(D))) + + ----------------------------- + + --- concat F and h and erase multiples of h in F + + updatF(h: Dpol, deg:NNI, F: List(sugarPol)) == + null F => [[deg,h]] + f1:= first(F) + critM(degree(h), degree(f1.pol)) => updatF(h, deg, rest(F)) + cons(f1, updatF(h, deg, rest(F))) + + ----------------------------- + + --- concat ordered critical pair lists D1 and D2 + + updatD(D1: List(critPair), D2: List(critPair)) == + null D1 => D2 + null D2 => D1 + dl1:= first(D1) + dl2:= first(D2) + critpOrder(dl1,dl2) => cons(dl1, updatD(D1.rest, D2)) + cons(dl2, updatD(D1, D2.rest)) + + ----------------------------- + + --- remove gcd from pair of coefficients + + gcdCo(c1:Dom, c2:Dom):Record(co1:Dom,co2:Dom) == + d:=gcd(c1,c2) + [(c1 exquo d)::Dom, (c2 exquo d)::Dom] + + --- calculate S-polynomial of a critical pair + + sPol(p:critPair)== + Tij := p.lcmfij + fi := p.poli + fj := p.polj + cc := gcdCo(leadingCoefficient fi, leadingCoefficient fj) + reductum(fi)*monomial(cc.co2,subtractIfCan(Tij, degree fi)::Expon) - + reductum(fj)*monomial(cc.co1,subtractIfCan(Tij, degree fj)::Expon) + + ---------------------------- + + --- reduce critpair polynomial mod F + --- iterative version + + redPo(s: Dpol, F: List(Dpol)) == + m:Dom := 1 + Fh := F + while _^ ( s = 0 or null F ) repeat + f1:= first(F) + s1:= degree(s) + e: Union(Expon, "failed") + (e:= subtractIfCan(s1, degree(f1))) case Expon => + cc:=gcdCo(leadingCoefficient f1, leadingCoefficient s) + s:=cc.co1*reductum(s) - monomial(cc.co2,e)*reductum(f1) + m := m*cc.co1 + F:= Fh + F:= rest F + [s,m] + + redPol(s: Dpol, F: List(Dpol)) == credPol(redPo(s,F).poly,F) + + ---------------------------- + + --- crit T true, if e1 and e2 are disjoint + + critT(p: critPair) == p.lcmfij = (degree(p.poli) + degree(p.polj)) + + ---------------------------- + + --- crit M - true, if lcm#2 multiple of lcm#1 + + critM(e1: Expon, e2: Expon) == + en: Union(Expon, "failed") + (en:=subtractIfCan(e2, e1)) case Expon + + ---------------------------- + + --- crit B - true, if eik is a multiple of eh and eik ^equal + --- lcm(eh,ei) and eik ^equal lcm(eh,ek) + + critB(eh:Expon, eik:Expon, ei:Expon, ek:Expon) == + critM(eh, eik) and (eik ^= sup(eh, ei)) and (eik ^= sup(eh, ek)) + + ---------------------------- + + --- make polynomial monic case Domain a Field + + hMonic(p: Dpol) == + p= 0 => p + -- inv(leadingCoefficient(p))*p + primitivePart p + + ----------------------------- + + --- reduce all terms of h mod F (iterative version ) + + credPol(h: Dpol, F: List(Dpol) ) == + null F => h + h0:Dpol:= monomial(leadingCoefficient h, degree h) + while (h:=reductum h) ^= 0 repeat + hred:= redPo(h, F) + h := hred.poly + h0:=(hred.mult)*h0 + monomial(leadingCoefficient(h),degree h) + h0 + + ------------------------------- + + ---- calculate minimal basis for ordered F + + minGbasis(F: List(Dpol)) == + null F => nil + newbas := minGbasis rest F + cons(hMonic credPol( first(F), newbas),newbas) + + ------------------------------- + + ---- calculate number of terms of polynomial + + lepol(p1:Dpol)== + n: Integer + n:= 0 + while p1 ^= 0 repeat + n:= n + 1 + p1:= reductum(p1) + n + + ---- print blanc lines + + prinb(n: Integer)== + for x in 1..n repeat + messagePrint(" ") + + ---- print reduced critpair polynom + + prinshINFO(h: Dpol)== + prinb(2) + messagePrint(" reduced Critpair - Polynom :") + prinb(2) + print(h::Ex) + prinb(2) + + ------------------------------- + + ---- print info string + + prindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer, + i2:Integer, n:Integer) == + ll: List Prinp + a: Dom + cpi:= cp.poli + cpj:= cp.polj + if n = 1 then + prinb(1) + messagePrint("you choose option -info- ") + messagePrint("abbrev. for the following information strings are") + messagePrint(" ci => Leading monomial for critpair calculation") + messagePrint(" tci => Number of terms of polynomial i") + messagePrint(" cj => Leading monomial for critpair calculation") + messagePrint(" tcj => Number of terms of polynomial j") + messagePrint(" c => Leading monomial of critpair polynomial") + messagePrint(" tc => Number of terms of critpair polynomial") + messagePrint(" rc => Leading monomial of redcritpair polynomial") + messagePrint(" trc => Number of terms of redcritpair polynomial") + messagePrint(" tF => Number of polynomials in reduction list F") + messagePrint(" tD => Number of critpairs still to do") + prinb(4) + n:= 2 + prinb(1) + a:= 1 + ph = 0 => + ps = 0 => + ll:= [[monomial(a,degree(cpi)),lepol(cpi), + monomial(a,degree(cpj)), + lepol(cpj),ps,0,ph,0,i1,i2]$Prinp] + print(ll::Ex) + prinb(1) + n + ll:= [[monomial(a,degree(cpi)),lepol(cpi), + monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)), + lepol(ps), ph,0,i1,i2]$Prinp] + print(ll::Ex) + prinb(1) + n + ll:= [[monomial(a,degree(cpi)),lepol(cpi), + monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)), + lepol(ps),monomial(a,degree(ph)),lepol(ph),i1,i2]$Prinp] + print(ll::Ex) + prinb(1) + n + + ------------------------------- + + ---- print the groebner basis polynomials + + prinpolINFO(pl: List(Dpol))== + n:Integer + n:= # pl + prinb(1) + n = 1 => + messagePrint(" There is 1 Groebner Basis Polynomial ") + prinb(2) + messagePrint(" There are ") + prinb(1) + print(n::Ex) + prinb(1) + messagePrint(" Groebner Basis Polynomials. ") + prinb(2) + + fprindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer, + i2:Integer, i3:Integer, n: Integer) == + ll: List Prinpp + a: Dom + cpi:= cp.poli + cpj:= cp.polj + if n = 1 then + prinb(1) + messagePrint("you choose option -info- ") + messagePrint("abbrev. for the following information strings are") + messagePrint(" ci => Leading monomial for critpair calculation") + messagePrint(" tci => Number of terms of polynomial i") + messagePrint(" cj => Leading monomial for critpair calculation") + messagePrint(" tcj => Number of terms of polynomial j") + messagePrint(" c => Leading monomial of critpair polynomial") + messagePrint(" tc => Number of terms of critpair polynomial") + messagePrint(" rc => Leading monomial of redcritpair polynomial") + messagePrint(" trc => Number of terms of redcritpair polynomial") + messagePrint(" tF => Number of polynomials in reduction list F") + messagePrint(" tD => Number of critpairs still to do") + messagePrint(" tDF => Number of subproblems still to do") + prinb(4) + n:= 2 + prinb(1) + a:= 1 + ph = 0 => + ps = 0 => + ll:= [[monomial(a,degree(cpi)),lepol(cpi), + monomial(a,degree(cpj)), + lepol(cpj),ps,0,ph,0,i1,i2,i3]$Prinpp] + print(ll::Ex) + prinb(1) + n + ll:= [[monomial(a,degree(cpi)),lepol(cpi), + monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)), + lepol(ps), ph,0,i1,i2,i3]$Prinpp] + print(ll::Ex) + prinb(1) + n + ll:= [[monomial(a,degree(cpi)),lepol(cpi), + monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)), + lepol(ps),monomial(a,degree(ph)),lepol(ph),i1,i2,i3]$Prinpp] + print(ll::Ex) + prinb(1) + n + +@ +<>= +"GBINTERN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GBINTERN"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"GBINTERN" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GB GroebnerPackage} +<>= +)sys rm GroebnerPackage.output +)spool GroebnerPackage.output +)set message test on +)set message auto off +)clear all +--S 1 of 24 +s1:DMP([w,p,z,t,s,b],FRAC(INT)):= 45*p + 35*s - 165*b - 36 +--R +--R (1) 45p + 35s - 165b - 36 +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 1 + +--S 2 of 24 +s2:DMP([w,p,z,t,s,b],FRAC(INT)):= 35*p + 40*z + 25*t - 27*s +--R +--R (2) 35p + 40z + 25t - 27s +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 2 + +--S 3 of 24 +s3:DMP([w,p,z,t,s,b],FRAC(INT)):= 15*w + 25*p*s + 30*z - 18*t - 165*b**2 +--R +--R 2 +--R (3) 15w + 25p s + 30z - 18t - 165b +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 3 + +--S 4 of 24 +s4:DMP([w,p,z,t,s,b],FRAC(INT)):= -9*w + 15*p*t + 20*z*s +--R +--R (4) - 9w + 15p t + 20z s +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 4 + +--S 5 of 24 +s5:DMP([w,p,z,t,s,b],FRAC(INT)):= w*p + 2*z*t - 11*b**3 +--R +--R 3 +--R (5) w p + 2z t - 11b +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 5 + +--S 6 of 24 +s6:DMP([w,p,z,t,s,b],FRAC(INT)):= 99*w - 11*b*s + 3*b**2 +--R +--R 2 +--R (6) 99w - 11s b + 3b +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 6 + +--S 7 of 24 +s7:DMP([w,p,z,t,s,b],FRAC(INT)):= b**2 + 33/50*b + 2673/10000 +--R +--R 2 33 2673 +--R (7) b + -- b + ----- +--R 50 10000 +--R Type: DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 7 + +--S 8 of 24 +sn7:=[s1,s2,s3,s4,s5,s6,s7] +--R +--R (8) +--R [45p + 35s - 165b - 36, 35p + 40z + 25t - 27s, +--R 2 3 +--R 15w + 25p s + 30z - 18t - 165b , - 9w + 15p t + 20z s, w p + 2z t - 11b , +--R 2 2 33 2673 +--R 99w - 11s b + 3b , b + -- b + -----] +--R 50 10000 +--R Type: List DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 8 + +--S 9 of 24 +groebner(sn7) +--R +--R (9) +--R 19 1323 31 153 49 1143 37 27 +--R [w + --- b + -----, p - -- b - ---, z + -- b + ----, t - -- b + ---, +--R 120 20000 18 200 36 2000 15 250 +--R 5 9 2 33 2673 +--R s - - b - ---, b + -- b + -----] +--R 2 200 50 10000 +--R Type: List DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 9 + +--S 10 of 24 +groebner(sn7,"redcrit") +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 61 77 7 +--R z + - t - -- s + -- b + -- +--R 8 45 24 10 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 66 603 278 2 11 672 2277 415881 +--R t s - -- t b + ---- t - --- s + -- s b - --- s - ---- b - ------ +--R 29 1450 435 29 725 7250 725000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 100 2 160 104 37 79 +--R t + --- s - --- s b - --- s - --- b - --- +--R 189 63 63 105 125 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 3 1026 2 5424 2 2529 1326807 12717 660717 +--R s - ---- s b - ---- s - ---- s b - ------- s + ----- b + ------- +--R 145 3625 725 362500 6250 3625000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 91248294 2 6550614 7087292937 20020838931 +--R s b + --------- s - ------- s b + ----------- s - ----------- b +--R 128176525 5127061 12817652500 12817652500 +--R + +--R 37595502243 +--R - ----------- +--R 51270610000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 4746183626079988 1015195815329760 30723564870033201 +--R s - ---------------- s b - ---------------- s - ----------------- b +--R 987357073521193 987357073521193 24683926838029825 +--R + +--R 3696123458901625353 +--R - ------------------- +--R 2468392683802982500 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 16827373608076633182513471 1262793163581645698534964 +--R s b + -------------------------- s - ------------------------- b +--R 23063714246644859914108300 5765928561661214978527075 +--R + +--R 91594345205981119652436033 +--R --------------------------- +--R 144148214041530374463176875 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 9 +--R s - - b - --- +--R 2 200 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R THE GROEBNER BASIS POLYNOMIALS +--R +--R (10) +--R 19 1323 31 153 49 1143 37 27 +--R [w + --- b + -----, p - -- b - ---, z + -- b + ----, t - -- b + ---, +--R 120 20000 18 200 36 2000 15 250 +--R 5 9 2 33 2673 +--R s - - b - ---, b + -- b + -----] +--R 2 200 50 10000 +--R Type: List DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 10 + +--S 11 of 24 +groebner(sn7,"info") +--R +--R you choose option -info- +--R abbrev. for the following information strings are +--R ci => Leading monomial for critpair calculation +--R tci => Number of terms of polynomial i +--R cj => Leading monomial for critpair calculation +--R tcj => Number of terms of polynomial j +--R c => Leading monomial of critpair polynomial +--R tc => Number of terms of critpair polynomial +--R rc => Leading monomial of redcritpair polynomial +--R trc => Number of terms of redcritpair polynomial +--R tF => Number of polynomials in reduction list F +--R tD => Number of critpairs still to do +--R +--R +--R +--R +--R +--R [[ci= p,tci= 4,cj= p,tcj= 4,c= z,tc= 5,rc= z,trc= 5,tF= 4,tD= 3]] +--R +--R +--R [[ci= w,tci= 3,cj= w,tcj= 5,c= p t,tc= 6,rc= t s,trc= 8,tF= 5,tD= 2]] +--R +--R +--R [[ci= w,tci= 3,cj= w,tcj= 3,c= p t,tc= 4,rc= t,trc= 6,tF= 5,tD= 2]] +--R +--R +--R 3 +--R [[ci= t s,tci= 8,cj= t,tcj= 6,c= t b,tc= 9,rc= s ,trc= 7,tF= 6,tD= 1]] +--R +--R +--R 2 +--R [[ci= w p,tci= 3,cj= w,tcj= 3,c= p s b,tc= 4,rc= s b,trc= 6,tF= 7,tD= 2]] +--R +--R +--R 2 2 2 2 +--R [[ci= b ,tci= 3,cj= s b,tcj= 6,c= s b,tc= 6,rc= s ,trc= 5,tF= 6,tD= 2]] +--R +--R +--R 2 2 2 +--R [[ci= s b,tci= 6,cj= s ,tcj= 5,c= s ,tc= 7,rc= 0,trc= 0,tF= 6,tD= 1]] +--R +--R +--R 3 2 2 +--R [[ci= s ,tci= 7,cj= s ,tcj= 5,c= s b,tc= 6,rc= s b,trc= 4,tF= 7,tD= 2]] +--R +--R +--R 2 +--R [[ci= b ,tci= 3,cj= s b,tcj= 4,c= s b,tc= 4,rc= s,trc= 3,tF= 6,tD= 2]] +--R +--R +--R [[ci= s b,tci= 4,cj= s,tcj= 3,c= s,tc= 4,rc= 0,trc= 0,tF= 6,tD= 1]] +--R +--R +--R 2 +--R [[ci= s ,tci= 5,cj= s,tcj= 3,c= s b,tc= 4,rc= 0,trc= 0,tF= 6,tD= 0]] +--R +--R +--R There are +--R +--R 6 +--R +--R Groebner Basis Polynomials. +--R +--R +--R THE GROEBNER BASIS POLYNOMIALS +--R +--R (11) +--R 19 1323 31 153 49 1143 37 27 +--R [w + --- b + -----, p - -- b - ---, z + -- b + ----, t - -- b + ---, +--R 120 20000 18 200 36 2000 15 250 +--R 5 9 2 33 2673 +--R s - - b - ---, b + -- b + -----] +--R 2 200 50 10000 +--R Type: List DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 11 + +--S 12 of 24 +groebner(sn7,"redcrit","info") +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 61 77 7 +--R z + - t - -- s + -- b + -- +--R 8 45 24 10 +--R +--R +--R +--R you choose option -info- +--R abbrev. for the following information strings are +--R ci => Leading monomial for critpair calculation +--R tci => Number of terms of polynomial i +--R cj => Leading monomial for critpair calculation +--R tcj => Number of terms of polynomial j +--R c => Leading monomial of critpair polynomial +--R tc => Number of terms of critpair polynomial +--R rc => Leading monomial of redcritpair polynomial +--R trc => Number of terms of redcritpair polynomial +--R tF => Number of polynomials in reduction list F +--R tD => Number of critpairs still to do +--R +--R +--R +--R +--R +--R [[ci= p,tci= 4,cj= p,tcj= 4,c= z,tc= 5,rc= z,trc= 5,tF= 4,tD= 3]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 66 603 278 2 11 672 2277 415881 +--R t s - -- t b + ---- t - --- s + -- s b - --- s - ---- b - ------ +--R 29 1450 435 29 725 7250 725000 +--R +--R +--R +--R [[ci= w,tci= 3,cj= w,tcj= 5,c= p t,tc= 6,rc= t s,trc= 8,tF= 5,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 100 2 160 104 37 79 +--R t + --- s - --- s b - --- s - --- b - --- +--R 189 63 63 105 125 +--R +--R +--R +--R [[ci= w,tci= 3,cj= w,tcj= 3,c= p t,tc= 4,rc= t,trc= 6,tF= 5,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 3 1026 2 5424 2 2529 1326807 12717 660717 +--R s - ---- s b - ---- s - ---- s b - ------- s + ----- b + ------- +--R 145 3625 725 362500 6250 3625000 +--R +--R +--R +--R 3 +--R [[ci= t s,tci= 8,cj= t,tcj= 6,c= t b,tc= 9,rc= s ,trc= 7,tF= 6,tD= 1]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 91248294 2 6550614 7087292937 20020838931 +--R s b + --------- s - ------- s b + ----------- s - ----------- b +--R 128176525 5127061 12817652500 12817652500 +--R + +--R 37595502243 +--R - ----------- +--R 51270610000 +--R +--R +--R +--R 2 +--R [[ci= w p,tci= 3,cj= w,tcj= 3,c= p s b,tc= 4,rc= s b,trc= 6,tF= 7,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 4746183626079988 1015195815329760 30723564870033201 +--R s - ---------------- s b - ---------------- s - ----------------- b +--R 987357073521193 987357073521193 24683926838029825 +--R + +--R 3696123458901625353 +--R - ------------------- +--R 2468392683802982500 +--R +--R +--R +--R 2 2 2 2 +--R [[ci= b ,tci= 3,cj= s b,tcj= 6,c= s b,tc= 6,rc= s ,trc= 5,tF= 6,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 2 2 +--R [[ci= s b,tci= 6,cj= s ,tcj= 5,c= s ,tc= 7,rc= 0,trc= 0,tF= 6,tD= 1]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 16827373608076633182513471 1262793163581645698534964 +--R s b + -------------------------- s - ------------------------- b +--R 23063714246644859914108300 5765928561661214978527075 +--R + +--R 91594345205981119652436033 +--R --------------------------- +--R 144148214041530374463176875 +--R +--R +--R +--R 3 2 2 +--R [[ci= s ,tci= 7,cj= s ,tcj= 5,c= s b,tc= 6,rc= s b,trc= 4,tF= 7,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 9 +--R s - - b - --- +--R 2 200 +--R +--R +--R +--R 2 +--R [[ci= b ,tci= 3,cj= s b,tcj= 4,c= s b,tc= 4,rc= s,trc= 3,tF= 6,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R [[ci= s b,tci= 4,cj= s,tcj= 3,c= s,tc= 4,rc= 0,trc= 0,tF= 6,tD= 1]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= s ,tci= 5,cj= s,tcj= 3,c= s b,tc= 4,rc= 0,trc= 0,tF= 6,tD= 0]] +--R +--R +--R There are +--R +--R 6 +--R +--R Groebner Basis Polynomials. +--R +--R +--R THE GROEBNER BASIS POLYNOMIALS +--R +--R (12) +--R 19 1323 31 153 49 1143 37 27 +--R [w + --- b + -----, p - -- b - ---, z + -- b + ----, t - -- b + ---, +--R 120 20000 18 200 36 2000 15 250 +--R 5 9 2 33 2673 +--R s - - b - ---, b + -- b + -----] +--R 2 200 50 10000 +--R Type: List DistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 12 + +--S 13 of 24 +hs1:HDMP([w,p,z,t,s,b],FRAC(INT)):= 45*p + 35*s - 165*b - 36 +--R +--R (13) 45p + 35s - 165b - 36 +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 13 + +--S 14 of 24 +hs2:HDMP([w,p,z,t,s,b],FRAC(INT)):= 35*p + 40*z + 25*t - 27*s +--R +--R (14) 35p + 40z + 25t - 27s +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 14 + +--S 15 of 24 +hs3:HDMP([w,p,z,t,s,b],FRAC(INT)):= 15*w + 25*p*s + 30*z - 18*t - 165*b**2 +--R 2 +--R (15) 25p s - 165b + 15w + 30z - 18t +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 15 + +--S 16 of 24 +hs4:HDMP([w,p,z,t,s,b],FRAC(INT)):= -9*w + 15*p*t + 20*z*s +--R +--R (16) 15p t + 20z s - 9w +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 16 + +--S 17 of 24 +hs5:HDMP([w,p,z,t,s,b],FRAC(INT)):= w*p + 2*z*t - 11*b**3 +--R +--R 3 +--R (17) - 11b + w p + 2z t +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 17 + +--S 18 of 24 +hs6:HDMP([w,p,z,t,s,b],FRAC(INT)):= 99*w - 11*b*s + 3*b**2 +--R +--R 2 +--R (18) - 11s b + 3b + 99w +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 18 + +--S 19 of 24 +hs7:HDMP([w,p,z,t,s,b],FRAC(INT)):= b**2 + 33/50*b + 2673/10000 +--R +--R 2 33 2673 +--R (19) b + -- b + ----- +--R 50 10000 +--RType: HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 19 + +--S 20 of 24 +hsn7:=[hs1,hs2,hs3,hs4,hs5,hs6,hs7] +--R +--R (20) +--R [45p + 35s - 165b - 36, 35p + 40z + 25t - 27s, +--R 2 3 +--R 25p s - 165b + 15w + 30z - 18t, 15p t + 20z s - 9w, - 11b + w p + 2z t, +--R 2 2 33 2673 +--R - 11s b + 3b + 99w, b + -- b + -----] +--R 50 10000 +--RType: List HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 20 + +--S 21 of 24 +groebner(hsn7) +--R +--R (21) +--R 2 33 2673 19 1323 31 153 49 1143 +--R [b + -- b + -----, w + --- b + -----, p - -- b - ---, z + -- b + ----, +--R 50 10000 120 20000 18 200 36 2000 +--R 37 27 5 9 +--R t - -- b + ---, s - - b - ---] +--R 15 250 2 200 +--RType: List HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 21 + +--S 22 of 24 +groebner(hsn7,"redcrit") +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 61 77 7 +--R z + - t - -- s + -- b + -- +--R 8 45 24 10 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 216 189 78 99 10557 +--R s - --- w + --- t - -- s + --- b - ----- +--R 5 100 25 500 12500 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 66 17541 5886 10588 9273 8272413 +--R t s - -- t b - ----- w + ---- t - ----- s - ----- b - ------- +--R 29 725 3625 3625 36250 7250000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 28 44 143 962712 420652 5166944 +--R t + -- w s - -- w b + --- t b - ------ w + ------ t - ------- s +--R 45 15 725 18125 90625 815625 +--R + +--R 5036339 83580953 +--R ------- b - -------- +--R 5437500 90625000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 33 297 81 +--R w b + -- w + ----- s - ----- b +--R 50 10000 10000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 21 33 6723 2031 104247 +--R w s + --- t b - --- w + ----- s - ----- b + ------- +--R 100 250 50000 25000 5000000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2373 41563 17253 578853 258751 11330361 +--R w t + ---- t b - ----- w + ------ t + ------- s - ------- b + --------- +--R 7250 36250 290000 7250000 3625000 362500000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 51061712 91248294 1516761889 481096937 5789482077 +--R t b - -------- w + --------- t - ---------- s + ---------- b + ----------- +--R 5127061 128176525 1922647875 1281765250 51270610000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2962071220563579 1229379913128787 4524811449715289 +--R w + ---------------- t - ---------------- s + ---------------- b +--R 98138188260880 36801820597830 490690941304400 +--R + +--R 59240140318722273 +--R ----------------- +--R 12267273532610000 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 172832706542351932 47302810289036749 2736061156820726 +--R t - ------------------ s + ------------------ b + ----------------- +--R 155991468675747195 155991468675747195 17332385408416355 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 9 +--R s - - b - --- +--R 2 200 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R THE GROEBNER BASIS POLYNOMIALS +--R +--R (22) +--R 2 33 2673 19 1323 31 153 49 1143 +--R [b + -- b + -----, w + --- b + -----, p - -- b - ---, z + -- b + ----, +--R 50 10000 120 20000 18 200 36 2000 +--R 37 27 5 9 +--R t - -- b + ---, s - - b - ---] +--R 15 250 2 200 +--RType: List HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 22 + +--S 23 of 24 +groebner(hsn7,"info") +--R +--R you choose option -info- +--R abbrev. for the following information strings are +--R ci => Leading monomial for critpair calculation +--R tci => Number of terms of polynomial i +--R cj => Leading monomial for critpair calculation +--R tcj => Number of terms of polynomial j +--R c => Leading monomial of critpair polynomial +--R tc => Number of terms of critpair polynomial +--R rc => Leading monomial of redcritpair polynomial +--R trc => Number of terms of redcritpair polynomial +--R tF => Number of polynomials in reduction list F +--R tD => Number of critpairs still to do +--R +--R +--R +--R +--R +--R [[ci= p,tci= 4,cj= p,tcj= 4,c= z,tc= 5,rc= z,trc= 5,tF= 4,tD= 5]] +--R +--R +--R 2 +--R [[ci= p s,tci= 5,cj= p,tcj= 4,c= z s,tc= 7,rc= s ,trc= 6,tF= 5,tD= 5]] +--R +--R +--R [[ci= p t,tci= 3,cj= p,tcj= 4,c= z t,tc= 5,rc= t s,trc= 7,tF= 6,tD= 6]] +--R +--R +--R 3 2 2 +--R [[ci= b ,tci= 3,cj= b ,tcj= 3,c= w p,tc= 4,rc= t ,trc= 9,tF= 7,tD= 6]] +--R +--R +--R 2 3 +--R [[ci= s b,tci= 3,cj= b ,tcj= 3,c= b ,tc= 4,rc= w b,trc= 4,tF= 8,tD= 7]] +--R +--R +--R 2 2 +--R [[ci= s b,tci= 3,cj= s ,tcj= 6,c= s b ,tc= 7,rc= w s,trc= 6,tF= 9,tD= 9]] +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= t s,tcj= 7,c= t b ,tc= 7,rc= w t,trc= 7,tF= 10,tD= 11]] +--R +--R +--R 2 +--R [[ci= p s,tci= 5,cj= s b,tcj= 3,c= p b ,tc= 6,rc= 0,trc= 0,tF= 10,tD= 10]] +--R +--R +--R 2 +--R [[ci= s ,tci= 6,cj= t s,tcj= 7,c= t s b,tc= 10,rc= t b,trc= 6,tF= 11,tD= 13]] +--R +--R +--R 2 +--R [[ci= b ,tci= 3,cj= t b,tcj= 6,c= w b,tc= 6,rc= w,trc= 5,tF= 9,tD= 14]] +--R +--R +--R 2 +--R [[ci= b ,tci= 3,cj= w b,tcj= 4,c= s b,tc= 3,rc= 0,trc= 0,tF= 9,tD= 13]] +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= t b,tcj= 6,c= t b ,tc= 7,rc= t,trc= 4,tF= 7,tD= 11]] +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= w b,tcj= 4,c= w b ,tc= 5,rc= s,trc= 3,tF= 6,tD= 9]] +--R +--R +--R 2 +--R [[ci= w b,tci= 4,cj= t b,tcj= 6,c= w ,tc= 7,rc= 0,trc= 0,tF= 6,tD= 8]] +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= s,tcj= 3,c= b ,tc= 3,rc= 0,trc= 0,tF= 6,tD= 7]] +--R +--R +--R [[ci= t b,tci= 6,cj= t,tcj= 4,c= s b,tc= 7,rc= 0,trc= 0,tF= 6,tD= 6]] +--R +--R +--R [[ci= w b,tci= 4,cj= w,tcj= 5,c= t b,tc= 6,rc= 0,trc= 0,tF= 6,tD= 5]] +--R +--R +--R 2 +--R [[ci= s ,tci= 6,cj= s,tcj= 3,c= s b,tc= 6,rc= 0,trc= 0,tF= 6,tD= 4]] +--R +--R +--R 2 +--R [[ci= t s,tci= 7,cj= t,tcj= 4,c= s ,tc= 8,rc= 0,trc= 0,tF= 6,tD= 3]] +--R +--R +--R [[ci= w s,tci= 6,cj= w,tcj= 5,c= t s,tc= 8,rc= 0,trc= 0,tF= 6,tD= 2]] +--R +--R +--R 2 +--R [[ci= t ,tci= 9,cj= t,tcj= 4,c= w s,tc= 9,rc= 0,trc= 0,tF= 6,tD= 1]] +--R +--R +--R 2 +--R [[ci= w t,tci= 7,cj= w,tcj= 5,c= t ,tc= 8,rc= 0,trc= 0,tF= 6,tD= 0]] +--R +--R +--R There are +--R +--R 6 +--R +--R Groebner Basis Polynomials. +--R +--R +--R THE GROEBNER BASIS POLYNOMIALS +--R +--R (23) +--R 2 33 2673 19 1323 31 153 49 1143 +--R [b + -- b + -----, w + --- b + -----, p - -- b - ---, z + -- b + ----, +--R 50 10000 120 20000 18 200 36 2000 +--R 37 27 5 9 +--R t - -- b + ---, s - - b - ---] +--R 15 250 2 200 +--RType: List HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 23 + +--S 24 of 24 +groebner(hsn7,"redcrit","info") +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 61 77 7 +--R z + - t - -- s + -- b + -- +--R 8 45 24 10 +--R +--R +--R +--R you choose option -info- +--R abbrev. for the following information strings are +--R ci => Leading monomial for critpair calculation +--R tci => Number of terms of polynomial i +--R cj => Leading monomial for critpair calculation +--R tcj => Number of terms of polynomial j +--R c => Leading monomial of critpair polynomial +--R tc => Number of terms of critpair polynomial +--R rc => Leading monomial of redcritpair polynomial +--R trc => Number of terms of redcritpair polynomial +--R tF => Number of polynomials in reduction list F +--R tD => Number of critpairs still to do +--R +--R +--R +--R +--R +--R [[ci= p,tci= 4,cj= p,tcj= 4,c= z,tc= 5,rc= z,trc= 5,tF= 4,tD= 5]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 216 189 78 99 10557 +--R s - --- w + --- t - -- s + --- b - ----- +--R 5 100 25 500 12500 +--R +--R +--R +--R 2 +--R [[ci= p s,tci= 5,cj= p,tcj= 4,c= z s,tc= 7,rc= s ,trc= 6,tF= 5,tD= 5]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 66 17541 5886 10588 9273 8272413 +--R t s - -- t b - ----- w + ---- t - ----- s - ----- b - ------- +--R 29 725 3625 3625 36250 7250000 +--R +--R +--R +--R [[ci= p t,tci= 3,cj= p,tcj= 4,c= z t,tc= 5,rc= t s,trc= 7,tF= 6,tD= 6]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2 28 44 143 962712 420652 5166944 +--R t + -- w s - -- w b + --- t b - ------ w + ------ t - ------- s +--R 45 15 725 18125 90625 815625 +--R + +--R 5036339 83580953 +--R ------- b - -------- +--R 5437500 90625000 +--R +--R +--R +--R 3 2 2 +--R [[ci= b ,tci= 3,cj= b ,tcj= 3,c= w p,tc= 4,rc= t ,trc= 9,tF= 7,tD= 6]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 33 297 81 +--R w b + -- w + ----- s - ----- b +--R 50 10000 10000 +--R +--R +--R +--R 2 3 +--R [[ci= s b,tci= 3,cj= b ,tcj= 3,c= b ,tc= 4,rc= w b,trc= 4,tF= 8,tD= 7]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 21 33 6723 2031 104247 +--R w s + --- t b - --- w + ----- s - ----- b + ------- +--R 100 250 50000 25000 5000000 +--R +--R +--R +--R 2 2 +--R [[ci= s b,tci= 3,cj= s ,tcj= 6,c= s b ,tc= 7,rc= w s,trc= 6,tF= 9,tD= 9]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2373 41563 17253 578853 258751 11330361 +--R w t + ---- t b - ----- w + ------ t + ------- s - ------- b + --------- +--R 7250 36250 290000 7250000 3625000 362500000 +--R +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= t s,tcj= 7,c= t b ,tc= 7,rc= w t,trc= 7,tF= 10,tD= 11]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= p s,tci= 5,cj= s b,tcj= 3,c= p b ,tc= 6,rc= 0,trc= 0,tF= 10,tD= 10]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 51061712 91248294 1516761889 481096937 5789482077 +--R t b - -------- w + --------- t - ---------- s + ---------- b + ----------- +--R 5127061 128176525 1922647875 1281765250 51270610000 +--R +--R +--R +--R 2 +--R [[ci= s ,tci= 6,cj= t s,tcj= 7,c= t s b,tc= 10,rc= t b,trc= 6,tF= 11,tD= 13]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 2962071220563579 1229379913128787 4524811449715289 +--R w + ---------------- t - ---------------- s + ---------------- b +--R 98138188260880 36801820597830 490690941304400 +--R + +--R 59240140318722273 +--R ----------------- +--R 12267273532610000 +--R +--R +--R +--R 2 +--R [[ci= b ,tci= 3,cj= t b,tcj= 6,c= w b,tc= 6,rc= w,trc= 5,tF= 9,tD= 14]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= b ,tci= 3,cj= w b,tcj= 4,c= s b,tc= 3,rc= 0,trc= 0,tF= 9,tD= 13]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 172832706542351932 47302810289036749 2736061156820726 +--R t - ------------------ s + ------------------ b + ----------------- +--R 155991468675747195 155991468675747195 17332385408416355 +--R +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= t b,tcj= 6,c= t b ,tc= 7,rc= t,trc= 4,tF= 7,tD= 11]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 5 9 +--R s - - b - --- +--R 2 200 +--R +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= w b,tcj= 4,c= w b ,tc= 5,rc= s,trc= 3,tF= 6,tD= 9]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= w b,tci= 4,cj= t b,tcj= 6,c= w ,tc= 7,rc= 0,trc= 0,tF= 6,tD= 8]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= s b,tci= 3,cj= s,tcj= 3,c= b ,tc= 3,rc= 0,trc= 0,tF= 6,tD= 7]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R [[ci= t b,tci= 6,cj= t,tcj= 4,c= s b,tc= 7,rc= 0,trc= 0,tF= 6,tD= 6]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R [[ci= w b,tci= 4,cj= w,tcj= 5,c= t b,tc= 6,rc= 0,trc= 0,tF= 6,tD= 5]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= s ,tci= 6,cj= s,tcj= 3,c= s b,tc= 6,rc= 0,trc= 0,tF= 6,tD= 4]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= t s,tci= 7,cj= t,tcj= 4,c= s ,tc= 8,rc= 0,trc= 0,tF= 6,tD= 3]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R [[ci= w s,tci= 6,cj= w,tcj= 5,c= t s,tc= 8,rc= 0,trc= 0,tF= 6,tD= 2]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= t ,tci= 9,cj= t,tcj= 4,c= w s,tc= 9,rc= 0,trc= 0,tF= 6,tD= 1]] +--R +--R +--R +--R reduced Critpair - Polynom : +--R +--R +--R 0 +--R +--R +--R +--R 2 +--R [[ci= w t,tci= 7,cj= w,tcj= 5,c= t ,tc= 8,rc= 0,trc= 0,tF= 6,tD= 0]] +--R +--R +--R There are +--R +--R 6 +--R +--R Groebner Basis Polynomials. +--R +--R +--R THE GROEBNER BASIS POLYNOMIALS +--R +--R (24) +--R 2 33 2673 19 1323 31 153 49 1143 +--R [b + -- b + -----, w + --- b + -----, p - -- b - ---, z + -- b + ----, +--R 50 10000 120 20000 18 200 36 2000 +--R 37 27 5 9 +--R t - -- b + ---, s - - b - ---] +--R 15 250 2 200 +--RType: List HomogeneousDistributedMultivariatePolynomial([w,p,z,t,s,b],Fraction Integer) +--E 24 + +)spool +)lisp (bye) +@ +<>= +==================================================================== +groebner examples +==================================================================== + +Example to call groebner: + + s1:DMP[w,p,z,t,s,b]RN:= 45*p + 35*s - 165*b - 36 + s2:DMP[w,p,z,t,s,b]RN:= 35*p + 40*z + 25*t - 27*s + s3:DMP[w,p,z,t,s,b]RN:= 15*w + 25*p*s + 30*z - 18*t - 165*b**2 + s4:DMP[w,p,z,t,s,b]RN:= -9*w + 15*p*t + 20*z*s + s5:DMP[w,p,z,t,s,b]RN:= w*p + 2*z*t - 11*b**3 + s6:DMP[w,p,z,t,s,b]RN:= 99*w - 11*b*s + 3*b**2 + s7:DMP[w,p,z,t,s,b]RN:= b**2 + 33/50*b + 2673/10000 + + sn7:=[s1,s2,s3,s4,s5,s6,s7] + + groebner(sn7,info) + +groebner calculates a minimal Groebner Basis +all reductions are TOTAL reductions + +To get the reduced critical pairs do: + + groebner(sn7,"redcrit") + +You can get other information by calling: + + groebner(sn7,"info") + +which returns: + ci => Leading monomial for critpair calculation + tci => Number of terms of polynomial i + cj => Leading monomial for critpair calculation + tcj => Number of terms of polynomial j + c => Leading monomial of critpair polynomial + tc => Number of terms of critpair polynomial + rc => Leading monomial of redcritpair polynomial + trc => Number of terms of redcritpair polynomial + tF => Number of polynomials in reduction list F + tD => Number of critpairs still to do + +See Also: +o )display operations groebner +o )show GroebnerPackage +o )show DistributedMultivariatePolynomial +o )show HomogeneousDistributedMultivariatePolynomial +o )show EuclideanGroebnerBasisPackage + +@ +\pagehead{GroebnerPackage}{GB} +\pagepic{ps/v104groebnerpackage.ps}{GB}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GB GroebnerPackage +++ Authors: Gebauer, Trager +++ Date Created: 12-1-86 +++ Date Last Updated: 2-28-91 +++ Basic Functions: groebner normalForm +++ Related Constructors: Ideal, IdealDecompositionPackage +++ Also See: +++ AMS Classifications: +++ Keywords: groebner basis, polynomial ideal +++ References: +++ Description: \spadtype{GroebnerPackage} computes groebner +++ bases for polynomial ideals. The basic computation provides +++ a distinguished set of generators for polynomial ideals over fields. +++ This basis allows an easy test for membership: the operation \spadfun{normalForm} +++ returns zero on ideal members. When the provided coefficient domain, Dom, +++ is not a field, the result is equivalent to considering the extended +++ ideal with \spadtype{Fraction(Dom)} as coefficients, but considerably more efficient +++ since all calculations are performed in Dom. Additional argument "info" and "redcrit" +++ can be given to provide incremental information during +++ computation. Argument "info" produces a computational summary for each s-polynomial. +++ Argument "redcrit" prints out the reduced critical pairs. The term ordering +++ is determined by the polynomial type used. Suggested types include +++ \spadtype{DistributedMultivariatePolynomial}, +++ \spadtype{HomogeneousDistributedMultivariatePolynomial}, +++ \spadtype{GeneralDistributedMultivariatePolynomial}. + +GroebnerPackage(Dom, Expon, VarSet, Dpol): T == C where + + Dom: GcdDomain + Expon: OrderedAbelianMonoidSup + VarSet: OrderedSet + Dpol: PolynomialCategory(Dom, Expon, VarSet) + + T== with + + groebner: List(Dpol) -> List(Dpol) + ++ groebner(lp) computes a groebner basis for a polynomial ideal + ++ generated by the list of polynomials lp. + ++ + ++X s1:DMP([w,p,z,t,s,b],FRAC(INT)):= 45*p + 35*s - 165*b - 36 + ++X s2:DMP([w,p,z,t,s,b],FRAC(INT)):= 35*p + 40*z + 25*t - 27*s + ++X s3:DMP([w,p,z,t,s,b],FRAC(INT)):= 15*w + 25*p*s + 30*z - 18*t - 165*b**2 + ++X s4:DMP([w,p,z,t,s,b],FRAC(INT)):= -9*w + 15*p*t + 20*z*s + ++X s5:DMP([w,p,z,t,s,b],FRAC(INT)):= w*p + 2*z*t - 11*b**3 + ++X s6:DMP([w,p,z,t,s,b],FRAC(INT)):= 99*w - 11*b*s + 3*b**2 + ++X s7:DMP([w,p,z,t,s,b],FRAC(INT)):= b**2 + 33/50*b + 2673/10000 + ++X sn7:=[s1,s2,s3,s4,s5,s6,s7] + ++X groebner(sn7) + + groebner: ( List(Dpol), String ) -> List(Dpol) + ++ groebner(lp, infoflag) computes a groebner basis + ++ for a polynomial ideal + ++ generated by the list of polynomials lp. + ++ Argument infoflag is used to get information on the computation. + ++ If infoflag is "info", then summary information + ++ is displayed for each s-polynomial generated. + ++ If infoflag is "redcrit", the reduced critical pairs are displayed. + ++ If infoflag is any other string, + ++ no information is printed during computation. + ++ + ++X s1:DMP([w,p,z,t,s,b],FRAC(INT)):= 45*p + 35*s - 165*b - 36 + ++X s2:DMP([w,p,z,t,s,b],FRAC(INT)):= 35*p + 40*z + 25*t - 27*s + ++X s3:DMP([w,p,z,t,s,b],FRAC(INT)):= 15*w + 25*p*s + 30*z - 18*t - 165*b**2 + ++X s4:DMP([w,p,z,t,s,b],FRAC(INT)):= -9*w + 15*p*t + 20*z*s + ++X s5:DMP([w,p,z,t,s,b],FRAC(INT)):= w*p + 2*z*t - 11*b**3 + ++X s6:DMP([w,p,z,t,s,b],FRAC(INT)):= 99*w - 11*b*s + 3*b**2 + ++X s7:DMP([w,p,z,t,s,b],FRAC(INT)):= b**2 + 33/50*b + 2673/10000 + ++X sn7:=[s1,s2,s3,s4,s5,s6,s7] + ++X groebner(sn7,"info") + ++X groebner(sn7,"redcrit") + + groebner: ( List(Dpol), String, String ) -> List(Dpol) + ++ groebner(lp, "info", "redcrit") computes a groebner basis + ++ for a polynomial ideal generated by the list of polynomials lp, + ++ displaying both a summary of the critical pairs considered ("info") + ++ and the result of reducing each critical pair ("redcrit"). + ++ If the second or third arguments have any other string value, + ++ the indicated information is suppressed. + ++ + ++X s1:DMP([w,p,z,t,s,b],FRAC(INT)):= 45*p + 35*s - 165*b - 36 + ++X s2:DMP([w,p,z,t,s,b],FRAC(INT)):= 35*p + 40*z + 25*t - 27*s + ++X s3:DMP([w,p,z,t,s,b],FRAC(INT)):= 15*w + 25*p*s + 30*z - 18*t - 165*b**2 + ++X s4:DMP([w,p,z,t,s,b],FRAC(INT)):= -9*w + 15*p*t + 20*z*s + ++X s5:DMP([w,p,z,t,s,b],FRAC(INT)):= w*p + 2*z*t - 11*b**3 + ++X s6:DMP([w,p,z,t,s,b],FRAC(INT)):= 99*w - 11*b*s + 3*b**2 + ++X s7:DMP([w,p,z,t,s,b],FRAC(INT)):= b**2 + 33/50*b + 2673/10000 + ++X sn7:=[s1,s2,s3,s4,s5,s6,s7] + ++X groebner(sn7,"info","redcrit") + + if Dom has Field then + normalForm: (Dpol, List(Dpol)) -> Dpol + ++ normalForm(poly,gb) reduces the polynomial poly modulo the + ++ precomputed groebner basis gb giving a canonical representative + ++ of the residue class. + C== add + import OutputForm + import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol) + + if Dom has Field then + monicize(p: Dpol):Dpol == +-- one?(lc := leadingCoefficient p) => p + ((lc := leadingCoefficient p) = 1) => p + inv(lc)*p + + normalForm(p : Dpol, l : List(Dpol)) : Dpol == + redPol(p,map(monicize,l)) + + ------ MAIN ALGORITHM GROEBNER ------------------------ + + groebner( Pol: List(Dpol) ) == + Pol=[] => Pol + Pol:=[x for x in Pol | x ^= 0] + Pol=[] => [0] + minGbasis(sort( degree #1 > degree #2, gbasis(Pol,0,0))) + + groebner( Pol: List(Dpol), xx1: String) == + Pol=[] => Pol + Pol:=[x for x in Pol | x ^= 0] + Pol=[] => [0] + xx1 = "redcrit" => + minGbasis(sort( degree #1 > degree #2, gbasis(Pol,1,0))) + xx1 = "info" => + minGbasis(sort( degree #1 > degree #2, gbasis(Pol,2,1))) + messagePrint(" ") + messagePrint("WARNING: options are - redcrit and/or info - ") + messagePrint(" you didn't type them correct") + messagePrint(" please try again") + messagePrint(" ") + [] + + groebner( Pol: List(Dpol), xx1: String, xx2: String) == + Pol=[] => Pol + Pol:=[x for x in Pol | x ^= 0] + Pol=[] => [0] + (xx1 = "redcrit" and xx2 = "info") or + (xx1 = "info" and xx2 = "redcrit") => + minGbasis(sort( degree #1 > degree #2, gbasis(Pol,1,1))) + xx1 = "redcrit" and xx2 = "redcrit" => + minGbasis(sort( degree #1 > degree #2, gbasis(Pol,1,0))) + xx1 = "info" and xx2 = "info" => + minGbasis(sort( degree #1 > degree #2, gbasis(Pol,2,1))) + messagePrint(" ") + messagePrint("WARNING: options are - redcrit and/or info - ") + messagePrint(" you didn't type them correctly") + messagePrint(" please try again ") + messagePrint(" ") + [] + +@ +<>= +"GB" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GB"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"] +"GB" -> "PFECAT" +"GB" -> "STRING" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package GROEBSOL GroebnerSolve} +\pagehead{GroebnerSolve}{GROEBSOL} +\pagepic{ps/v104groebnersolve.ps}{GROEBSOL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package GROEBSOL GroebnerSolve +++ Author : P.Gianni, Summer '88, revised November '89 +++ Solve systems of polynomial equations using Groebner bases +++ Total order Groebner bases are computed and then converted to lex ones +++ This package is mostly intended for internal use. +GroebnerSolve(lv,F,R) : C == T + + where + R : GcdDomain + F : GcdDomain + lv : List Symbol + + NNI ==> NonNegativeInteger + I ==> Integer + S ==> Symbol + + OV ==> OrderedVariableList(lv) + IES ==> IndexedExponents Symbol + + DP ==> DirectProduct(#lv,NonNegativeInteger) + DPoly ==> DistributedMultivariatePolynomial(lv,F) + + HDP ==> HomogeneousDirectProduct(#lv,NonNegativeInteger) + HDPoly ==> HomogeneousDistributedMultivariatePolynomial(lv,F) + + SUP ==> SparseUnivariatePolynomial(DPoly) + L ==> List + P ==> Polynomial + + C == with + groebSolve : (L DPoly,L OV) -> L L DPoly + ++ groebSolve(lp,lv) reduces the polynomial system lp in variables lv + ++ to triangular form. Algorithm based on groebner bases algorithm + ++ with linear algebra for change of ordering. + ++ Preprocessing for the general solver. + ++ The polynomials in input are of type \spadtype{DMP}. + + testDim : (L HDPoly,L OV) -> Union(L HDPoly,"failed") + ++ testDim(lp,lv) tests if the polynomial system lp + ++ in variables lv is zero dimensional. + + genericPosition : (L DPoly, L OV) -> Record(dpolys:L DPoly, coords: L I) + ++ genericPosition(lp,lv) puts a radical zero dimensional ideal + ++ in general position, for system lp in variables lv. + + T == add + import PolToPol(lv,F) + import GroebnerPackage(F,DP,OV,DPoly) + import GroebnerInternalPackage(F,DP,OV,DPoly) + import GroebnerPackage(F,HDP,OV,HDPoly) + import LinGroebnerPackage(lv,F) + + nv:NNI:=#lv + + ---- test if f is power of a linear mod (rad lpol) ---- + ---- f is monic ---- + testPower(uf:SUP,x:OV,lpol:L DPoly) : Union(DPoly,"failed") == + df:=degree(uf) + trailp:DPoly := coefficient(uf,(df-1)::NNI) + (testquo := trailp exquo (df::F)) case "failed" => "failed" + trailp := testquo::DPoly + gg:=gcd(lc:=leadingCoefficient(uf),trailp) + trailp := (trailp exquo gg)::DPoly + lc := (lc exquo gg)::DPoly + linp:SUP:=monomial(lc,1$NNI)$SUP + monomial(trailp,0$NNI)$SUP + g:DPoly:=multivariate(uf-linp**df,x) + redPol(g,lpol) ^= 0 => "failed" + multivariate(linp,x) + + -- is the 0-dimensional ideal I in general position ? -- + ---- internal function ---- + testGenPos(lpol:L DPoly,lvar:L OV):Union(L DPoly,"failed") == + rlpol:=reverse lpol + f:=rlpol.first + #lvar=1 => [f] + rlvar:=rest reverse lvar + newlpol:List(DPoly):=[f] + for f in rlpol.rest repeat + x:=first rlvar + fi:= univariate(f,x) + if (mainVariable leadingCoefficient fi case "failed") then + if ((g:= testPower(fi,x,newlpol)) case "failed") + then return "failed" + newlpol :=concat(redPol(g::DPoly,newlpol),newlpol) + rlvar:=rest rlvar + else if redPol(f,newlpol)^=0 then return"failed" + newlpol + + + -- change coordinates and out the ideal in general position ---- + genPos(lp:L DPoly,lvar:L OV): Record(polys:L HDPoly, lpolys:L DPoly, + coord:L I, univp:HDPoly) == + rlvar:=reverse lvar + lnp:=[dmpToHdmp(f) for f in lp] + x := first rlvar;rlvar:=rest rlvar + testfail:=true + for count in 1.. while testfail repeat + ranvals:L I:=[1+(random()$I rem (count*(# lvar))) for vv in rlvar] + val:=+/[rv*(vv::HDPoly) + for vv in rlvar for rv in ranvals] + val:=val+x::HDPoly + gb:L HDPoly:= [elt(univariate(p,x),val) for p in lnp] + gb:=groebner gb + gbt:=totolex gb + (gb1:=testGenPos(gbt,lvar)) case "failed"=>"try again" + testfail:=false + [gb,gbt,ranvals,dmpToHdmp(last (gb1::L DPoly))] + + genericPosition(lp:L DPoly,lvar:L OV) == + nans:=genPos(lp,lvar) + [nans.lpolys, nans.coord] + + ---- select the univariate factors + select(lup:L L HDPoly) : L L HDPoly == + lup=[] => list [] + [:[cons(f,lsel) for lsel in select lup.rest] for f in lup.first] + + ---- in the non generic case, we compute the prime ideals ---- + ---- associated to leq, basis is the algebra basis ---- + findCompon(leq:L HDPoly,lvar:L OV):L L DPoly == + teq:=totolex(leq) + #teq = #lvar => [teq] + -- ^((teq1:=testGenPos(teq,lvar)) case "failed") => [teq1::L DPoly] + gp:=genPos(teq,lvar) + lgp:= gp.polys + g:HDPoly:=gp.univp + fg:=(factor g)$GeneralizedMultivariateFactorize(OV,HDP,R,F,HDPoly) + lfact:=[ff.factor for ff in factors(fg::Factored(HDPoly))] + result: L L HDPoly := [] + #lfact=1 => [teq] + for tfact in lfact repeat + tlfact:=concat(tfact,lgp) + result:=concat(tlfact,result) + ranvals:L I:=gp.coord + rlvar:=reverse lvar + x:=first rlvar + rlvar:=rest rlvar + val:=+/[rv*(vv::HDPoly) for vv in rlvar for rv in ranvals] + val:=(x::HDPoly)-val + ans:=[totolex groebner [elt(univariate(p,x),val) for p in lp] + for lp in result] + [ll for ll in ans | ll^=[1]] + + zeroDim?(lp: List HDPoly,lvar:L OV) : Boolean == + empty? lp => false + n:NNI := #lvar + #lp < n => false + lvint1 := lvar + for f in lp while not empty?(lvint1) repeat + g:= f - reductum f + x:=mainVariable(g)::OV + if ground?(leadingCoefficient(univariate(g,x))) then + lvint1 := remove(x, lvint1) + empty? lvint1 + + -- general solve, gives an error if the system not 0-dimensional + groebSolve(leq: L DPoly,lvar:L OV) : L L DPoly == + lnp:=[dmpToHdmp(f) for f in leq] + leq1:=groebner lnp + #(leq1) = 1 and first(leq1) = 1 => list empty() + ^(zeroDim?(leq1,lvar)) => + error "system does not have a finite number of solutions" + -- add computation of dimension, for a more useful error + basis:=computeBasis(leq1) + lup:L HDPoly:=[] + llfact:L Factored(HDPoly):=[] + for x in lvar repeat + g:=minPol(leq1,basis,x) + fg:=(factor g)$GeneralizedMultivariateFactorize(OV,HDP,R,F,HDPoly) + llfact:=concat(fg::Factored(HDPoly),llfact) + if degree(g,x) = #basis then leave "stop factoring" + result: L L DPoly := [] + -- selecting a factor from the lists of the univariate factors + lfact:=select [[ff.factor for ff in factors llf] + for llf in llfact] + for tfact in lfact repeat + tfact:=groebner concat(tfact,leq1) + tfact=[1] => "next value" + result:=concat(result,findCompon(tfact,lvar)) + result + + -- test if the system is zero dimensional + testDim(leq : L HDPoly,lvar : L OV) : Union(L HDPoly,"failed") == + leq1:=groebner leq + #(leq1) = 1 and first(leq1) = 1 => empty() + ^(zeroDim?(leq1,lvar)) => "failed" + leq1 + +@ +<>= +"GROEBSOL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GROEBSOL"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"] +"GROEBSOL" -> "PFECAT" +"GROEBSOL" -> "DIRPCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter H} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package HB HallBasis} @@ -22091,6 +27886,743 @@ HallBasis() : Export == Implement where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter I} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IDECOMP IdealDecompositionPackage} +\pagehead{IdealDecompositionPackage}{IDECOMP} +\pagepic{ps/v104idealdecompositionpackage.ps}{IDECOMP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IDECOMP IdealDecompositionPackage +++ Author: P. Gianni +++ Date Created: summer 1986 +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: PolynomialIdeals +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package provides functions for the primary decomposition of +++ polynomial ideals over the rational numbers. The ideals are members +++ of the \spadtype{PolynomialIdeals} domain, and the polynomial generators are +++ required to be from the \spadtype{DistributedMultivariatePolynomial} domain. + +IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't + -- compile if it isn't there + where + vl : List Symbol + nv : NonNegativeInteger + Z ==> Integer -- substitute with PFE cat + Q ==> Fraction Z + F ==> Fraction P + P ==> Polynomial Z + UP ==> SparseUnivariatePolynomial P + Expon ==> DirectProduct(nv,NNI) + OV ==> OrderedVariableList(vl) + SE ==> Symbol + SUP ==> SparseUnivariatePolynomial(DPoly) + + DPoly1 ==> DistributedMultivariatePolynomial(vl,Q) + DPoly ==> DistributedMultivariatePolynomial(vl,F) + NNI ==> NonNegativeInteger + + Ideal == PolynomialIdeals(Q,Expon,OV,DPoly1) + FIdeal == PolynomialIdeals(F,Expon,OV,DPoly) + Fun0 == Union("zeroPrimDecomp","zeroRadComp") + GenPos == Record(changeval:List Z,genideal:FIdeal) + + C == with + + + zeroDimPrime? : Ideal -> Boolean + ++ zeroDimPrime?(I) tests if the ideal I is a 0-dimensional prime. + + zeroDimPrimary? : Ideal -> Boolean + ++ zeroDimPrimary?(I) tests if the ideal I is 0-dimensional primary. + prime? : Ideal -> Boolean + ++ prime?(I) tests if the ideal I is prime. + radical : Ideal -> Ideal + ++ radical(I) returns the radical of the ideal I. + primaryDecomp : Ideal -> List(Ideal) + ++ primaryDecomp(I) returns a list of primary ideals such that their + ++ intersection is the ideal I. + + contract : (Ideal,List OV ) -> Ideal + ++ contract(I,lvar) contracts the ideal I to the polynomial ring + ++ \spad{F[lvar]}. + + T == add + + import MPolyCatRationalFunctionFactorizer(Expon,OV,Z,DPoly) + import GroebnerPackage(F,Expon,OV,DPoly) + import GroebnerPackage(Q,Expon,OV,DPoly1) + + ---- Local Functions ----- + genPosLastVar : (FIdeal,List OV) -> GenPos + zeroPrimDecomp : (FIdeal,List OV) -> List(FIdeal) + zeroRadComp : (FIdeal,List OV) -> FIdeal + zerodimcase : (FIdeal,List OV) -> Boolean + is0dimprimary : (FIdeal,List OV) -> Boolean + backGenPos : (FIdeal,List Z,List OV) -> FIdeal + reduceDim : (Fun0,FIdeal,List OV) -> List FIdeal + findvar : (FIdeal,List OV) -> OV + testPower : (SUP,OV,FIdeal) -> Boolean + goodPower : (DPoly,FIdeal) -> Record(spol:DPoly,id:FIdeal) + pushdown : (DPoly,OV) -> DPoly + pushdterm : (DPoly,OV,Z) -> DPoly + pushup : (DPoly,OV) -> DPoly + pushuterm : (DPoly,SE,OV) -> DPoly + pushucoef : (UP,OV) -> DPoly + trueden : (P,SE) -> P + rearrange : (List OV) -> List OV + deleteunit : List FIdeal -> List FIdeal + ismonic : (DPoly,OV) -> Boolean + + + MPCFQF ==> MPolyCatFunctions2(OV,Expon,Expon,Q,F,DPoly1,DPoly) + MPCFFQ ==> MPolyCatFunctions2(OV,Expon,Expon,F,Q,DPoly,DPoly1) + + convertQF(a:Q) : F == ((numer a):: F)/((denom a)::F) + convertFQ(a:F) : Q == (ground numer a)/(ground denom a) + + internalForm(I:Ideal) : FIdeal == + Id:=generators I + nId:=[map(convertQF,poly)$MPCFQF for poly in Id] + groebner? I => groebnerIdeal nId + ideal nId + + externalForm(I:FIdeal) : Ideal == + Id:=generators I + nId:=[map(convertFQ,poly)$MPCFFQ for poly in Id] + groebner? I => groebnerIdeal nId + ideal nId + + lvint:=[variable(xx)::OV for xx in vl] + nvint1:=(#lvint-1)::NNI + + deleteunit(lI: List FIdeal) : List FIdeal == + [I for I in lI | _^ element?(1$DPoly,I)] + + rearrange(vlist:List OV) :List OV == + vlist=[] => vlist + sort(#1>#2,setDifference(lvint,setDifference(lvint,vlist))) + + ---- radical of a 0-dimensional ideal ---- + zeroRadComp(I:FIdeal,truelist:List OV) : FIdeal == + truelist=[] => I + Id:=generators I + x:OV:=truelist.last + #Id=1 => + f:=Id.first + g:= (f exquo (gcd (f,differentiate(f,x))))::DPoly + groebnerIdeal([g]) + y:=truelist.first + px:DPoly:=x::DPoly + py:DPoly:=y::DPoly + f:=Id.last + g:= (f exquo (gcd (f,differentiate(f,x))))::DPoly + Id:=groebner(cons(g,remove(f,Id))) + lf:=Id.first + pv:DPoly:=0 + pw:DPoly:=0 + while degree(lf,y)^=1 repeat + val:=random()$Z rem 23 + pv:=px+val*py + pw:=px-val*py + Id:=groebner([(univariate(h,x)).pv for h in Id]) + lf:=Id.first + ris:= generators(zeroRadComp(groebnerIdeal(Id.rest),truelist.rest)) + ris:=cons(lf,ris) + if pv^=0 then + ris:=[(univariate(h,x)).pw for h in ris] + groebnerIdeal(groebner ris) + + ---- find the power that stabilizes (I:s) ---- + goodPower(s:DPoly,I:FIdeal) : Record(spol:DPoly,id:FIdeal) == + f:DPoly:=s + I:=groebner I + J:=generators(JJ:= (saturate(I,s))) + while _^ in?(ideal([f*g for g in J]),I) repeat f:=s*f + [f,JJ] + + ---- is the ideal zerodimensional? ---- + ---- the "true variables" are in truelist ---- + zerodimcase(J:FIdeal,truelist:List OV) : Boolean == + element?(1,J) => true + truelist=[] => true + n:=#truelist + Jd:=groebner generators J + for x in truelist while Jd^=[] repeat + f := Jd.first + Jd:=Jd.rest + if ((y:=mainVariable f) case "failed") or (y::OV ^=x ) + or _^ (ismonic (f,x)) then return false + while Jd^=[] and (mainVariable Jd.first)::OV=x repeat Jd:=Jd.rest + if Jd=[] and position(x,truelist) [J] + zerodimcase(J,truelist) => + (flag case "zeroPrimDecomp") => zeroPrimDecomp(J,truelist) + (flag case "zeroRadComp") => [zeroRadComp(J,truelist)] + x:OV:=findvar(J,truelist) + Jnew:=[pushdown(f,x) for f in generators J] + Jc: List FIdeal :=[] + Jc:=reduceDim(flag,groebnerIdeal Jnew,remove(x,truelist)) + res1:=[ideal([pushup(f,x) for f in generators idp]) for idp in Jc] + s:=pushup((_*/[leadingCoefficient f for f in Jnew])::DPoly,x) + degree(s,x)=0 => res1 + res1:=[saturate(II,s) for II in res1] + good:=goodPower(s,J) + sideal := groebnerIdeal(groebner(cons(good.spol,generators J))) + in?(good.id, sideal) => res1 + sresult:=reduceDim(flag,sideal,truelist) + for JJ in sresult repeat + if not(in?(good.id,JJ)) then res1:=cons(JJ,res1) + res1 + + ---- Primary Decomposition for 0-dimensional ideals ---- + zeroPrimDecomp(I:FIdeal,truelist:List OV): List(FIdeal) == + truelist=[] => list I + newJ:=genPosLastVar(I,truelist);lval:=newJ.changeval; + J:=groebner newJ.genideal + x:=truelist.last + Jd:=generators J + g:=Jd.last + lfact:= factors factor(g) + ris:List FIdeal:=[] + for ef in lfact repeat + g:DPoly:=(ef.factor)**(ef.exponent::NNI) + J1:= groebnerIdeal(groebner cons(g,Jd)) + if _^ (is0dimprimary (J1,truelist)) then + return zeroPrimDecomp(I,truelist) + ris:=cons(groebner backGenPos(J1,lval,truelist),ris) + ris + + ---- radical of an Ideal ---- + radical(I:Ideal) : Ideal == + J:=groebner(internalForm I) + truelist:=rearrange("setUnion"/[variables f for f in generators J]) + truelist=[] => externalForm J + externalForm("intersect"/reduceDim("zeroRadComp",J,truelist)) + + +-- the following functions are used to "push" x in the coefficient ring - + + ---- push x in the coefficient domain for a polynomial ---- + pushdown(g:DPoly,x:OV) : DPoly == + rf:DPoly:=0$DPoly + i:=position(x,lvint) + while g^=0 repeat + g1:=reductum g + rf:=rf+pushdterm(g-g1,x,i) + g := g1 + rf + + ---- push x in the coefficient domain for a term ---- + pushdterm(t:DPoly,x:OV,i:Z):DPoly == + n:=degree(t,x) + xp:=convert(x)@SE + cf:=monomial(1,xp,n)$P :: F + newt := t exquo monomial(1,x,n)$DPoly + cf * newt::DPoly + + ---- push back the variable ---- + pushup(f:DPoly,x:OV) :DPoly == + h:=1$P + rf:DPoly:=0$DPoly + g := f + xp := convert(x)@SE + while g^=0 repeat + h:=lcm(trueden(denom leadingCoefficient g,xp),h) + g:=reductum g + f:=(h::F)*f + while f^=0 repeat + g:=reductum f + rf:=rf+pushuterm(f-g,xp,x) + f:=g + rf + + trueden(c:P,x:SE) : P == + degree(c,x) = 0 => 1 + c + + ---- push x back from the coefficient domain for a term ---- + pushuterm(t:DPoly,xp:SE,x:OV):DPoly == + pushucoef((univariate(numer leadingCoefficient t,xp)$P), x)* + monomial(inv((denom leadingCoefficient t)::F),degree t)$DPoly + + + pushucoef(c:UP,x:OV):DPoly == + c = 0 => 0 + monomial((leadingCoefficient c)::F::DPoly,x,degree c) + + pushucoef(reductum c,x) + + -- is the 0-dimensional ideal I primary ? -- + ---- internal function ---- + is0dimprimary(J:FIdeal,truelist:List OV) : Boolean == + element?(1,J) => true + Jd:=generators(groebner J) + #(factors factor Jd.last)^=1 => return false + i:=subtractIfCan(#truelist,1) + (i case "failed") => return true + JR:=(reverse Jd);JM:=groebnerIdeal([JR.first]);JP:List(DPoly):=[] + for f in JR.rest repeat + if _^ ismonic(f,truelist.i) then + if _^ inRadical?(f,JM) then return false + JP:=cons(f,JP) + else + x:=truelist.i + i:=(i-1)::NNI + if _^ testPower(univariate(f,x),x,JM) then return false + JM :=groebnerIdeal(append(cons(f,JP),generators JM)) + true + + ---- Functions for the General Position step ---- + + ---- put the ideal in general position ---- + genPosLastVar(J:FIdeal,truelist:List OV):GenPos == + x := last truelist ;lv1:List OV :=remove(x,truelist) + ranvals:List(Z):=[(random()$Z rem 23) for vv in lv1] + val:=_+/[rv*(vv::DPoly) for vv in lv1 for rv in ranvals] + val:=val+(x::DPoly) + [ranvals,groebnerIdeal(groebner([(univariate(p,x)).val + for p in generators J]))]$GenPos + + + ---- convert back the ideal ---- + backGenPos(I:FIdeal,lval:List Z,truelist:List OV) : FIdeal == + lval=[] => I + x := last truelist ;lv1:List OV:=remove(x,truelist) + val:=-(_+/[rv*(vv::DPoly) for vv in lv1 for rv in lval]) + val:=val+(x::DPoly) + groebnerIdeal + (groebner([(univariate(p,x)).val for p in generators I ])) + + ismonic(f:DPoly,x:OV) : Boolean == ground? leadingCoefficient(univariate(f,x)) + + ---- test if f is power of a linear mod (rad J) ---- + ---- f is monic ---- + testPower(uf:SUP,x:OV,J:FIdeal) : Boolean == + df:=degree(uf) + trailp:DPoly := inv(df:Z ::F) *coefficient(uf,(df-1)::NNI) + linp:SUP:=(monomial(1$DPoly,1$NNI)$SUP + + monomial(trailp,0$NNI)$SUP)**df + g:DPoly:=multivariate(uf-linp,x) + inRadical?(g,J) + + + ---- Exported Functions ---- + + -- is the 0-dimensional ideal I prime ? -- + zeroDimPrime?(I:Ideal) : Boolean == + J:=groebner((genPosLastVar(internalForm I,lvint)).genideal) + element?(1,J) => true + n:NNI:=#vl;i:NNI:=1 + Jd:=generators J + #Jd^=n => false + for f in Jd repeat + if _^ ismonic(f,lvint.i) then return false + if i1 => false + lfact.1.exponent =1 + + + -- is the 0-dimensional ideal I primary ? -- + zeroDimPrimary?(J:Ideal):Boolean == + is0dimprimary(internalForm J,lvint) + + ---- Primary Decomposition of I ----- + + primaryDecomp(I:Ideal) : List(Ideal) == + J:=groebner(internalForm I) + truelist:=rearrange("setUnion"/[variables f for f in generators J]) + truelist=[] => [externalForm J] + [externalForm II for II in reduceDim("zeroPrimDecomp",J,truelist)] + + ---- contract I to the ring with lvar variables ---- + contract(I:Ideal,lvar: List OV) : Ideal == + Id:= generators(groebner I) + empty?(Id) => I + fullVars:= "setUnion"/[variables g for g in Id] + fullVars = lvar => I + n:= # lvar + #fullVars < n => error "wrong vars" + n=0 => I + newVars:= append([vv for vv in fullVars| ^member?(vv,lvar)]$List(OV),lvar) + subsVars := [monomial(1,vv,1)$DPoly1 for vv in newVars] + lJ:= [eval(g,fullVars,subsVars) for g in Id] + J := groebner(lJ) + J=[1] => groebnerIdeal J + J=[0] => groebnerIdeal empty() + J:=[f for f in J| member?(mainVariable(f)::OV,newVars)] + fullPol :=[monomial(1,vv,1)$DPoly1 for vv in fullVars] + groebnerIdeal([eval(gg,newVars,fullPol) for gg in J]) + +@ +<>= +"IDECOMP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IDECOMP"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"] +"IDECOMP" -> "PFECAT" +"IDECOMP" -> "DIRPCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INFPROD0 InfiniteProductCharacteristicZero} +\pagehead{InfiniteProductCharacteristicZero}{INFPROD0} +\pagepic{ps/v104infiniteproductcharacteristiczero.ps}{INFPROD0}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INFPROD0 InfiniteProductCharacteristicZero +++ Author: Clifton J. Williamson +++ Date Created: 22 February 1990 +++ Date Last Updated: 23 February 1990 +++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, +++ generalInfiniteProduct +++ Related Domains: UnivariateTaylorSeriesCategory +++ Also See: +++ AMS Classifications: +++ Keywords: Taylor series, infinite product +++ Examples: +++ References: +++ Description: +++ This package computes infinite products of univariate Taylor series +++ over an integral domain of characteristic 0. +InfiniteProductCharacteristicZero(Coef,UTS):_ + Exports == Implementation where + Coef : Join(IntegralDomain,CharacteristicZero) + UTS : UnivariateTaylorSeriesCategory Coef + I ==> Integer + + Exports ==> with + + infiniteProduct: UTS -> UTS + ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + evenInfiniteProduct: UTS -> UTS + ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + oddInfiniteProduct: UTS -> UTS + ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + generalInfiniteProduct: (UTS,I,I) -> UTS + ++ generalInfiniteProduct(f(x),a,d) computes + ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + + Implementation ==> add + + import StreamInfiniteProduct Coef + + infiniteProduct x == series infiniteProduct coefficients x + evenInfiniteProduct x == series evenInfiniteProduct coefficients x + oddInfiniteProduct x == series oddInfiniteProduct coefficients x + + generalInfiniteProduct(x,a,d) == + series generalInfiniteProduct(coefficients x,a,d) + +@ +<>= +"INFPROD0" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INFPROD0"] +"UTSCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=UTSCAT"] +"INFPROD0" -> "UTSCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INPRODFF InfiniteProductFiniteField} +\pagehead{InfiniteProductFiniteField}{INPRODFF} +\pagepic{ps/v104infiniteproductfinitefield.ps}{INPRODFF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INPRODFF InfiniteProductFiniteField +++ Author: Clifton J. Williamson +++ Date Created: 22 February 1990 +++ Date Last Updated: 23 February 1990 +++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, +++ generalInfiniteProduct +++ Related Domains: UnivariateTaylorSeriesCategory +++ Also See: +++ AMS Classifications: +++ Keywords: Taylor series, infinite product +++ Examples: +++ References: +++ Description: +++ This package computes infinite products of univariate Taylor series +++ over an arbitrary finite field. +InfiniteProductFiniteField(K,UP,Coef,UTS):_ + Exports == Implementation where + K : Join(Field,Finite,ConvertibleTo Integer) + UP : UnivariatePolynomialCategory K + Coef : MonogenicAlgebra(K,UP) + UTS : UnivariateTaylorSeriesCategory Coef + I ==> Integer + RN ==> Fraction Integer + SAE ==> SimpleAlgebraicExtension + ST ==> Stream + STF ==> StreamTranscendentalFunctions + STT ==> StreamTaylorSeriesOperations + ST2 ==> StreamFunctions2 + SUP ==> SparseUnivariatePolynomial + + Exports ==> with + + infiniteProduct: UTS -> UTS + ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + evenInfiniteProduct: UTS -> UTS + ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + oddInfiniteProduct: UTS -> UTS + ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + generalInfiniteProduct: (UTS,I,I) -> UTS + ++ generalInfiniteProduct(f(x),a,d) computes + ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + + Implementation ==> add + + liftPoly: UP -> SUP RN + liftPoly poly == + -- lift coefficients of 'poly' to integers + ans : SUP RN := 0 + while not zero? poly repeat + coef := convert(leadingCoefficient poly)@I :: RN + ans := ans + monomial(coef,degree poly) + poly := reductum poly + ans + + reducePoly: SUP RN -> UP + reducePoly poly == + -- reduce coefficients of 'poly' to elements of K + ans : UP := 0 + while not zero? poly repeat + coef := numer(leadingCoefficient(poly)) :: K + ans := ans + monomial(coef,degree poly) + poly := reductum poly + ans + + POLY := liftPoly definingPolynomial()$Coef + ALG := SAE(RN,SUP RN,POLY) + + infiniteProduct x == + stUP := map(lift,coefficients x)$ST2(Coef,UP) + stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) + stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) + stALG := exp(lambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG) + stSUP := map(lift,stALG)$ST2(ALG,SUP RN) + stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) + series map(reduce,stUP)$ST2(UP,Coef) + + evenInfiniteProduct x == + stUP := map(lift,coefficients x)$ST2(Coef,UP) + stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) + stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) + stALG := exp(evenlambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG) + stSUP := map(lift,stALG)$ST2(ALG,SUP RN) + stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) + series map(reduce,stUP)$ST2(UP,Coef) + + oddInfiniteProduct x == + stUP := map(lift,coefficients x)$ST2(Coef,UP) + stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) + stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) + stALG := exp(oddlambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG) + stSUP := map(lift,stALG)$ST2(ALG,SUP RN) + stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) + series map(reduce,stUP)$ST2(UP,Coef) + + generalInfiniteProduct(x,a,d) == + stUP := map(lift,coefficients x)$ST2(Coef,UP) + stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) + stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) + stALG := generalLambert(log(stALG)$STF(ALG),a,d)$STT(ALG) + stALG := exp(stALG)$STF(ALG) + stSUP := map(lift,stALG)$ST2(ALG,SUP RN) + stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) + series map(reduce,stUP)$ST2(UP,Coef) + +@ +<>= +"INPRODFF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INPRODFF"] +"UTSCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=UTSCAT"] +"INPRODFF" -> "UTSCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INPRODPF InfiniteProductPrimeField} +\pagehead{InfiniteProductPrimeField}{INPRODPF} +\pagepic{ps/v104infiniteproductprimefield.ps}{INPRODPF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INPRODPF InfiniteProductPrimeField +++ Author: Clifton J. Williamson +++ Date Created: 22 February 1990 +++ Date Last Updated: 23 February 1990 +++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, +++ generalInfiniteProduct +++ Related Domains: UnivariateTaylorSeriesCategory +++ Also See: +++ AMS Classifications: +++ Keywords: Taylor series, infinite product +++ Examples: +++ References: +++ Description: +++ This package computes infinite products of univariate Taylor series +++ over a field of prime order. +InfiniteProductPrimeField(Coef,UTS): Exports == Implementation where + Coef : Join(Field,Finite,ConvertibleTo Integer) + UTS : UnivariateTaylorSeriesCategory Coef + I ==> Integer + ST ==> Stream + + Exports ==> with + + infiniteProduct: UTS -> UTS + ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + evenInfiniteProduct: UTS -> UTS + ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + oddInfiniteProduct: UTS -> UTS + ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + generalInfiniteProduct: (UTS,I,I) -> UTS + ++ generalInfiniteProduct(f(x),a,d) computes + ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + + Implementation ==> add + + import StreamInfiniteProduct Integer + + applyOverZ:(ST I -> ST I,ST Coef) -> ST Coef + applyOverZ(f,st) == + stZ := map(convert(#1)@Integer,st)$StreamFunctions2(Coef,I) + map(#1 :: Coef,f stZ)$StreamFunctions2(I,Coef) + + infiniteProduct x == + series applyOverZ(infiniteProduct,coefficients x) + evenInfiniteProduct x == + series applyOverZ(evenInfiniteProduct,coefficients x) + oddInfiniteProduct x == + series applyOverZ(oddInfiniteProduct,coefficients x) + generalInfiniteProduct(x,a,d) == + series applyOverZ(generalInfiniteProduct(#1,a,d),coefficients x) + +@ +<>= +"INPRODPF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INPRODPF"] +"UTSCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=UTSCAT"] +"INPRODPF" -> "UTSCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ITFUN2 InfiniteTupleFunctions2} +\pagehead{InfiniteTupleFunctions2}{ITFUN2} +\pagepic{ps/v104infinitetuplefunctions2.ps}{ITFUN2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ITFUN2 InfiniteTupleFunctions2 +InfiniteTupleFunctions2(A:Type,B:Type): Exports == Implementation where + ++ Functions defined on streams with entries in two sets. + IT ==> InfiniteTuple + + Exports ==> with + map: ((A -> B),IT A) -> IT B + ++ \spad{map(f,[x0,x1,x2,...])} returns \spad{[f(x0),f(x1),f(x2),..]}. + + Implementation ==> add + + map(f,x) == + map(f,x pretend Stream(A))$StreamFunctions2(A,B) pretend IT(B) + +@ +<>= +"ITFUN2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ITFUN2"] +"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"] +"ITFUN2" -> "TYPE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ITFUN3 InfiniteTupleFunctions3} +\pagehead{InfiniteTupleFunctions3}{ITFUN3} +\pagepic{ps/v104infinitetuplefunctions3.ps}{ITFUN3}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ITFUN3 InfiniteTupleFunctions3 +InfiniteTupleFunctions3(A:Type, B:Type,C:Type): Exports + == Implementation where + ++ Functions defined on streams with entries in two sets. + IT ==> InfiniteTuple + ST ==> Stream + SF3 ==> StreamFunctions3(A,B,C) + FUN ==> ((A,B)->C) + Exports ==> with + map: (((A,B)->C), IT A, IT B) -> IT C + ++ map(f,a,b) \undocumented + map: (((A,B)->C), ST A, IT B) -> ST C + ++ map(f,a,b) \undocumented + map: (((A,B)->C), IT A, ST B) -> ST C + ++ map(f,a,b) \undocumented + + Implementation ==> add + + map(f:FUN, s1:IT A, s2:IT B):IT C == + map(f, s1 pretend Stream(A), s2 pretend Stream(B))$SF3 pretend IT(C) + map(f:FUN, s1:ST A, s2:IT B):ST C == + map(f, s1, s2 pretend Stream(B))$SF3 + map(f:FUN, s1:IT A, s2:ST B):ST C == + map(f, s1 pretend Stream(A), s2)$SF3 + +@ +<>= +"ITFUN3" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ITFUN3"] +"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"] +"ITFUN3" -> "TYPE" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package INFINITY Infinity} \pagehead{Infinity}{INFINITY} \pagepic{ps/v104infinity.ps}{INFINITY}{1.00} @@ -22998,6 +29530,1536 @@ IntegerCombinatoricFunctions(I:IntegerNumberSystem): with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTFACT IntegerFactorizationPackage} +\pagehead{IntegerFactorizationPackage}{INTFACT} +\pagepic{ps/v104integerfactorizationpackage.ps}{INTFACT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTFACT IntegerFactorizationPackage +++ This Package contains basic methods for integer factorization. +++ The factor operation employs trial division up to 10,000. It +++ then tests to see if n is a perfect power before using Pollards +++ rho method. Because Pollards method may fail, the result +++ of factor may contain composite factors. We should also employ +++ Lenstra's eliptic curve method. + +IntegerFactorizationPackage(I): Exports == Implementation where + I: IntegerNumberSystem + + B ==> Boolean + FF ==> Factored I + NNI ==> NonNegativeInteger + LMI ==> ListMultiDictionary I + FFE ==> Record(flg:Union("nil","sqfr","irred","prime"), + fctr:I, xpnt:Integer) + + Exports ==> with + factor : I -> FF + ++ factor(n) returns the full factorization of integer n + squareFree : I -> FF + ++ squareFree(n) returns the square free factorization of integer n + BasicMethod : I -> FF + ++ BasicMethod(n) returns the factorization + ++ of integer n by trial division + PollardSmallFactor: I -> Union(I,"failed") + ++ PollardSmallFactor(n) returns a factor + ++ of n or "failed" if no one is found + + Implementation ==> add + import IntegerRoots(I) + + BasicSieve: (I, I) -> FF + +@ +\subsection{squareFree} +<>= + squareFree(n:I):FF == + u:I + if n<0 then (m := -n; u := -1) + else (m := n; u := 1) + (m > 1) and ((v := perfectSqrt m) case I) => + for rec in (l := factorList(sv := squareFree(v::I))) repeat + rec.xpnt := 2 * rec.xpnt + makeFR(u * unit sv, l) + -- avoid using basic sieve when the lim is too big + -- we know the sieve constants up to sqrt(100000000) + lim := 1 + approxSqrt(m) + lim > (100000000::I) => makeFR(u, factorList factor m) + x := BasicSieve(m, lim) + y := + ((m:= unit x) = 1) => factorList x + (v := perfectSqrt m) case I => + concat_!(factorList x, ["sqfr",v,2]$FFE) + concat_!(factorList x, ["sqfr",m,1]$FFE) + makeFR(u, y) + +@ +\subsection{PollardSmallFactor} +This is Brent's\cite{1} optimization of Pollard's\cite{2} rho factoring. +Brent's algorithm is about 24 percent faster than Pollard's. Pollard;s +algorithm has complexity $O(p^{1/2})$ where $p$ is the smallest prime +factor of the composite number $N$. + +Pollard's idea is based on the observation that two numbers $x$ and $y$ +are congruent modulo $p$ with probability 0.5 after $1.177*\sqrt{p}$ numbers +have been randomly chosen. If we try to factor $n$ and $p$ is a factor of +$n$, then +$$1 < gcd(\vert x-y\vert,n) \le n$$ since $p$ divides both $\vert x-y\vert$ +and $n$. + +Given a function $f$ which generates a pseudo-random sequence of numbers +we allow $x$ to walk the sequence in order and $y$ to walk the sequence +at twice the rate. At each cycle we compute $gcd(\vert x-y\vert,n)$. +If this GCD ever equals $n$ then $x=y$ which means that we have walked +"all the way around the pseudo-random cycle" and we terminate with failure. + +This algorithm returns failure on all primes but also fails on some +composite numbers. + +Quoting Brent's back-tracking idea: +\begin{quote} +The best-known algorithm for finding GCDs is the Euclidean algorithm +which takes $O(\log N)$ times as long as one multiplication mod $N$. Pollard +showed that most of the GCD computations in Floyd's algorithm could be +dispensed with. ... The idea is simple: if $P_F$ computes $GCD(z_1,N)$, +$GCD(z_2,N)$,$\ldots$, then we compute +$$q_i=\prod_{j=1}^i{z_j}(\textrm{mod }N)$$ +and only compute $GCD(q_i,N)$ when $i$ is a multiple of $m$, where +$\log N < < m < < N^{1/4}$. Since $q_{i+1}=q_i \times z_{i+1}(\textrm{mod }N)$, +the work required for each GCD computation in algorithm $P_F$ is effectively +reduced to that for a multiplication mod $N$ in the modified algorithm. +The probability of the algorithm failing because $q_i=0$ increases, so it +is best not to choose $m$ too large. This problem can be minimized by +backtracking to the state after the previous GCD computation and setting +$m=1$. +\end{quote} +Brent incorporates back-tracking, omits the random choice of u, and +makes some minor modifications. His algorithm (p192-183) reads: + +\noindent +$y:=x_0; r:=1; q:=1;$ + +\noindent +\hbox{\hskip 0.5cm}{\bf repeat} $x:=y;$ + +\noindent +\hbox{\hskip 1.0cm}{\bf for} $i:=1$ {\bf to} $r$ {\bf do} $y:=f(y); k:=0;$ + +\noindent +\hbox{\hskip 1.0cm}{\bf repeat} $ys:=y;$ + +\noindent +\hbox{\hskip 1.5cm}{\bf for} $i:=1$ {\bf to} $min(m,r-k)$ {\bf do} + +\noindent +\hbox{\hskip 2.0cm}{\bf begin} $y:=f(y); q:=q*\vert x-y\vert mod N$ + +\noindent +\hbox{\hskip 2.0cm}{\bf end}; + +\noindent +\hbox{\hskip 1.5cm}$G:=GCD(q,N); k:=k+m$ + +\noindent +\hbox{\hskip 1.0cm}{\bf until} $(k \ge r)$ {\bf or} $(G > 1); r:=2*r$ + +\noindent +\hbox{\hskip 0.5cm}{\bf until} $G > 1$; + +\noindent +\hbox{\hskip 0.5cm}{\bf if} $G=N$ {\bf then} + +\noindent +\hbox{\hskip 1.0cm}{\bf repeat} $ys:=f(ys); G:=GCD(\vert y-yx\vert,N)$ + +\noindent +\hbox{\hskip 1.0cm}{\bf until} $G > 1$; + +\noindent +\hbox{\hskip 0.5cm}{\bf if} $G=N$ {\bf then} failure {\bf else} success + +Here we use the function +$$(y*y+5::I)~{\textrm rem}~ n$$ +as our pseudo-random sequence with a random starting value for y. + +On possible optimization to explore is to keep a hash table for the +computed values of the function $y_{i+1}:=f(y_i)$ since we effectively +walk the sequence several times. And we walk the sequence in a loop +many times. But because we are generating a very large number of +numbers the array can be a simple array of fixed size that captures +the last n values. So if we make a fixed array F of, say $2^q$ +elements we can store $f(y_i)$ in F[$y_i$ mod $2^q$]. + +One property that this algorithm assumes is that the function used +to generate the numbers has a long, hopefully complete, period. It +is not clear that the recommended function has that property. + +<>= + PollardSmallFactor(n:I):Union(I,"failed") == + -- Use the Brent variation + x0 := random()$I + m := 100::I + y := x0 rem n + r:I := 1 + q:I := 1 + G:I := 1 + until G > 1 repeat + x := y + for i in 1..convert(r)@Integer repeat + y := (y*y+5::I) rem n + k:I := 0 + until (k>=r) or (G>1) repeat + ys := y + for i in 1..convert(min(m,r-k))@Integer repeat + y := (y*y+5::I) rem n + q := q*abs(x-y) rem n + G := gcd(q,n) + k := k+m + r := 2*r + if G=n then + until G>1 repeat + ys := (ys*ys+5::I) rem n + G := gcd(abs(x-ys),n) + G=n => "failed" + G + +@ +\subsection{BasicSieve} +We create a list of prime numbers up to the limit given. The prior code +used a circular list but tests of that list show that on average more +than 50% of those numbers are not prime. Now we call primes to generate +the required prime numbers. Overall this is a small percentage of the +time needed to factor. + +This loop uses three pieces of information +\begin{enumerate} +\item n which is the number we are testing +\item d which is the current prime to test +\item lim which is the upper limit of the primes to test +\end{enumerate} + +We loop d over the list of primes. If the remaining number n is +smaller than the square of d then n must be prime and if it is +not one, we add it to the list of primes. If the remaining number +is larger than the square of d we remove all factors of d, reducing +n each time. Then we add a record of the new factor and its multiplicity, m. +We continue the loop until we run out of primes. + +Annoyingly enough, primes does not return an ordered list so we fix this. + +The sieve works up to a given limit, reducing out the factors that it +finds. If it can find all of the factors than it returns a factored +result where the first element is the unit 1. If there is still a +part of the number unfactored it returns the number and a list of +the factors found and their multiplicity. + +Basically we just loop thru the prime factors checking to see if +they are a component of the number, n. If so, we remove the factor from +the number n (possibly m times) and continue thru the list of primes. +<>= + BasicSieve(n, lim) == + p:=primes(1::I,lim::I)$IntegerPrimesPackage(I) + l:List(I) := append([first p],reverse rest p) + ls := empty()$List(FFE) + for d in l repeat + if n1 then ls := concat_!(ls, ["prime",n,1]$FFE) + return makeFR(1, ls) + for m in 0.. while zero?(n rem d) repeat n := n quo d + if m>0 then ls := concat_!(ls, ["prime",d,convert m]$FFE) + makeFR(n,ls) + +@ +\subsection{BasicMethod} +<>= + BasicMethod n == + u:I + if n<0 then (m := -n; u := -1) + else (m := n; u := 1) + x := BasicSieve(m, 1 + approxSqrt m) + makeFR(u, factorList x) + +@ +\subsection{factor} +The factor function is many orders of magnitude slower than the results +of other systems. A posting on sci.math.symbolic showed that NTL could +factor the final value (t6) in about 11 seconds. Axiom takes about 8 hours. +\begin{verbatim} +a1:=101 +a2:=109 +t1:=a1*a2 +factor t1 + +a3:=21525175387 +t2:=t1*a3 +factor t2 + +a4:=218301576858349 +t3:=t2*a4 +factor t3 + +a5:=13731482973783137 +t4:=t3*a5 +factor t4 + +a6:=23326138687706820109 +t5:=t4*a6 +factor t5 + +a7:=4328240801173188438252813716944518369161 +t6:=t5*a7 +factor t6 +\end{verbatim} +<>= + factor m == + u:I + zero? m => 0 + if negative? m then (n := -m; u := -1) + else (n := m; u := 1) + b := BasicSieve(n, 10000::I) + flb := factorList b + ((n := unit b) = 1) => makeFR(u, flb) + a:LMI := dictionary() -- numbers yet to be factored + b:LMI := dictionary() -- prime factors found + f:LMI := dictionary() -- number which could not be factored + insert_!(n, a) + while not empty? a repeat + n := inspect a; c := count(n, a); remove_!(n, a) + prime?(n)$IntegerPrimesPackage(I) => insert_!(n, b, c) + -- test for a perfect power + (s := perfectNthRoot n).exponent > 1 => + insert_!(s.base, a, c * s.exponent) + -- test for a difference of square + x:=approxSqrt n + if (x**2 + insert_!(x+y,a,c) + insert_!(x-y,a,c) + (d := PollardSmallFactor n) case I => + for m in 0.. while zero?(n rem d) repeat n := n quo d + insert_!(d, a, m * c) + if n > 1 then insert_!(n, a, c) + -- an elliptic curve factorization attempt should be made here + insert_!(n, f, c) + -- insert prime factors found + while not empty? b repeat + n := inspect b; c := count(n, b); remove_!(n, b) + flb := concat_!(flb, ["prime",n,convert c]$FFE) + -- insert non-prime factors found + while not empty? f repeat + n := inspect f; c := count(n, f); remove_!(n, f) + flb := concat_!(flb, ["nil",n,convert c]$FFE) + makeFR(u, flb) + +@ +<>= +"INTFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTFACT"] +"MDAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=MDAGG"] +"INTFACT" -> "MDAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package PRIMES IntegerPrimesPackage} +We've expanded the list of small primes to include those between 1 and 10000. +\pagehead{IntegerPrimesPackage}{PRIMES} +\pagepic{ps/v104integerprimespackage.ps}{PRIMES}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package PRIMES IntegerPrimesPackage +++ Author: Michael Monagan +++ Date Created: August 1987 +++ Date Last Updated: 31 May 1993 +++ Updated by: James Davenport +++ Updated Because: of problems with strong pseudo-primes +++ and for some efficiency reasons. +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: integer, prime +++ Examples: +++ References: Davenport's paper in ISSAC 1992 +++ AXIOM Technical Report ATR/6 +++ Description: +++ The \spadtype{IntegerPrimesPackage} implements a modification of +++ Rabin's probabilistic +++ primality test and the utility functions \spadfun{nextPrime}, +++ \spadfun{prevPrime} and \spadfun{primes}. +IntegerPrimesPackage(I:IntegerNumberSystem): with + prime?: I -> Boolean + ++ \spad{prime?(n)} returns true if n is prime and false if not. + ++ The algorithm used is Rabin's probabilistic primality test + ++ (reference: Knuth Volume 2 Semi Numerical Algorithms). + ++ If \spad{prime? n} returns false, n is proven composite. + ++ If \spad{prime? n} returns true, prime? may be in error + ++ however, the probability of error is very low. + ++ and is zero below 25*10**9 (due to a result of Pomerance et al), + ++ below 10**12 and 10**13 due to results of Pinch, + ++ and below 341550071728321 due to a result of Jaeschke. + ++ Specifically, this implementation does at least 10 pseudo prime + ++ tests and so the probability of error is \spad{< 4**(-10)}. + ++ The running time of this method is cubic in the length + ++ of the input n, that is \spad{O( (log n)**3 )}, for n<10**20. + ++ beyond that, the algorithm is quartic, \spad{O( (log n)**4 )}. + ++ Two improvements due to Davenport have been incorporated + ++ which catches some trivial strong pseudo-primes, such as + ++ [Jaeschke, 1991] 1377161253229053 * 413148375987157, which + ++ the original algorithm regards as prime + nextPrime: I -> I + ++ \spad{nextPrime(n)} returns the smallest prime strictly larger than n + prevPrime: I -> I + ++ \spad{prevPrime(n)} returns the largest prime strictly smaller than n + primes: (I,I) -> List I + ++ \spad{primes(a,b)} returns a list of all primes p with + ++ \spad{a <= p <= b} + == add +@ +\subsection{smallPrimes} +This is a table of all of the primes in [2..10000]. It is used by the +prime? function to check for primality. It is used by the primes function +to generate arrays of primes in a given range. Changing the range included +in this table implies changing the value of the nextSmallPrime variable. +There is a constant in the function squareFree from IntegerFactorizationPackage +that is the square of the upper bound of the table range, in this case +10000000. +<>= + smallPrimes: List I := + [2::I, 3::I, 5::I, 7::I, 11::I, 13::I, 17::I, 19::I,_ + 23::I, 29::I, 31::I, 37::I, 41::I, 43::I, 47::I, 53::I,_ + 59::I, 61::I, 67::I, 71::I, 73::I, 79::I, 83::I, 89::I,_ + 97::I, 101::I, 103::I, 107::I, 109::I, 113::I, 127::I,_ + 131::I, 137::I, 139::I, 149::I, 151::I, 157::I, 163::I,_ + 167::I, 173::I, 179::I, 181::I, 191::I, 193::I, 197::I,_ + 199::I, 211::I, 223::I, 227::I, 229::I, 233::I, 239::I,_ + 241::I, 251::I, 257::I, 263::I, 269::I, 271::I, 277::I,_ + 281::I, 283::I, 293::I, 307::I, 311::I, 313::I, 317::I,_ + 331::I, 337::I, 347::I, 349::I, 353::I, 359::I, 367::I,_ + 373::I, 379::I, 383::I, 389::I, 397::I, 401::I, 409::I,_ + 419::I, 421::I, 431::I, 433::I, 439::I, 443::I, 449::I,_ + 457::I, 461::I, 463::I, 467::I, 479::I, 487::I, 491::I,_ + 499::I, 503::I, 509::I, 521::I, 523::I, 541::I, 547::I,_ + 557::I, 563::I, 569::I, 571::I, 577::I, 587::I, 593::I,_ + 599::I, 601::I, 607::I, 613::I, 617::I, 619::I, 631::I,_ + 641::I, 643::I, 647::I, 653::I, 659::I, 661::I, 673::I,_ + 677::I, 683::I, 691::I, 701::I, 709::I, 719::I, 727::I,_ + 733::I, 739::I, 743::I, 751::I, 757::I, 761::I, 769::I,_ + 773::I, 787::I, 797::I, 809::I, 811::I, 821::I, 823::I,_ + 827::I, 829::I, 839::I, 853::I, 857::I, 859::I, 863::I,_ + 877::I, 881::I, 883::I, 887::I, 907::I, 911::I, 919::I,_ + 929::I, 937::I, 941::I, 947::I, 953::I, 967::I, 971::I,_ + 977::I, 983::I, 991::I, 997::I, 1009::I, 1013::I,_ + 1019::I, 1021::I, 1031::I, 1033::I, 1039::I, 1049::I,_ + 1051::I, 1061::I, 1063::I, 1069::I, 1087::I, 1091::I,_ + 1093::I, 1097::I, 1103::I, 1109::I, 1117::I, 1123::I,_ + 1129::I, 1151::I, 1153::I, 1163::I, 1171::I, 1181::I,_ + 1187::I, 1193::I, 1201::I, 1213::I, 1217::I, 1223::I,_ + 1229::I, 1231::I, 1237::I, 1249::I, 1259::I, 1277::I,_ + 1279::I, 1283::I, 1289::I, 1291::I, 1297::I, 1301::I,_ + 1303::I, 1307::I, 1319::I, 1321::I, 1327::I, 1361::I,_ + 1367::I, 1373::I, 1381::I, 1399::I, 1409::I, 1423::I,_ + 1427::I, 1429::I, 1433::I, 1439::I, 1447::I, 1451::I,_ + 1453::I, 1459::I, 1471::I, 1481::I, 1483::I, 1487::I,_ + 1489::I, 1493::I, 1499::I, 1511::I, 1523::I, 1531::I,_ + 1543::I, 1549::I, 1553::I, 1559::I, 1567::I, 1571::I,_ + 1579::I, 1583::I, 1597::I, 1601::I, 1607::I, 1609::I,_ + 1613::I, 1619::I, 1621::I, 1627::I, 1637::I, 1657::I,_ + 1663::I, 1667::I, 1669::I, 1693::I, 1697::I, 1699::I,_ + 1709::I, 1721::I, 1723::I, 1733::I, 1741::I, 1747::I,_ + 1753::I, 1759::I, 1777::I, 1783::I, 1787::I, 1789::I,_ + 1801::I, 1811::I, 1823::I, 1831::I, 1847::I, 1861::I,_ + 1867::I, 1871::I, 1873::I, 1877::I, 1879::I, 1889::I,_ + 1901::I, 1907::I, 1913::I, 1931::I, 1933::I, 1949::I,_ + 1951::I, 1973::I, 1979::I, 1987::I, 1993::I, 1997::I,_ + 1999::I, 2003::I, 2011::I, 2017::I, 2027::I, 2029::I,_ + 2039::I, 2053::I, 2063::I, 2069::I, 2081::I, 2083::I,_ + 2087::I, 2089::I, 2099::I, 2111::I, 2113::I, 2129::I,_ + 2131::I, 2137::I, 2141::I, 2143::I, 2153::I, 2161::I,_ + 2179::I, 2203::I, 2207::I, 2213::I, 2221::I, 2237::I,_ + 2239::I, 2243::I, 2251::I, 2267::I, 2269::I, 2273::I,_ + 2281::I, 2287::I, 2293::I, 2297::I, 2309::I, 2311::I,_ + 2333::I, 2339::I, 2341::I, 2347::I, 2351::I, 2357::I,_ + 2371::I, 2377::I, 2381::I, 2383::I, 2389::I, 2393::I,_ + 2399::I, 2411::I, 2417::I, 2423::I, 2437::I, 2441::I,_ + 2447::I, 2459::I, 2467::I, 2473::I, 2477::I, 2503::I,_ + 2521::I, 2531::I, 2539::I, 2543::I, 2549::I, 2551::I,_ + 2557::I, 2579::I, 2591::I, 2593::I, 2609::I, 2617::I,_ + 2621::I, 2633::I, 2647::I, 2657::I, 2659::I, 2663::I,_ + 2671::I, 2677::I, 2683::I, 2687::I, 2689::I, 2693::I,_ + 2699::I, 2707::I, 2711::I, 2713::I, 2719::I, 2729::I,_ + 2731::I, 2741::I, 2749::I, 2753::I, 2767::I, 2777::I,_ + 2789::I, 2791::I, 2797::I, 2801::I, 2803::I, 2819::I,_ + 2833::I, 2837::I, 2843::I, 2851::I, 2857::I, 2861::I,_ + 2879::I, 2887::I, 2897::I, 2903::I, 2909::I, 2917::I,_ + 2927::I, 2939::I, 2953::I, 2957::I, 2963::I, 2969::I,_ + 2971::I, 2999::I, 3001::I, 3011::I, 3019::I, 3023::I,_ + 3037::I, 3041::I, 3049::I, 3061::I, 3067::I, 3079::I,_ + 3083::I, 3089::I, 3109::I, 3119::I, 3121::I, 3137::I,_ + 3163::I, 3167::I, 3169::I, 3181::I, 3187::I, 3191::I,_ + 3203::I, 3209::I, 3217::I, 3221::I, 3229::I, 3251::I,_ + 3253::I, 3257::I, 3259::I, 3271::I, 3299::I, 3301::I,_ + 3307::I, 3313::I, 3319::I, 3323::I, 3329::I, 3331::I,_ + 3343::I, 3347::I, 3359::I, 3361::I, 3371::I, 3373::I,_ + 3389::I, 3391::I, 3407::I, 3413::I, 3433::I, 3449::I,_ + 3457::I, 3461::I, 3463::I, 3467::I, 3469::I, 3491::I,_ + 3499::I, 3511::I, 3517::I, 3527::I, 3529::I, 3533::I,_ + 3539::I, 3541::I, 3547::I, 3557::I, 3559::I, 3571::I,_ + 3581::I, 3583::I, 3593::I, 3607::I, 3613::I, 3617::I,_ + 3623::I, 3631::I, 3637::I, 3643::I, 3659::I, 3671::I,_ + 3673::I, 3677::I, 3691::I, 3697::I, 3701::I, 3709::I,_ + 3719::I, 3727::I, 3733::I, 3739::I, 3761::I, 3767::I,_ + 3769::I, 3779::I, 3793::I, 3797::I, 3803::I, 3821::I,_ + 3823::I, 3833::I, 3847::I, 3851::I, 3853::I, 3863::I,_ + 3877::I, 3881::I, 3889::I, 3907::I, 3911::I, 3917::I,_ + 3919::I, 3923::I, 3929::I, 3931::I, 3943::I, 3947::I,_ + 3967::I, 3989::I, 4001::I, 4003::I, 4007::I, 4013::I,_ + 4019::I, 4021::I, 4027::I, 4049::I, 4051::I, 4057::I,_ + 4073::I, 4079::I, 4091::I, 4093::I, 4099::I, 4111::I,_ + 4127::I, 4129::I, 4133::I, 4139::I, 4153::I, 4157::I,_ + 4159::I, 4177::I, 4201::I, 4211::I, 4217::I, 4219::I,_ + 4229::I, 4231::I, 4241::I, 4243::I, 4253::I, 4259::I,_ + 4261::I, 4271::I, 4273::I, 4283::I, 4289::I, 4297::I,_ + 4327::I, 4337::I, 4339::I, 4349::I, 4357::I, 4363::I,_ + 4373::I, 4391::I, 4397::I, 4409::I, 4421::I, 4423::I,_ + 4441::I, 4447::I, 4451::I, 4457::I, 4463::I, 4481::I,_ + 4483::I, 4493::I, 4507::I, 4513::I, 4517::I, 4519::I,_ + 4523::I, 4547::I, 4549::I, 4561::I, 4567::I, 4583::I,_ + 4591::I, 4597::I, 4603::I, 4621::I, 4637::I, 4639::I,_ + 4643::I, 4649::I, 4651::I, 4657::I, 4663::I, 4673::I,_ + 4679::I, 4691::I, 4703::I, 4721::I, 4723::I, 4729::I,_ + 4733::I, 4751::I, 4759::I, 4783::I, 4787::I, 4789::I,_ + 4793::I, 4799::I, 4801::I, 4813::I, 4817::I, 4831::I,_ + 4861::I, 4871::I, 4877::I, 4889::I, 4903::I, 4909::I,_ + 4919::I, 4931::I, 4933::I, 4937::I, 4943::I, 4951::I,_ + 4957::I, 4967::I, 4969::I, 4973::I, 4987::I, 4993::I,_ + 4999::I, 5003::I, 5009::I, 5011::I, 5021::I, 5023::I,_ + 5039::I, 5051::I, 5059::I, 5077::I, 5081::I, 5087::I,_ + 5099::I, 5101::I, 5107::I, 5113::I, 5119::I, 5147::I,_ + 5153::I, 5167::I, 5171::I, 5179::I, 5189::I, 5197::I,_ + 5209::I, 5227::I, 5231::I, 5233::I, 5237::I, 5261::I,_ + 5273::I, 5279::I, 5281::I, 5297::I, 5303::I, 5309::I,_ + 5323::I, 5333::I, 5347::I, 5351::I, 5381::I, 5387::I,_ + 5393::I, 5399::I, 5407::I, 5413::I, 5417::I, 5419::I,_ + 5431::I, 5437::I, 5441::I, 5443::I, 5449::I, 5471::I,_ + 5477::I, 5479::I, 5483::I, 5501::I, 5503::I, 5507::I,_ + 5519::I, 5521::I, 5527::I, 5531::I, 5557::I, 5563::I,_ + 5569::I, 5573::I, 5581::I, 5591::I, 5623::I, 5639::I,_ + 5641::I, 5647::I, 5651::I, 5653::I, 5657::I, 5659::I,_ + 5669::I, 5683::I, 5689::I, 5693::I, 5701::I, 5711::I,_ + 5717::I, 5737::I, 5741::I, 5743::I, 5749::I, 5779::I,_ + 5783::I, 5791::I, 5801::I, 5807::I, 5813::I, 5821::I,_ + 5827::I, 5839::I, 5843::I, 5849::I, 5851::I, 5857::I,_ + 5861::I, 5867::I, 5869::I, 5879::I, 5881::I, 5897::I,_ + 5903::I, 5923::I, 5927::I, 5939::I, 5953::I, 5981::I,_ + 5987::I, 6007::I, 6011::I, 6029::I, 6037::I, 6043::I,_ + 6047::I, 6053::I, 6067::I, 6073::I, 6079::I, 6089::I,_ + 6091::I, 6101::I, 6113::I, 6121::I, 6131::I, 6133::I,_ + 6143::I, 6151::I, 6163::I, 6173::I, 6197::I, 6199::I,_ + 6203::I, 6211::I, 6217::I, 6221::I, 6229::I, 6247::I,_ + 6257::I, 6263::I, 6269::I, 6271::I, 6277::I, 6287::I,_ + 6299::I, 6301::I, 6311::I, 6317::I, 6323::I, 6329::I,_ + 6337::I, 6343::I, 6353::I, 6359::I, 6361::I, 6367::I,_ + 6373::I, 6379::I, 6389::I, 6397::I, 6421::I, 6427::I,_ + 6449::I, 6451::I, 6469::I, 6473::I, 6481::I, 6491::I,_ + 6521::I, 6529::I, 6547::I, 6551::I, 6553::I, 6563::I,_ + 6569::I, 6571::I, 6577::I, 6581::I, 6599::I, 6607::I,_ + 6619::I, 6637::I, 6653::I, 6659::I, 6661::I, 6673::I,_ + 6679::I, 6689::I, 6691::I, 6701::I, 6703::I, 6709::I,_ + 6719::I, 6733::I, 6737::I, 6761::I, 6763::I, 6779::I,_ + 6781::I, 6791::I, 6793::I, 6803::I, 6823::I, 6827::I,_ + 6829::I, 6833::I, 6841::I, 6857::I, 6863::I, 6869::I,_ + 6871::I, 6883::I, 6899::I, 6907::I, 6911::I, 6917::I,_ + 6947::I, 6949::I, 6959::I, 6961::I, 6967::I, 6971::I,_ + 6977::I, 6983::I, 6991::I, 6997::I, 7001::I, 7013::I,_ + 7019::I, 7027::I, 7039::I, 7043::I, 7057::I, 7069::I,_ + 7079::I, 7103::I, 7109::I, 7121::I, 7127::I, 7129::I,_ + 7151::I, 7159::I, 7177::I, 7187::I, 7193::I, 7207::I,_ + 7211::I, 7213::I, 7219::I, 7229::I, 7237::I, 7243::I,_ + 7247::I, 7253::I, 7283::I, 7297::I, 7307::I, 7309::I,_ + 7321::I, 7331::I, 7333::I, 7349::I, 7351::I, 7369::I,_ + 7393::I, 7411::I, 7417::I, 7433::I, 7451::I, 7457::I,_ + 7459::I, 7477::I, 7481::I, 7487::I, 7489::I, 7499::I,_ + 7507::I, 7517::I, 7523::I, 7529::I, 7537::I, 7541::I,_ + 7547::I, 7549::I, 7559::I, 7561::I, 7573::I, 7577::I,_ + 7583::I, 7589::I, 7591::I, 7603::I, 7607::I, 7621::I,_ + 7639::I, 7643::I, 7649::I, 7669::I, 7673::I, 7681::I,_ + 7687::I, 7691::I, 7699::I, 7703::I, 7717::I, 7723::I,_ + 7727::I, 7741::I, 7753::I, 7757::I, 7759::I, 7789::I,_ + 7793::I, 7817::I, 7823::I, 7829::I, 7841::I, 7853::I,_ + 7867::I, 7873::I, 7877::I, 7879::I, 7883::I, 7901::I,_ + 7907::I, 7919::I, 7927::I, 7933::I, 7937::I, 7949::I,_ + 7951::I, 7963::I, 7993::I, 8009::I, 8011::I, 8017::I,_ + 8039::I, 8053::I, 8059::I, 8069::I, 8081::I, 8087::I,_ + 8089::I, 8093::I, 8101::I, 8111::I, 8117::I, 8123::I,_ + 8147::I, 8161::I, 8167::I, 8171::I, 8179::I, 8191::I,_ + 8209::I, 8219::I, 8221::I, 8231::I, 8233::I, 8237::I,_ + 8243::I, 8263::I, 8269::I, 8273::I, 8287::I, 8291::I,_ + 8293::I, 8297::I, 8311::I, 8317::I, 8329::I, 8353::I,_ + 8363::I, 8369::I, 8377::I, 8387::I, 8389::I, 8419::I,_ + 8423::I, 8429::I, 8431::I, 8443::I, 8447::I, 8461::I,_ + 8467::I, 8501::I, 8513::I, 8521::I, 8527::I, 8537::I,_ + 8539::I, 8543::I, 8563::I, 8573::I, 8581::I, 8597::I,_ + 8599::I, 8609::I, 8623::I, 8627::I, 8629::I, 8641::I,_ + 8647::I, 8663::I, 8669::I, 8677::I, 8681::I, 8689::I,_ + 8693::I, 8699::I, 8707::I, 8713::I, 8719::I, 8731::I,_ + 8737::I, 8741::I, 8747::I, 8753::I, 8761::I, 8779::I,_ + 8783::I, 8803::I, 8807::I, 8819::I, 8821::I, 8831::I,_ + 8837::I, 8839::I, 8849::I, 8861::I, 8863::I, 8867::I,_ + 8887::I, 8893::I, 8923::I, 8929::I, 8933::I, 8941::I,_ + 8951::I, 8963::I, 8969::I, 8971::I, 8999::I, 9001::I,_ + 9007::I, 9011::I, 9013::I, 9029::I, 9041::I, 9043::I,_ + 9049::I, 9059::I, 9067::I, 9091::I, 9103::I, 9109::I,_ + 9127::I, 9133::I, 9137::I, 9151::I, 9157::I, 9161::I,_ + 9173::I, 9181::I, 9187::I, 9199::I, 9203::I, 9209::I,_ + 9221::I, 9227::I, 9239::I, 9241::I, 9257::I, 9277::I,_ + 9281::I, 9283::I, 9293::I, 9311::I, 9319::I, 9323::I,_ + 9337::I, 9341::I, 9343::I, 9349::I, 9371::I, 9377::I,_ + 9391::I, 9397::I, 9403::I, 9413::I, 9419::I, 9421::I,_ + 9431::I, 9433::I, 9437::I, 9439::I, 9461::I, 9463::I,_ + 9467::I, 9473::I, 9479::I, 9491::I, 9497::I, 9511::I,_ + 9521::I, 9533::I, 9539::I, 9547::I, 9551::I, 9587::I,_ + 9601::I, 9613::I, 9619::I, 9623::I, 9629::I, 9631::I,_ + 9643::I, 9649::I, 9661::I, 9677::I, 9679::I, 9689::I,_ + 9697::I, 9719::I, 9721::I, 9733::I, 9739::I, 9743::I,_ + 9749::I, 9767::I, 9769::I, 9781::I, 9787::I, 9791::I,_ + 9803::I, 9811::I, 9817::I, 9829::I, 9833::I, 9839::I,_ + 9851::I, 9857::I, 9859::I, 9871::I, 9883::I, 9887::I,_ + 9901::I, 9907::I, 9923::I, 9929::I, 9931::I, 9941::I,_ + 9949::I, 9967::I, 9973::I] + + productSmallPrimes := */smallPrimes + nextSmallPrime := 10007::I + nextSmallPrimeSquared := nextSmallPrime**2 + two := 2::I + tenPowerTwenty:=(10::I)**20 + PomeranceList:= [25326001::I, 161304001::I, 960946321::I, 1157839381::I, + -- 3215031751::I, -- has a factor of 151 + 3697278427::I, 5764643587::I, 6770862367::I, + 14386156093::I, 15579919981::I, 18459366157::I, + 19887974881::I, 21276028621::I ]::(List I) + PomeranceLimit:=27716349961::I -- replaces (25*10**9) due to Pinch + PinchList:= _ + [3215031751::I, 118670087467::I, 128282461501::I, 354864744877::I, + 546348519181::I, 602248359169::I, 669094855201::I ] + PinchLimit:= (10**12)::I + PinchList2:= [2152302898747::I, 3474749660383::I] + PinchLimit2:= (10**13)::I + JaeschkeLimit:=341550071728321::I + rootsMinus1:Set I := empty() + -- used to check whether we detect too many roots of -1 + count2Order:Vector NonNegativeInteger := new(1,0) + -- used to check whether we observe an element of maximal two-order + +@ +\subsection{primes} +<>= + primes(m, n) == + -- computes primes from m to n inclusive using prime? + l:List(I) := + m <= two => [two] + empty() + n < two or n < m => empty() + if even? m then m := m + 1 + ll:List(I) := [k::I for k in + convert(m)@Integer..convert(n)@Integer by 2 | prime?(k::I)] + reverse_! concat_!(ll, l) + + rabinProvesComposite : (I,I,I,I,NonNegativeInteger) -> Boolean + rabinProvesCompositeSmall : (I,I,I,I,NonNegativeInteger) -> Boolean + + +@ +\subsection{rabinProvesCompositeSmall} +<>= + rabinProvesCompositeSmall(p,n,nm1,q,k) == + -- probability n prime is > 3/4 for each iteration + -- for most n this probability is much greater than 3/4 + t := powmod(p, q, n) + -- neither of these cases tells us anything + if not ((t = 1) or t = nm1) then + for j in 1..k-1 repeat + oldt := t + t := mulmod(t, t, n) + (t = 1) => return true + -- we have squared someting not -1 and got 1 + t = nm1 => + leave + not (t = nm1) => return true + false + +@ +\subsection{rabinProvesComposite} +<>= + rabinProvesComposite(p,n,nm1,q,k) == + -- probability n prime is > 3/4 for each iteration + -- for most n this probability is much greater than 3/4 + t := powmod(p, q, n) + -- neither of these cases tells us anything + if t=nm1 then count2Order(1):=count2Order(1)+1 + if not ((t = 1) or t = nm1) then + for j in 1..k-1 repeat + oldt := t + t := mulmod(t, t, n) + (t = 1) => return true + -- we have squared someting not -1 and got 1 + t = nm1 => + rootsMinus1:=union(rootsMinus1,oldt) + count2Order(j+1):=count2Order(j+1)+1 + leave + not (t = nm1) => return true + # rootsMinus1 > 2 => true -- Z/nZ can't be a field + false + +@ +\subsection{prime?} +<>= + prime? n == + n < two => false + n < nextSmallPrime => member?(n, smallPrimes) + not (gcd(n, productSmallPrimes) = 1) => false + n < nextSmallPrimeSquared => true + + nm1 := n-1 + q := (nm1) quo two + for k in 1.. while not odd? q repeat q := q quo two + -- q = (n-1) quo 2**k for largest possible k + + n < JaeschkeLimit => + rabinProvesCompositeSmall(2::I,n,nm1,q,k) => return false + rabinProvesCompositeSmall(3::I,n,nm1,q,k) => return false + + n < PomeranceLimit => + rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false + member?(n,PomeranceList) => return false + true + + rabinProvesCompositeSmall(7::I,n,nm1,q,k) => return false + n < PinchLimit => + rabinProvesCompositeSmall(10::I,n,nm1,q,k) => return false + member?(n,PinchList) => return false + true + + rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false + rabinProvesCompositeSmall(11::I,n,nm1,q,k) => return false + n < PinchLimit2 => + member?(n,PinchList2) => return false + true + + rabinProvesCompositeSmall(13::I,n,nm1,q,k) => return false + rabinProvesCompositeSmall(17::I,n,nm1,q,k) => return false + true + + rootsMinus1:= empty() + count2Order := new(k,0) -- vector of k zeroes + + mn := minIndex smallPrimes + for i in mn+1..mn+10 repeat + rabinProvesComposite(smallPrimes i,n,nm1,q,k) => return false + import IntegerRoots(I) + q > 1 and perfectSquare?(3*n+1) => false + ((n9:=n rem (9::I))=1 or n9 = -1) and perfectSquare?(8*n+1) => false + -- Both previous tests from Damgard & Landrock + currPrime:=smallPrimes(mn+10) + probablySafe:=tenPowerTwenty + while count2Order(k) = 0 or n > probablySafe repeat + currPrime := nextPrime currPrime + probablySafe:=probablySafe*(100::I) + rabinProvesComposite(currPrime,n,nm1,q,k) => return false + true + +@ +\subsection{nextPrime} +<>= + nextPrime n == + -- computes the first prime after n + n < two => two + if odd? n then n := n + two else n := n + 1 + while not prime? n repeat n := n + two + n + +@ +\subsection{prevPrime} +<>= + prevPrime n == + -- computes the first prime before n + n < 3::I => error "no primes less than 2" + n = 3::I => two + if odd? n then n := n - two else n := n - 1 + while not prime? n repeat n := n - two + n + +@ +<>= +"PRIMES" [color="#FF4488",href="bookvol10.4.pdf#nameddest=PRIMES"] +"FSAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FSAGG"] +"PRIMES" -> "FSAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IROOT IntegerRoots} +\pagehead{IntegerRoots}{IROOT} +\pagepic{ps/v104integerroots.ps}{IROOT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IROOT IntegerRoots +++ Author: Michael Monagan +++ Date Created: November 1987 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: integer roots +++ Examples: +++ References: +++ Description: The \spadtype{IntegerRoots} package computes square roots and +++ nth roots of integers efficiently. +IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where + NNI ==> NonNegativeInteger + + Exports ==> with + perfectNthPower?: (I, NNI) -> Boolean + ++ \spad{perfectNthPower?(n,r)} returns true if n is an \spad{r}th + ++ power and false otherwise + perfectNthRoot: (I,NNI) -> Union(I,"failed") + ++ \spad{perfectNthRoot(n,r)} returns the \spad{r}th root of n if n + ++ is an \spad{r}th power and returns "failed" otherwise + perfectNthRoot: I -> Record(base:I, exponent:NNI) + ++ \spad{perfectNthRoot(n)} returns \spad{[x,r]}, where \spad{n = x\^r} + ++ and r is the largest integer such that n is a perfect \spad{r}th power + approxNthRoot: (I,NNI) -> I + ++ \spad{approxRoot(n,r)} returns an approximation x + ++ to \spad{n**(1/r)} such that \spad{-1 < x - n**(1/r) < 1} + perfectSquare?: I -> Boolean + ++ \spad{perfectSquare?(n)} returns true if n is a perfect square + ++ and false otherwise + perfectSqrt: I -> Union(I,"failed") + ++ \spad{perfectSqrt(n)} returns the square root of n if n is a + ++ perfect square and returns "failed" otherwise + approxSqrt: I -> I + ++ \spad{approxSqrt(n)} returns an approximation x + ++ to \spad{sqrt(n)} such that \spad{-1 < x - sqrt(n) < 1}. + ++ Compute an approximation s to \spad{sqrt(n)} such that + ++ \spad{-1 < s - sqrt(n) < 1} + ++ A variable precision Newton iteration is used. + ++ The running time is \spad{O( log(n)**2 )}. + + Implementation ==> add + import IntegerPrimesPackage(I) + + resMod144: List I := [0::I,1::I,4::I,9::I,16::I,25::I,36::I,49::I,_ + 52::I,64::I,73::I,81::I,97::I,100::I,112::I,121::I] + two := 2::I + +@ +\subsection{perfectSquare?} +<>= + perfectSquare? a == (perfectSqrt a) case I + +@ +\subsection{perfectNthPower?} +<>= + perfectNthPower?(b, n) == perfectNthRoot(b, n) case I + +@ +\subsection{perfectNthRoot} +<>= + perfectNthRoot n == -- complexity (log log n)**2 (log n)**2 + m:NNI + (n = 1) or zero? n or n = -1 => [n, 1] + e:NNI := 1 + p:NNI := 2 + while p::I <= length(n) + 1 repeat + for m in 0.. while (r := perfectNthRoot(n, p)) case I repeat + n := r::I + e := e * p ** m + p := convert(nextPrime(p::I))@Integer :: NNI + [n, e] + +@ +\subsection{approxNthRoot} +<>= + approxNthRoot(a, n) == -- complexity (log log n) (log n)**2 + zero? n => error "invalid arguments" + (n = 1) => a + n=2 => approxSqrt a + negative? a => + odd? n => - approxNthRoot(-a, n) + 0 + zero? a => 0 + (a = 1) => 1 + -- quick check for case of large n + ((3*n) quo 2)::I >= (l := length a) => two + -- the initial approximation must be >= the root + y := max(two, shift(1, (n::I+l-1) quo (n::I))) + z:I := 1 + n1:= (n-1)::NNI + while z > 0 repeat + x := y + xn:= x**n1 + y := (n1*x*xn+a) quo (n*xn) + z := x-y + x + +@ +\subsection{perfectNthRoot} +<>= + perfectNthRoot(b, n) == + (r := approxNthRoot(b, n)) ** n = b => r + "failed" + +@ +\subsection{perfectSqrt} +<>= + perfectSqrt a == + a < 0 or not member?(a rem (144::I), resMod144) => "failed" + (s := approxSqrt a) * s = a => s + "failed" + +@ +\subsection{approxSqrt} +<>= + approxSqrt a == + a < 1 => 0 + if (n := length a) > (100::I) then + -- variable precision newton iteration + n := n quo (4::I) + s := approxSqrt shift(a, -2 * n) + s := shift(s, n) + return ((1 + s + a quo s) quo two) + -- initial approximation for the root is within a factor of 2 + (new, old) := (shift(1, n quo two), 1) + while new ^= old repeat + (new, old) := ((1 + new + a quo new) quo two, new) + new + +@ +<>= +"IROOT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IROOT"] +"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"] +"IROOT" -> "FLAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTSLPE IntegerSolveLinearPolynomialEquation} +\pagehead{IntegerSolveLinearPolynomialEquation}{INTSLPE} +\pagepic{ps/v104integersolvelinearpolynomialequation.ps}{INTSLPE}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTSLPE IntegerSolveLinearPolynomialEquation +++ Author: Davenport +++ Date Created: 1991 +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package provides the implementation for the +++ \spadfun{solveLinearPolynomialEquation} +++ operation over the integers. It uses a lifting technique +++ from the package GenExEuclid +IntegerSolveLinearPolynomialEquation(): C ==T + where + ZP ==> SparseUnivariatePolynomial Integer + C == with + solveLinearPolynomialEquation: (List ZP,ZP) -> Union(List ZP,"failed") + ++ solveLinearPolynomialEquation([f1, ..., fn], g) + ++ (where the fi are relatively prime to each other) + ++ returns a list of ai such that + ++ \spad{g/prod fi = sum ai/fi} + ++ or returns "failed" if no such list of ai's exists. + T == add + oldlp:List ZP := [] + slpePrime:Integer:=(2::Integer) + oldtable:Vector List ZP := empty() + solveLinearPolynomialEquation(lp,p) == + if (oldlp ^= lp) then + -- we have to generate a new table + deg:= _+/[degree u for u in lp] + ans:Union(Vector List ZP,"failed"):="failed" + slpePrime:=2147483647::Integer -- 2**31 -1 : a prime + -- a good test case for this package is + -- ([x**31-1,x-2],2) + while (ans case "failed") repeat + ans:=tablePow(deg,slpePrime,lp)$GenExEuclid(Integer,ZP) + if (ans case "failed") then + slpePrime:= prevPrime(slpePrime)$IntegerPrimesPackage(Integer) + oldtable:=(ans:: Vector List ZP) + answer:=solveid(p,slpePrime,oldtable) + answer + +@ +<>= +"INTSLPE" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTSLPE"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INTSLPE" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IBATOOL IntegralBasisTools} +\pagehead{IntegralBasisTools}{IBATOOL} +\pagepic{ps/v104integralbasistools.ps}{IBATOOL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IBATOOL IntegralBasisTools +++ Functions common to both integral basis packages +++ Author: Victor Miller, Barry Trager, Clifton Williamson +++ Date Created: 11 April 1990 +++ Date Last Updated: 20 September 1994 +++ Keywords: integral basis, function field, number field +++ Examples: +++ References: +++ Description: +++ This package contains functions used in the packages +++ FunctionFieldIntegralBasis and NumberFieldIntegralBasis. + +IntegralBasisTools(R,UP,F): Exports == Implementation where + R : EuclideanDomain with + squareFree: $ -> Factored $ + ++ squareFree(x) returns a square-free factorisation of x + UP : UnivariatePolynomialCategory R + F : FramedAlgebra(R,UP) + Mat ==> Matrix R + NNI ==> NonNegativeInteger + Ans ==> Record(basis: Mat, basisDen: R, basisInv:Mat) + + Exports ==> with + + diagonalProduct: Mat -> R + ++ diagonalProduct(m) returns the product of the elements on the + ++ diagonal of the matrix m + matrixGcd: (Mat,R,NNI) -> R + ++ matrixGcd(mat,sing,n) is \spad{gcd(sing,g)} where \spad{g} is the + ++ gcd of the entries of the \spad{n}-by-\spad{n} upper-triangular + ++ matrix \spad{mat}. + divideIfCan_!: (Matrix R,Matrix R,R,Integer) -> R + ++ divideIfCan!(matrix,matrixOut,prime,n) attempts to divide the + ++ entries of \spad{matrix} by \spad{prime} and store the result in + ++ \spad{matrixOut}. If it is successful, 1 is returned and if not, + ++ \spad{prime} is returned. Here both \spad{matrix} and + ++ \spad{matrixOut} are \spad{n}-by-\spad{n} upper triangular matrices. + leastPower: (NNI,NNI) -> NNI + ++ leastPower(p,n) returns e, where e is the smallest integer + ++ such that \spad{p **e >= n} + idealiser: (Mat,Mat) -> Mat + ++ idealiser(m1,m2) computes the order of an ideal defined by m1 and m2 + idealiser: (Mat,Mat,R) -> Mat + ++ idealiser(m1,m2,d) computes the order of an ideal defined by m1 and m2 + ++ where d is the known part of the denominator + idealiserMatrix: (Mat, Mat) -> Mat + ++ idealiserMatrix(m1, m2) returns the matrix representing the linear + ++ conditions on the Ring associatied with an ideal defined by m1 and m2. + moduleSum: (Ans,Ans) -> Ans + ++ moduleSum(m1,m2) returns the sum of two modules in the framed + ++ algebra \spad{F}. Each module \spad{mi} is represented as follows: + ++ F is a framed algebra with R-module basis \spad{w1,w2,...,wn} and + ++ \spad{mi} is a record \spad{[basis,basisDen,basisInv]}. If + ++ \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ a basis \spad{v1,...,vn} for \spad{mi} is given by + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of 'basis' contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + + Implementation ==> add + import ModularHermitianRowReduction(R) + import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) + + diagonalProduct m == + ans : R := 1 + for i in minRowIndex m .. maxRowIndex m + for j in minColIndex m .. maxColIndex m repeat + ans := ans * qelt(m, i, j) + ans + + matrixGcd(mat,sing,n) == + -- note: 'matrix' is upper triangular; + -- no need to do anything below the diagonal + d := sing + for i in 1..n repeat + for j in i..n repeat + if not zero?(mij := qelt(mat,i,j)) then d := gcd(d,mij) +-- one? d => return d + (d = 1) => return d + d + + divideIfCan_!(matrix,matrixOut,prime,n) == + -- note: both 'matrix' and 'matrixOut' will be upper triangular; + -- no need to do anything below the diagonal + for i in 1..n repeat + for j in i..n repeat + (a := (qelt(matrix,i,j) exquo prime)) case "failed" => return prime + qsetelt_!(matrixOut,i,j,a :: R) + 1 + + leastPower(p,n) == + -- efficiency is not an issue here + e : NNI := 1; q := p + while q < n repeat (e := e + 1; q := q * p) + e + + idealiserMatrix(ideal,idealinv) == + -- computes the Order of the ideal + n := rank()$F + bigm := zero(n * n,n)$Mat + mr := minRowIndex bigm; mc := minColIndex bigm + v := basis()$F + for i in 0..n-1 repeat + r := regularRepresentation qelt(v,i + minIndex v) + m := ideal * r * idealinv + for j in 0..n-1 repeat + for k in 0..n-1 repeat + bigm(j * n + k + mr,i + mc) := qelt(m,j + mr,k + mc) + bigm + + idealiser(ideal,idealinv) == + bigm := idealiserMatrix(ideal, idealinv) + transpose squareTop rowEch bigm + + idealiser(ideal,idealinv,denom) == + bigm := (idealiserMatrix(ideal, idealinv) exquo denom)::Mat + transpose squareTop rowEchelon(bigm,denom) + + moduleSum(mod1,mod2) == + rb1 := mod1.basis; rbden1 := mod1.basisDen; rbinv1 := mod1.basisInv + rb2 := mod2.basis; rbden2 := mod2.basisDen; rbinv2 := mod2.basisInv + -- compatibility check: doesn't take much computation time + (not square? rb1) or (not square? rbinv1) or (not square? rb2) _ + or (not square? rbinv2) => + error "moduleSum: matrices must be square" + ((n := nrows rb1) ^= (nrows rbinv1)) or (n ^= (nrows rb2)) _ + or (n ^= (nrows rbinv2)) => + error "moduleSum: matrices of imcompatible dimensions" + (zero? rbden1) or (zero? rbden2) => + error "moduleSum: denominator must be non-zero" + den := lcm(rbden1,rbden2); c1 := den quo rbden1; c2 := den quo rbden2 + rb := squareTop rowEchelon(vertConcat(c1 * rb1,c2 * rb2),den) + rbinv := UpTriBddDenomInv(rb,den) + [rb,den,rbinv] + +@ +<>= +"IBATOOL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IBATOOL"] +"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"] +"IBATOOL" -> "FRAMALG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IR2 IntegrationResultFunctions2} +\pagehead{IntegrationResultFunctions2}{IR2} +\pagepic{ps/v104integrationresultfunctions2.ps}{IR2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IR2 IntegrationResultFunctions2 +++ Internally used by the integration packages +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 12 August 1992 +++ Keywords: integration. +IntegrationResultFunctions2(E, F): Exports == Implementation where + E : Field + F : Field + + SE ==> Symbol + Q ==> Fraction Integer + IRE ==> IntegrationResult E + IRF ==> IntegrationResult F + UPE ==> SparseUnivariatePolynomial E + UPF ==> SparseUnivariatePolynomial F + NEE ==> Record(integrand:E, intvar:E) + NEF ==> Record(integrand:F, intvar:F) + LGE ==> Record(scalar:Q, coeff:UPE, logand:UPE) + LGF ==> Record(scalar:Q, coeff:UPF, logand:UPF) + NLE ==> Record(coeff:E, logand:E) + NLF ==> Record(coeff:F, logand:F) + UFE ==> Union(Record(mainpart:E, limitedlogs:List NLE), "failed") + URE ==> Union(Record(ratpart:E, coeff:E), "failed") + UE ==> Union(E, "failed") + + Exports ==> with + map: (E -> F, IRE) -> IRF + ++ map(f,ire) \undocumented + map: (E -> F, URE) -> Union(Record(ratpart:F, coeff:F), "failed") + ++ map(f,ure) \undocumented + map: (E -> F, UE) -> Union(F, "failed") + ++ map(f,ue) \undocumented + map: (E -> F, UFE) -> + Union(Record(mainpart:F, limitedlogs:List NLF), "failed") + ++ map(f,ufe) \undocumented + + Implementation ==> add + import SparseUnivariatePolynomialFunctions2(E, F) + + NEE2F: (E -> F, NEE) -> NEF + LGE2F: (E -> F, LGE) -> LGF + NLE2F: (E -> F, NLE) -> NLF + + NLE2F(func, r) == [func(r.coeff), func(r.logand)] + NEE2F(func, n) == [func(n.integrand), func(n.intvar)] + map(func:E -> F, u:UE) == (u case "failed" => "failed"; func(u::E)) + + map(func:E -> F, ir:IRE) == + mkAnswer(func ratpart ir, [LGE2F(func, f) for f in logpart ir], + [NEE2F(func, g) for g in notelem ir]) + + map(func:E -> F, u:URE) == + u case "failed" => "failed" + [func(u.ratpart), func(u.coeff)] + + map(func:E -> F, u:UFE) == + u case "failed" => "failed" + [func(u.mainpart), [NLE2F(func, f) for f in u.limitedlogs]] + + LGE2F(func, lg) == + [lg.scalar, map(func, lg.coeff), map(func, lg.logand)] + +@ +<>= +"IR2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IR2"] +"FIELD" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FIELD"] +"IR2" -> "FIELD" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IRRF2F IntegrationResultRFToFunction} +\pagehead{IntegrationResultRFToFunction}{IRRF2F} +\pagepic{ps/v104integrationresultrftofunction.ps}{IRRF2F}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IRRF2F IntegrationResultRFToFunction +++ Conversion of integration results to top-level expressions +++ Author: Manuel Bronstein +++ Description: +++ This package allows a sum of logs over the roots of a polynomial +++ to be expressed as explicit logarithms and arc tangents, provided +++ that the indexing polynomial can be factored into quadratics. +++ Date Created: 21 August 1988 +++ Date Last Updated: 4 October 1993 +IntegrationResultRFToFunction(R): Exports == Implementation where + R: Join(GcdDomain, RetractableTo Integer, OrderedSet, + LinearlyExplicitRingOver Integer) + + RF ==> Fraction Polynomial R + F ==> Expression R + IR ==> IntegrationResult RF + + Exports ==> with + split : IR -> IR + ++ split(u(x) + sum_{P(a)=0} Q(a,x)) returns + ++ \spad{u(x) + sum_{P1(a)=0} Q(a,x) + ... + sum_{Pn(a)=0} Q(a,x)} + ++ where P1,...,Pn are the factors of P. + expand : IR -> List F + ++ expand(i) returns the list of possible real functions + ++ corresponding to i. + complexExpand : IR -> F + ++ complexExpand(i) returns the expanded complex function + ++ corresponding to i. + if R has CharacteristicZero then + integrate : (RF, Symbol) -> Union(F, List F) + ++ integrate(f, x) returns the integral of \spad{f(x)dx} + ++ where x is viewed as a real variable.. + complexIntegrate: (RF, Symbol) -> F + ++ complexIntegrate(f, x) returns the integral of \spad{f(x)dx} + ++ where x is viewed as a complex variable. + + Implementation ==> add + import IntegrationTools(R, F) + import TrigonometricManipulations(R, F) + import IntegrationResultToFunction(R, F) + + toEF: IR -> IntegrationResult F + + toEF i == map(#1::F, i)$IntegrationResultFunctions2(RF, F) + expand i == expand toEF i + complexExpand i == complexExpand toEF i + + split i == + map(retract, split toEF i)$IntegrationResultFunctions2(F, RF) + + if R has CharacteristicZero then + import RationalFunctionIntegration(R) + + complexIntegrate(f, x) == complexExpand internalIntegrate(f, x) + +-- do not use real integration if R is complex + if R has imaginary: () -> R then integrate(f, x) == complexIntegrate(f, x) + else + integrate(f, x) == + l := [mkPrim(real g, x) for g in expand internalIntegrate(f, x)] + empty? rest l => first l + l + +@ +<>= +"IRRF2F" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IRRF2F"] +"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"] +"IRRF2F" -> "ACFS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IR2F IntegrationResultToFunction} +\pagehead{IntegrationResultToFunction}{IR2F} +\pagepic{ps/v104integrationresulttofunction.ps}{IR2F}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IR2F IntegrationResultToFunction +++ Conversion of integration results to top-level expressions +++ Author: Manuel Bronstein +++ Date Created: 4 February 1988 +++ Date Last Updated: 9 October 1991 +++ Description: +++ This package allows a sum of logs over the roots of a polynomial +++ to be expressed as explicit logarithms and arc tangents, provided +++ that the indexing polynomial can be factored into quadratics. +++ Keywords: integration, expansion, function. +IntegrationResultToFunction(R, F): Exports == Implementation where + R: Join(GcdDomain, RetractableTo Integer, OrderedSet, + LinearlyExplicitRingOver Integer) + F: Join(AlgebraicallyClosedFunctionSpace R, + TranscendentalFunctionCategory) + + N ==> NonNegativeInteger + Z ==> Integer + Q ==> Fraction Z + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + IR ==> IntegrationResult F + REC ==> Record(ans1:F, ans2:F) + LOG ==> Record(scalar:Q, coeff:UP, logand:UP) + + Exports ==> with + split : IR -> IR + ++ split(u(x) + sum_{P(a)=0} Q(a,x)) returns + ++ \spad{u(x) + sum_{P1(a)=0} Q(a,x) + ... + sum_{Pn(a)=0} Q(a,x)} + ++ where P1,...,Pn are the factors of P. + expand : IR -> List F + ++ expand(i) returns the list of possible real functions + ++ corresponding to i. + complexExpand: IR -> F + ++ complexExpand(i) returns the expanded complex function + ++ corresponding to i. + + Implementation ==> add + import AlgebraicManipulations(R, F) + import ElementaryFunctionSign(R, F) + + IR2F : IR -> F + insqrt : F -> Record(sqrt:REC, sgn:Z) + pairsum : (List F, List F) -> List F + pairprod : (F, List F) -> List F + quadeval : (UP, F, F, F) -> REC + linear : (UP, UP) -> F + tantrick : (F, F) -> F + ilog : (F, F, List K) -> F + ilog0 : (F, F, UP, UP, F) -> F + nlogs : LOG -> List LOG + lg2func : LOG -> List F + quadratic : (UP, UP) -> List F + mkRealFunc : List LOG -> List F + lg2cfunc : LOG -> F + loglist : (Q, UP, UP) -> List LOG + cmplex : (F, UP) -> F + evenRoots : F -> List F + compatible?: (List F, List F) -> Boolean + + cmplex(alpha, p) == alpha * log p alpha + IR2F i == retract mkAnswer(ratpart i, empty(), notelem i) + pairprod(x, l) == [x * y for y in l] + + evenRoots x == + [first argument k for k in tower x | + is?(k,"nthRoot"::Symbol) and even?(retract(second argument k)@Z) + and (not empty? variables first argument k)] + + expand i == + j := split i + pairsum([IR2F j], mkRealFunc logpart j) + + split i == + mkAnswer(ratpart i,concat [nlogs l for l in logpart i],notelem i) + + complexExpand i == + j := split i + IR2F j + +/[lg.scalar::F * lg2cfunc lg for lg in logpart j] + +-- p = a t^2 + b t + c +-- Expands sum_{p(t) = 0} t log(lg(t)) + quadratic(p, lg) == + zero?(delta := (b := coefficient(p, 1))**2 - 4 * + (a := coefficient(p,2)) * (p0 := coefficient(p, 0))) => + [linear(monomial(1, 1) + (b / a)::UP, lg)] + e := (q := quadeval(lg, c := - b * (d := inv(2*a)),d, delta)).ans1 + lgp := c * log(nrm := (e**2 - delta * (f := q.ans2)**2)) + s := (sqr := insqrt delta).sqrt + pp := nn := 0$F + if sqr.sgn >= 0 then + sqrp := s.ans1 * rootSimp sqrt(s.ans2) + pp := lgp + d * sqrp * log(((2 * e * f) / nrm) * sqrp + + (e**2 + delta * f**2) / nrm) + if sqr.sgn <= 0 then + sqrn := s.ans1 * rootSimp sqrt(-s.ans2) + nn := lgp + d * sqrn * ilog(e, f * sqrn, + setUnion(setUnion(kernels a, kernels b), kernels p0)) + sqr.sgn > 0 => [pp] + sqr.sgn < 0 => [nn] + [pp, nn] + +-- returns 2 atan(a/b) or 2 atan(-b/a) whichever looks better +-- they differ by a constant so it's ok to do it from an IR + tantrick(a, b) == + retractIfCan(a)@Union(Q, "failed") case Q => 2 * atan(-b/a) + 2 * atan(a/b) + +-- transforms i log((a + i b) / (a - i b)) into a sum of real +-- arc-tangents using Rioboo's algorithm +-- lk is a list of kernels which are parameters for the integral + ilog(a, b, lk) == + l := setDifference(setUnion(variables numer a, variables numer b), + setUnion(lk, setUnion(variables denom a, variables denom b))) + empty? l => tantrick(a, b) + k := "max"/l + ilog0(a, b, numer univariate(a, k), numer univariate(b, k), k::F) + +-- transforms i log((a + i b) / (a - i b)) into a sum of real +-- arc-tangents using Rioboo's algorithm +-- the arc-tangents will not have k in the denominator +-- we always keep upa(k) = a and upb(k) = b + ilog0(a, b, upa, upb, k) == + if degree(upa) < degree(upb) then + (upa, upb) := (-upb, upa) + (a, b) := (-b, a) + zero? degree upb => tantrick(a, b) + r := extendedEuclidean(upa, upb) + (g:= retractIfCan(r.generator)@Union(F,"failed")) case "failed" => + tantrick(a, b) + if degree(r.coef1) >= degree upb then + qr := divide(r.coef1, upb) + r.coef1 := qr.remainder + r.coef2 := r.coef2 + qr.quotient * upa + aa := (r.coef2) k + bb := -(r.coef1) k + tantrick(aa * a + bb * b, g::F) + ilog0(aa,bb,r.coef2,-r.coef1,k) + + lg2func lg == + zero?(d := degree(p := lg.coeff)) => error "poly has degree 0" +-- one? d => [linear(p, lg.logand)] + (d = 1) => [linear(p, lg.logand)] + d = 2 => quadratic(p, lg.logand) + odd? d and + ((r := retractIfCan(reductum p)@Union(F, "failed")) case F) => + pairsum([cmplex(alpha := rootSimp zeroOf p, lg.logand)], + lg2func [lg.scalar, + (p exquo (monomial(1, 1)$UP - alpha::UP))::UP, + lg.logand]) + [lg2cfunc lg] + + lg2cfunc lg == + +/[cmplex(alpha, lg.logand) for alpha in zerosOf(lg.coeff)] + + mkRealFunc l == + ans := empty()$List(F) + for lg in l repeat + ans := pairsum(ans, pairprod(lg.scalar::F, lg2func lg)) + ans + +-- returns a log(b) + linear(p, lg) == + alpha := - coefficient(p, 0) / coefficient(p, 1) + alpha * log lg alpha + +-- returns (c, d) s.t. p(a + b t) = c + d t, where t^2 = delta + quadeval(p, a, b, delta) == + zero? p => [0, 0] + bi := c := d := 0$F + ai := 1$F + v := vectorise(p, 1 + degree p) + for i in minIndex v .. maxIndex v repeat + c := c + qelt(v, i) * ai + d := d + qelt(v, i) * bi + temp := a * ai + b * bi * delta + bi := a * bi + b * ai + ai := temp + [c, d] + + compatible?(lx, ly) == + empty? ly => true + for x in lx repeat + for y in ly repeat + ((s := sign(x*y)) case Z) and (s::Z < 0) => return false + true + + pairsum(lx, ly) == + empty? lx => ly + empty? ly => lx + l := empty()$List(F) + for x in lx repeat + ls := evenRoots x + if not empty?(ln := + [x + y for y in ly | compatible?(ls, evenRoots y)]) then + l := removeDuplicates concat(l, ln) + l + +-- returns [[a, b], s] where sqrt(y) = a sqrt(b) and +-- s = 1 if b > 0, -1 if b < 0, 0 if the sign of b cannot be determined + insqrt y == + rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F) +-- one?(rec.exponent) => [[rec.coef * rec.radicand, 1], 1] + ((rec.exponent) = 1) => [[rec.coef * rec.radicand, 1], 1] + rec.exponent ^=2 => error "Should not happen" + [[rec.coef, rec.radicand], + ((s := sign(rec.radicand)) case "failed" => 0; s::Z)] + + nlogs lg == + [[f.exponent * lg.scalar, f.factor, lg.logand] for f in factors + ffactor(primitivePart(lg.coeff) + )$FunctionSpaceUnivariatePolynomialFactor(R, F, UP)] + +@ +<>= +"IR2F" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IR2F"] +"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"] +"IR2F" -> "ACFS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package IRREDFFX IrredPolyOverFiniteField} \pagehead{IrredPolyOverFiniteField}{IRREDFFX} \pagepic{ps/v104irredpolyoverfinitefield.ps}{IRREDFFX}{1.00} @@ -23078,11 +31140,475 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package IRSN IrrRepSymNatPackage} +\pagehead{IrrRepSymNatPackage}{IRSN} +\pagepic{ps/v104irrrepsymnatpackage.ps}{IRSN}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package IRSN IrrRepSymNatPackage +++ Authors: Johannes Grabmeier, Thorsten Werther +++ Date Created: 04 August 1988 +++ Date Last Updated: 24 May 1991 +++ Basic Operations: dimensionOfIrreducibleRepresentation +++ irreducibleRepresentation +++ Related Constructors: RepresentationTheoryPackage1 +++ RepresentationTheoryPackage2 +++ Also See: SymmetricGroupCombinatoricFunctions +++ AMS Classifications: +++ Keywords: +++ References: +++ G. James, A. Kerber: The Representation Theory of the Symmetric +++ Group. Encycl. of Math. and its Appl. Vol 16., Cambr. Univ Press 1981; +++ J. Grabmeier, A. Kerber: The Evaluation of Irreducible +++ Polynomial Representations of the General Linear Groups +++ and of the Unitary Groups over Fields of Characteristic 0, +++ Acta Appl. Math. 8 (1987), 271-291; +++ H. Gollan, J. Grabmeier: Algorithms in Representation Theory and +++ their Realization in the Computer Algebra System Scratchpad, +++ Bayreuther Mathematische Schriften, Heft 33, 1990, 1-23 +++ Description: +++ IrrRepSymNatPackage contains functions for computing +++ the ordinary irreducible representations of symmetric groups on +++ n letters {\em {1,2,...,n}} in Young's natural form and their dimensions. +++ These representations can be labelled by number partitions of n, +++ i.e. a weakly decreasing sequence of integers summing up to n, e.g. +++ {\em [3,3,3,1]} labels an irreducible representation for n equals 10. +++ Note: whenever a \spadtype{List Integer} appears in a signature, +++ a partition required. +-- NOT TRUE in current system, but should: +-- also could be an element of \spadtype(Partition) + +IrrRepSymNatPackage(): public == private where + NNI ==> NonNegativeInteger + I ==> Integer + L ==> List + M ==> Matrix + V ==> Vector + B ==> Boolean + SGCF ==> SymmetricGroupCombinatoricFunctions + ICF ==> IntegerCombinatoricFunctions Integer + PP ==> PartitionsAndPermutations + PERM ==> Permutation + + public ==> with + + dimensionOfIrreducibleRepresentation : L I -> NNI + ++ dimensionOfIrreducibleRepresentation(lambda) is the dimension + ++ of the ordinary irreducible representation of the symmetric group + ++ corresponding to {\em lambda}. + ++ Note: the Robinson-Thrall hook formula is implemented. + irreducibleRepresentation : (L I, PERM I) -> M I + ++ irreducibleRepresentation(lambda,pi) is the irreducible representation + ++ corresponding to partition {\em lambda} in Young's natural form of the + ++ permutation {\em pi} in the symmetric group, whose elements permute + ++ {\em {1,2,...,n}}. + irreducibleRepresentation : L I -> L M I + ++ irreducibleRepresentation(lambda) is the list of the two + ++ irreducible representations corresponding to the partition {\em lambda} + ++ in Young's natural form for the following two generators + ++ of the symmetric group, whose elements permute + ++ {\em {1,2,...,n}}, namely {\em (1 2)} (2-cycle) and + ++ {\em (1 2 ... n)} (n-cycle). + irreducibleRepresentation : (L I, L PERM I) -> L M I + ++ irreducibleRepresentation(lambda,listOfPerm) is the list of the + ++ irreducible representations corresponding to {\em lambda} + ++ in Young's natural form for the list of permutations + ++ given by {\em listOfPerm}. + + private ==> add + + -- local variables + oldlambda : L I := nil$(L I) + flambda : NNI := 0 -- dimension of the irreducible repr. + younglist : L M I := nil$(L M I) -- list of all standard tableaus + lprime : L I := nil$(L I) -- conjugated partition of lambda + n : NNI := 0 -- concerning symmetric group S_n + rows : NNI := 0 -- # of rows of standard tableau + columns : NNI := 0 -- # of columns of standard tableau + aId : M I := new(1,1,0) + + -- declaration of local functions + + aIdInverse : () -> Void + -- computes aId, the inverse of the matrix + -- (signum(k,l,id))_1 <= k,l <= flambda, where id + -- denotes the identity permutation + + alreadyComputed? : L I -> Void + -- test if the last calling of an exported function concerns + -- the same partition lambda as the previous call + + listPermutation : PERM I -> L I -- should be in Permutation + -- converts a permutation pi into the list + -- [pi(1),pi(2),..,pi(n)] + + signum : (NNI, NNI, L I) -> I + -- if there exists a vertical permutation v of the tableau + -- tl := pi o younglist(l) (l-th standard tableau) + -- and a horizontal permutation h of the tableau + -- tk := younglist(k) (k-th standard tableau) such that + -- v o tl = h o tk, + -- then + -- signum(k,l,pi) = sign(v), + -- otherwise + -- signum(k,l,pi) = 0. + + sumPartition : L I -> NNI + -- checks if lambda is a proper partition and results in + -- the sum of the entries + + testPermutation : L I -> NNI + -- testPermutation(pi) checks if pi is an element of S_n, + -- the set of permutations of the set {1,2,...,n}. + -- If not, an error message will occur, if yes it replies n. + + + -- definition of local functions + + + aIdInverse() == + + aId := new(flambda,flambda,0) + for k in 1..flambda repeat + aId(k,k) := 1 + if n < 5 then return aId + + idperm : L I := nil$(L I) + for k in n..1 by -1 repeat + idperm := cons(k,idperm) + for k in 1..(flambda-1) repeat + for l in (k+1)..flambda repeat + aId(k::NNI,l::NNI) := signum(k::NNI,l::NNI,idperm) + + -- invert the upper triangular matrix aId + for j in flambda..2 by -1 repeat + for i in (j-1)..1 by -1 repeat + aId(i::NNI,j:NNI) := -aId(i::NNI,j::NNI) + for k in (j+1)..flambda repeat + for i in (j-1)..1 by -1 repeat + aId(i::NNI,k:NNI) := aId(i::NNI,k::NNI) + + aId(i::NNI,j:NNI) * aId(j::NNI,k::NNI) + + + alreadyComputed?(lambda) == + if not(lambda = oldlambda) then + oldlambda := lambda + lprime := conjugate(lambda)$PP + rows := (first(lprime)$(L I))::NNI + columns := (first(lambda)$(L I))::NNI + n := (+/lambda)::NNI + younglist := listYoungTableaus(lambda)$SGCF + flambda := #younglist + aIdInverse() -- side effect: creates actual aId + + listPermutation(pi) == + li : L I := nil$(L I) + for k in n..1 by -1 repeat + li := cons(eval(pi,k)$(PERM I),li) + li + + signum(numberOfRowTableau, numberOfColumnTableau,pi) == + + rowtab : M I := copy younglist numberOfRowTableau + columntab : M I := copy younglist numberOfColumnTableau + swap : I + sign : I := 1 + end : B := false + endk : B + ctrl : B + + -- k-loop for all rows of tableau rowtab + k : NNI := 1 + while (k <= rows) and (not end) repeat + -- l-loop along the k-th row of rowtab + l : NNI := 1 + while (l <= oldlambda(k)) and (not end) repeat + z : NNI := l + endk := false + -- z-loop for k-th row of rowtab beginning at column l. + -- test wether the entry rowtab(k,z) occurs in the l-th column + -- beginning at row k of pi o columntab + while (z <= oldlambda(k)) and (not endk) repeat + s : NNI := k + ctrl := true + while ctrl repeat + if (s <= lprime(l)) + then + if (1+rowtab(k,z) = pi(1+columntab(s,l))) + -- if entries in the tableaus were from 1,..,n, then + -- it should be ..columntab(s,l)... . + then ctrl := false + else s := s + 1 + else ctrl := false + -- end of ctrl-loop + endk := (s <= lprime(l)) -- same entry found ? + if not endk + then -- try next entry + z := z + 1 + else + if k < s + then -- verticalpermutation + sign := -sign + swap := columntab(s,l) + columntab(s,l) := columntab(k,l) + columntab(k,l) := swap + if l < z + then -- horizontalpermutation + swap := rowtab(k,z) + rowtab(k,z) := rowtab(k,l) + rowtab(k,l) := swap + -- end of else + -- end of z-loop + if (z > oldlambda(k)) -- no coresponding entry found + then + sign := 0 + end := true + l := l + 1 + -- end of l-loop + k := k + 1 + -- end of k-loop + + sign + + + sumPartition(lambda) == + ok : B := true + prev : I := first lambda + sum : I := 0 + for x in lambda repeat + sum := sum + x + ok := ok and (prev >= x) + prev := x + if not ok then + error("No proper partition ") + sum::NNI + + + testPermutation(pi : L I) : NNI == + ok : B := true + n : I := 0 + for i in pi repeat + if i > n then n := i -- find the largest entry n in pi + if i < 1 then ok := false -- check whether there are entries < 1 + -- now n should be the number of permuted objects + if (not (n=#pi)) or (not ok) then + error("No permutation of 1,2,..,n") + -- now we know that pi has n Elements ranging from 1 to n + test : Vector(B) := new((n)::NNI,false) + for i in pi repeat + test(i) := true -- this means that i occurs in pi + if member?(false,test) then error("No permutation") -- pi not surjective + n::NNI + + + -- definitions of exported functions + + + dimensionOfIrreducibleRepresentation(lambda) == + nn : I := sumPartition(lambda)::I --also checks whether lambda + dd : I := 1 --is a partition + lambdaprime : L I := conjugate(lambda)$PP + -- run through all rows of the Youngtableau corr. to lambda + for i in 1..lambdaprime.1 repeat + -- run through all nodes in row i of the Youngtableau + for j in 1..lambda.i repeat + -- the hooklength of node (i,j) of the Youngtableau + -- is the new factor, remember counting starts with 1 + dd := dd * (lambda.i + lambdaprime.j - i - j + 1) + (factorial(nn)$ICF quo dd)::NNI + + + irreducibleRepresentation(lambda:(L I),pi:(PERM I)) == + nn : NNI := sumPartition(lambda) + alreadyComputed?(lambda) + piList : L I := listPermutation pi + if not (nn = testPermutation(piList)) then + error("Partition and permutation are not consistent") + aPi : M I := new(flambda,flambda,0) + for k in 1..flambda repeat + for l in 1..flambda repeat + aPi(k,l) := signum(k,l,piList) + aId * aPi + + + irreducibleRepresentation(lambda) == + listperm : L PERM I := nil$(L PERM I) + li : L I := nil$(L I) + sumPartition(lambda) + alreadyComputed?(lambda) + listperm := + n = 1 => cons(1$(PERM I),listperm) + n = 2 => cons(cycle([1,2])$(PERM I),listperm) + -- the n-cycle (1,2,..,n) and the 2-cycle (1,2) generate S_n + for k in n..1 by -1 repeat + li := cons(k,li) -- becomes n-cycle (1,2,..,n) + listperm := cons(cycle(li)$(PERM I),listperm) + -- 2-cycle (1,2) + cons(cycle([1,2])$(PERM I),listperm) + irreducibleRepresentation(lambda,listperm) + + + irreducibleRepresentation(lambda:(L I),listperm:(L PERM I)) == + sumPartition(lambda) + alreadyComputed?(lambda) + [irreducibleRepresentation(lambda, pi) for pi in listperm] + +@ +<>= +"IRSN" [color="#FF4488",href="bookvol10.4.pdf#nameddest=IRSN"] +"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"] +"IRSN" -> "IVECTOR" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter J} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter K} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package KERNEL2 KernelFunctions2} +\pagehead{KernelFunctions2}{KERNEL2} +\pagepic{ps/v104kernelfunctions2.ps}{KERNEL2}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package KERNEL2 KernelFunctions2 +++ Description: +++ This package exports some auxiliary functions on kernels +KernelFunctions2(R:OrderedSet, S:OrderedSet): with + constantKernel: R -> Kernel S + ++ constantKernel(r) \undocumented + constantIfCan : Kernel S -> Union(R, "failed") + ++ constantIfCan(k) \undocumented + + == add + import BasicOperatorFunctions1(R) + + constantKernel r == kernel(constantOperator r, nil(), 1) + constantIfCan k == constantOpIfCan operator k + +@ +<>= +"KERNEL2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=KERNEL2"] +"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"] +"KERNEL2" -> "ORDSET" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package KOVACIC Kovacic} +\pagehead{Kovacic}{KOVACIC} +\pagepic{ps/v104kovacic.ps}{KOVACIC}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package KOVACIC Kovacic +++ Author: Manuel Bronstein +++ Date Created: 14 January 1992 +++ Date Last Updated: 3 February 1994 +++ Description: +++ \spadtype{Kovacic} provides a modified Kovacic's algorithm for +++ solving explicitely irreducible 2nd order linear ordinary +++ differential equations. +++ Keywords: differential equation, ODE +Kovacic(F, UP): Exports == Impl where + F : Join(CharacteristicZero, AlgebraicallyClosedField, + RetractableTo Integer, RetractableTo Fraction Integer) + UP : UnivariatePolynomialCategory F + + RF ==> Fraction UP + SUP ==> SparseUnivariatePolynomial RF + LF ==> List Record(factor:UP, exponent:Integer) + LODO==> LinearOrdinaryDifferentialOperator1 RF + + Exports ==> with + kovacic: (RF, RF, RF) -> Union(SUP, "failed") + ++ kovacic(a_0,a_1,a_2) returns either "failed" or P(u) such that + ++ \spad{$e^{\int(-a_1/2a_2)} e^{\int u}$} is a solution of + ++ \spad{a_2 y'' + a_1 y' + a0 y = 0} + ++ whenever \spad{u} is a solution of \spad{P u = 0}. + ++ The equation must be already irreducible over the rational functions. + kovacic: (RF, RF, RF, UP -> Factored UP) -> Union(SUP, "failed") + ++ kovacic(a_0,a_1,a_2,ezfactor) returns either "failed" or P(u) such + ++ that \spad{$e^{\int(-a_1/2a_2)} e^{\int u}$} is a solution of + ++ \spad{$a_2 y'' + a_1 y' + a0 y = 0$} + ++ whenever \spad{u} is a solution of \spad{P u = 0}. + ++ The equation must be already irreducible over the rational functions. + ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, + ++ not necessarily into irreducibles. + + Impl ==> add + import RationalRicDE(F, UP) + + case2 : (RF, LF, UP -> Factored UP) -> Union(SUP, "failed") + cannotCase2?: LF -> Boolean + + kovacic(a0, a1, a2) == kovacic(a0, a1, a2, squareFree) + + -- it is assumed here that a2 y'' + a1 y' + a0 y is already irreducible + -- over the rational functions, i.e. that the associated Riccati equation + -- does NOT have rational solutions (so we don't check case 1 of Kovacic's + -- algorithm) + -- currently only check case 2, not 3 + kovacic(a0, a1, a2, ezfactor) == + -- transform first the equation to the form y'' = r y + -- which makes the Galois group unimodular + -- this does not change irreducibility over the rational functions + -- the following is split into 5 lines in order to save a couple of + -- hours of compile time. + r:RF := a1**2 + r := r + 2 * a2 * differentiate a1 + r := r - 2 * a1 * differentiate a2 + r := r - 4 * a0 * a2 + r := r / (4 * a2**2) + lf := factors squareFree denom r + case2(r, lf, ezfactor) + + -- this is case 2 of Kovacic's algorithm, i.e. look for a solution + -- of the associated Riccati equation in a quadratic extension + -- lf is the squarefree factorisation of denom(r) and is used to + -- check the necessary condition + case2(r, lf, ezfactor) == + cannotCase2? lf => "failed" + -- build the symmetric square of the operator L = y'' - r y + -- which is L2 = y''' - 4 r y' - 2 r' y + l2:LODO := monomial(1, 3) - monomial(4*r, 1) - 2 * differentiate(r)::LODO + -- no solution in this case if L2 has no rational solution + empty?(sol := ricDsolve(l2, ezfactor)) => "failed" + -- otherwise the defining polynomial for an algebraic solution + -- of the Ricatti equation associated with L is + -- u^2 - b u + (1/2 b' + 1/2 b^2 - r) = 0 + -- where b is a rational solution of the Ricatti of L2 + b := first sol + monomial(1, 2)$SUP - monomial(b, 1)$SUP + + ((differentiate(b) + b**2 - 2 * r) / (2::RF))::SUP + + -- checks the necessary condition for case 2 + -- returns true if case 2 cannot have solutions + -- the necessary condition is that there is either a factor with + -- exponent 2 or odd exponent > 2 + cannotCase2? lf == + for rec in lf repeat + rec.exponent = 2 or (odd?(rec.exponent) and rec.exponent > 2) => + return false + true + +@ +<>= +"KOVACIC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=KOVACIC"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"KOVACIC" -> "ACF" + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter L} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -23520,6 +32046,93 @@ ModularHermitianRowReduction(R): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package MONOTOOL MonomialExtensionTools} +\pagehead{MonomialExtensionTools}{MONOTOOL} +\pagepic{ps/v104monomialextensiontools.ps}{MONOTOOL}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package MONOTOOL MonomialExtensionTools +++ Tools for handling monomial extensions +++ Author: Manuel Bronstein +++ Date Created: 18 August 1992 +++ Date Last Updated: 3 June 1993 +++ Description: Tools for handling monomial extensions. +MonomialExtensionTools(F, UP): Exports == Implementation where + F : Field + UP: UnivariatePolynomialCategory F + + RF ==> Fraction UP + FR ==> Factored UP + + Exports ==> with + split : (UP, UP -> UP) -> Record(normal:UP, special:UP) + ++ split(p, D) returns \spad{[n,s]} such that \spad{p = n s}, + ++ all the squarefree factors of n are normal w.r.t. D, + ++ and s is special w.r.t. D. + ++ D is the derivation to use. + splitSquarefree: (UP, UP -> UP) -> Record(normal:FR, special:FR) + ++ splitSquarefree(p, D) returns + ++ \spad{[n_1 n_2\^2 ... n_m\^m, s_1 s_2\^2 ... s_q\^q]} such that + ++ \spad{p = n_1 n_2\^2 ... n_m\^m s_1 s_2\^2 ... s_q\^q}, each + ++ \spad{n_i} is normal w.r.t. D and each \spad{s_i} is special + ++ w.r.t D. + ++ D is the derivation to use. + normalDenom: (RF, UP -> UP) -> UP + ++ normalDenom(f, D) returns the product of all the normal factors + ++ of \spad{denom(f)}. + ++ D is the derivation to use. + decompose : (RF, UP -> UP) -> Record(poly:UP, normal:RF, special:RF) + ++ decompose(f, D) returns \spad{[p,n,s]} such that \spad{f = p+n+s}, + ++ all the squarefree factors of \spad{denom(n)} are normal w.r.t. D, + ++ \spad{denom(s)} is special w.r.t. D, + ++ and n and s are proper fractions (no pole at infinity). + ++ D is the derivation to use. + + Implementation ==> add + normalDenom(f, derivation) == split(denom f, derivation).normal + + split(p, derivation) == + pbar := (gcd(p, derivation p) exquo gcd(p, differentiate p))::UP + zero? degree pbar => [p, 1] + rec := split((p exquo pbar)::UP, derivation) + [rec.normal, pbar * rec.special] + + splitSquarefree(p, derivation) == + s:Factored(UP) := 1 + n := s + q := squareFree p + for rec in factors q repeat + r := rec.factor + g := gcd(r, derivation r) + if not ground? g then s := s * sqfrFactor(g, rec.exponent) + h := (r exquo g)::UP + if not ground? h then n := n * sqfrFactor(h, rec.exponent) + [n, unit(q) * s] + + decompose(f, derivation) == + qr := divide(numer f, denom f) +-- rec.normal * rec.special = denom f + rec := split(denom f, derivation) +-- eeu.coef1 * rec.normal + eeu.coef2 * rec.special = qr.remainder +-- and degree(eeu.coef1) < degree(rec.special) +-- and degree(eeu.coef2) < degree(rec.normal) +-- qr.remainder/denom(f) = eeu.coef1 / rec.special + eeu.coef2 / rec.normal + eeu := extendedEuclidean(rec.normal, rec.special, + qr.remainder)::Record(coef1:UP, coef2:UP) + [qr.quotient, eeu.coef2 / rec.normal, eeu.coef1 / rec.special] + +@ +<>= +"MONOTOOL" [color="#FF4488",href="bookvol10.4.pdf#nameddest=MONOTOOL"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"MONOTOOL" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package MPCPF MPolyCatPolyFactorizer} \pagehead{MPolyCatPolyFactorizer}{MPCPF} \pagepic{ps/v104mpolycatpolyfactorizer.ps}{MPCPF}{1.00} @@ -28344,6 +36957,249 @@ NormInMonogenicAlgebra(R, PolR, E, PolE): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package NFINTBAS NumberFieldIntegralBasis} +\pagehead{NumberFieldIntegralBasis}{NFINTBAS} +\pagepic{ps/v104numberfieldintegralbasis.ps}{NFINTBAS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package NFINTBAS NumberFieldIntegralBasis +++ Author: Victor Miller, Clifton Williamson +++ Date Created: 9 April 1990 +++ Date Last Updated: 20 September 1994 +++ Basic Operations: discriminant, integralBasis +++ Related Domains: IntegralBasisTools, TriangularMatrixOperations +++ Also See: FunctionFieldIntegralBasis, WildFunctionFieldIntegralBasis +++ AMS Classifications: +++ Keywords: number field, integral basis, discriminant +++ Examples: +++ References: +++ Description: +++ In this package F is a framed algebra over the integers (typically +++ \spad{F = Z[a]} for some algebraic integer a). The package provides +++ functions to compute the integral closure of Z in the quotient +++ quotient field of F. +NumberFieldIntegralBasis(UP,F): Exports == Implementation where + UP : UnivariatePolynomialCategory Integer + F : FramedAlgebra(Integer,UP) + + FR ==> Factored Integer + I ==> Integer + Mat ==> Matrix I + NNI ==> NonNegativeInteger + Ans ==> Record(basis: Mat, basisDen: I, basisInv:Mat,discr: I) + + Exports ==> with + discriminant: () -> Integer + ++ \spad{discriminant()} returns the discriminant of the integral + ++ closure of Z in the quotient field of the framed algebra F. + integralBasis : () -> Record(basis: Mat, basisDen: I, basisInv:Mat) + ++ \spad{integralBasis()} returns a record + ++ \spad{[basis,basisDen,basisInv]} + ++ containing information regarding the integral closure of Z in the + ++ quotient field of F, where F is a framed algebra with Z-module + ++ basis \spad{w1,w2,...,wn}. + ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ the \spad{i}th element of the integral basis is + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of \spad{basis} contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + localIntegralBasis : I -> Record(basis: Mat, basisDen: I, basisInv:Mat) + ++ \spad{integralBasis(p)} returns a record + ++ \spad{[basis,basisDen,basisInv]} containing information regarding + ++ the local integral closure of Z at the prime \spad{p} in the quotient + ++ field of F, where F is a framed algebra with Z-module basis + ++ \spad{w1,w2,...,wn}. + ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ the \spad{i}th element of the integral basis is + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of \spad{basis} contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + + Implementation ==> add + import IntegralBasisTools(I, UP, F) + import ModularHermitianRowReduction(I) + import TriangularMatrixOperations(I, Vector I, Vector I, Matrix I) + + frobMatrix : (Mat,Mat,I,NNI) -> Mat + wildPrimes : (FR,I) -> List I + tameProduct : (FR,I) -> I + iTameLocalIntegralBasis : (Mat,I,I) -> Ans + iWildLocalIntegralBasis : (Mat,I,I) -> Ans + + frobMatrix(rb,rbinv,rbden,p) == + n := rank()$F; b := basis()$F + v : Vector F := new(n,0) + for i in minIndex(v)..maxIndex(v) + for ii in minRowIndex(rb)..maxRowIndex(rb) repeat + a : F := 0 + for j in minIndex(b)..maxIndex(b) + for jj in minColIndex(rb)..maxColIndex(rb) repeat + a := a + qelt(rb,ii,jj) * qelt(b,j) + qsetelt_!(v,i,a**p) + mat := transpose coordinates v + ((transpose(rbinv) * mat) exquo (rbden ** p)) :: Mat + + wildPrimes(factoredDisc,n) == + -- returns a list of the primes <=n which divide factoredDisc to a + -- power greater than 1 + ans : List I := empty() + for f in factors(factoredDisc) repeat + if f.exponent > 1 and f.factor <= n then ans := concat(f.factor,ans) + ans + + tameProduct(factoredDisc,n) == + -- returns the product of the primes > n which divide factoredDisc + -- to a power greater than 1 + ans : I := 1 + for f in factors(factoredDisc) repeat + if f.exponent > 1 and f.factor > n then ans := f.factor * ans + ans + + integralBasis() == + traceMat := traceMatrix()$F; n := rank()$F + disc := determinant traceMat -- discriminant of current order + disc0 := disc -- this is disc(F) + factoredDisc := factor(disc0)$IntegerFactorizationPackage(Integer) + wilds := wildPrimes(factoredDisc,n) + sing := tameProduct(factoredDisc,n) + runningRb := scalarMatrix(n, 1); runningRbinv := scalarMatrix(n, 1) + -- runningRb = basis matrix of current order + -- runningRbinv = inverse basis matrix of current order + -- these are wrt the original basis for F + runningRbden : I := 1 + -- runningRbden = denominator for current basis matrix +-- one? sing and empty? wilds => [runningRb, runningRbden, runningRbinv] + (sing = 1) and empty? wilds => [runningRb, runningRbden, runningRbinv] + -- id = basis matrix of the ideal (p-radical) wrt current basis + matrixOut : Mat := scalarMatrix(n,0) + for p in wilds repeat + lb := iWildLocalIntegralBasis(matrixOut,disc,p) + rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen + disc := lb.discr + -- update 'running integral basis' if newly computed + -- local integral basis is non-trivial + if sizeLess?(1,rbden) then + mat := vertConcat(rbden * runningRb,runningRbden * rb) + runningRbden := runningRbden * rbden + runningRb := squareTop rowEchelon(mat,runningRbden) + runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) + lb := iTameLocalIntegralBasis(traceMat,disc,sing) + rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen + disc := lb.discr + -- update 'running integral basis' if newly computed + -- local integral basis is non-trivial + if sizeLess?(1,rbden) then + mat := vertConcat(rbden * runningRb,runningRbden * rb) + runningRbden := runningRbden * rbden + runningRb := squareTop rowEchelon(mat,runningRbden) + runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) + [runningRb,runningRbden,runningRbinv] + + localIntegralBasis p == + traceMat := traceMatrix()$F; n := rank()$F + disc := determinant traceMat -- discriminant of current order + (disc exquo (p*p)) case "failed" => + [scalarMatrix(n, 1), 1, scalarMatrix(n, 1)] + lb := + p > rank()$F => + iTameLocalIntegralBasis(traceMat,disc,p) + iWildLocalIntegralBasis(scalarMatrix(n,0),disc,p) + [lb.basis,lb.basisDen,lb.basisInv] + + iTameLocalIntegralBasis(traceMat,disc,sing) == + n := rank()$F; disc0 := disc + rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) + -- rb = basis matrix of current order + -- rbinv = inverse basis matrix of current order + -- these are wrt the original basis for F + rbden : I := 1; index : I := 1; oldIndex : I := 1 + -- rbden = denominator for current basis matrix + -- id = basis matrix of the ideal (p-radical) wrt current basis + tfm := traceMat + repeat + -- compute the p-radical = p-trace-radical + idinv := transpose squareTop rowEchelon(tfm,sing) + -- [u1,..,un] are the coordinates of an element of the p-radical + -- iff [u1,..,un] * idinv is in p * Z^n + id := rowEchelon LowTriBddDenomInv(idinv, sing) + -- id = basis matrix of the p-radical + idinv := UpTriBddDenomInv(id, sing) + -- id * idinv = sing * identity + -- no need to check for inseparability in this case + rbinv := idealiser(id * rb, rbinv * idinv, sing * rbden) + index := diagonalProduct rbinv + rb := rowEchelon LowTriBddDenomInv(rbinv, sing * rbden) + g := matrixGcd(rb,sing,n) + if sizeLess?(1,g) then rb := (rb exquo g) :: Mat + rbden := rbden * (sing quo g) + rbinv := UpTriBddDenomInv(rb, rbden) + disc := disc0 quo (index * index) + indexChange := index quo oldIndex; oldIndex := index +-- one? indexChange => return [rb, rbden, rbinv, disc] + (indexChange = 1) => return [rb, rbden, rbinv, disc] + tfm := ((rb * traceMat * transpose rb) exquo (rbden * rbden)) :: Mat + + iWildLocalIntegralBasis(matrixOut,disc,p) == + n := rank()$F; disc0 := disc + rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) + -- rb = basis matrix of current order + -- rbinv = inverse basis matrix of current order + -- these are wrt the original basis for F + rbden : I := 1; index : I := 1; oldIndex : I := 1 + -- rbden = denominator for current basis matrix + -- id = basis matrix of the ideal (p-radical) wrt current basis + p2 := p * p; lp := leastPower(p::NNI,n) + repeat + tfm := frobMatrix(rb,rbinv,rbden,p::NNI) ** lp + -- compute Rp = p-radical + idinv := transpose squareTop rowEchelon(tfm, p) + -- [u1,..,un] are the coordinates of an element of Rp + -- iff [u1,..,un] * idinv is in p * Z^n + id := rowEchelon LowTriBddDenomInv(idinv,p) + -- id = basis matrix of the p-radical + idinv := UpTriBddDenomInv(id,p) + -- id * idinv = p * identity + -- no need to check for inseparability in this case + rbinv := idealiser(id * rb, rbinv * idinv, p * rbden) + index := diagonalProduct rbinv + rb := rowEchelon LowTriBddDenomInv(rbinv, p * rbden) + if divideIfCan_!(rb,matrixOut,p,n) = 1 + then rb := matrixOut + else rbden := p * rbden + rbinv := UpTriBddDenomInv(rb, rbden) + indexChange := index quo oldIndex; oldIndex := index + disc := disc quo (indexChange * indexChange) +-- one? indexChange or gcd(p2,disc) ^= p2 => + (indexChange = 1) or gcd(p2,disc) ^= p2 => + return [rb, rbden, rbinv, disc] + + discriminant() == + disc := determinant traceMatrix()$F + intBas := integralBasis() + rb := intBas.basis; rbden := intBas.basisDen + index := ((rbden ** rank()$F) exquo (determinant rb)) :: Integer + (disc exquo (index * index)) :: Integer + +@ +<>= +"NFINTBAS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NFINTBAS"] +"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"] +"NFINTBAS" -> "FRAMALG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package NCNTFRAC NumericContinuedFraction} \pagehead{NumericContinuedFraction}{NCNTFRAC} \pagepic{ps/v104numericcontinuedfraction.ps}{NCNTFRAC}{1.00} @@ -28562,6 +37418,93 @@ OrderedCompletionFunctions2(R, S): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package ORDFUNS OrderingFunctions} +\pagehead{OrderingFunctions}{ORDFUNS} +\pagepic{ps/v104orderingfunctions.ps}{ORDFUNS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package ORDFUNS OrderingFunctions +++ Author: Barry Trager +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: OrderedDirectProduct +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This package provides ordering functions on vectors which +++ are suitable parameters for OrderedDirectProduct. + +OrderingFunctions(dim,S) : T == C where + dim : NonNegativeInteger + S : OrderedAbelianMonoid + VS == Vector S + + T == with + pureLex : (VS,VS) -> Boolean + ++ pureLex(v1,v2) return true if the vector v1 is less than the + ++ vector v2 in the lexicographic ordering. + totalLex : (VS,VS) -> Boolean + ++ totalLex(v1,v2) return true if the vector v1 is less than the + ++ vector v2 in the ordering which is total degree refined by + ++ lexicographic ordering. + reverseLex : (VS,VS) -> Boolean + ++ reverseLex(v1,v2) return true if the vector v1 is less than the + ++ vector v2 in the ordering which is total degree refined by + ++ the reverse lexicographic ordering. + + C == add + n:NonNegativeInteger:=dim + + -- pure lexicographical ordering + pureLex(v1:VS,v2:VS) : Boolean == + for i in 1..n repeat + if qelt(v1,i) < qelt(v2,i) then return true + if qelt(v2,i) < qelt(v1,i) then return false + false + + -- total ordering refined with lex + totalLex(v1:VS,v2:VS) :Boolean == + n1:S:=0 + n2:S:=0 + for i in 1..n repeat + n1:= n1+qelt(v1,i) + n2:=n2+qelt(v2,i) + n1 true + n2 false + for i in 1..n repeat + if qelt(v1,i) < qelt(v2,i) then return true + if qelt(v2,i) < qelt(v1,i) then return false + false + + -- reverse lexicographical ordering + reverseLex(v1:VS,v2:VS) :Boolean == + n1:S:=0 + n2:S:=0 + for i in 1..n repeat + n1:= n1+qelt(v1,i) + n2:=n2+qelt(v2,i) + n1 true + n2 false + for i in reverse(1..n) repeat + if qelt(v2,i) < qelt(v1,i) then return true + if qelt(v1,i) < qelt(v2,i) then return false + false + +@ +<>= +"ORDFUNS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=ORDFUNS"] +"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"] +"ORDFUNS" -> "IVECTOR" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package OPQUERY OperationsQuery} \pagehead{OperationsQuery}{OPQUERY} \pagepic{ps/v104operationsquery.ps}{OPQUERY}{1.00} @@ -28644,6 +37587,339 @@ PatternMatchAssertions(): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTPM PatternMatchIntegration} +\pagehead{PatternMatchIntegration}{INTPM} +\pagepic{ps/v104patternmatchintegration.ps}{INTPM}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTPM PatternMatchIntegration +++ Author: Manuel Bronstein +++ Date Created: 5 May 1992 +++ Date Last Updated: 27 September 1995 +++ Description: +++ \spadtype{PatternMatchIntegration} provides functions that use +++ the pattern matcher to find some indefinite and definite integrals +++ involving special functions and found in the litterature. +PatternMatchIntegration(R, F): Exports == Implementation where + R : Join(OrderedSet, RetractableTo Integer, GcdDomain, + LinearlyExplicitRingOver Integer) + F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory, + FunctionSpace R) + + N ==> NonNegativeInteger + Z ==> Integer + SY ==> Symbol + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + SUP ==> SparseUnivariatePolynomial F + PAT ==> Pattern Z + RES ==> PatternMatchResult(Z, F) + OFE ==> OrderedCompletion F + REC ==> Record(which: Z, exponent: F, coeff: F) + ANS ==> Record(special:F, integrand:F) + NONE ==> 0 + EI ==> 1 + ERF ==> 2 + SI ==> 3 + CI ==> 4 + GAM2 ==> 5 + CI0 ==> 6 + + Exports ==> with + splitConstant: (F, SY) -> Record(const:F, nconst:F) + ++ splitConstant(f, x) returns \spad{[c, g]} such that + ++ \spad{f = c * g} and \spad{c} does not involve \spad{t}. + if R has ConvertibleTo Pattern Integer and + R has PatternMatchable Integer then + if F has LiouvillianFunctionCategory then + pmComplexintegrate: (F, SY) -> Union(ANS, "failed") + ++ pmComplexintegrate(f, x) returns either "failed" or + ++ \spad{[g,h]} such that + ++ \spad{integrate(f,x) = g + integrate(h,x)}. + ++ It only looks for special complex integrals that pmintegrate + ++ does not return. + pmintegrate: (F, SY) -> Union(ANS, "failed") + ++ pmintegrate(f, x) returns either "failed" or \spad{[g,h]} such + ++ that \spad{integrate(f,x) = g + integrate(h,x)}. + if F has SpecialFunctionCategory then + pmintegrate: (F, SY, OFE, OFE) -> Union(F, "failed") + ++ pmintegrate(f, x = a..b) returns the integral of + ++ \spad{f(x)dx} from a to b + ++ if it can be found by the built-in pattern matching rules. + + Implementation ==> add + import PatternMatch(Z, F, F) + import ElementaryFunctionSign(R, F) + import FunctionSpaceAssertions(R, F) + import TrigonometricManipulations(R, F) + import FunctionSpaceAttachPredicates(R, F, F) + + mkalist : RES -> AssociationList(SY, F) + + pm := new()$SY + pmw := new pm + pmm := new pm + pms := new pm + pmc := new pm + pma := new pm + pmb := new pm + + c := optional(pmc::F) + w := suchThat(optional(pmw::F), empty? variables #1) + s := suchThat(optional(pms::F), empty? variables #1 and real? #1) + m := suchThat(optional(pmm::F), + (retractIfCan(#1)@Union(Z,"failed") case Z) and #1 >= 0) + + spi := sqrt(pi()$F) + + half := 1::F / 2::F + + mkalist res == construct destruct res + + splitConstant(f, x) == + not member?(x, variables f) => [f, 1] + (retractIfCan(f)@Union(K, "failed")) case K => [1, f] + (u := isTimes f) case List(F) => + cc := nc := 1$F + for g in u::List(F) repeat + rec := splitConstant(g, x) + cc := cc * rec.const + nc := nc * rec.nconst + [cc, nc] + (u := isPlus f) case List(F) => + rec := splitConstant(first(u::List(F)), x) + cc := rec.const + nc := rec.nconst + for g in rest(u::List(F)) repeat + rec := splitConstant(g, x) + if rec.nconst = nc then cc := cc + rec.const + else if rec.nconst = -nc then cc := cc - rec.const + else return [1, f] + [cc, nc] + if (v := isPower f) case Record(val:F, exponent:Z) then + vv := v::Record(val:F, exponent:Z) + (vv.exponent ^= 1) => + rec := splitConstant(vv.val, x) + return [rec.const ** vv.exponent, rec.nconst ** vv.exponent] + error "splitConstant: should not happen" + + if R has ConvertibleTo Pattern Integer and + R has PatternMatchable Integer then + if F has LiouvillianFunctionCategory then + import ElementaryFunctionSign(R, F) + + insqrt : F -> F + matchei : (F, SY) -> REC + matcherfei : (F, SY, Boolean) -> REC + matchsici : (F, SY) -> REC + matchli : (F, SY) -> List F + matchli0 : (F, K, SY) -> List F + matchdilog : (F, SY) -> List F + matchdilog0: (F, K, SY, P, F) -> List F + goodlilog? : (K, P) -> Boolean + gooddilog? : (K, P, P) -> Boolean + +-- goodlilog?(k, p) == is?(k, "log"::SY) and one? minimumDegree(p, k) + goodlilog?(k, p) == is?(k, "log"::SY) and (minimumDegree(p, k) = 1) + + gooddilog?(k, p, q) == +-- is?(k, "log"::SY) and one? degree(p, k) and zero? degree(q, k) + is?(k, "log"::SY) and (degree(p, k) = 1) and zero? degree(q, k) + +-- matches the integral to a result of the form d * erf(u) or d * ei(u) +-- returns [case, u, d] + matcherfei(f, x, comp?) == + res0 := new()$RES + pat := c * exp(pma::F) + failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + comp? => [NONE, 0,0] + matchei(f,x) + l := mkalist res + da := differentiate(a := l.pma, x) + d := a * (cc := l.pmc) / da + zero? differentiate(d, x) => [EI, a, d] + comp? or (((u := sign a) case Z) and (u::Z) < 0) => + d := cc * (sa := insqrt(- a)) / da + zero? differentiate(d, x) => [ERF, sa, - d * spi] + [NONE, 0, 0] + [NONE, 0, 0] + +-- matches the integral to a result of the form d * ei(k * log u) +-- returns [case, k * log u, d] + matchei(f, x) == + res0 := new()$RES + a := pma::F + pat := c * a**w / log a + failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + [NONE, 0, 0] + l := mkalist res + da := differentiate(a := l.pma, x) + d := (cc := l.pmc) / da + zero? differentiate(d, x) => [EI, (1 + l.pmw) * log a, d] + [NONE, 0, 0] + +-- matches the integral to a result of the form d * dilog(u) + int(v), +-- returns [u,d,v] or [] + matchdilog(f, x) == + n := numer f + df := (d := denom f)::F + for k in select_!(gooddilog?(#1, n, d), variables n)$List(K) repeat + not empty?(l := matchdilog0(f, k, x, n, df)) => return l + empty() + +-- matches the integral to a result of the form d * dilog(a) + int(v) +-- where k = log(a) +-- returns [a,d,v] or [] + matchdilog0(f, k, x, p, q) == + zero?(da := differentiate(a := first argument k, x)) => empty() + a1 := 1 - a + d := coefficient(univariate(p, k), 1)::F * a1 / (q * da) + zero? differentiate(d, x) => [a, d, f - d * da * (k::F) / a1] + empty() + +-- matches the integral to a result of the form d * li(u) + int(v), +-- returns [u,d,v] or [] + matchli(f, x) == + d := denom f + for k in select_!(goodlilog?(#1, d), variables d)$List(K) repeat + not empty?(l := matchli0(f, k, x)) => return l + empty() + +-- matches the integral to a result of the form d * li(a) + int(v) +-- where k = log(a) +-- returns [a,d,v] or [] + matchli0(f, k, x) == + g := (lg := k::F) * f + zero?(da := differentiate(a := first argument k, x)) => empty() + zero? differentiate(d := g / da, x) => [a, d, 0] + ug := univariate(g, k) + (u:=retractIfCan(ug)@Union(SUP,"failed")) case "failed" => empty() + degree(p := u::SUP) > 1 => empty() + zero? differentiate(d := coefficient(p, 0) / da, x) => + [a, d, leadingCoefficient p] + empty() + +-- matches the integral to a result of the form d * Si(u) or d * Ci(u) +-- returns [case, u, d] + matchsici(f, x) == + res0 := new()$RES + b := pmb::F + t := tan(a := pma::F) + patsi := c * t / (patden := b + b * t**2) + patci := (c - c * t**2) / patden + patci0 := c / patden + ci0?:Boolean + (ci? := failed?(res := patternMatch(f, convert(patsi)@PAT, res0))) + and (ci0?:=failed?(res:=patternMatch(f,convert(patci)@PAT,res0))) + and failed?(res := patternMatch(f,convert(patci0)@PAT,res0)) => + [NONE, 0, 0] + l := mkalist res + (b := l.pmb) ^= 2 * (a := l.pma) => [NONE, 0, 0] + db := differentiate(b, x) + d := (cc := l.pmc) / db + zero? differentiate(d, x) => + ci? => + ci0? => [CI0, b, d / (2::F)] + [CI, b, d] + [SI, b, d / (2::F)] + [NONE, 0, 0] + +-- returns a simplified sqrt(y) + insqrt y == + rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F) +-- one?(rec.exponent) => rec.coef * rec.radicand + ((rec.exponent) = 1) => rec.coef * rec.radicand + rec.exponent ^=2 => error "insqrt: hould not happen" + rec.coef * sqrt(rec.radicand) + + pmintegrate(f, x) == + (rc := splitConstant(f, x)).const ^= 1 => + (u := pmintegrate(rc.nconst, x)) case "failed" => "failed" + rec := u::ANS + [rc.const * rec.special, rc.const * rec.integrand] + not empty?(l := matchli(f, x)) => [second l * li first l, third l] + not empty?(l := matchdilog(f, x)) => + [second l * dilog first l, third l] + cse := (rec := matcherfei(f, x, false)).which + cse = EI => [rec.coeff * Ei(rec.exponent), 0] + cse = ERF => [rec.coeff * erf(rec.exponent), 0] + cse := (rec := matchsici(f, x)).which + cse = SI => [rec.coeff * Si(rec.exponent), 0] + cse = CI => [rec.coeff * Ci(rec.exponent), 0] + cse = CI0 => [rec.coeff * Ci(rec.exponent) + + rec.coeff * log(rec.exponent), 0] + "failed" + + pmComplexintegrate(f, x) == + (rc := splitConstant(f, x)).const ^= 1 => + (u := pmintegrate(rc.nconst, x)) case "failed" => "failed" + rec := u::ANS + [rc.const * rec.special, rc.const * rec.integrand] + cse := (rec := matcherfei(f, x, true)).which + cse = ERF => [rec.coeff * erf(rec.exponent), 0] + "failed" + + if F has SpecialFunctionCategory then + match1 : (F, SY, F, F) -> List F + formula1 : (F, SY, F, F) -> Union(F, "failed") + +-- tries only formula (1) of the Geddes & al, AAECC 1 (1990) paper + formula1(f, x, t, cc) == + empty?(l := match1(f, x, t, cc)) => "failed" + mw := first l + zero?(ms := third l) or ((sgs := sign ms) case "failed")=> "failed" + ((sgz := sign(z := (mw + 1) / ms)) case "failed") or (sgz::Z < 0) + => "failed" + mmi := retract(mm := second l)@Z + sgs * (last l) * ms**(- mmi - 1) * + eval(differentiate(Gamma(x::F), x, mmi::N), [kernel(x)@K], [z]) + +-- returns [w, m, s, c] or [] +-- matches only formula (1) of the Geddes & al, AAECC 1 (1990) paper + match1(f, x, t, cc) == + res0 := new()$RES + pat := cc * log(t)**m * exp(-t**s) + not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + l := mkalist res + [0, l.pmm, l.pms, l.pmc] + pat := cc * t**w * exp(-t**s) + not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + l := mkalist res + [l.pmw, 0, l.pms, l.pmc] + pat := cc / t**w * exp(-t**s) + not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + l := mkalist res + [- l.pmw, 0, l.pms, l.pmc] + pat := cc * t**w * log(t)**m * exp(-t**s) + not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + l := mkalist res + [l.pmw, l.pmm, l.pms, l.pmc] + pat := cc / t**w * log(t)**m * exp(-t**s) + not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => + l := mkalist res + [- l.pmw, l.pmm, l.pms, l.pmc] + empty() + + pmintegrate(f, x, a, b) == +-- zero? a and one? whatInfinity b => + zero? a and ((whatInfinity b) = 1) => + formula1(f, x, constant(x::F), suchThat(c, freeOf?(#1, x))) + "failed" + +@ +<>= +"INTPM" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTPM"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"INTPM" -> "ACF" +"INTPM" -> "FS" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package PICOERCE PiCoercions} \pagehead{PiCoercions}{PICOERCE} \pagepic{ps/v104picoercions.ps}{PICOERCE}{1.00} @@ -28789,6 +38065,405 @@ PrimitiveArrayFunctions2(A, B): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTPAF PureAlgebraicIntegration} +\pagehead{PureAlgebraicIntegration}{INTPAF} +\pagepic{ps/v104purealgebraicintegration.ps}{INTPAF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTPAF PureAlgebraicIntegration +++ Integration of pure algebraic functions; +++ Author: Manuel Bronstein +++ Date Created: 27 May 1988 +++ Date Last Updated: 24 June 1994 +++ Description: +++ This package provides functions for integration, limited integration, +++ extended integration and the risch differential equation for +++ pure algebraic integrands; +PureAlgebraicIntegration(R, F, L): Exports == Implementation where + R: Join(GcdDomain,RetractableTo Integer,OrderedSet, CharacteristicZero, + LinearlyExplicitRingOver Integer) + F: Join(FunctionSpace R, AlgebraicallyClosedField, + TranscendentalFunctionCategory) + L: SetCategory + + SY ==> Symbol + N ==> NonNegativeInteger + K ==> Kernel F + P ==> SparseMultivariatePolynomial(R, K) + UP ==> SparseUnivariatePolynomial F + RF ==> Fraction UP + UPUP==> SparseUnivariatePolynomial RF + IR ==> IntegrationResult F + IR2 ==> IntegrationResultFunctions2(curve, F) + ALG ==> AlgebraicIntegrate(R, F, UP, UPUP, curve) + LDALG ==> LinearOrdinaryDifferentialOperator1 curve + RDALG ==> PureAlgebraicLODE(F, UP, UPUP, curve) + LOG ==> Record(coeff:F, logand:F) + REC ==> Record(particular:U1, basis:List F) + CND ==> Record(left:UP, right:UP) + CHV ==> Record(int:UPUP, left:UP, right:UP, den:RF, deg:N) + U1 ==> Union(F, "failed") + U2 ==> Union(Record(ratpart:F, coeff:F),"failed") + U3 ==> Union(Record(mainpart:F, limitedlogs:List LOG), "failed") + FAIL==> error "failed - cannot handle that integrand" + + Exports ==> with + palgint : (F, K, K) -> IR + ++ palgint(f, x, y) returns the integral of \spad{f(x,y)dx} + ++ where y is an algebraic function of x. + palgextint: (F, K, K, F) -> U2 + ++ palgextint(f, x, y, g) returns functions \spad{[h, c]} such that + ++ \spad{dh/dx = f(x,y) - c g}, where y is an algebraic function of x; + ++ returns "failed" if no such functions exist. + palglimint: (F, K, K, List F) -> U3 + ++ palglimint(f, x, y, [u1,...,un]) returns functions + ++ \spad{[h,[[ci, ui]]]} such that the ui's are among \spad{[u1,...,un]} + ++ and \spad{d(h + sum(ci log(ui)))/dx = f(x,y)} if such functions exist, + ++ "failed" otherwise; + ++ y is an algebraic function of x. + palgRDE : (F, F, F, K, K, (F, F, SY) -> U1) -> U1 + ++ palgRDE(nfp, f, g, x, y, foo) returns a function \spad{z(x,y)} + ++ such that \spad{dz/dx + n * df/dx z(x,y) = g(x,y)} if such a z exists, + ++ "failed" otherwise; + ++ y is an algebraic function of x; + ++ \spad{foo(a, b, x)} is a function that solves + ++ \spad{du/dx + n * da/dx u(x) = u(x)} + ++ for an unknown \spad{u(x)} not involving y. + ++ \spad{nfp} is \spad{n * df/dx}. + if L has LinearOrdinaryDifferentialOperatorCategory F then + palgLODE: (L, F, K, K, SY) -> REC + ++ palgLODE(op, g, kx, y, x) returns the solution of \spad{op f = g}. + ++ y is an algebraic function of x. + + Implementation ==> add + import IntegrationTools(R, F) + import RationalIntegration(F, UP) + import GenusZeroIntegration(R, F, L) + import ChangeOfVariable(F, UP, UPUP) + import IntegrationResultFunctions2(F, F) + import IntegrationResultFunctions2(RF, F) + import SparseUnivariatePolynomialFunctions2(F, RF) + import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) + import PolynomialCategoryQuotientFunctions(IndexedExponents K, + K, R, P, F) + + quadIfCan : (K, K) -> Union(Record(coef:F, poly:UP), "failed") + linearInXIfCan : (K, K) -> Union(Record(xsub:F, dxsub:RF), "failed") + prootintegrate : (F, K, K) -> IR + prootintegrate1: (UPUP, K, K, UPUP) -> IR + prootextint : (F, K, K, F) -> U2 + prootlimint : (F, K, K, List F) -> U3 + prootRDE : (F, F, F, K, K, (F, F, SY) -> U1) -> U1 + palgRDE1 : (F, F, K, K) -> U1 + palgLODE1 : (List F, F, K, K, SY) -> REC + palgintegrate : (F, K, K) -> IR + palgext : (F, K, K, F) -> U2 + palglim : (F, K, K, List F) -> U3 + UPUP2F1 : (UPUP, RF, RF, K, K) -> F + UPUP2F0 : (UPUP, K, K) -> F + RF2UPUP : (RF, UPUP) -> UPUP + algaddx : (IR, F) -> IR + chvarIfCan : (UPUP, RF, UP, RF) -> Union(UPUP, "failed") + changeVarIfCan : (UPUP, RF, N) -> Union(CHV, "failed") + rationalInt : (UPUP, N, UP) -> IntegrationResult RF + chv : (UPUP, N, F, F) -> RF + chv0 : (UPUP, N, F, F) -> F + candidates : UP -> List CND + + dummy := new()$SY + dumk := kernel(dummy)@K + + UPUP2F1(p, t, cf, kx, k) == UPUP2F0(eval(p, t, cf), kx, k) + UPUP2F0(p, kx, k) == multivariate(p, kx, k::F) + chv(f, n, a, b) == univariate(chv0(f, n, a, b), dumk) + + RF2UPUP(f, modulus) == + bc := extendedEuclidean(map(#1::UP::RF, denom f), modulus, + 1)::Record(coef1:UPUP, coef2:UPUP) + (map(#1::UP::RF, numer f) * bc.coef1) rem modulus + +-- returns "failed", or (xx, c) such that f(x, y)dx = f(xx, y) c dy +-- if p(x, y) = 0 is linear in x + linearInXIfCan(x, y) == + a := b := 0$UP + p := clearDenominator lift(minPoly y, x) + while p ^= 0 repeat + degree(q := numer leadingCoefficient p) > 1 => return "failed" + a := a + monomial(coefficient(q, 1), d := degree p) + b := b - monomial(coefficient(q, 0), d) + p := reductum p + xx:RF := b / a + [xx(dumk::F), differentiate(xx, differentiate)] + +-- return Int(f(x,y)dx) where y is an n^th root of a rational function in x + prootintegrate(f, x, y) == + modulus := lift(p := minPoly y, x) + rf := reductum(ff := univariate(f, x, y, p)) + ((r := retractIfCan(rf)@Union(RF,"failed")) case RF) and rf ^= 0 => + -- in this case, ff := lc(ff) y^i + r so we integrate both terms + -- separately to gain time + map(#1(x::F), integrate(r::RF)) + + prootintegrate1(leadingMonomial ff, x, y, modulus) + prootintegrate1(ff, x, y, modulus) + + prootintegrate1(ff, x, y, modulus) == + chv:CHV + r := radPoly(modulus)::Record(radicand:RF, deg:N) + (uu := changeVarIfCan(ff, r.radicand, r.deg)) case CHV => + chv := uu::CHV + newalg := nthRoot((chv.left)(dumk::F), chv.deg) + kz := retract(numer newalg)@K + newf := multivariate(chv.int, ku := dumk, newalg) + vu := (chv.right)(x::F) + vz := (chv.den)(x::F) * (y::F) * denom(newalg)::F + map(eval(#1, [ku, kz], [vu, vz]), palgint(newf, ku, kz)) + cv := chvar(ff, modulus) + r := radPoly(cv.poly)::Record(radicand:RF, deg:N) + qprime := differentiate(q := retract(r.radicand)@UP)::RF + not zero? qprime and + ((u := chvarIfCan(cv.func, 1, q, inv qprime)) case UPUP) => + m := monomial(1, r.deg)$UPUP - q::RF::UPUP + map(UPUP2F1(RF2UPUP(#1, m), cv.c1, cv.c2, x, y), + rationalInt(u::UPUP, r.deg, monomial(1, 1))) + curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) + algaddx(map(UPUP2F1(lift #1, cv.c1, cv.c2, x, y), + palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F) + +-- Do the rationalizing change of variable +-- Int(f(x, y) dx) --> Int(n u^(n-1) f((u^n - b)/a, u) / a du) where +-- u^n = y^n = g(x) = a x + b +-- returns the integral as an integral of a rational function in u + rationalInt(f, n, g) == +-- not one? degree g => error "rationalInt: radicand must be linear" + not ((degree g) = 1) => error "rationalInt: radicand must be linear" + a := leadingCoefficient g + integrate(n * monomial(inv a, (n-1)::N)$UP + * chv(f, n, a, leadingCoefficient reductum g)) + +-- Do the rationalizing change of variable f(x,y) --> f((u^n - b)/a, u) where +-- u = y = (a x + b)^(1/n). +-- Returns f((u^n - b)/a,u) as an element of F + chv0(f, n, a, b) == + d := dumk::F + (f (d::UP::RF)) ((d ** n - b) / a) + +-- candidates(p) returns a list of pairs [g, u] such that p(x) = g(u(x)), +-- those u's are candidates for change of variables +-- currently uses a dumb heuristic where the candidates u's are p itself +-- and all the powers x^2, x^3, ..., x^{deg(p)}, +-- will use polynomial decomposition in smarter days MB 8/93 + candidates p == + l:List(CND) := empty() + ground? p => l + for i in 2..degree p repeat + if (u := composite(p, xi := monomial(1, i))) case UP then + l := concat([u::UP, xi], l) + concat([monomial(1, 1), p], l) + +-- checks whether Int(p(x, y) dx) can be rewritten as +-- Int(r(u, z) du) where u is some polynomial of x, +-- z = d y for some polynomial d, and z^m = g(u) +-- returns either [r(u, z), g, u, d, m] or "failed" +-- we have y^n = radi + changeVarIfCan(p, radi, n) == + rec := rootPoly(radi, n) + for cnd in candidates(rec.radicand) repeat + (u := chvarIfCan(p, rec.coef, cnd.right, + inv(differentiate(cnd.right)::RF))) case UPUP => + return [u::UPUP, cnd.left, cnd.right, rec.coef, rec.exponent] + "failed" + +-- checks whether Int(p(x, y) dx) can be rewritten as +-- Int(r(u, z) du) where u is some polynomial of x and z = d y +-- we have y^n = a(x)/d(x) +-- returns either "failed" or r(u, z) + chvarIfCan(p, d, u, u1) == + ans:UPUP := 0 + while p ^= 0 repeat + (v := composite(u1 * leadingCoefficient(p) / d ** degree(p), u)) + case "failed" => return "failed" + ans := ans + monomial(v::RF, degree p) + p := reductum p + ans + + algaddx(i, xx) == + elem? i => i + mkAnswer(ratpart i, logpart i, + [[- ne.integrand / (xx**2), xx] for ne in notelem i]) + + prootRDE(nfp, f, g, x, k, rde) == + modulus := lift(p := minPoly k, x) + r := radPoly(modulus)::Record(radicand:RF, deg:N) + rec := rootPoly(r.radicand, r.deg) + dqdx := inv(differentiate(q := rec.radicand)::RF) + ((uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,1)) case UPUP) and + ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx)) case UPUP) => + (u := rde(chv0(uf::UPUP, rec.exponent, 1, 0), rec.exponent * + (dumk::F) ** (rec.exponent * (rec.exponent - 1)) + * chv0(ug::UPUP, rec.exponent, 1, 0), + symbolIfCan(dumk)::SY)) case "failed" => "failed" + eval(u::F, dumk, k::F) +-- one?(rec.coef) => + ((rec.coef) = 1) => + curve := RadicalFunctionField(F, UP, UPUP, q::RF, rec.exponent) + rc := algDsolve(D()$LDALG + reduce(univariate(nfp, x, k, p))::LDALG, + reduce univariate(g, x, k, p))$RDALG + rc.particular case "failed" => "failed" + UPUP2F0(lift((rc.particular)::curve), x, k) + palgRDE1(nfp, g, x, k) + + prootlimint(f, x, k, lu) == + modulus := lift(p := minPoly k, x) + r := radPoly(modulus)::Record(radicand:RF, deg:N) + rec := rootPoly(r.radicand, r.deg) + dqdx := inv(differentiate(q := rec.radicand)::RF) + (uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,dqdx)) case UPUP => + l := empty()$List(RF) + n := rec.exponent * monomial(1, (rec.exponent - 1)::N)$UP + for u in lu repeat + if ((v:=chvarIfCan(uu:=univariate(u,x,k,p),rec.coef,q,dqdx))case UPUP) + then l := concat(n * chv(v::UPUP,rec.exponent, 1, 0), l) else FAIL + m := monomial(1, rec.exponent)$UPUP - q::RF::UPUP + map(UPUP2F0(RF2UPUP(#1,m), x, k), + limitedint(n * chv(uf::UPUP, rec.exponent, 1, 0), reverse_! l)) + cv := chvar(ff, modulus) + r := radPoly(cv.poly)::Record(radicand:RF, deg:N) + dqdx := inv(differentiate(q := retract(r.radicand)@UP)::RF) + curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) + (ui := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) + case "failed" => FAIL + [UPUP2F1(lift(ui::curve), cv.c1, cv.c2, x, k), empty()] + + prootextint(f, x, k, g) == + modulus := lift(p := minPoly k, x) + r := radPoly(modulus)::Record(radicand:RF, deg:N) + rec := rootPoly(r.radicand, r.deg) + dqdx := inv(differentiate(q := rec.radicand)::RF) + ((uf:=chvarIfCan(ff:=univariate(f,x,k,p),rec.coef,q,dqdx)) case UPUP) and + ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx)) case UPUP) => + m := monomial(1, rec.exponent)$UPUP - q::RF::UPUP + n := rec.exponent * monomial(1, (rec.exponent - 1)::N)$UP + map(UPUP2F0(RF2UPUP(#1,m), x, k), + extendedint(n * chv(uf::UPUP, rec.exponent, 1, 0), + n * chv(ug::UPUP, rec.exponent, 1, 0))) + cv := chvar(ff, modulus) + r := radPoly(cv.poly)::Record(radicand:RF, deg:N) + dqdx := inv(differentiate(q := retract(r.radicand)@UP)::RF) + curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) + (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) + case "failed" => FAIL + [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0] + + palgRDE1(nfp, g, x, y) == + palgLODE1([nfp, 1], g, x, y, symbolIfCan(x)::SY).particular + + palgLODE1(eq, g, kx, y, x) == + modulus:= lift(p := minPoly y, kx) + curve := AlgebraicFunctionField(F, UP, UPUP, modulus) + neq:LDALG := 0 + for f in eq for i in 0.. repeat + neq := neq + monomial(reduce univariate(f, kx, y, p), i) + empty? remove_!(y, remove_!(kx, varselect(kernels g, x))) => + rec := algDsolve(neq, reduce univariate(g, kx, y, p))$RDALG + bas:List(F) := [UPUP2F0(lift h, kx, y) for h in rec.basis] + rec.particular case "failed" => ["failed", bas] + [UPUP2F0(lift((rec.particular)::curve), kx, y), bas] + rec := algDsolve(neq, 0) + ["failed", [UPUP2F0(lift h, kx, y) for h in rec.basis]] + + palgintegrate(f, x, k) == + modulus:= lift(p := minPoly k, x) + cv := chvar(univariate(f, x, k, p), modulus) + curve := AlgebraicFunctionField(F, UP, UPUP, cv.poly) + knownInfBasis(cv.deg) + algaddx(map(UPUP2F1(lift #1, cv.c1, cv.c2, x, k), + palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F) + + palglim(f, x, k, lu) == + modulus:= lift(p := minPoly k, x) + cv := chvar(univariate(f, x, k, p), modulus) + curve := AlgebraicFunctionField(F, UP, UPUP, cv.poly) + knownInfBasis(cv.deg) + (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) + case "failed" => FAIL + [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), empty()] + + palgext(f, x, k, g) == + modulus:= lift(p := minPoly k, x) + cv := chvar(univariate(f, x, k, p), modulus) + curve := AlgebraicFunctionField(F, UP, UPUP, cv.poly) + knownInfBasis(cv.deg) + (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) + case "failed" => FAIL + [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0] + + palgint(f, x, y) == + (v := linearInXIfCan(x, y)) case "failed" => + (u := quadIfCan(x, y)) case "failed" => + is?(y, "nthRoot"::SY) => prootintegrate(f, x, y) + is?(y, "rootOf"::SY) => palgintegrate(f, x, y) + FAIL + palgint0(f, x, y, u.coef, u.poly) + palgint0(f, x, y, dumk, v.xsub, v.dxsub) + + palgextint(f, x, y, g) == + (v := linearInXIfCan(x, y)) case "failed" => + (u := quadIfCan(x, y)) case "failed" => + is?(y, "nthRoot"::SY) => prootextint(f, x, y, g) + is?(y, "rootOf"::SY) => palgext(f, x, y, g) + FAIL + palgextint0(f, x, y, g, u.coef, u.poly) + palgextint0(f, x, y, g, dumk, v.xsub, v.dxsub) + + palglimint(f, x, y, lu) == + (v := linearInXIfCan(x, y)) case "failed" => + (u := quadIfCan(x, y)) case "failed" => + is?(y, "nthRoot"::SY) => prootlimint(f, x, y, lu) + is?(y, "rootOf"::SY) => palglim(f, x, y, lu) + FAIL + palglimint0(f, x, y, lu, u.coef, u.poly) + palglimint0(f, x, y, lu, dumk, v.xsub, v.dxsub) + + palgRDE(nfp, f, g, x, y, rde) == + (v := linearInXIfCan(x, y)) case "failed" => + (u := quadIfCan(x, y)) case "failed" => + is?(y, "nthRoot"::SY) => prootRDE(nfp, f, g, x, y, rde) + palgRDE1(nfp, g, x, y) + palgRDE0(f, g, x, y, rde, u.coef, u.poly) + palgRDE0(f, g, x, y, rde, dumk, v.xsub, v.dxsub) + + -- returns "failed", or (d, P) such that (dy)**2 = P(x) + -- and degree(P) = 2 + quadIfCan(x, y) == + (degree(p := minPoly y) = 2) and zero?(coefficient(p, 1)) => + d := denom(ff := + univariate(- coefficient(p, 0) / coefficient(p, 2), x)) + degree(radi := d * numer ff) = 2 => [d(x::F), radi] + "failed" + "failed" + + if L has LinearOrdinaryDifferentialOperatorCategory F then + palgLODE(eq, g, kx, y, x) == + (v := linearInXIfCan(kx, y)) case "failed" => + (u := quadIfCan(kx, y)) case "failed" => + palgLODE1([coefficient(eq, i) for i in 0..degree eq], g, kx, y, x) + palgLODE0(eq, g, kx, y, u.coef, u.poly) + palgLODE0(eq, g, kx, y, dumk, v.xsub, v.dxsub) + +@ +<>= +"INTPAF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTPAF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"INTPAF" -> "FS" +"INTPAF" -> "ACF" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package PUSHVAR PushVariables} \pagehead{PushVariables}{PUSHVAR} \pagepic{ps/v104pushvariables.ps}{PUSHVAR}{1.00} @@ -29135,9 +38810,165 @@ RationalFunctionFactorizer(R) : C == T @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTRF RationalFunctionIntegration} +\pagehead{RationalFunctionIntegration}{INTRF} +\pagepic{ps/v104rationalfunctionintegration.ps}{INTRF}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTRF RationalFunctionIntegration +++ Integration of rational functions +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 29 Mar 1990 +++ Keywords: polynomial, fraction, integration. +++ Description: +++ This package provides functions for the integration +++ of rational functions. +++ Examples: )r INTRF INPUT +RationalFunctionIntegration(F): Exports == Implementation where + F: Join(IntegralDomain, RetractableTo Integer, CharacteristicZero) + + SE ==> Symbol + P ==> Polynomial F + Q ==> Fraction P + UP ==> SparseUnivariatePolynomial Q + QF ==> Fraction UP + LGQ ==> List Record(coeff:Q, logand:Q) + UQ ==> Union(Record(ratpart:Q, coeff:Q), "failed") + ULQ ==> Union(Record(mainpart:Q, limitedlogs:LGQ), "failed") + + Exports ==> with + internalIntegrate: (Q, SE) -> IntegrationResult Q + ++ internalIntegrate(f, x) returns g such that \spad{dg/dx = f}. + infieldIntegrate : (Q, SE) -> Union(Q, "failed") + ++ infieldIntegrate(f, x) returns a fraction + ++ g such that \spad{dg/dx = f} + ++ if g exists, "failed" otherwise. + limitedIntegrate : (Q, SE, List Q) -> ULQ + ++ \spad{limitedIntegrate(f, x, [g1,...,gn])} returns fractions + ++ \spad{[h, [[ci,gi]]]} such that the gi's are among + ++ \spad{[g1,...,gn]}, + ++ \spad{dci/dx = 0}, and \spad{d(h + sum(ci log(gi)))/dx = f} + ++ if possible, "failed" otherwise. + extendedIntegrate: (Q, SE, Q) -> UQ + ++ extendedIntegrate(f, x, g) returns fractions \spad{[h, c]} such that + ++ \spad{dc/dx = 0} and \spad{dh/dx = f - cg}, if \spad{(h, c)} exist, + ++ "failed" otherwise. + + Implementation ==> add + import RationalIntegration(Q, UP) + import IntegrationResultFunctions2(QF, Q) + import PolynomialCategoryQuotientFunctions(IndexedExponents SE, + SE, F, P, Q) + + infieldIntegrate(f, x) == + map(multivariate(#1, x), infieldint univariate(f, x)) + + internalIntegrate(f, x) == + map(multivariate(#1, x), integrate univariate(f, x)) + + extendedIntegrate(f, x, g) == + map(multivariate(#1, x), + extendedint(univariate(f, x), univariate(g, x))) + + limitedIntegrate(f, x, lu) == + map(multivariate(#1, x), + limitedint(univariate(f, x), [univariate(u, x) for u in lu])) + +@ +<>= +"INTRF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTRF"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INTRF" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTRAT RationalIntegration} +\pagehead{RationalIntegration}{INTRAT} +\pagepic{ps/v104rationalintegration.ps}{INTRAT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTRAT RationalIntegration +++ Rational function integration +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 24 October 1995 +++ Description: +++ This package provides functions for the base +++ case of the Risch algorithm. +-- Used internally bt the integration packages +RationalIntegration(F, UP): Exports == Implementation where + F : Join(Field, CharacteristicZero, RetractableTo Integer) + UP: UnivariatePolynomialCategory F + + RF ==> Fraction UP + IR ==> IntegrationResult RF + LLG ==> List Record(coeff:RF, logand:RF) + URF ==> Union(Record(ratpart:RF, coeff:RF), "failed") + U ==> Union(Record(mainpart:RF, limitedlogs:LLG), "failed") + + Exports ==> with + integrate : RF -> IR + ++ integrate(f) returns g such that \spad{g' = f}. + infieldint : RF -> Union(RF, "failed") + ++ infieldint(f) returns g such that \spad{g' = f} or "failed" + ++ if the integral of f is not a rational function. + extendedint: (RF, RF) -> URF + ++ extendedint(f, g) returns fractions \spad{[h, c]} such that + ++ \spad{c' = 0} and \spad{h' = f - cg}, + ++ if \spad{(h, c)} exist, "failed" otherwise. + limitedint : (RF, List RF) -> U + ++ \spad{limitedint(f, [g1,...,gn])} returns + ++ fractions \spad{[h,[[ci, gi]]]} + ++ such that the gi's are among \spad{[g1,...,gn]}, \spad{ci' = 0}, and + ++ \spad{(h+sum(ci log(gi)))' = f}, if possible, "failed" otherwise. + + Implementation ==> add + import TranscendentalIntegration(F, UP) + + infieldint f == + rec := baseRDE(0, f)$TranscendentalRischDE(F, UP) + rec.nosol => "failed" + rec.ans + + integrate f == + rec := monomialIntegrate(f, differentiate) + integrate(rec.polypart)::RF::IR + rec.ir + + limitedint(f, lu) == + quorem := divide(numer f, denom f) + (u := primlimintfrac(quorem.remainder / (denom f), differentiate, + lu)) case "failed" => "failed" + [u.mainpart + integrate(quorem.quotient)::RF, u.limitedlogs] + + extendedint(f, g) == + fqr := divide(numer f, denom f) + gqr := divide(numer g, denom g) + (i1 := primextintfrac(fqr.remainder / (denom f), differentiate, + gqr.remainder / (denom g))) case "failed" => "failed" + i2:=integrate(fqr.quotient-retract(i1.coeff)@UP *gqr.quotient)::RF + [i2 + i1.ratpart, i1.coeff] + +@ +<>= +"INTRAT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTRAT"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INTRAT" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package REALSOLV RealSolvePackage} <>= -- acplot.spad.pamphlet RealSolvePackage.input +)sys rm RealSolvePackage.output )spool RealSolvePackage.output )set message test on )set message auto off @@ -29578,6 +39409,329 @@ SimpleAlgebraicExtensionAlgFactor(UP,SAE,UPA):Exports==Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package SCACHE SortedCache} +\pagehead{SortedCache}{SCACHE} +\pagepic{ps/v104sortedcache.ps}{SCACHE}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package SCACHE SortedCache +++ Cache of elements in a set +++ Author: Manuel Bronstein +++ Date Created: 31 Oct 1988 +++ Date Last Updated: 14 May 1991 +++ A sorted cache of a cachable set S is a dynamic structure that +++ keeps the elements of S sorted and assigns an integer to each +++ element of S once it is in the cache. This way, equality and ordering +++ on S are tested directly on the integers associated with the elements +++ of S, once they have been entered in the cache. +SortedCache(S:CachableSet): Exports == Implementation where + N ==> NonNegativeInteger + DIFF ==> 1024 + + Exports ==> with + clearCache : () -> Void + ++ clearCache() empties the cache. + cache : () -> List S + ++ cache() returns the current cache as a list. + enterInCache: (S, S -> Boolean) -> S + ++ enterInCache(x, f) enters x in the cache, calling \spad{f(y)} to + ++ determine whether x is equal to y. It returns x with an integer + ++ associated with it. + enterInCache: (S, (S, S) -> Integer) -> S + ++ enterInCache(x, f) enters x in the cache, calling \spad{f(x, y)} to + ++ determine whether \spad{x < y (f(x,y) < 0), x = y (f(x,y) = 0)}, or + ++ \spad{x > y (f(x,y) > 0)}. + ++ It returns x with an integer associated with it. + + Implementation ==> add + shiftCache : (List S, N) -> Void + insertInCache: (List S, List S, S, N) -> S + + cach := [nil()]$Record(cche:List S) + + cache() == cach.cche + + shiftCache(l, n) == + for x in l repeat setPosition(x, n + position x) + void + + clearCache() == + for x in cache repeat setPosition(x, 0) + cach.cche := nil() + void + + enterInCache(x:S, equal?:S -> Boolean) == + scan := cache() + while not null scan repeat + equal?(y := first scan) => + setPosition(x, position y) + return y + scan := rest scan + setPosition(x, 1 + #cache()) + cach.cche := concat(cache(), x) + x + + enterInCache(x:S, triage:(S, S) -> Integer) == + scan := cache() + pos:N:= 0 + for i in 1..#scan repeat + zero?(n := triage(x, y := first scan)) => + setPosition(x, position y) + return y + n<0 => return insertInCache(first(cache(),(i-1)::N),scan,x,pos) + scan := rest scan + pos := position y + setPosition(x, pos + DIFF) + cach.cche := concat(cache(), x) + x + + insertInCache(before, after, x, pos) == + if ((pos+1) = position first after) then shiftCache(after, DIFF) + setPosition(x, pos + (((position first after) - pos)::N quo 2)) + cach.cche := concat(before, concat(x, after)) + x + +@ +<>= +"SCACHE" [color="#FF4488",href="bookvol10.4.pdf#nameddest=SCACHE"] +"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"] +"SCACHE" -> "FLAGG" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package STINPROD StreamInfiniteProduct} +\pagehead{StreamInfiniteProduct}{STINPROD} +\pagepic{ps/v104streaminfiniteproduct.ps}{STINPROD}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package STINPROD StreamInfiniteProduct +++ Author: Clifton J. Williamson +++ Date Created: 23 February 1990 +++ Date Last Updated: 23 February 1990 +++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, +++ generalInfiniteProduct +++ Related Domains: UnivariateTaylorSeriesCategory +++ Also See: +++ AMS Classifications: +++ Keywords: Taylor series, infinite product +++ Examples: +++ References: +++ Description: +++ This package computes infinite products of Taylor series over an +++ integral domain of characteristic 0. Here Taylor series are +++ represented by streams of Taylor coefficients. +StreamInfiniteProduct(Coef): Exports == Implementation where + Coef: Join(IntegralDomain,CharacteristicZero) + I ==> Integer + QF ==> Fraction + ST ==> Stream + + Exports ==> with + + infiniteProduct: ST Coef -> ST Coef + ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + evenInfiniteProduct: ST Coef -> ST Coef + ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + oddInfiniteProduct: ST Coef -> ST Coef + ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + generalInfiniteProduct: (ST Coef,I,I) -> ST Coef + ++ generalInfiniteProduct(f(x),a,d) computes + ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. + ++ The series \spad{f(x)} should have constant coefficient 1. + + Implementation ==> add + + if Coef has Field then + + import StreamTaylorSeriesOperations(Coef) + import StreamTranscendentalFunctions(Coef) + + infiniteProduct st == exp lambert log st + evenInfiniteProduct st == exp evenlambert log st + oddInfiniteProduct st == exp oddlambert log st + generalInfiniteProduct(st,a,d) == exp generalLambert(log st,a,d) + + else + + import StreamTaylorSeriesOperations(QF Coef) + import StreamTranscendentalFunctions(QF Coef) + + applyOverQF:(ST QF Coef -> ST QF Coef,ST Coef) -> ST Coef + applyOverQF(f,st) == + stQF := map(#1 :: QF(Coef),st)$StreamFunctions2(Coef,QF Coef) + map(retract(#1)@Coef,f stQF)$StreamFunctions2(QF Coef,Coef) + + infiniteProduct st == applyOverQF(exp lambert log #1,st) + evenInfiniteProduct st == applyOverQF(exp evenlambert log #1,st) + oddInfiniteProduct st == applyOverQF(exp oddlambert log #1,st) + generalInfiniteProduct(st,a,d) == + applyOverQF(exp generalLambert(log #1,a,d),st) + +@ +<>= +"STINPROD" [color="#FF4488",href="bookvol10.4.pdf#nameddest=STINPROD"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"STINPROD" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package SUBRESP SubResultantPackage} +\pagehead{SubResultantPackage}{SUBRESP} +\pagepic{ps/v104subresultantpackage.ps}{SUBRESP}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package SUBRESP SubResultantPackage +++ Subresultants +++ Author: Barry Trager, Renaud Rioboo +++ Date Created: 1987 +++ Date Last Updated: August 2000 +++ Description: +++ This package computes the subresultants of two polynomials which is needed +++ for the `Lazard Rioboo' enhancement to Tragers integrations formula +++ For efficiency reasons this has been rewritten to call Lionel Ducos +++ package which is currently the best one. +++ +SubResultantPackage(R, UP): Exports == Implementation where + R : IntegralDomain + UP: UnivariatePolynomialCategory R + + Z ==> Integer + N ==> NonNegativeInteger + + Exports ==> with + subresultantVector: (UP, UP) -> PrimitiveArray UP + ++ subresultantVector(p, q) returns \spad{[p0,...,pn]} + ++ where pi is the i-th subresultant of p and q. + ++ In particular, \spad{p0 = resultant(p, q)}. + if R has EuclideanDomain then + primitivePart : (UP, R) -> UP + ++ primitivePart(p, q) reduces the coefficient of p + ++ modulo q, takes the primitive part of the result, + ++ and ensures that the leading coefficient of that + ++ result is monic. + + Implementation ==> add + + Lionel ==> PseudoRemainderSequence(R,UP) + + if R has EuclideanDomain then + primitivePart(p, q) == + rec := extendedEuclidean(leadingCoefficient p, q, + 1)::Record(coef1:R, coef2:R) + unitCanonical primitivePart map((rec.coef1 * #1) rem q, p) + + subresultantVector(p1, p2) == + F : UP -- auxiliary stuff ! + res : PrimitiveArray(UP) := new(2+max(degree(p1),degree(p2)), 0) + -- + -- kind of stupid interface to Lionel's Package !!!!!!!!!!!! + -- might have been wiser to rewrite the loop ... + -- But I'm too lazy. [rr] + -- + l := chainSubResultants(p1,p2)$Lionel + -- + -- this returns the chain of non null subresultants ! + -- we must rebuild subresultants from this. + -- we really hope Lionel Ducos minded what he wrote + -- since we are fully blind ! + -- + null l => + -- Hum it seems that Lionel returns [] when min(|p1|,|p2|) = 0 + zero?(degree(p1)) => + res.degree(p2) := p2 + if degree(p2) > 0 + then + res.((degree(p2)-1)::NonNegativeInteger) := p1 + res.0 := (leadingCoefficient(p1)**(degree p2)) :: UP + else + -- both are of degree 0 the resultant is 1 according to Loos + res.0 := 1 + res + zero?(degree(p2)) => + if degree(p1) > 0 + then + res.((degree(p1)-1)::NonNegativeInteger) := p2 + res.0 := (leadingCoefficient(p2)**(degree p1)) :: UP + else + -- both are of degree 0 the resultant is 1 according to Loos + res.0 := 1 + res + error "SUBRESP: strange Subresultant chain from PRS" + Sn := first(l) + -- + -- as of Loos definitions last subresultant should not be defective + -- + l := rest(l) + n := degree(Sn) + F := Sn + null l => error "SUBRESP: strange Subresultant chain from PRS" + zero? Sn => error "SUBRESP: strange Subresultant chain from PRS" + while (l ^= []) repeat + res.(n) := Sn + F := first(l) + l := rest(l) + -- F is potentially defective + if degree(F) = n + then + -- + -- F is defective + -- + null l => error "SUBRESP: strange Subresultant chain from PRS" + Sn := first(l) + l := rest(l) + n := degree(Sn) + res.((n-1)::NonNegativeInteger) := F + else + -- + -- F is non defective + -- + degree(F) < n => error "strange result !" + Sn := F + n := degree(Sn) + -- + -- Lionel forgets about p1 if |p1| > |p2| + -- forgets about p2 if |p2| > |p1| + -- but he reminds p2 if |p1| = |p2| + -- a glance at Loos should correct this ! + -- + res.n := Sn + -- + -- Loos definition + -- + if degree(p1) = degree(p2) + then + res.((degree p1)+1) := p1 + else + if degree(p1) > degree(p2) + then + res.(degree p1) := p1 + else + res.(degree p2) := p2 + res + +@ +<>= +"SUBRESP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=SUBRESP"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"SUBRESP" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package SUPFRACF SupFractionFactorizer} \pagehead{SupFractionFactorizer}{SUPFRACF} \pagepic{ps/v104supfractionfactorizer.ps}{SUPFRACF}{1.00} @@ -31065,6 +41219,632 @@ TopLevelDrawFunctionsForPoints(): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTHERTR TranscendentalHermiteIntegration} +\pagehead{TranscendentalHermiteIntegration}{INTHERTR} +\pagepic{ps/v104transcendentalhermiteintegration.ps}{INTHERTR}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTHERTR TranscendentalHermiteIntegration +++ Hermite integration, transcendental case +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 12 August 1992 +++ Description: Hermite integration, transcendental case. +TranscendentalHermiteIntegration(F, UP): Exports == Implementation where + F : Field + UP : UnivariatePolynomialCategory F + + N ==> NonNegativeInteger + RF ==> Fraction UP + REC ==> Record(answer:RF, lognum:UP, logden:UP) + HER ==> Record(answer:RF, logpart:RF, specpart:RF, polypart:UP) + + Exports ==> with + HermiteIntegrate: (RF, UP -> UP) -> HER + ++ HermiteIntegrate(f, D) returns \spad{[g, h, s, p]} + ++ such that \spad{f = Dg + h + s + p}, + ++ h has a squarefree denominator normal w.r.t. D, + ++ and all the squarefree factors of the denominator of s are + ++ special w.r.t. D. Furthermore, h and s have no polynomial parts. + ++ D is the derivation to use on \spadtype{UP}. + + Implementation ==> add + import MonomialExtensionTools(F, UP) + + normalHermiteIntegrate: (RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP) + + HermiteIntegrate(f, derivation) == + rec := decompose(f, derivation) + hi := normalHermiteIntegrate(rec.normal, derivation) + qr := divide(hi.lognum, hi.logden) + [hi.answer, qr.remainder / hi.logden, rec.special, qr.quotient + rec.poly] + +-- Hermite Reduction on f, every squarefree factor of denom(f) is normal wrt D +-- this is really a "parallel" Hermite reduction, in the sense that +-- every multiple factor of the denominator gets reduced at each pass +-- so if the denominator is P1 P2**2 ... Pn**n, this requires O(n) +-- reduction steps instead of O(n**2), like Mack's algorithm +-- (D.Mack, On Rational Integration, Univ. of Utah C.S. Tech.Rep. UCP-38,1975) +-- returns [g, b, d] s.t. f = g' + b/d and d is squarefree and normal wrt D + normalHermiteIntegrate(f, derivation) == + a := numer f + q := denom f + p:UP := 0 + mult:UP := 1 + qhat := (q exquo (g0 := g := gcd(q, differentiate q)))::UP + while(degree(qbar := g) > 0) repeat + qbarhat := (qbar exquo (g := gcd(qbar, differentiate qbar)))::UP + qtil:= - ((qhat * (derivation qbar)) exquo qbar)::UP + bc := + extendedEuclidean(qtil, qbarhat, a)::Record(coef1:UP, coef2:UP) + qr := divide(bc.coef1, qbarhat) + a := bc.coef2 + qtil * qr.quotient - derivation(qr.remainder) + * (qhat exquo qbarhat)::UP + p := p + mult * qr.remainder + mult:= mult * qbarhat + [p / g0, a, qhat] + +@ +<>= +"INTHERTR" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTHERTR"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INTHERTR" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package INTTR TranscendentalIntegration} +\pagehead{TranscendentalIntegration}{INTTR} +\pagepic{ps/v104transcendentalintegration.ps}{INTTR}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package INTTR TranscendentalIntegration +++ Risch algorithm, transcendental case +++ Author: Manuel Bronstein +++ Date Created: 1987 +++ Date Last Updated: 24 October 1995 +++ Description: +++ This package provides functions for the transcendental +++ case of the Risch algorithm. +-- Internally used by the integrator +TranscendentalIntegration(F, UP): Exports == Implementation where + F : Field + UP : UnivariatePolynomialCategory F + + N ==> NonNegativeInteger + Z ==> Integer + Q ==> Fraction Z + GP ==> LaurentPolynomial(F, UP) + UP2 ==> SparseUnivariatePolynomial UP + RF ==> Fraction UP + UPR ==> SparseUnivariatePolynomial RF + IR ==> IntegrationResult RF + LOG ==> Record(scalar:Q, coeff:UPR, logand:UPR) + LLG ==> List Record(coeff:RF, logand:RF) + NE ==> Record(integrand:RF, intvar:RF) + NL ==> Record(mainpart:RF, limitedlogs:LLG) + UPF ==> Record(answer:UP, a0:F) + RFF ==> Record(answer:RF, a0:F) + IRF ==> Record(answer:IR, a0:F) + NLF ==> Record(answer:NL, a0:F) + GPF ==> Record(answer:GP, a0:F) + UPUP==> Record(elem:UP, notelem:UP) + GPGP==> Record(elem:GP, notelem:GP) + RFRF==> Record(elem:RF, notelem:RF) + FF ==> Record(ratpart:F, coeff:F) + FFR ==> Record(ratpart:RF, coeff:RF) + UF ==> Union(FF, "failed") + UF2 ==> Union(List F, "failed") + REC ==> Record(ir:IR, specpart:RF, polypart:UP) + PSOL==> Record(ans:F, right:F, sol?:Boolean) + FAIL==> error "Sorry - cannot handle that integrand yet" + + Exports ==> with + primintegrate : (RF, UP -> UP, F -> UF) -> IRF + ++ primintegrate(f, ', foo) returns \spad{[g, a]} such that + ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in UP. + ++ Argument foo is an extended integration function on F. + expintegrate : (RF, UP -> UP, (Z, F) -> PSOL) -> IRF + ++ expintegrate(f, ', foo) returns \spad{[g, a]} such that + ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in F; + ++ Argument foo is a Risch differential equation solver on F; + tanintegrate : (RF, UP -> UP, (Z, F, F) -> UF2) -> IRF + ++ tanintegrate(f, ', foo) returns \spad{[g, a]} such that + ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in F; + ++ Argument foo is a Risch differential system solver on F; + primextendedint:(RF, UP -> UP, F->UF, RF) -> Union(RFF,FFR,"failed") + ++ primextendedint(f, ', foo, g) returns either \spad{[v, c]} such that + ++ \spad{f = v' + c g} and \spad{c' = 0}, or \spad{[v, a]} such that + ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in UP. + ++ Returns "failed" if neither case can hold. + ++ Argument foo is an extended integration function on F. + expextendedint:(RF,UP->UP,(Z,F)->PSOL, RF) -> Union(RFF,FFR,"failed") + ++ expextendedint(f, ', foo, g) returns either \spad{[v, c]} such that + ++ \spad{f = v' + c g} and \spad{c' = 0}, or \spad{[v, a]} such that + ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in F. + ++ Returns "failed" if neither case can hold. + ++ Argument foo is a Risch differential equation function on F. + primlimitedint:(RF, UP -> UP, F->UF, List RF) -> Union(NLF,"failed") + ++ primlimitedint(f, ', foo, [u1,...,un]) returns + ++ \spad{[v, [c1,...,cn], a]} such that \spad{ci' = 0}, + ++ \spad{f = v' + a + reduce(+,[ci * ui'/ui])}, + ++ and \spad{a = 0} or \spad{a} has no integral in UP. + ++ Returns "failed" if no such v, ci, a exist. + ++ Argument foo is an extended integration function on F. + explimitedint:(RF, UP->UP,(Z,F)->PSOL,List RF) -> Union(NLF,"failed") + ++ explimitedint(f, ', foo, [u1,...,un]) returns + ++ \spad{[v, [c1,...,cn], a]} such that \spad{ci' = 0}, + ++ \spad{f = v' + a + reduce(+,[ci * ui'/ui])}, + ++ and \spad{a = 0} or \spad{a} has no integral in F. + ++ Returns "failed" if no such v, ci, a exist. + ++ Argument foo is a Risch differential equation function on F. + primextintfrac : (RF, UP -> UP, RF) -> Union(FFR, "failed") + ++ primextintfrac(f, ', g) returns \spad{[v, c]} such that + ++ \spad{f = v' + c g} and \spad{c' = 0}. + ++ Error: if \spad{degree numer f >= degree denom f} or + ++ if \spad{degree numer g >= degree denom g} or + ++ if \spad{denom g} is not squarefree. + primlimintfrac : (RF, UP -> UP, List RF) -> Union(NL, "failed") + ++ primlimintfrac(f, ', [u1,...,un]) returns \spad{[v, [c1,...,cn]]} + ++ such that \spad{ci' = 0} and \spad{f = v' + +/[ci * ui'/ui]}. + ++ Error: if \spad{degree numer f >= degree denom f}. + primintfldpoly : (UP, F -> UF, F) -> Union(UP, "failed") + ++ primintfldpoly(p, ', t') returns q such that \spad{p' = q} or + ++ "failed" if no such q exists. Argument \spad{t'} is the derivative of + ++ the primitive generating the extension. + expintfldpoly : (GP, (Z, F) -> PSOL) -> Union(GP, "failed") + ++ expintfldpoly(p, foo) returns q such that \spad{p' = q} or + ++ "failed" if no such q exists. + ++ Argument foo is a Risch differential equation function on F. + monomialIntegrate : (RF, UP -> UP) -> REC + ++ monomialIntegrate(f, ') returns \spad{[ir, s, p]} such that + ++ \spad{f = ir' + s + p} and all the squarefree factors of the + ++ denominator of s are special w.r.t the derivation '. + monomialIntPoly : (UP, UP -> UP) -> Record(answer:UP, polypart:UP) + ++ monomialIntPoly(p, ') returns [q, r] such that + ++ \spad{p = q' + r} and \spad{degree(r) < degree(t')}. + ++ Error if \spad{degree(t') < 2}. + + Implementation ==> add + import SubResultantPackage(UP, UP2) + import MonomialExtensionTools(F, UP) + import TranscendentalHermiteIntegration(F, UP) + import CommuteUnivariatePolynomialCategory(F, UP, UP2) + + primintegratepoly : (UP, F -> UF, F) -> Union(UPF, UPUP) + expintegratepoly : (GP, (Z, F) -> PSOL) -> Union(GPF, GPGP) + expextintfrac : (RF, UP -> UP, RF) -> Union(FFR, "failed") + explimintfrac : (RF, UP -> UP, List RF) -> Union(NL, "failed") + limitedLogs : (RF, RF -> RF, List RF) -> Union(LLG, "failed") + logprmderiv : (RF, UP -> UP) -> RF + logexpderiv : (RF, UP -> UP, F) -> RF + tanintegratespecial: (RF, RF -> RF, (Z, F, F) -> UF2) -> Union(RFF, RFRF) + UP2UP2 : UP -> UP2 + UP2UPR : UP -> UPR + UP22UPR : UP2 -> UPR + notelementary : REC -> IR + kappa : (UP, UP -> UP) -> UP + + dummy:RF := 0 + + logprmderiv(f, derivation) == differentiate(f, derivation) / f + + UP2UP2 p == + map(#1::UP, p)$UnivariatePolynomialCategoryFunctions2(F, UP, UP, UP2) + + UP2UPR p == + map(#1::UP::RF, p)$UnivariatePolynomialCategoryFunctions2(F, UP, RF, UPR) + + UP22UPR p == map(#1::RF, p)$SparseUnivariatePolynomialFunctions2(UP, RF) + +-- given p in k[z] and a derivation on k[t] returns the coefficient lifting +-- in k[z] of the restriction of D to k. + kappa(p, derivation) == + ans:UP := 0 + while p ^= 0 repeat + ans := ans + derivation(leadingCoefficient(p)::UP)*monomial(1,degree p) + p := reductum p + ans + +-- works in any monomial extension + monomialIntegrate(f, derivation) == + zero? f => [0, 0, 0] + r := HermiteIntegrate(f, derivation) + zero?(inum := numer(r.logpart)) => [r.answer::IR, r.specpart, r.polypart] + iden := denom(r.logpart) + x := monomial(1, 1)$UP + resultvec := subresultantVector(UP2UP2 inum - + (x::UP2) * UP2UP2 derivation iden, UP2UP2 iden) + respoly := primitivePart leadingCoefficient resultvec 0 + rec := splitSquarefree(respoly, kappa(#1, derivation)) + logs:List(LOG) := [ + [1, UP2UPR(term.factor), + UP22UPR swap primitivePart(resultvec(term.exponent),term.factor)] + for term in factors(rec.special)] + dlog := +-- one? derivation x => r.logpart + ((derivation x) = 1) => r.logpart + differentiate(mkAnswer(0, logs, empty()), + differentiate(#1, derivation)) + (u := retractIfCan(p := r.logpart - dlog)@Union(UP, "failed")) case UP => + [mkAnswer(r.answer, logs, empty), r.specpart, r.polypart + u::UP] + [mkAnswer(r.answer, logs, [[p, dummy]]), r.specpart, r.polypart] + +-- returns [q, r] such that p = q' + r and degree(r) < degree(dt) +-- must have degree(derivation t) >= 2 + monomialIntPoly(p, derivation) == + (d := degree(dt := derivation monomial(1,1))::Z) < 2 => + error "monomIntPoly: monomial must have degree 2 or more" + l := leadingCoefficient dt + ans:UP := 0 + while (n := 1 + degree(p)::Z - d) > 0 repeat + ans := ans + (term := monomial(leadingCoefficient(p) / (n * l), n::N)) + p := p - derivation term -- degree(p) must drop here + [ans, p] + +-- returns either +-- (q in GP, a in F) st p = q' + a, and a=0 or a has no integral in F +-- or (q in GP, r in GP) st p = q' + r, and r has no integral elem/UP + expintegratepoly(p, FRDE) == + coef0:F := 0 + notelm := answr := 0$GP + while p ^= 0 repeat + ans1 := FRDE(n := degree p, a := leadingCoefficient p) + answr := answr + monomial(ans1.ans, n) + if ~ans1.sol? then -- Risch d.e. has no complete solution + missing := a - ans1.right + if zero? n then coef0 := missing + else notelm := notelm + monomial(missing, n) + p := reductum p + zero? notelm => [answr, coef0] + [answr, notelm] + +-- f is either 0 or of the form p(t)/(1 + t**2)**n +-- returns either +-- (q in RF, a in F) st f = q' + a, and a=0 or a has no integral in F +-- or (q in RF, r in RF) st f = q' + r, and r has no integral elem/UP + tanintegratespecial(f, derivation, FRDE) == + ans:RF := 0 + p := monomial(1, 2)$UP + 1 + while (n := degree(denom f) quo 2) ^= 0 repeat + r := numer(f) rem p + a := coefficient(r, 1) + b := coefficient(r, 0) + (u := FRDE(n, a, b)) case "failed" => return [ans, f] + l := u::List(F) + term:RF := (monomial(first l, 1)$UP + second(l)::UP) / denom f + ans := ans + term + f := f - derivation term -- the order of the pole at 1+t^2 drops + zero?(c0 := retract(retract(f)@UP)@F) or + (u := FRDE(0, c0, 0)) case "failed" => [ans, c0] + [ans + first(u::List(F))::UP::RF, 0::F] + +-- returns (v in RF, c in RF) s.t. f = v' + cg, and c' = 0, or "failed" +-- g must have a squarefree denominator (always possible) +-- g must have no polynomial part and no pole above t = 0 +-- f must have no polynomial part and no pole above t = 0 + expextintfrac(f, derivation, g) == + zero? f => [0, 0] + degree numer f >= degree denom f => error "Not a proper fraction" + order(denom f,monomial(1,1)) ^= 0 => error "Not integral at t = 0" + r := HermiteIntegrate(f, derivation) + zero? g => + r.logpart ^= 0 => "failed" + [r.answer, 0] + degree numer g >= degree denom g => error "Not a proper fraction" + order(denom g,monomial(1,1)) ^= 0 => error "Not integral at t = 0" + differentiate(c := r.logpart / g, derivation) ^= 0 => "failed" + [r.answer, c] + + limitedLogs(f, logderiv, lu) == + zero? f => empty() + empty? lu => "failed" + empty? rest lu => + logderiv(c0 := f / logderiv(u0 := first lu)) ^= 0 => "failed" + [[c0, u0]] + num := numer f + den := denom f + l1:List Record(logand2:RF, contrib:UP) := +-- [[u, numer v] for u in lu | one? denom(v := den * logderiv u)] + [[u, numer v] for u in lu | (denom(v := den * logderiv u) = 1)] + rows := max(degree den, + 1 + reduce(max, [degree(u.contrib) for u in l1], 0)$List(N)) + m:Matrix(F) := zero(rows, cols := 1 + #l1) + for i in 0..rows-1 repeat + for pp in l1 for j in minColIndex m .. maxColIndex m - 1 repeat + qsetelt_!(m, i + minRowIndex m, j, coefficient(pp.contrib, i)) + qsetelt_!(m,i+minRowIndex m, maxColIndex m, coefficient(num, i)) + m := rowEchelon m + ans := empty()$LLG + for i in minRowIndex m .. maxRowIndex m | + qelt(m, i, maxColIndex m) ^= 0 repeat + OK := false + for pp in l1 for j in minColIndex m .. maxColIndex m - 1 + while not OK repeat + if qelt(m, i, j) ^= 0 then + OK := true + c := qelt(m, i, maxColIndex m) / qelt(m, i, j) + logderiv(c0 := c::UP::RF) ^= 0 => return "failed" + ans := concat([c0, pp.logand2], ans) + not OK => return "failed" + ans + +-- returns q in UP s.t. p = q', or "failed" + primintfldpoly(p, extendedint, t') == + (u := primintegratepoly(p, extendedint, t')) case UPUP => "failed" + u.a0 ^= 0 => "failed" + u.answer + +-- returns q in GP st p = q', or "failed" + expintfldpoly(p, FRDE) == + (u := expintegratepoly(p, FRDE)) case GPGP => "failed" + u.a0 ^= 0 => "failed" + u.answer + +-- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0, +-- and f = v' + a + +/[ci * ui'/ui] +-- and a = 0 or a has no integral in UP + primlimitedint(f, derivation, extendedint, lu) == + qr := divide(numer f, denom f) + (u1 := primlimintfrac(qr.remainder / (denom f), derivation, lu)) + case "failed" => "failed" + (u2 := primintegratepoly(qr.quotient, extendedint, + retract derivation monomial(1, 1))) case UPUP => "failed" + [[u1.mainpart + u2.answer::RF, u1.limitedlogs], u2.a0] + +-- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0, +-- and f = v' + a + +/[ci * ui'/ui] +-- and a = 0 or a has no integral in F + explimitedint(f, derivation, FRDE, lu) == + qr := separate(f)$GP + (u1 := explimintfrac(qr.fracPart,derivation, lu)) case "failed" => + "failed" + (u2 := expintegratepoly(qr.polyPart, FRDE)) case GPGP => "failed" + [[u1.mainpart + convert(u2.answer)@RF, u1.limitedlogs], u2.a0] + +-- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui] +-- f must have no polynomial part (degree numer f < degree denom f) + primlimintfrac(f, derivation, lu) == + zero? f => [0, empty()] + degree numer f >= degree denom f => error "Not a proper fraction" + r := HermiteIntegrate(f, derivation) + zero?(r.logpart) => [r.answer, empty()] + (u := limitedLogs(r.logpart, logprmderiv(#1, derivation), lu)) + case "failed" => "failed" + [r.answer, u::LLG] + +-- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui] +-- f must have no polynomial part (degree numer f < degree denom f) +-- f must be integral above t = 0 + explimintfrac(f, derivation, lu) == + zero? f => [0, empty()] + degree numer f >= degree denom f => error "Not a proper fraction" + order(denom f, monomial(1,1)) > 0 => error "Not integral at t = 0" + r := HermiteIntegrate(f, derivation) + zero?(r.logpart) => [r.answer, empty()] + eta' := coefficient(derivation monomial(1, 1), 1) + (u := limitedLogs(r.logpart, logexpderiv(#1,derivation,eta'), lu)) + case "failed" => "failed" + [r.answer - eta'::UP * + +/[((degree numer(v.logand))::Z - (degree denom(v.logand))::Z) * + v.coeff for v in u], u::LLG] + + logexpderiv(f, derivation, eta') == + (differentiate(f, derivation) / f) - + (((degree numer f)::Z - (degree denom f)::Z) * eta')::UP::RF + + notelementary rec == + rec.ir + integral(rec.polypart::RF + rec.specpart, monomial(1,1)$UP :: RF) + +-- returns +-- (g in IR, a in F) st f = g'+ a, and a=0 or a has no integral in UP + primintegrate(f, derivation, extendedint) == + rec := monomialIntegrate(f, derivation) + not elem?(i1 := rec.ir) => [notelementary rec, 0] + (u2 := primintegratepoly(rec.polypart, extendedint, + retract derivation monomial(1, 1))) case UPUP => + [i1 + u2.elem::RF::IR + + integral(u2.notelem::RF, monomial(1,1)$UP :: RF), 0] + [i1 + u2.answer::RF::IR, u2.a0] + +-- returns +-- (g in IR, a in F) st f = g' + a, and a = 0 or a has no integral in F + expintegrate(f, derivation, FRDE) == + rec := monomialIntegrate(f, derivation) + not elem?(i1 := rec.ir) => [notelementary rec, 0] +-- rec.specpart is either 0 or of the form p(t)/t**n + special := rec.polypart::GP + + (numer(rec.specpart)::GP exquo denom(rec.specpart)::GP)::GP + (u2 := expintegratepoly(special, FRDE)) case GPGP => + [i1 + convert(u2.elem)@RF::IR + integral(convert(u2.notelem)@RF, + monomial(1,1)$UP :: RF), 0] + [i1 + convert(u2.answer)@RF::IR, u2.a0] + +-- returns +-- (g in IR, a in F) st f = g' + a, and a = 0 or a has no integral in F + tanintegrate(f, derivation, FRDE) == + rec := monomialIntegrate(f, derivation) + not elem?(i1 := rec.ir) => [notelementary rec, 0] + r := monomialIntPoly(rec.polypart, derivation) + t := monomial(1, 1)$UP + c := coefficient(r.polypart, 1) / leadingCoefficient(derivation t) + derivation(c::UP) ^= 0 => + [i1 + mkAnswer(r.answer::RF, empty(), + [[r.polypart::RF + rec.specpart, dummy]$NE]), 0] + logs:List(LOG) := + zero? c => empty() + [[1, monomial(1,1)$UPR - (c/(2::F))::UP::RF::UPR, (1 + t**2)::RF::UPR]] + c0 := coefficient(r.polypart, 0) + (u := tanintegratespecial(rec.specpart, differentiate(#1, derivation), + FRDE)) case RFRF => + [i1 + mkAnswer(r.answer::RF + u.elem, logs, [[u.notelem,dummy]$NE]), c0] + [i1 + mkAnswer(r.answer::RF + u.answer, logs, empty()), u.a0 + c0] + +-- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 +-- or (v in RF, a in F) s.t. f = v' + a +-- and a = 0 or a has no integral in UP + primextendedint(f, derivation, extendedint, g) == + fqr := divide(numer f, denom f) + gqr := divide(numer g, denom g) + (u1 := primextintfrac(fqr.remainder / (denom f), derivation, + gqr.remainder / (denom g))) case "failed" => "failed" + zero?(gqr.remainder) => + -- the following FAIL cannot occur if the primitives are all logs + degree(gqr.quotient) > 0 => FAIL + (u3 := primintegratepoly(fqr.quotient, extendedint, + retract derivation monomial(1, 1))) case UPUP => "failed" + [u1.ratpart + u3.answer::RF, u3.a0] + (u2 := primintfldpoly(fqr.quotient - retract(u1.coeff)@UP * + gqr.quotient, extendedint, retract derivation monomial(1, 1))) + case "failed" => "failed" + [u2::UP::RF + u1.ratpart, u1.coeff] + +-- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 +-- or (v in RF, a in F) s.t. f = v' + a +-- and a = 0 or a has no integral in F + expextendedint(f, derivation, FRDE, g) == + qf := separate(f)$GP + qg := separate g + (u1 := expextintfrac(qf.fracPart, derivation, qg.fracPart)) + case "failed" => "failed" + zero?(qg.fracPart) => + --the following FAIL's cannot occur if the primitives are all logs + retractIfCan(qg.polyPart)@Union(F,"failed") case "failed"=> FAIL + (u3 := expintegratepoly(qf.polyPart,FRDE)) case GPGP => "failed" + [u1.ratpart + convert(u3.answer)@RF, u3.a0] + (u2 := expintfldpoly(qf.polyPart - retract(u1.coeff)@UP :: GP + * qg.polyPart, FRDE)) case "failed" => "failed" + [convert(u2::GP)@RF + u1.ratpart, u1.coeff] + +-- returns either +-- (q in UP, a in F) st p = q'+ a, and a=0 or a has no integral in UP +-- or (q in UP, r in UP) st p = q'+ r, and r has no integral elem/UP + primintegratepoly(p, extendedint, t') == + zero? p => [0, 0$F] + ans:UP := 0 + while (d := degree p) > 0 repeat + (ans1 := extendedint leadingCoefficient p) case "failed" => + return([ans, p]) + p := reductum p - monomial(d * t' * ans1.ratpart, (d - 1)::N) + ans := ans + monomial(ans1.ratpart, d) + + monomial(ans1.coeff / (d + 1)::F, d + 1) + (ans1:= extendedint(rp := retract(p)@F)) case "failed" => [ans,rp] + [monomial(ans1.coeff, 1) + ans1.ratpart::UP + ans, 0$F] + +-- returns (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 +-- g must have a squarefree denominator (always possible) +-- g must have no polynomial part (degree numer g < degree denom g) +-- f must have no polynomial part (degree numer f < degree denom f) + primextintfrac(f, derivation, g) == + zero? f => [0, 0] + degree numer f >= degree denom f => error "Not a proper fraction" + r := HermiteIntegrate(f, derivation) + zero? g => + r.logpart ^= 0 => "failed" + [r.answer, 0] + degree numer g >= degree denom g => error "Not a proper fraction" + differentiate(c := r.logpart / g, derivation) ^= 0 => "failed" + [r.answer, c] + +@ +<>= +"INTTR" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTTR"] +"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] +"INTTR" -> "PFECAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package TRIMAT TriangularMatrixOperations} +\pagehead{TriangularMatrixOperations}{TRIMAT} +\pagepic{ps/v104triangularmatrixoperations.ps}{TRIMAT}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package TRIMAT TriangularMatrixOperations +++ Fraction free inverses of triangular matrices +++ Author: Victor Miller +++ Date Created: +++ Date Last Updated: 24 Jul 1990 +++ Keywords: +++ Examples: +++ References: +++ Description: +++ This package provides functions that compute "fraction-free" +++ inverses of upper and lower triangular matrices over a integral +++ domain. By "fraction-free inverses" we mean the following: +++ given a matrix B with entries in R and an element d of R such that +++ d * inv(B) also has entries in R, we return d * inv(B). Thus, +++ it is not necessary to pass to the quotient field in any of our +++ computations. + + +TriangularMatrixOperations(R,Row,Col,M): Exports == Implementation where + R : IntegralDomain + Row : FiniteLinearAggregate R + Col : FiniteLinearAggregate R + M : MatrixCategory(R,Row,Col) + + Exports ==> with + + UpTriBddDenomInv: (M,R) -> M + ++ UpTriBddDenomInv(B,d) returns M, where + ++ B is a non-singular upper triangular matrix and d is an + ++ element of R such that \spad{M = d * inv(B)} has entries in R. + LowTriBddDenomInv:(M,R) -> M + ++ LowTriBddDenomInv(B,d) returns M, where + ++ B is a non-singular lower triangular matrix and d is an + ++ element of R such that \spad{M = d * inv(B)} has entries in R. + + Implementation ==> add + + UpTriBddDenomInv(A,denom) == + AI := zero(nrows A, nrows A)$M + offset := minColIndex AI - minRowIndex AI + for i in minRowIndex AI .. maxRowIndex AI + for j in minColIndex AI .. maxColIndex AI repeat + qsetelt_!(AI,i,j,(denom exquo qelt(A,i,j))::R) + for i in minRowIndex AI .. maxRowIndex AI repeat + for j in offset + i + 1 .. maxColIndex AI repeat + qsetelt_!(AI,i,j, - (((+/[qelt(AI,i,k) * qelt(A,k-offset,j) + for k in i+offset..(j-1)]) + exquo qelt(A, j-offset, j))::R)) + AI + + LowTriBddDenomInv(A, denom) == + AI := zero(nrows A, nrows A)$M + offset := minColIndex AI - minRowIndex AI + for i in minRowIndex AI .. maxRowIndex AI + for j in minColIndex AI .. maxColIndex AI repeat + qsetelt_!(AI,i,j,(denom exquo qelt(A,i,j))::R) + for i in minColIndex AI .. maxColIndex AI repeat + for j in i - offset + 1 .. maxRowIndex AI repeat + qsetelt_!(AI,j,i, - (((+/[qelt(A,j,k+offset) * qelt(AI,k,i) + for k in i-offset..(j-1)]) + exquo qelt(A, j, j+offset))::R)) + AI + +@ +<>= +"TRIMAT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=TRIMAT"] +"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] +"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] +"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"] +"TRIGMNIP" -> "ACF" +"TRIGMNIP" -> "FS" +"TRIGMNIP" -> "COMPCAT" + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package TRIGMNIP TrigonometricManipulations} \pagehead{TrigonometricManipulations}{TRIGMNIP} \pagepic{ps/v104trigonometricmanipulations.ps}{TRIGMNIP}{1.00} @@ -31589,6 +42369,217 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter W} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{package WFFINTBS WildFunctionFieldIntegralBasis} +\pagehead{WildFunctionFieldIntegralBasis}{WFFINTBS} +\pagepic{ps/v104wildfunctionfieldintegralbasis.ps}{WFFINTBS}{1.00} + +{\bf Exports:}\\ +\begin{tabular}{lllll} +\end{tabular} + +<>= +)abbrev package WFFINTBS WildFunctionFieldIntegralBasis +++ Authors: Victor Miller, Clifton Williamson +++ Date Created: 24 July 1991 +++ Date Last Updated: 20 September 1994 +++ Basic Operations: integralBasis, localIntegralBasis +++ Related Domains: IntegralBasisTools(R,UP,F), +++ TriangularMatrixOperations(R,Vector R,Vector R,Matrix R) +++ Also See: FunctionFieldIntegralBasis, NumberFieldIntegralBasis +++ AMS Classifications: +++ Keywords: function field, integral basis +++ Examples: +++ References: +++ Description: +++ In this package K is a finite field, R is a ring of univariate +++ polynomials over K, and F is a framed algebra over R. The package +++ provides a function to compute the integral closure of R in the quotient +++ field of F as well as a function to compute a "local integral basis" +++ at a specific prime. + +WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where + K : FiniteFieldCategory + --K : Join(Field,Finite) + R : UnivariatePolynomialCategory K + UP : UnivariatePolynomialCategory R + F : FramedAlgebra(R,UP) + + I ==> Integer + Mat ==> Matrix R + NNI ==> NonNegativeInteger + SAE ==> SimpleAlgebraicExtension + RResult ==> Record(basis: Mat, basisDen: R, basisInv:Mat) + IResult ==> Record(basis: Mat, basisDen: R, basisInv:Mat,discr: R) + MATSTOR ==> StorageEfficientMatrixOperations + + Exports ==> with + integralBasis : () -> RResult + ++ \spad{integralBasis()} returns a record + ++ \spad{[basis,basisDen,basisInv]} containing information regarding + ++ the integral closure of R in the quotient field of F, where + ++ F is a framed algebra with R-module basis \spad{w1,w2,...,wn}. + ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ the \spad{i}th element of the integral basis is + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of \spad{basis} contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + localIntegralBasis : R -> RResult + ++ \spad{integralBasis(p)} returns a record + ++ \spad{[basis,basisDen,basisInv]} containing information regarding + ++ the local integral closure of R at the prime \spad{p} in the quotient + ++ field of F, where F is a framed algebra with R-module basis + ++ \spad{w1,w2,...,wn}. + ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then + ++ the \spad{i}th element of the local integral basis is + ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the + ++ \spad{i}th row of \spad{basis} contains the coordinates of the + ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the + ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with + ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the + ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then + ++ \spad{wi = sum(bij * vj, j = 1..n)}. + + Implementation ==> add + import IntegralBasisTools(R, UP, F) + import ModularHermitianRowReduction(R) + import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) + import DistinctDegreeFactorize(K,R) + + listSquaredFactors: R -> List R + listSquaredFactors px == + -- returns a list of the factors of px which occur with + -- exponent > 1 + ans : List R := empty() + factored := factor(px)$DistinctDegreeFactorize(K,R) + for f in factors(factored) repeat + if f.exponent > 1 then ans := concat(f.factor,ans) + ans + + iLocalIntegralBasis: (Vector F,Vector F,Matrix R,Matrix R,R,R) -> IResult + iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) == + n := rank()$F; standardBasis := basis()$F + -- 'standardBasis' is the basis for F as a FramedAlgebra; + -- usually this is [1,y,y**2,...,y**(n-1)] + p2 := prime * prime; sae := SAE(K,R,prime) + p := characteristic()$F; q := size()$sae + lp := leastPower(q,n) + rb := scalarMatrix(n,1); rbinv := scalarMatrix(n,1) + -- rb = basis matrix of current order + -- rbinv = inverse basis matrix of current order + -- these are wrt the orginal basis for F + rbden : R := 1; index : R := 1; oldIndex : R := 1 + -- rbden = denominator for current basis matrix + -- index = index of original order in current order + repeat + -- pows = [(w1 * rbden) ** q,...,(wn * rbden) ** q], where + -- bas = [w1,...,wn] is 'rbden' times the basis for the order B = 'rb' + for i in 1..n repeat + bi : F := 0 + for j in 1..n repeat + bi := bi + qelt(rb,i,j) * qelt(standardBasis,j) + qsetelt_!(bas,i,bi) + qsetelt_!(pows,i,bi ** p) + coor0 := transpose coordinates(pows,bas) + denPow := rbden ** ((p - 1) :: NNI) + (coMat0 := coor0 exquo denPow) case "failed" => + error "can't happen" + -- the jth column of coMat contains the coordinates of (wj/rbden)**q + -- with respect to the basis [w1/rbden,...,wn/rbden] + coMat := coMat0 :: Matrix R + -- the ith column of 'pPows' contains the coordinates of the pth power + -- of the ith basis element for B/prime.B over 'sae' = R/prime.R + pPows := map(reduce,coMat)$MatrixCategoryFunctions2(R,Vector R, + Vector R,Matrix R,sae,Vector sae,Vector sae,Matrix sae) + -- 'frob' will eventually be the Frobenius matrix for B/prime.B over + -- 'sae' = R/prime.R; at each stage of the loop the ith column will + -- contain the coordinates of p^k-th powers of the ith basis element + frob := copy pPows; tmpMat : Matrix sae := new(n,n,0) + for r in 2..leastPower(p,q) repeat + for i in 1..n repeat for j in 1..n repeat + qsetelt_!(tmpMat,i,j,qelt(frob,i,j) ** p) + times_!(frob,pPows,tmpMat)$MATSTOR(sae) + frobPow := frob ** lp + -- compute the p-radical + ns := nullSpace frobPow + for i in 1..n repeat for j in 1..n repeat qsetelt_!(tfm,i,j,0) + for vec in ns for i in 1.. repeat + for j in 1..n repeat + qsetelt_!(tfm,i,j,lift qelt(vec,j)) + id := squareTop rowEchelon(tfm,prime) + -- id = basis matrix of the p-radical + idinv := UpTriBddDenomInv(id, prime) + -- id * idinv = prime * identity + -- no need to check for inseparability in this case + rbinv := idealiser(id * rb, rbinv * idinv, prime * rbden) + index := diagonalProduct rbinv + rb := rowEchelon LowTriBddDenomInv(rbinv,rbden * prime) + if divideIfCan_!(rb,matrixOut,prime,n) = 1 + then rb := matrixOut + else rbden := rbden * prime + rbinv := UpTriBddDenomInv(rb,rbden) + indexChange := index quo oldIndex + oldIndex := index + disc := disc quo (indexChange * indexChange) + (not sizeLess?(1,indexChange)) or ((disc exquo p2) case "failed") => + return [rb, rbden, rbinv, disc] + + integralBasis() == + traceMat := traceMatrix()$F; n := rank()$F + disc := determinant traceMat -- discriminant of current order + zero? disc => error "integralBasis: polynomial must be separable" + singList := listSquaredFactors disc -- singularities of relative Spec + runningRb := scalarMatrix(n,1); runningRbinv := scalarMatrix(n,1) + -- runningRb = basis matrix of current order + -- runningRbinv = inverse basis matrix of current order + -- these are wrt the original basis for F + runningRbden : R := 1 + -- runningRbden = denominator for current basis matrix + empty? singList => [runningRb, runningRbden, runningRbinv] + bas : Vector F := new(n,0); pows : Vector F := new(n,0) + -- storage for basis elements and their powers + tfm : Matrix R := new(n,n,0) + -- 'tfm' will contain the coordinates of a lifting of the kernel + -- of a power of Frobenius + matrixOut : Matrix R := new(n,n,0) + for prime in singList repeat + lb := iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) + rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen + disc := lb.discr + -- update 'running integral basis' if newly computed + -- local integral basis is non-trivial + if sizeLess?(1,rbden) then + mat := vertConcat(rbden * runningRb,runningRbden * rb) + runningRbden := runningRbden * rbden + runningRb := squareTop rowEchelon(mat,runningRbden) + runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) + [runningRb, runningRbden, runningRbinv] + + localIntegralBasis prime == + traceMat := traceMatrix()$F; n := rank()$F + disc := determinant traceMat -- discriminant of current order + zero? disc => error "localIntegralBasis: polynomial must be separable" + (disc exquo (prime * prime)) case "failed" => + [scalarMatrix(n,1), 1, scalarMatrix(n,1)] + bas : Vector F := new(n,0); pows : Vector F := new(n,0) + -- storage for basis elements and their powers + tfm : Matrix R := new(n,n,0) + -- 'tfm' will contain the coordinates of a lifting of the kernel + -- of a power of Frobenius + matrixOut : Matrix R := new(n,n,0) + lb := iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) + [lb.basis, lb.basisDen, lb.basisInv] + +@ +<>= +"WFFINTBS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=WFFINTBS"] +"MONOGEN" [color="#4488FF",href="bookvol10.2.pdf#nameddest=MONOGEN"] +"WFFINTBS" -> "MONOGEN" + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter X} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -31603,6 +42594,9 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= <> +<> +<> +<> <> <> <> @@ -31619,6 +42613,7 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> <> <> <> @@ -31638,6 +42633,7 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> <> <> <> @@ -31652,6 +42648,7 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> <> <> <> @@ -31688,9 +42685,12 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> <> <> +<> <> +<> <> <> <> @@ -31701,23 +42701,53 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> <> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> <> +<> +<> +<> +<> +<> +<> <> <> <> <> <> <> +<> +<> +<> +<> +<> +<> +<> +<> <> +<> + +<> +<> <> <> <> <> +<> <> <> <> @@ -31741,17 +42771,21 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> <> <> <> <> +<> <> <> +<> <> <> <> +<> <> <> @@ -31759,6 +42793,8 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> +<> +<> <> <> <> @@ -31766,7 +42802,10 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where <> <> <> -p<> +<> +<> +<> +<> <> <> @@ -31775,11 +42814,16 @@ p<> <> <> <> +<> +<> +p<> <> <> <> +<> + @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Index} diff --git a/books/ps/v104algebraichermiteintegration.ps b/books/ps/v104algebraichermiteintegration.ps new file mode 100644 index 0000000..8572123 --- /dev/null +++ b/books/ps/v104algebraichermiteintegration.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 +% INTHERAL +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTHERAL) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.63123e-14 108 lineto +5.2458e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.63123e-14 108 lineto +5.2458e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 69 (INTHERAL) alignedtext +grestore +% FFCAT +gsave +[ /Rect [ 13 0 71 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 71 36 moveto +13 36 lineto +13 1.06581e-14 lineto +71 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 71 36 moveto +13 36 lineto +13 1.06581e-14 lineto +71 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +21 13.9 moveto 42 (FFCAT) alignedtext +grestore +% INTHERAL->FFCAT +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/v104algebraicintegrate.ps b/books/ps/v104algebraicintegrate.ps new file mode 100644 index 0000000..d3a5e10 --- /dev/null +++ b/books/ps/v104algebraicintegrate.ps @@ -0,0 +1,371 @@ +%!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 246 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 210 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 +% INTALG +gsave +[ /Rect [ 66 72 132 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTALG) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 132 108 moveto +66 108 lineto +66 72 lineto +132 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 132 108 moveto +66 108 lineto +66 72 lineto +132 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +73.5 85.9 moveto 51 (INTALG) alignedtext +grestore +% ACF +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 27 (ACF) alignedtext +grestore +% INTALG->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 81 72 moveto +72 63 62 53 52 43 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 54.546 40.5962 moveto +45 36 lineto +49.5962 45.546 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 54.546 40.5962 moveto +45 36 lineto +49.5962 45.546 lineto +closepath stroke +grestore +% FS +gsave +[ /Rect [ 72 0 126 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +91.5 13.9 moveto 15 (FS) alignedtext +grestore +% INTALG->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 99 72 moveto +99 64 99 55 99 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 102.5 46 moveto +99 36 lineto +95.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 102.5 46 moveto +99 36 lineto +95.5001 46 lineto +closepath stroke +grestore +% FFCAT +gsave +[ /Rect [ 144 0 202 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 202 36 moveto +144 36 lineto +144 1.06581e-14 lineto +202 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 202 36 moveto +144 36 lineto +144 1.06581e-14 lineto +202 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +152 13.9 moveto 42 (FFCAT) alignedtext +grestore +% INTALG->FFCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 118 72 moveto +127 63 138 53 148 43 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 150.404 45.546 moveto +155 36 lineto +145.454 40.5962 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 150.404 45.546 moveto +155 36 lineto +145.454 40.5962 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 246 152 +end +restore +%%EOF diff --git a/books/ps/v104algebraicintegration.ps b/books/ps/v104algebraicintegration.ps new file mode 100644 index 0000000..fbaa2ab --- /dev/null +++ b/books/ps/v104algebraicintegration.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 +% INTAF +gsave +[ /Rect [ 35 72 91 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTAF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 91 108 moveto +35 108 lineto +35 72 lineto +91 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 91 108 moveto +35 108 lineto +35 72 lineto +91 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +43 85.9 moveto 40 (INTAF) alignedtext +grestore +% ACF +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 27 (ACF) alignedtext +grestore +% INTAF->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 54 72 moveto +50 64 45 54 40 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath stroke +grestore +% FS +gsave +[ /Rect [ 72 0 126 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +91.5 13.9 moveto 15 (FS) alignedtext +grestore +% INTAF->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 72 72 moveto +76 64 81 54 86 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 170 152 +end +restore +%%EOF diff --git a/books/ps/v104doubleresultantpackage.ps b/books/ps/v104doubleresultantpackage.ps new file mode 100644 index 0000000..1a1226b --- /dev/null +++ b/books/ps/v104doubleresultantpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 120 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 84 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% DBLRESP +gsave +[ /Rect [ 0 72 76 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=DBLRESP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 76 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +76 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 76 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +76 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 60 (DBLRESP) alignedtext +grestore +% FFCAT +gsave +[ /Rect [ 9 0 67 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 67 36 moveto +9 36 lineto +9 1.06581e-14 lineto +67 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +9 36 lineto +9 1.06581e-14 lineto +67 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +17 13.9 moveto 42 (FFCAT) alignedtext +grestore +% DBLRESP->FFCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 38 72 moveto +38 64 38 55 38 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 41.5001 46 moveto +38 36 lineto +34.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 41.5001 46 moveto +38 36 lineto +34.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 120 152 +end +restore +%%EOF diff --git a/books/ps/v104elementaryintegration.ps b/books/ps/v104elementaryintegration.ps new file mode 100644 index 0000000..1bafbac --- /dev/null +++ b/books/ps/v104elementaryintegration.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 +% INTEF +gsave +[ /Rect [ 35 72 91 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTEF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 91 108 moveto +35 108 lineto +35 72 lineto +91 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 91 108 moveto +35 108 lineto +35 72 lineto +91 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +43 85.9 moveto 40 (INTEF) alignedtext +grestore +% ACF +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 27 (ACF) alignedtext +grestore +% INTEF->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 54 72 moveto +50 64 45 54 40 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath stroke +grestore +% FS +gsave +[ /Rect [ 72 0 126 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +91.5 13.9 moveto 15 (FS) alignedtext +grestore +% INTEF->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 72 72 moveto +76 64 81 54 86 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 170 152 +end +restore +%%EOF diff --git a/books/ps/v104functionfieldintegralbasis.ps b/books/ps/v104functionfieldintegralbasis.ps new file mode 100644 index 0000000..169a891 --- /dev/null +++ b/books/ps/v104functionfieldintegralbasis.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 +% FFINTBAS +gsave +[ /Rect [ 2 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=FFINTBAS) >> + /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 (FFINTBAS) alignedtext +grestore +% FRAMALG +gsave +[ /Rect [ 0 0 84 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FRAMALG) >> + /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 (FRAMALG) alignedtext +grestore +% FFINTBAS->FRAMALG +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/v104functionspacecomplexintegration.ps b/books/ps/v104functionspacecomplexintegration.ps new file mode 100644 index 0000000..11e4def --- /dev/null +++ b/books/ps/v104functionspacecomplexintegration.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 +% FSCINT +gsave +[ /Rect [ 0 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=FSCINT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 48 (FSCINT) alignedtext +grestore +% ACFS +gsave +[ /Rect [ 5 0 59 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 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 +14.5 13.9 moveto 35 (ACFS) alignedtext +grestore +% FSCINT->ACFS +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/v104functionspaceintegration.ps b/books/ps/v104functionspaceintegration.ps new file mode 100644 index 0000000..f67a755 --- /dev/null +++ b/books/ps/v104functionspaceintegration.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 62 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% FSINT +gsave +[ /Rect [ 0 72 54 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=FSINT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 38 (FSINT) alignedtext +grestore +% ACFS +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACFS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 13.9 moveto 35 (ACFS) alignedtext +grestore +% FSINT->ACFS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 27 72 moveto +27 64 27 55 27 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 98 152 +end +restore +%%EOF diff --git a/books/ps/v104genuszerointegration.ps b/books/ps/v104genuszerointegration.ps new file mode 100644 index 0000000..41ea160 --- /dev/null +++ b/books/ps/v104genuszerointegration.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 +% INTG0 +gsave +[ /Rect [ 35 72 91 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTG0) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 91 108 moveto +35 108 lineto +35 72 lineto +91 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 91 108 moveto +35 108 lineto +35 72 lineto +91 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +42.5 85.9 moveto 41 (INTG0) 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 +% INTG0->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 +% INTG0->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/v104idealdecompositionpackage.ps b/books/ps/v104idealdecompositionpackage.ps new file mode 100644 index 0000000..89427b6 --- /dev/null +++ b/books/ps/v104idealdecompositionpackage.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 202 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 166 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 +% IDECOMP +gsave +[ /Rect [ 37 72 117 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IDECOMP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 117 108 moveto +37 108 lineto +37 72 lineto +117 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 117 108 moveto +37 108 lineto +37 72 lineto +117 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +45 85.9 moveto 64 (IDECOMP) 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 +% IDECOMP->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 66 72 moveto +61 64 55 54 49 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 51.916 43.0418 moveto +44 36 lineto +45.7969 46.4414 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 51.916 43.0418 moveto +44 36 lineto +45.7969 46.4414 lineto +closepath stroke +grestore +% DIRPCAT +gsave +[ /Rect [ 84 0 158 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=DIRPCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 158 36 moveto +84 36 lineto +84 1.06581e-14 lineto +158 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 158 36 moveto +84 36 lineto +84 1.06581e-14 lineto +158 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +92 13.9 moveto 58 (DIRPCAT) alignedtext +grestore +% IDECOMP->DIRPCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 88 72 moveto +93 64 99 54 105 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 108.203 46.4414 moveto +110 36 lineto +102.084 43.0418 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 108.203 46.4414 moveto +110 36 lineto +102.084 43.0418 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 202 152 +end +restore +%%EOF diff --git a/books/ps/v104infiniteproductcharacteristiczero.ps b/books/ps/v104infiniteproductcharacteristiczero.ps new file mode 100644 index 0000000..2a535c7 --- /dev/null +++ b/books/ps/v104infiniteproductcharacteristiczero.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INFPROD0 +gsave +[ /Rect [ 0 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INFPROD0) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 66 (INFPROD0) alignedtext +grestore +% UTSCAT +gsave +[ /Rect [ 6 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=UTSCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +6 36 lineto +6 1.06581e-14 lineto +76 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +6 36 lineto +6 1.06581e-14 lineto +76 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14 13.9 moveto 54 (UTSCAT) alignedtext +grestore +% INFPROD0->UTSCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/books/ps/v104infiniteproductfinitefield.ps b/books/ps/v104infiniteproductfinitefield.ps new file mode 100644 index 0000000..2036704 --- /dev/null +++ b/books/ps/v104infiniteproductfinitefield.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INPRODFF +gsave +[ /Rect [ 0 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INPRODFF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 66 (INPRODFF) alignedtext +grestore +% UTSCAT +gsave +[ /Rect [ 6 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=UTSCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +6 36 lineto +6 1.06581e-14 lineto +76 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +6 36 lineto +6 1.06581e-14 lineto +76 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14 13.9 moveto 54 (UTSCAT) alignedtext +grestore +% INPRODFF->UTSCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/books/ps/v104infiniteproductprimefield.ps b/books/ps/v104infiniteproductprimefield.ps new file mode 100644 index 0000000..3712519 --- /dev/null +++ b/books/ps/v104infiniteproductprimefield.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 126 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 90 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INPRODPF +gsave +[ /Rect [ 0 72 82 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INPRODPF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 82 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +82 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 66 (INPRODPF) alignedtext +grestore +% UTSCAT +gsave +[ /Rect [ 6 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=UTSCAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +6 36 lineto +6 1.06581e-14 lineto +76 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 76 36 moveto +6 36 lineto +6 1.06581e-14 lineto +76 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +14 13.9 moveto 54 (UTSCAT) alignedtext +grestore +% INPRODPF->UTSCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 41 72 moveto +41 64 41 55 41 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 44.5001 46 moveto +41 36 lineto +37.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 126 152 +end +restore +%%EOF diff --git a/books/ps/v104infinitetuplefunctions2.ps b/books/ps/v104infinitetuplefunctions2.ps new file mode 100644 index 0000000..63d44b5 --- /dev/null +++ b/books/ps/v104infinitetuplefunctions2.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 +% ITFUN2 +gsave +[ /Rect [ 0 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ITFUN2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 48 (ITFUN2) alignedtext +grestore +% TYPE +gsave +[ /Rect [ 5 0 59 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=TYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 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 +14.5 13.9 moveto 35 (TYPE) alignedtext +grestore +% ITFUN2->TYPE +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/v104infinitetuplefunctions3.ps b/books/ps/v104infinitetuplefunctions3.ps new file mode 100644 index 0000000..c995c4c --- /dev/null +++ b/books/ps/v104infinitetuplefunctions3.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 +% ITFUN3 +gsave +[ /Rect [ 0 72 64 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=ITFUN3) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +64 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 64 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +64 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 48 (ITFUN3) alignedtext +grestore +% TYPE +gsave +[ /Rect [ 5 0 59 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=TYPE) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 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 +14.5 13.9 moveto 35 (TYPE) alignedtext +grestore +% ITFUN3->TYPE +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/v104integerfactorizationpackage.ps b/books/ps/v104integerfactorizationpackage.ps new file mode 100644 index 0000000..ecc796a --- /dev/null +++ b/books/ps/v104integerfactorizationpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 118 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 82 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% INTFACT +gsave +[ /Rect [ 0 72 74 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTFACT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 74 108 moveto +2.00881e-14 108 lineto +6.06806e-15 72 lineto +74 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 74 108 moveto +2.00881e-14 108 lineto +6.06806e-15 72 lineto +74 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 59 (INTFACT) alignedtext +grestore +% MDAGG +gsave +[ /Rect [ 3 0 71 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=MDAGG) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 71 36 moveto +3 36 lineto +3 1.06581e-14 lineto +71 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 71 36 moveto +3 36 lineto +3 1.06581e-14 lineto +71 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10.5 13.9 moveto 53 (MDAGG) alignedtext +grestore +% INTFACT->MDAGG +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 37 72 moveto +37 64 37 55 37 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 40.5001 46 moveto +37 36 lineto +33.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 40.5001 46 moveto +37 36 lineto +33.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 118 152 +end +restore +%%EOF diff --git a/books/ps/v104integerprimespackage.ps b/books/ps/v104integerprimespackage.ps new file mode 100644 index 0000000..3f57501 --- /dev/null +++ b/books/ps/v104integerprimespackage.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 +% PRIMES +gsave +[ /Rect [ 0 72 66 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=PRIMES) >> + /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 (PRIMES) alignedtext +grestore +% FSAGG +gsave +[ /Rect [ 2 0 64 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FSAGG) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 64 36 moveto +2 36 lineto +2 1.06581e-14 lineto +64 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 64 36 moveto +2 36 lineto +2 1.06581e-14 lineto +64 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10 13.9 moveto 46 (FSAGG) alignedtext +grestore +% PRIMES->FSAGG +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/v104integerroots.ps b/books/ps/v104integerroots.ps new file mode 100644 index 0000000..a95f30b --- /dev/null +++ b/books/ps/v104integerroots.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 106 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 70 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% IROOT +gsave +[ /Rect [ 1 72 61 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IROOT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +1 108 lineto +1 72 lineto +61 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +1 108 lineto +1 72 lineto +61 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9 85.9 moveto 44 (IROOT) alignedtext +grestore +% FLAGG +gsave +[ /Rect [ 0 0 62 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 62 36 moveto +2.26989e-14 36 lineto +5.21631e-15 1.06581e-14 lineto +62 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 62 36 moveto +2.26989e-14 36 lineto +5.21631e-15 1.06581e-14 lineto +62 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 13.9 moveto 47 (FLAGG) alignedtext +grestore +% IROOT->FLAGG +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 31 72 moveto +31 64 31 55 31 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 34.5001 46 moveto +31 36 lineto +27.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 34.5001 46 moveto +31 36 lineto +27.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 106 152 +end +restore +%%EOF diff --git a/books/ps/v104integersolvelinearpolynomialequation.ps b/books/ps/v104integersolvelinearpolynomialequation.ps new file mode 100644 index 0000000..2d5c17e --- /dev/null +++ b/books/ps/v104integersolvelinearpolynomialequation.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 +% INTSLPE +gsave +[ /Rect [ 0 72 72 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTSLPE) >> + /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 (INTSLPE) 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 +% INTSLPE->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/books/ps/v104integralbasistools.ps b/books/ps/v104integralbasistools.ps new file mode 100644 index 0000000..8a00f33 --- /dev/null +++ b/books/ps/v104integralbasistools.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 +% IBATOOL +gsave +[ /Rect [ 4 72 80 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IBATOOL) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +4 108 lineto +4 72 lineto +80 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 80 108 moveto +4 108 lineto +4 72 lineto +80 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12 85.9 moveto 60 (IBATOOL) alignedtext +grestore +% FRAMALG +gsave +[ /Rect [ 0 0 84 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FRAMALG) >> + /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 (FRAMALG) alignedtext +grestore +% IBATOOL->FRAMALG +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/v104integrationresultfunctions2.ps b/books/ps/v104integrationresultfunctions2.ps new file mode 100644 index 0000000..e50fe3b --- /dev/null +++ b/books/ps/v104integrationresultfunctions2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 62 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% IR2 +gsave +[ /Rect [ 0 72 54 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IR2) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +17 85.9 moveto 20 (IR2) 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 +% IR2->FIELD +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 27 72 moveto +27 64 27 55 27 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 98 152 +end +restore +%%EOF diff --git a/books/ps/v104integrationresultrftofunction.ps b/books/ps/v104integrationresultrftofunction.ps new file mode 100644 index 0000000..8c63879 --- /dev/null +++ b/books/ps/v104integrationresultrftofunction.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 +% IRRF2F +gsave +[ /Rect [ 0 72 60 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IRRF2F) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 60 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +60 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 60 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +60 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 44 (IRRF2F) alignedtext +grestore +% ACFS +gsave +[ /Rect [ 3 0 57 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 57 36 moveto +3 36 lineto +3 1.06581e-14 lineto +57 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 57 36 moveto +3 36 lineto +3 1.06581e-14 lineto +57 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12.5 13.9 moveto 35 (ACFS) alignedtext +grestore +% IRRF2F->ACFS +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/v104integrationresulttofunction.ps b/books/ps/v104integrationresulttofunction.ps new file mode 100644 index 0000000..1a8c7b0 --- /dev/null +++ b/books/ps/v104integrationresulttofunction.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 62 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% IR2F +gsave +[ /Rect [ 0 72 54 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IR2F) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 54 108 moveto +2.13163e-14 108 lineto +3.55271e-15 72 lineto +54 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13 85.9 moveto 28 (IR2F) alignedtext +grestore +% ACFS +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACFS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +9.5 13.9 moveto 35 (ACFS) alignedtext +grestore +% IR2F->ACFS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 27 72 moveto +27 64 27 55 27 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 30.5001 46 moveto +27 36 lineto +23.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 98 152 +end +restore +%%EOF diff --git a/books/ps/v104irrrepsymnatpackage.ps b/books/ps/v104irrrepsymnatpackage.ps new file mode 100644 index 0000000..56d2f87 --- /dev/null +++ b/books/ps/v104irrrepsymnatpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% IRSN +gsave +[ /Rect [ 12 72 66 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=IRSN) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +12 108 lineto +12 72 lineto +66 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 66 108 moveto +12 108 lineto +12 72 lineto +66 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +23.5 85.9 moveto 31 (IRSN) alignedtext +grestore +% IVECTOR +gsave +[ /Rect [ 0 0 78 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IVECTOR) >> + /Subtype /Link +/ANN pdfmark +0.273 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath fill +1 setlinewidth +filled +0.273 0.733 1.000 nodecolor +newpath 78 36 moveto +2.84217e-14 36 lineto +7.10543e-15 1.06581e-14 lineto +78 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 13.9 moveto 62 (IVECTOR) alignedtext +grestore +% IRSN->IVECTOR +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 39 72 moveto +39 64 39 55 39 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 42.5001 46 moveto +39 36 lineto +35.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 122 152 +end +restore +%%EOF diff --git a/books/ps/v104kernelfunctions2.ps b/books/ps/v104kernelfunctions2.ps new file mode 100644 index 0000000..6febc96 --- /dev/null +++ b/books/ps/v104kernelfunctions2.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% KERNEL2 +gsave +[ /Rect [ 0 72 78 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=KERNEL2) >> + /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 (KERNEL2) alignedtext +grestore +% ORDSET +gsave +[ /Rect [ 4 0 74 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ORDSET) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 74 36 moveto +4 36 lineto +4 1.06581e-14 lineto +74 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 74 36 moveto +4 36 lineto +4 1.06581e-14 lineto +74 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +11.5 13.9 moveto 55 (ORDSET) alignedtext +grestore +% KERNEL2->ORDSET +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/v104kovacic.ps b/books/ps/v104kovacic.ps new file mode 100644 index 0000000..a886d07 --- /dev/null +++ b/books/ps/v104kovacic.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 122 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 86 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% KOVACIC +gsave +[ /Rect [ 0 72 78 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=KOVACIC) >> + /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 (KOVACIC) alignedtext +grestore +% ACF +gsave +[ /Rect [ 12 0 66 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 66 36 moveto +12 36 lineto +12 1.06581e-14 lineto +66 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 66 36 moveto +12 36 lineto +12 1.06581e-14 lineto +66 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +25.5 13.9 moveto 27 (ACF) alignedtext +grestore +% KOVACIC->ACF +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/v104monomialextensiontools.ps b/books/ps/v104monomialextensiontools.ps new file mode 100644 index 0000000..2ae5ac8 --- /dev/null +++ b/books/ps/v104monomialextensiontools.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 142 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 106 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 +% MONOTOOL +gsave +[ /Rect [ 0 72 98 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=MONOTOOL) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 98 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +98 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 98 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +98 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 82 (MONOTOOL) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 16 0 82 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 82 36 moveto +16 36 lineto +16 1.06581e-14 lineto +82 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 82 36 moveto +16 36 lineto +16 1.06581e-14 lineto +82 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +23.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% MONOTOOL->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 49 72 moveto +49 64 49 55 49 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 52.5001 46 moveto +49 36 lineto +45.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 52.5001 46 moveto +49 36 lineto +45.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 142 152 +end +restore +%%EOF diff --git a/books/ps/v104numberfieldintegralbasis.ps b/books/ps/v104numberfieldintegralbasis.ps new file mode 100644 index 0000000..50ab3a5 --- /dev/null +++ b/books/ps/v104numberfieldintegralbasis.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 +% NFINTBAS +gsave +[ /Rect [ 1 72 83 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=NFINTBAS) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 83 108 moveto +1 108 lineto +1 72 lineto +83 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 83 108 moveto +1 108 lineto +1 72 lineto +83 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8.5 85.9 moveto 67 (NFINTBAS) alignedtext +grestore +% FRAMALG +gsave +[ /Rect [ 0 0 84 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FRAMALG) >> + /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 (FRAMALG) alignedtext +grestore +% NFINTBAS->FRAMALG +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/v104patternmatchintegration.ps b/books/ps/v104patternmatchintegration.ps new file mode 100644 index 0000000..048ed5c --- /dev/null +++ b/books/ps/v104patternmatchintegration.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 +% INTPM +gsave +[ /Rect [ 33 72 93 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTPM) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 93 108 moveto +33 108 lineto +33 72 lineto +93 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 93 108 moveto +33 108 lineto +33 72 lineto +93 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +41 85.9 moveto 44 (INTPM) alignedtext +grestore +% ACF +gsave +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=ACF) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 54 36 moveto +2.13163e-14 36 lineto +3.55271e-15 1.06581e-14 lineto +54 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13.5 13.9 moveto 27 (ACF) alignedtext +grestore +% INTPM->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 54 72 moveto +50 64 45 54 40 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 43.2598 43.7166 moveto +36 36 lineto +36.8631 46.5596 lineto +closepath stroke +grestore +% FS +gsave +[ /Rect [ 72 0 126 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=FS) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 126 36 moveto +72 36 lineto +72 1.06581e-14 lineto +126 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +91.5 13.9 moveto 15 (FS) alignedtext +grestore +% INTPM->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 72 72 moveto +76 64 81 54 86 45 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 89.1369 46.5596 moveto +90 36 lineto +82.7402 43.7166 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 170 152 +end +restore +%%EOF diff --git a/books/ps/v104purealgebraicintegration.ps b/books/ps/v104purealgebraicintegration.ps new file mode 100644 index 0000000..8fe2405 --- /dev/null +++ b/books/ps/v104purealgebraicintegration.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 +% INTPAF +gsave +[ /Rect [ 32 72 94 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTPAF) >> + /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 +39.5 85.9 moveto 47 (INTPAF) 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 +% INTPAF->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 +% INTPAF->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/v104rationalfunctionintegration.ps b/books/ps/v104rationalfunctionintegration.ps new file mode 100644 index 0000000..b7d81e0 --- /dev/null +++ b/books/ps/v104rationalfunctionintegration.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 +% INTRF +gsave +[ /Rect [ 5 72 61 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTRF) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +5 108 lineto +5 72 lineto +61 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +5 108 lineto +5 72 lineto +61 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +13 85.9 moveto 40 (INTRF) 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 +% INTRF->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/v104rationalintegration.ps b/books/ps/v104rationalintegration.ps new file mode 100644 index 0000000..66a92ab --- /dev/null +++ b/books/ps/v104rationalintegration.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 +% INTRAT +gsave +[ /Rect [ 0 72 66 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTRAT) >> + /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 (INTRAT) 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 +% INTRAT->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/v104sortedcache.ps b/books/ps/v104sortedcache.ps new file mode 100644 index 0000000..aa35e98 --- /dev/null +++ b/books/ps/v104sortedcache.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 +% SCACHE +gsave +[ /Rect [ 0 72 72 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=SCACHE) >> + /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 (SCACHE) alignedtext +grestore +% FLAGG +gsave +[ /Rect [ 5 0 67 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 67 36 moveto +5 36 lineto +5 1.06581e-14 lineto +67 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 67 36 moveto +5 36 lineto +5 1.06581e-14 lineto +67 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12.5 13.9 moveto 47 (FLAGG) alignedtext +grestore +% SCACHE->FLAGG +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/v104streaminfiniteproduct.ps b/books/ps/v104streaminfiniteproduct.ps new file mode 100644 index 0000000..893ee84 --- /dev/null +++ b/books/ps/v104streaminfiniteproduct.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 +% STINPROD +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=STINPROD) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 68 (STINPROD) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 9 0 75 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% STINPROD->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 42 72 moveto +42 64 42 55 42 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 128 152 +end +restore +%%EOF diff --git a/books/ps/v104subresultantpackage.ps b/books/ps/v104subresultantpackage.ps new file mode 100644 index 0000000..f2a3f51 --- /dev/null +++ b/books/ps/v104subresultantpackage.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 120 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 84 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% SUBRESP +gsave +[ /Rect [ 0 72 76 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=SUBRESP) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 76 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +76 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 76 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +76 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 60 (SUBRESP) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 5 0 71 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 71 36 moveto +5 36 lineto +5 1.06581e-14 lineto +71 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 71 36 moveto +5 36 lineto +5 1.06581e-14 lineto +71 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% SUBRESP->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 38 72 moveto +38 64 38 55 38 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 41.5001 46 moveto +38 36 lineto +34.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 41.5001 46 moveto +38 36 lineto +34.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 120 152 +end +restore +%%EOF diff --git a/books/ps/v104transcendentalhermiteintegration.ps b/books/ps/v104transcendentalhermiteintegration.ps new file mode 100644 index 0000000..67e5966 --- /dev/null +++ b/books/ps/v104transcendentalhermiteintegration.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 +% INTHERTR +gsave +[ /Rect [ 0 72 84 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTHERTR) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 84 108 moveto +2.84217e-14 108 lineto +7.10543e-15 72 lineto +84 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +8 85.9 moveto 68 (INTHERTR) alignedtext +grestore +% PFECAT +gsave +[ /Rect [ 9 0 75 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=PFECAT) >> + /Subtype /Link +/ANN pdfmark +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 75 36 moveto +9 36 lineto +9 1.06581e-14 lineto +75 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +16.5 13.9 moveto 51 (PFECAT) alignedtext +grestore +% INTHERTR->PFECAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 42 72 moveto +42 64 42 55 42 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 45.5001 46 moveto +42 36 lineto +38.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 128 152 +end +restore +%%EOF diff --git a/books/ps/v104transcendentalintegration.ps b/books/ps/v104transcendentalintegration.ps new file mode 100644 index 0000000..b362f47 --- /dev/null +++ b/books/ps/v104transcendentalintegration.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 +% INTTR +gsave +[ /Rect [ 5 72 61 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=INTTR) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +5 108 lineto +5 72 lineto +61 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 61 108 moveto +5 108 lineto +5 72 lineto +61 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +12.5 85.9 moveto 41 (INTTR) 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 +% INTTR->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/v104triangularmatrixoperations.ps b/books/ps/v104triangularmatrixoperations.ps new file mode 100644 index 0000000..fb77127 --- /dev/null +++ b/books/ps/v104triangularmatrixoperations.ps @@ -0,0 +1,391 @@ +%!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 301 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 265 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 +% TRIMAT +gsave +[ /Rect [ 0 72 68 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=TRIMAT) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 68 108 moveto +1.93977e-14 108 lineto +5.39152e-15 72 lineto +68 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +7.5 85.9 moveto 53 (TRIMAT) alignedtext +grestore +% ACF +gsave +[ /Rect [ 29 0 83 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 83 36 moveto +29 36 lineto +29 1.06581e-14 lineto +83 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 83 36 moveto +29 36 lineto +29 1.06581e-14 lineto +83 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +42.5 13.9 moveto 27 (ACF) alignedtext +grestore +% FS +gsave +[ /Rect [ 101 0 155 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 155 36 moveto +101 36 lineto +101 1.06581e-14 lineto +155 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 155 36 moveto +101 36 lineto +101 1.06581e-14 lineto +155 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +120.5 13.9 moveto 15 (FS) alignedtext +grestore +% COMPCAT +gsave +[ /Rect [ 173 0 257 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 257 36 moveto +173 36 lineto +173 1.06581e-14 lineto +257 0 lineto +closepath fill +1 setlinewidth +filled +0.606 0.733 1.000 nodecolor +newpath 257 36 moveto +173 36 lineto +173 1.06581e-14 lineto +257 0 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +181 13.9 moveto 68 (COMPCAT) alignedtext +grestore +% TRIGMNIP +gsave +0.000 0.000 1.000 nodecolor +newpath 170 108 moveto +86 108 lineto +86 72 lineto +170 72 lineto +closepath fill +1 setlinewidth +filled +0.000 0.000 1.000 nodecolor +newpath 170 108 moveto +86 108 lineto +86 72 lineto +170 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +94 85.9 moveto 68 (TRIGMNIP) alignedtext +grestore +% TRIGMNIP->ACF +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 110 72 moveto +101 63 91 53 81 43 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 83.546 40.5962 moveto +74 36 lineto +78.5962 45.546 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 83.546 40.5962 moveto +74 36 lineto +78.5962 45.546 lineto +closepath stroke +grestore +% TRIGMNIP->FS +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 128 72 moveto +128 64 128 55 128 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 131.5 46 moveto +128 36 lineto +124.5 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 131.5 46 moveto +128 36 lineto +124.5 46 lineto +closepath stroke +grestore +% TRIGMNIP->COMPCAT +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 150 72 moveto +161 63 174 52 185 42 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 187.1 44.8 moveto +193 36 lineto +182.9 39.2 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 187.1 44.8 moveto +193 36 lineto +182.9 39.2 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 301 152 +end +restore +%%EOF diff --git a/books/ps/v104wildfunctionfieldintegralbasis.ps b/books/ps/v104wildfunctionfieldintegralbasis.ps new file mode 100644 index 0000000..63556b7 --- /dev/null +++ b/books/ps/v104wildfunctionfieldintegralbasis.ps @@ -0,0 +1,281 @@ +%!PS-Adobe-2.0 +%%Creator: Graphviz version 2.16.1 (Mon Jul 7 18:20:33 UTC 2008) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: (atend) +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 132 152 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 96 116 boxprim clip newpath +1 1 set_scale 0 rotate 40 40 translate +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath fill +1 setlinewidth +0.167 0.600 1.000 graphcolor +newpath -4 -4 moveto +-4 716 lineto +536 716 lineto +536 -4 lineto +closepath stroke +% WFFINTBS +gsave +[ /Rect [ 2 72 86 108 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.4.pdf#nameddest=WFFINTBS) >> + /Subtype /Link +/ANN pdfmark +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2 108 lineto +2 72 lineto +86 72 lineto +closepath fill +1 setlinewidth +filled +0.939 0.733 1.000 nodecolor +newpath 86 108 moveto +2 108 lineto +2 72 lineto +86 72 lineto +closepath stroke +0.000 0.000 0.000 nodecolor +14.00 /Times-Roman set_font +10 85.9 moveto 68 (WFFINTBS) alignedtext +grestore +% MONOGEN +gsave +[ /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 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 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.00 /Times-Roman set_font +7.5 13.9 moveto 73 (MONOGEN) alignedtext +grestore +% WFFINTBS->MONOGEN +gsave +1 setlinewidth +0.000 0.000 0.000 edgecolor +newpath 44 72 moveto +44 64 44 55 44 46 curveto +stroke +0.000 0.000 0.000 edgecolor +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto +closepath fill +1 setlinewidth +solid +0.000 0.000 0.000 edgecolor +newpath 47.5001 46 moveto +44 36 lineto +40.5001 46 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 132 152 +end +restore +%%EOF diff --git a/changelog b/changelog index ca1a76a..5319b92 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,93 @@ +20090201 tpd src/axiom-website/patches.html 20090201.01.tpd.patch +20090201 tpd src/algebra/Makefile remove spad files +20090201 tpd src/algebra/kovacic.spad removed +20090201 tpd books/ps/v104kovacic.ps added +20090201 tpd src/algebra/kl.spad removed +20090201 tpd books/ps/v104kernelfunctions2.ps added +20090201 tpd books/ps/v104sortedcache.ps added +20090201 tpd src/algebra/ituple.spad removed +20090201 tpd books/ps/v104infinitetuplefunctions3.ps added +20090201 tpd books/ps/v104infinitetuplefunctions2.ps added +20090201 tpd src/algebra/irsn.spad removed +20090201 tpd books/ps/v104irrrepsymnatpackage.ps added +20090201 tpd src/algebra/irexpand.spad removed +20090201 tpd books/ps/v104integrationresultrftofunction.ps added +20090201 tpd books/ps/v104integrationresulttofunction.ps added +20090201 tpd src/algebra/intrf.spad removed +20090201 tpd books/ps/v104rationalfunctionintegration.ps added +20090201 tpd books/ps/v104rationalintegration.ps added +20090201 tpd books/ps/v104transcendentalintegration.ps added +20090201 tpd books/ps/v104transcendentalhermiteintegration.ps added +20090201 tpd books/ps/v104monomialextensiontools.ps added +20090201 tpd books/ps/v104subresultantpackage.ps added +20090201 tpd src/algebra/intpm.spad removed +20090201 tpd books/ps/v104patternmatchintegration.ps added +20090201 tpd src/algebra/intfact.spad removed +20090201 tpd books/ps/v104integerfactorizationpackage.ps added +20090201 tpd books/ps/v104integerroots.ps added +20090201 tpd books/ps/v104integerprimespackage.ps added +20090201 tpd src/algebra/integrat.spad removed +20090201 tpd books/ps/v104functionspaceintegration.ps added +20090201 tpd books/ps/v104functionspacecomplexintegration.ps added +20090201 tpd src/algebra/integer.spad removed +20090201 tpd books/ps/v104integersolvelinearpolynomialequation.ps added +20090201 tpd src/algebra/intef.spad removed +20090201 tpd books/ps/v104elementaryintegration.ps added +20090201 tpd src/algebra/intclos.spad removed +20090201 tpd books/ps/v104numberfieldintegralbasis.ps added +20090201 tpd books/ps/v104wildfunctionfieldintegralbasis.ps added +20090201 tpd books/ps/v104functionfieldintegralbasis.ps added +20090201 tpd books/ps/v104integralbasistools.ps added +20090201 tpd books/ps/v104triangularmatrixoperations.ps added +20090201 tpd src/algebra/intaux.spad removed +20090201 tpd books/ps/v104integrationresultfunctions2.ps added +20090201 tpd src/algebra/intalg.spad removed +20090201 tpd books/ps/v104algebraicintegrate.ps added +20090201 tpd books/ps/v104algebraichermiteintegration.ps added +20090201 tpd books/ps/v104doubleresultantpackage.ps added +20090201 tpd src/algebra/intaf.spad removed +20090201 tpd books/ps/v104algebraicintegration.ps added +20090201 tpd books/ps/v104purealgebraicintegration.ps added +20090201 tpd books/ps/v104genuszerointegration.ps added +20090201 tpd src/algebra/infprod.spad removed +20090201 tpd books/ps/v104infiniteproductfinitefield.ps added +20090201 tpd books/ps/v104infiniteproductprimefield.ps added +20090201 tpd books/ps/v104infiniteproductcharacteristiczero.ps added +20090201 tpd books/ps/v104streaminfiniteproduct.ps added +20090201 tpd src/algebra/idecomp.spad removed +20090201 tpd books/ps/v104idealdecompositionpackage.ps added +20090201 tpd books/bookvol10.1.pamphlet add theory +20090131 tpd src/axiom-website/patches.html 20090131.01.tpd.patch +20090131 tpd src/algebra/Makefile disable parallel test +20090131 tpd books/bookvol10.4.pamphlet add )sys rm for output files +20090131 tpd books/bookvol10.3.pamphlet add )sys rm for output files +20090131 tpd src/algebra/Makefile add GroebnerPackage help +20090131 tpd src/algebra/Makefile remove spad files +20090131 tpd src/algebra/groebsol.spad removed +20090131 tpd books/ps/v104groebnersolve.ps added +20090131 tpd src/algebra/groebf.spad removed +20090131 tpd books/ps/v104groebnerfactorizationpackage.ps added +20090131 tpd src/algebra/grdef.spad removed +20090131 tpd books/ps/v104graphicsdefaults.ps added +20090131 tpd src/algebra/gpgcd.spad removed +20090131 tpd books/ps/v104generalpolynomialgcdpackage.ps removed +20090131 tpd src/algebra/ghensel.spad removed +20090131 tpd books/ps/v104generalhenselpackage.ps added +20090131 tpd src/algebra/genups.spad removed +20090131 tpd books/ps/v104generateunivariatepowerseries.ps added +20090131 tpd src/algebra/genufact.spad removed +20090131 tpd books/ps/v104genufactorize.ps added +20090131 tpd src/algebra/generic.spad removed +20090131 tpd books/ps/v104coercevectormatrixpackage.ps added +20090131 tpd src/algebra/geneez.spad removed +20090131 tpd books/ps/v104genexeuclid.ps added +20090131 tpd src/algebra/gdirprod.spad.pamphlet removed +20090131 tpd books/ps/v104orderingfunctions.ps added +20090131 tpd src/algebra/gb.spad removed +20090131 tpd books/ps/v104groebnerpackage.ps added +20090131 tpd src/algebra/gbintern.spad removed +20090131 tpd books/ps/v104groebnerinternalpackage.ps added +20090130 tpd src/axiom-website/patches.html 20090130.01.tpd.patch 20090130 tpd books/bookvol4.pamphlet document spadhelp 20090130 tpd src/Makefile remove parallel input testing 20090130 tpd src/algebra/Makefile fix spadhelp diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 54b0720..86d693d 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -15771,20 +15771,6 @@ We need to figure out which mlift.spad to keep. <>= SPADFILES= \ - ${OUTSRC}/gbintern.spad ${OUTSRC}/gb.spad \ - ${OUTSRC}/gdirprod.spad ${OUTSRC}/geneez.spad \ - ${OUTSRC}/generic.spad ${OUTSRC}/genufact.spad ${OUTSRC}/genups.spad \ - ${OUTSRC}/ghensel.spad ${OUTSRC}/gpgcd.spad \ - ${OUTSRC}/grdef.spad ${OUTSRC}/groebf.spad ${OUTSRC}/groebsol.spad \ - ${OUTSRC}/idecomp.spad \ - ${OUTSRC}/infprod.spad ${OUTSRC}/intaf.spad ${OUTSRC}/intalg.spad \ - ${OUTSRC}/intaux.spad ${OUTSRC}/intclos.spad ${OUTSRC}/intef.spad \ - ${OUTSRC}/integer.spad ${OUTSRC}/integrat.spad \ - ${OUTSRC}/intfact.spad ${OUTSRC}/intpm.spad \ - ${OUTSRC}/intrf.spad \ - ${OUTSRC}/irexpand.spad \ - ${OUTSRC}/irsn.spad ${OUTSRC}/ituple.spad \ - ${OUTSRC}/kl.spad ${OUTSRC}/kovacic.spad \ ${OUTSRC}/laplace.spad ${OUTSRC}/laurent.spad ${OUTSRC}/leadcdet.spad \ ${OUTSRC}/limitps.spad ${OUTSRC}/lindep.spad \ ${OUTSRC}/lingrob.spad ${OUTSRC}/liouv.spad ${OUTSRC}/listgcd.spad \ @@ -15878,22 +15864,11 @@ ALDORFILES= \ DOCFILES= \ ${DOC}/exposed.lsp.dvi \ - ${DOC}/gbintern.spad.dvi ${DOC}/gb.spad.dvi \ - ${DOC}/gdirprod.spad.dvi ${DOC}/geneez.spad.dvi \ - ${DOC}/generic.spad.dvi ${DOC}/genufact.spad.dvi ${DOC}/genups.spad.dvi \ - ${DOC}/ghensel.spad.dvi ${DOC}/gpgcd.spad.dvi \ - ${DOC}/grdef.spad.dvi ${DOC}/groebf.spad.dvi ${DOC}/groebsol.spad.dvi \ ${DOC}/herm.as.dvi \ - ${DOC}/idecomp.spad.dvi \ - ${DOC}/infprod.spad.dvi ${DOC}/intaf.spad.dvi ${DOC}/intalg.spad.dvi \ - ${DOC}/intaux.spad.dvi ${DOC}/intclos.spad.dvi ${DOC}/intef.spad.dvi \ - ${DOC}/integer.spad.dvi ${DOC}/integrat.spad.dvi \ ${DOC}/interval.as.dvi \ - ${DOC}/intfact.spad.dvi ${DOC}/intpm.spad.dvi \ - ${DOC}/intrf.spad.dvi ${DOC}/invnode.as.dvi ${DOC}/invrender.as.dvi \ - ${DOC}/invtypes.as.dvi ${DOC}/invutils.as.dvi ${DOC}/irexpand.spad.dvi \ - ${DOC}/irsn.spad.dvi ${DOC}/ituple.spad.dvi ${DOC}/iviews.as.dvi \ - ${DOC}/kl.spad.dvi ${DOC}/kovacic.spad.dvi \ + ${DOC}/invnode.as.dvi ${DOC}/invrender.as.dvi \ + ${DOC}/invtypes.as.dvi ${DOC}/invutils.as.dvi \ + ${DOC}/iviews.as.dvi \ ${DOC}/laplace.spad.dvi ${DOC}/laurent.spad.dvi ${DOC}/leadcdet.spad.dvi \ ${DOC}/limitps.spad.dvi ${DOC}/lindep.spad.dvi \ ${DOC}/lingrob.spad.dvi ${DOC}/liouv.spad.dvi ${DOC}/listgcd.spad.dvi \ @@ -16587,6 +16562,7 @@ SPADHELP=\ ${HELP}/FullPartialFractionExpansion.help \ ${HELP}/GeneralDistributedMultivariatePolynomial.help \ ${HELP}/GeneralSparseTable.help ${HELP}/GroebnerFactorizationPackage.help \ + ${HELP}/GroebnerPackage.help \ ${HELP}/Heap.help ${HELP}/HexadecimalExpansion.help \ ${HELP}/HomogeneousDistributedMultivariatePolynomial.help \ ${HELP}/Integer.help ${HELP}/IntegerLinearDependence.help \ @@ -16653,6 +16629,7 @@ REGRESS=\ Fraction.regress FullPartialFractionExpansion.regress \ GeneralDistributedMultivariatePolynomial.regress \ GeneralSparseTable.regress GroebnerFactorizationPackage.regress \ + GroebnerPackage.regress \ Heap.regress HexadecimalExpansion.regress \ HomogeneousDistributedMultivariatePolynomial.regress \ Integer.regress IntegerLinearDependence.regress \ @@ -17022,18 +16999,28 @@ ${HELP}/GeneralSparseTable.help: ${BOOKS}/bookvol10.3.pamphlet >${INPUT}/GeneralSparseTable.input @echo "GeneralSparseTable (GSTBL)" >>${HELPFILE} -${HELP}/GroebnerFactorizationPackage.help: ${IN}/groebf.spad.pamphlet +${HELP}/GroebnerFactorizationPackage.help: ${BOOKS}/bookvol10.4.pamphlet @echo 7029 create GroebnerFactorizationPackage.help \ - from ${IN}/groebf.spad.pamphlet + from ${BOOKS}/bookvol10.4.pamphlet @${TANGLE} -R"GroebnerFactorizationPackage.help" \ - ${IN}/groebf.spad.pamphlet \ + ${BOOKS}/bookvol10.4.pamphlet \ >${HELP}/GroebnerFactorizationPackage.help @cp ${HELP}/GroebnerFactorizationPackage.help ${HELP}/GBF.help @${TANGLE} -R"GroebnerFactorizationPackage.input" \ - ${IN}/groebf.spad.pamphlet \ + ${BOOKS}/bookvol10.4.pamphlet \ >${INPUT}/GroebnerFactorizationPackage.input @echo "GroebnerFactorizationPackage (GBF)" >>${HELPFILE} +${HELP}/GroebnerPackage.help: ${BOOKS}/bookvol10.4.pamphlet + @echo 7020 create GroebnerPackage.help from \ + ${BOOKS}/bookvol10.4.pamphlet + @${TANGLE} -R"GroebnerPackage.help" ${BOOKS}/bookvol10.4.pamphlet \ + >${HELP}/GroebnerPackage.help + @cp ${HELP}/GroebnerPackage.help ${HELP}/GB.help + @${TANGLE} -R"GroebnerPackage.input" ${BOOKS}/bookvol10.4.pamphlet \ + >${INPUT}/GroebnerPackage.input + @echo "GroebnerPackage (GB)" >>${HELPFILE} + ${HELP}/Heap.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7030 create Heap.help from ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"Heap.help" ${BOOKS}/bookvol10.3.pamphlet \ diff --git a/src/algebra/idecomp.spad.pamphlet b/src/algebra/idecomp.spad.pamphlet deleted file mode 100644 index 9ba4d21..0000000 --- a/src/algebra/idecomp.spad.pamphlet +++ /dev/null @@ -1,440 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra idecomp.spad} -\author{Patrizia Gianni} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package IDECOMP IdealDecompositionPackage} -<>= -)abbrev package IDECOMP IdealDecompositionPackage -++ Author: P. Gianni -++ Date Created: summer 1986 -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: PolynomialIdeals -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package provides functions for the primary decomposition of -++ polynomial ideals over the rational numbers. The ideals are members -++ of the \spadtype{PolynomialIdeals} domain, and the polynomial generators are -++ required to be from the \spadtype{DistributedMultivariatePolynomial} domain. - -IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't - -- compile if it isn't there - where - vl : List Symbol - nv : NonNegativeInteger - Z ==> Integer -- substitute with PFE cat - Q ==> Fraction Z - F ==> Fraction P - P ==> Polynomial Z - UP ==> SparseUnivariatePolynomial P - Expon ==> DirectProduct(nv,NNI) - OV ==> OrderedVariableList(vl) - SE ==> Symbol - SUP ==> SparseUnivariatePolynomial(DPoly) - - DPoly1 ==> DistributedMultivariatePolynomial(vl,Q) - DPoly ==> DistributedMultivariatePolynomial(vl,F) - NNI ==> NonNegativeInteger - - Ideal == PolynomialIdeals(Q,Expon,OV,DPoly1) - FIdeal == PolynomialIdeals(F,Expon,OV,DPoly) - Fun0 == Union("zeroPrimDecomp","zeroRadComp") - GenPos == Record(changeval:List Z,genideal:FIdeal) - - C == with - - - zeroDimPrime? : Ideal -> Boolean - ++ zeroDimPrime?(I) tests if the ideal I is a 0-dimensional prime. - - zeroDimPrimary? : Ideal -> Boolean - ++ zeroDimPrimary?(I) tests if the ideal I is 0-dimensional primary. - prime? : Ideal -> Boolean - ++ prime?(I) tests if the ideal I is prime. - radical : Ideal -> Ideal - ++ radical(I) returns the radical of the ideal I. - primaryDecomp : Ideal -> List(Ideal) - ++ primaryDecomp(I) returns a list of primary ideals such that their - ++ intersection is the ideal I. - - contract : (Ideal,List OV ) -> Ideal - ++ contract(I,lvar) contracts the ideal I to the polynomial ring - ++ \spad{F[lvar]}. - - T == add - - import MPolyCatRationalFunctionFactorizer(Expon,OV,Z,DPoly) - import GroebnerPackage(F,Expon,OV,DPoly) - import GroebnerPackage(Q,Expon,OV,DPoly1) - - ---- Local Functions ----- - genPosLastVar : (FIdeal,List OV) -> GenPos - zeroPrimDecomp : (FIdeal,List OV) -> List(FIdeal) - zeroRadComp : (FIdeal,List OV) -> FIdeal - zerodimcase : (FIdeal,List OV) -> Boolean - is0dimprimary : (FIdeal,List OV) -> Boolean - backGenPos : (FIdeal,List Z,List OV) -> FIdeal - reduceDim : (Fun0,FIdeal,List OV) -> List FIdeal - findvar : (FIdeal,List OV) -> OV - testPower : (SUP,OV,FIdeal) -> Boolean - goodPower : (DPoly,FIdeal) -> Record(spol:DPoly,id:FIdeal) - pushdown : (DPoly,OV) -> DPoly - pushdterm : (DPoly,OV,Z) -> DPoly - pushup : (DPoly,OV) -> DPoly - pushuterm : (DPoly,SE,OV) -> DPoly - pushucoef : (UP,OV) -> DPoly - trueden : (P,SE) -> P - rearrange : (List OV) -> List OV - deleteunit : List FIdeal -> List FIdeal - ismonic : (DPoly,OV) -> Boolean - - - MPCFQF ==> MPolyCatFunctions2(OV,Expon,Expon,Q,F,DPoly1,DPoly) - MPCFFQ ==> MPolyCatFunctions2(OV,Expon,Expon,F,Q,DPoly,DPoly1) - - convertQF(a:Q) : F == ((numer a):: F)/((denom a)::F) - convertFQ(a:F) : Q == (ground numer a)/(ground denom a) - - internalForm(I:Ideal) : FIdeal == - Id:=generators I - nId:=[map(convertQF,poly)$MPCFQF for poly in Id] - groebner? I => groebnerIdeal nId - ideal nId - - externalForm(I:FIdeal) : Ideal == - Id:=generators I - nId:=[map(convertFQ,poly)$MPCFFQ for poly in Id] - groebner? I => groebnerIdeal nId - ideal nId - - lvint:=[variable(xx)::OV for xx in vl] - nvint1:=(#lvint-1)::NNI - - deleteunit(lI: List FIdeal) : List FIdeal == - [I for I in lI | _^ element?(1$DPoly,I)] - - rearrange(vlist:List OV) :List OV == - vlist=[] => vlist - sort(#1>#2,setDifference(lvint,setDifference(lvint,vlist))) - - ---- radical of a 0-dimensional ideal ---- - zeroRadComp(I:FIdeal,truelist:List OV) : FIdeal == - truelist=[] => I - Id:=generators I - x:OV:=truelist.last - #Id=1 => - f:=Id.first - g:= (f exquo (gcd (f,differentiate(f,x))))::DPoly - groebnerIdeal([g]) - y:=truelist.first - px:DPoly:=x::DPoly - py:DPoly:=y::DPoly - f:=Id.last - g:= (f exquo (gcd (f,differentiate(f,x))))::DPoly - Id:=groebner(cons(g,remove(f,Id))) - lf:=Id.first - pv:DPoly:=0 - pw:DPoly:=0 - while degree(lf,y)^=1 repeat - val:=random()$Z rem 23 - pv:=px+val*py - pw:=px-val*py - Id:=groebner([(univariate(h,x)).pv for h in Id]) - lf:=Id.first - ris:= generators(zeroRadComp(groebnerIdeal(Id.rest),truelist.rest)) - ris:=cons(lf,ris) - if pv^=0 then - ris:=[(univariate(h,x)).pw for h in ris] - groebnerIdeal(groebner ris) - - ---- find the power that stabilizes (I:s) ---- - goodPower(s:DPoly,I:FIdeal) : Record(spol:DPoly,id:FIdeal) == - f:DPoly:=s - I:=groebner I - J:=generators(JJ:= (saturate(I,s))) - while _^ in?(ideal([f*g for g in J]),I) repeat f:=s*f - [f,JJ] - - ---- is the ideal zerodimensional? ---- - ---- the "true variables" are in truelist ---- - zerodimcase(J:FIdeal,truelist:List OV) : Boolean == - element?(1,J) => true - truelist=[] => true - n:=#truelist - Jd:=groebner generators J - for x in truelist while Jd^=[] repeat - f := Jd.first - Jd:=Jd.rest - if ((y:=mainVariable f) case "failed") or (y::OV ^=x ) - or _^ (ismonic (f,x)) then return false - while Jd^=[] and (mainVariable Jd.first)::OV=x repeat Jd:=Jd.rest - if Jd=[] and position(x,truelist) [J] - zerodimcase(J,truelist) => - (flag case "zeroPrimDecomp") => zeroPrimDecomp(J,truelist) - (flag case "zeroRadComp") => [zeroRadComp(J,truelist)] - x:OV:=findvar(J,truelist) - Jnew:=[pushdown(f,x) for f in generators J] - Jc: List FIdeal :=[] - Jc:=reduceDim(flag,groebnerIdeal Jnew,remove(x,truelist)) - res1:=[ideal([pushup(f,x) for f in generators idp]) for idp in Jc] - s:=pushup((_*/[leadingCoefficient f for f in Jnew])::DPoly,x) - degree(s,x)=0 => res1 - res1:=[saturate(II,s) for II in res1] - good:=goodPower(s,J) - sideal := groebnerIdeal(groebner(cons(good.spol,generators J))) - in?(good.id, sideal) => res1 - sresult:=reduceDim(flag,sideal,truelist) - for JJ in sresult repeat - if not(in?(good.id,JJ)) then res1:=cons(JJ,res1) - res1 - - ---- Primary Decomposition for 0-dimensional ideals ---- - zeroPrimDecomp(I:FIdeal,truelist:List OV): List(FIdeal) == - truelist=[] => list I - newJ:=genPosLastVar(I,truelist);lval:=newJ.changeval; - J:=groebner newJ.genideal - x:=truelist.last - Jd:=generators J - g:=Jd.last - lfact:= factors factor(g) - ris:List FIdeal:=[] - for ef in lfact repeat - g:DPoly:=(ef.factor)**(ef.exponent::NNI) - J1:= groebnerIdeal(groebner cons(g,Jd)) - if _^ (is0dimprimary (J1,truelist)) then - return zeroPrimDecomp(I,truelist) - ris:=cons(groebner backGenPos(J1,lval,truelist),ris) - ris - - ---- radical of an Ideal ---- - radical(I:Ideal) : Ideal == - J:=groebner(internalForm I) - truelist:=rearrange("setUnion"/[variables f for f in generators J]) - truelist=[] => externalForm J - externalForm("intersect"/reduceDim("zeroRadComp",J,truelist)) - - --- the following functions are used to "push" x in the coefficient ring - - - ---- push x in the coefficient domain for a polynomial ---- - pushdown(g:DPoly,x:OV) : DPoly == - rf:DPoly:=0$DPoly - i:=position(x,lvint) - while g^=0 repeat - g1:=reductum g - rf:=rf+pushdterm(g-g1,x,i) - g := g1 - rf - - ---- push x in the coefficient domain for a term ---- - pushdterm(t:DPoly,x:OV,i:Z):DPoly == - n:=degree(t,x) - xp:=convert(x)@SE - cf:=monomial(1,xp,n)$P :: F - newt := t exquo monomial(1,x,n)$DPoly - cf * newt::DPoly - - ---- push back the variable ---- - pushup(f:DPoly,x:OV) :DPoly == - h:=1$P - rf:DPoly:=0$DPoly - g := f - xp := convert(x)@SE - while g^=0 repeat - h:=lcm(trueden(denom leadingCoefficient g,xp),h) - g:=reductum g - f:=(h::F)*f - while f^=0 repeat - g:=reductum f - rf:=rf+pushuterm(f-g,xp,x) - f:=g - rf - - trueden(c:P,x:SE) : P == - degree(c,x) = 0 => 1 - c - - ---- push x back from the coefficient domain for a term ---- - pushuterm(t:DPoly,xp:SE,x:OV):DPoly == - pushucoef((univariate(numer leadingCoefficient t,xp)$P), x)* - monomial(inv((denom leadingCoefficient t)::F),degree t)$DPoly - - - pushucoef(c:UP,x:OV):DPoly == - c = 0 => 0 - monomial((leadingCoefficient c)::F::DPoly,x,degree c) + - pushucoef(reductum c,x) - - -- is the 0-dimensional ideal I primary ? -- - ---- internal function ---- - is0dimprimary(J:FIdeal,truelist:List OV) : Boolean == - element?(1,J) => true - Jd:=generators(groebner J) - #(factors factor Jd.last)^=1 => return false - i:=subtractIfCan(#truelist,1) - (i case "failed") => return true - JR:=(reverse Jd);JM:=groebnerIdeal([JR.first]);JP:List(DPoly):=[] - for f in JR.rest repeat - if _^ ismonic(f,truelist.i) then - if _^ inRadical?(f,JM) then return false - JP:=cons(f,JP) - else - x:=truelist.i - i:=(i-1)::NNI - if _^ testPower(univariate(f,x),x,JM) then return false - JM :=groebnerIdeal(append(cons(f,JP),generators JM)) - true - - ---- Functions for the General Position step ---- - - ---- put the ideal in general position ---- - genPosLastVar(J:FIdeal,truelist:List OV):GenPos == - x := last truelist ;lv1:List OV :=remove(x,truelist) - ranvals:List(Z):=[(random()$Z rem 23) for vv in lv1] - val:=_+/[rv*(vv::DPoly) for vv in lv1 for rv in ranvals] - val:=val+(x::DPoly) - [ranvals,groebnerIdeal(groebner([(univariate(p,x)).val - for p in generators J]))]$GenPos - - - ---- convert back the ideal ---- - backGenPos(I:FIdeal,lval:List Z,truelist:List OV) : FIdeal == - lval=[] => I - x := last truelist ;lv1:List OV:=remove(x,truelist) - val:=-(_+/[rv*(vv::DPoly) for vv in lv1 for rv in lval]) - val:=val+(x::DPoly) - groebnerIdeal - (groebner([(univariate(p,x)).val for p in generators I ])) - - ismonic(f:DPoly,x:OV) : Boolean == ground? leadingCoefficient(univariate(f,x)) - - ---- test if f is power of a linear mod (rad J) ---- - ---- f is monic ---- - testPower(uf:SUP,x:OV,J:FIdeal) : Boolean == - df:=degree(uf) - trailp:DPoly := inv(df:Z ::F) *coefficient(uf,(df-1)::NNI) - linp:SUP:=(monomial(1$DPoly,1$NNI)$SUP + - monomial(trailp,0$NNI)$SUP)**df - g:DPoly:=multivariate(uf-linp,x) - inRadical?(g,J) - - - ---- Exported Functions ---- - - -- is the 0-dimensional ideal I prime ? -- - zeroDimPrime?(I:Ideal) : Boolean == - J:=groebner((genPosLastVar(internalForm I,lvint)).genideal) - element?(1,J) => true - n:NNI:=#vl;i:NNI:=1 - Jd:=generators J - #Jd^=n => false - for f in Jd repeat - if _^ ismonic(f,lvint.i) then return false - if i1 => false - lfact.1.exponent =1 - - - -- is the 0-dimensional ideal I primary ? -- - zeroDimPrimary?(J:Ideal):Boolean == - is0dimprimary(internalForm J,lvint) - - ---- Primary Decomposition of I ----- - - primaryDecomp(I:Ideal) : List(Ideal) == - J:=groebner(internalForm I) - truelist:=rearrange("setUnion"/[variables f for f in generators J]) - truelist=[] => [externalForm J] - [externalForm II for II in reduceDim("zeroPrimDecomp",J,truelist)] - - ---- contract I to the ring with lvar variables ---- - contract(I:Ideal,lvar: List OV) : Ideal == - Id:= generators(groebner I) - empty?(Id) => I - fullVars:= "setUnion"/[variables g for g in Id] - fullVars = lvar => I - n:= # lvar - #fullVars < n => error "wrong vars" - n=0 => I - newVars:= append([vv for vv in fullVars| ^member?(vv,lvar)]$List(OV),lvar) - subsVars := [monomial(1,vv,1)$DPoly1 for vv in newVars] - lJ:= [eval(g,fullVars,subsVars) for g in Id] - J := groebner(lJ) - J=[1] => groebnerIdeal J - J=[0] => groebnerIdeal empty() - J:=[f for f in J| member?(mainVariable(f)::OV,newVars)] - fullPol :=[monomial(1,vv,1)$DPoly1 for vv in fullVars] - groebnerIdeal([eval(gg,newVars,fullPol) for gg in J]) - -@ -\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/infprod.spad.pamphlet b/src/algebra/infprod.spad.pamphlet deleted file mode 100644 index ac34c2e..0000000 --- a/src/algebra/infprod.spad.pamphlet +++ /dev/null @@ -1,346 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra infprod.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package STINPROD StreamInfiniteProduct} -<>= -)abbrev package STINPROD StreamInfiniteProduct -++ Author: Clifton J. Williamson -++ Date Created: 23 February 1990 -++ Date Last Updated: 23 February 1990 -++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, -++ generalInfiniteProduct -++ Related Domains: UnivariateTaylorSeriesCategory -++ Also See: -++ AMS Classifications: -++ Keywords: Taylor series, infinite product -++ Examples: -++ References: -++ Description: -++ This package computes infinite products of Taylor series over an -++ integral domain of characteristic 0. Here Taylor series are -++ represented by streams of Taylor coefficients. -StreamInfiniteProduct(Coef): Exports == Implementation where - Coef: Join(IntegralDomain,CharacteristicZero) - I ==> Integer - QF ==> Fraction - ST ==> Stream - - Exports ==> with - - infiniteProduct: ST Coef -> ST Coef - ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - evenInfiniteProduct: ST Coef -> ST Coef - ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - oddInfiniteProduct: ST Coef -> ST Coef - ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - generalInfiniteProduct: (ST Coef,I,I) -> ST Coef - ++ generalInfiniteProduct(f(x),a,d) computes - ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - - Implementation ==> add - - if Coef has Field then - - import StreamTaylorSeriesOperations(Coef) - import StreamTranscendentalFunctions(Coef) - - infiniteProduct st == exp lambert log st - evenInfiniteProduct st == exp evenlambert log st - oddInfiniteProduct st == exp oddlambert log st - generalInfiniteProduct(st,a,d) == exp generalLambert(log st,a,d) - - else - - import StreamTaylorSeriesOperations(QF Coef) - import StreamTranscendentalFunctions(QF Coef) - - applyOverQF:(ST QF Coef -> ST QF Coef,ST Coef) -> ST Coef - applyOverQF(f,st) == - stQF := map(#1 :: QF(Coef),st)$StreamFunctions2(Coef,QF Coef) - map(retract(#1)@Coef,f stQF)$StreamFunctions2(QF Coef,Coef) - - infiniteProduct st == applyOverQF(exp lambert log #1,st) - evenInfiniteProduct st == applyOverQF(exp evenlambert log #1,st) - oddInfiniteProduct st == applyOverQF(exp oddlambert log #1,st) - generalInfiniteProduct(st,a,d) == - applyOverQF(exp generalLambert(log #1,a,d),st) - -@ -\section{package INFPROD0 InfiniteProductCharacteristicZero} -<>= -)abbrev package INFPROD0 InfiniteProductCharacteristicZero -++ Author: Clifton J. Williamson -++ Date Created: 22 February 1990 -++ Date Last Updated: 23 February 1990 -++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, -++ generalInfiniteProduct -++ Related Domains: UnivariateTaylorSeriesCategory -++ Also See: -++ AMS Classifications: -++ Keywords: Taylor series, infinite product -++ Examples: -++ References: -++ Description: -++ This package computes infinite products of univariate Taylor series -++ over an integral domain of characteristic 0. -InfiniteProductCharacteristicZero(Coef,UTS):_ - Exports == Implementation where - Coef : Join(IntegralDomain,CharacteristicZero) - UTS : UnivariateTaylorSeriesCategory Coef - I ==> Integer - - Exports ==> with - - infiniteProduct: UTS -> UTS - ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - evenInfiniteProduct: UTS -> UTS - ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - oddInfiniteProduct: UTS -> UTS - ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - generalInfiniteProduct: (UTS,I,I) -> UTS - ++ generalInfiniteProduct(f(x),a,d) computes - ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - - Implementation ==> add - - import StreamInfiniteProduct Coef - - infiniteProduct x == series infiniteProduct coefficients x - evenInfiniteProduct x == series evenInfiniteProduct coefficients x - oddInfiniteProduct x == series oddInfiniteProduct coefficients x - - generalInfiniteProduct(x,a,d) == - series generalInfiniteProduct(coefficients x,a,d) - -@ -\section{package INPRODPF InfiniteProductPrimeField} -<>= -)abbrev package INPRODPF InfiniteProductPrimeField -++ Author: Clifton J. Williamson -++ Date Created: 22 February 1990 -++ Date Last Updated: 23 February 1990 -++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, -++ generalInfiniteProduct -++ Related Domains: UnivariateTaylorSeriesCategory -++ Also See: -++ AMS Classifications: -++ Keywords: Taylor series, infinite product -++ Examples: -++ References: -++ Description: -++ This package computes infinite products of univariate Taylor series -++ over a field of prime order. -InfiniteProductPrimeField(Coef,UTS): Exports == Implementation where - Coef : Join(Field,Finite,ConvertibleTo Integer) - UTS : UnivariateTaylorSeriesCategory Coef - I ==> Integer - ST ==> Stream - - Exports ==> with - - infiniteProduct: UTS -> UTS - ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - evenInfiniteProduct: UTS -> UTS - ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - oddInfiniteProduct: UTS -> UTS - ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - generalInfiniteProduct: (UTS,I,I) -> UTS - ++ generalInfiniteProduct(f(x),a,d) computes - ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - - Implementation ==> add - - import StreamInfiniteProduct Integer - - applyOverZ:(ST I -> ST I,ST Coef) -> ST Coef - applyOverZ(f,st) == - stZ := map(convert(#1)@Integer,st)$StreamFunctions2(Coef,I) - map(#1 :: Coef,f stZ)$StreamFunctions2(I,Coef) - - infiniteProduct x == - series applyOverZ(infiniteProduct,coefficients x) - evenInfiniteProduct x == - series applyOverZ(evenInfiniteProduct,coefficients x) - oddInfiniteProduct x == - series applyOverZ(oddInfiniteProduct,coefficients x) - generalInfiniteProduct(x,a,d) == - series applyOverZ(generalInfiniteProduct(#1,a,d),coefficients x) - -@ -\section{package INPRODFF InfiniteProductFiniteField} -<>= -)abbrev package INPRODFF InfiniteProductFiniteField -++ Author: Clifton J. Williamson -++ Date Created: 22 February 1990 -++ Date Last Updated: 23 February 1990 -++ Basic Operations: infiniteProduct, evenInfiniteProduct, oddInfiniteProduct, -++ generalInfiniteProduct -++ Related Domains: UnivariateTaylorSeriesCategory -++ Also See: -++ AMS Classifications: -++ Keywords: Taylor series, infinite product -++ Examples: -++ References: -++ Description: -++ This package computes infinite products of univariate Taylor series -++ over an arbitrary finite field. -InfiniteProductFiniteField(K,UP,Coef,UTS):_ - Exports == Implementation where - K : Join(Field,Finite,ConvertibleTo Integer) - UP : UnivariatePolynomialCategory K - Coef : MonogenicAlgebra(K,UP) - UTS : UnivariateTaylorSeriesCategory Coef - I ==> Integer - RN ==> Fraction Integer - SAE ==> SimpleAlgebraicExtension - ST ==> Stream - STF ==> StreamTranscendentalFunctions - STT ==> StreamTaylorSeriesOperations - ST2 ==> StreamFunctions2 - SUP ==> SparseUnivariatePolynomial - - Exports ==> with - - infiniteProduct: UTS -> UTS - ++ infiniteProduct(f(x)) computes \spad{product(n=1,2,3...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - evenInfiniteProduct: UTS -> UTS - ++ evenInfiniteProduct(f(x)) computes \spad{product(n=2,4,6...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - oddInfiniteProduct: UTS -> UTS - ++ oddInfiniteProduct(f(x)) computes \spad{product(n=1,3,5...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - generalInfiniteProduct: (UTS,I,I) -> UTS - ++ generalInfiniteProduct(f(x),a,d) computes - ++ \spad{product(n=a,a+d,a+2*d,...,f(x**n))}. - ++ The series \spad{f(x)} should have constant coefficient 1. - - Implementation ==> add - - liftPoly: UP -> SUP RN - liftPoly poly == - -- lift coefficients of 'poly' to integers - ans : SUP RN := 0 - while not zero? poly repeat - coef := convert(leadingCoefficient poly)@I :: RN - ans := ans + monomial(coef,degree poly) - poly := reductum poly - ans - - reducePoly: SUP RN -> UP - reducePoly poly == - -- reduce coefficients of 'poly' to elements of K - ans : UP := 0 - while not zero? poly repeat - coef := numer(leadingCoefficient(poly)) :: K - ans := ans + monomial(coef,degree poly) - poly := reductum poly - ans - - POLY := liftPoly definingPolynomial()$Coef - ALG := SAE(RN,SUP RN,POLY) - - infiniteProduct x == - stUP := map(lift,coefficients x)$ST2(Coef,UP) - stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) - stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) - stALG := exp(lambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG) - stSUP := map(lift,stALG)$ST2(ALG,SUP RN) - stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) - series map(reduce,stUP)$ST2(UP,Coef) - - evenInfiniteProduct x == - stUP := map(lift,coefficients x)$ST2(Coef,UP) - stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) - stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) - stALG := exp(evenlambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG) - stSUP := map(lift,stALG)$ST2(ALG,SUP RN) - stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) - series map(reduce,stUP)$ST2(UP,Coef) - - oddInfiniteProduct x == - stUP := map(lift,coefficients x)$ST2(Coef,UP) - stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) - stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) - stALG := exp(oddlambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG) - stSUP := map(lift,stALG)$ST2(ALG,SUP RN) - stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) - series map(reduce,stUP)$ST2(UP,Coef) - - generalInfiniteProduct(x,a,d) == - stUP := map(lift,coefficients x)$ST2(Coef,UP) - stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN) - stALG := map(reduce,stSUP)$ST2(SUP RN,ALG) - stALG := generalLambert(log(stALG)$STF(ALG),a,d)$STT(ALG) - stALG := exp(stALG)$STF(ALG) - stSUP := map(lift,stALG)$ST2(ALG,SUP RN) - stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP) - series map(reduce,stUP)$ST2(UP,Coef) - -@ -\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/intaf.spad.pamphlet b/src/algebra/intaf.spad.pamphlet deleted file mode 100644 index 23f73b1..0000000 --- a/src/algebra/intaf.spad.pamphlet +++ /dev/null @@ -1,782 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intaf.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INTG0 GenusZeroIntegration} -<>= -)abbrev package INTG0 GenusZeroIntegration -++ Rationalization of several types of genus 0 integrands; -++ Author: Manuel Bronstein -++ Date Created: 11 October 1988 -++ Date Last Updated: 24 June 1994 -++ Description: -++ This internal package rationalises integrands on curves of the form: -++ \spad{y\^2 = a x\^2 + b x + c} -++ \spad{y\^2 = (a x + b) / (c x + d)} -++ \spad{f(x, y) = 0} where f has degree 1 in x -++ The rationalization is done for integration, limited integration, -++ extended integration and the risch differential equation; -GenusZeroIntegration(R, F, L): Exports == Implementation where - R: Join(GcdDomain, RetractableTo Integer, OrderedSet, CharacteristicZero, - LinearlyExplicitRingOver Integer) - F: Join(FunctionSpace R, AlgebraicallyClosedField, - TranscendentalFunctionCategory) - L: SetCategory - - SY ==> Symbol - Q ==> Fraction Integer - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - UPUP ==> SparseUnivariatePolynomial RF - IR ==> IntegrationResult F - LOG ==> Record(coeff:F, logand:F) - U1 ==> Union(F, "failed") - U2 ==> Union(Record(ratpart:F, coeff:F),"failed") - U3 ==> Union(Record(mainpart:F, limitedlogs:List LOG), "failed") - REC ==> Record(coeff:F, var:List K, val:List F) - ODE ==> Record(particular: Union(F, "failed"), basis: List F) - LODO==> LinearOrdinaryDifferentialOperator1 RF - - Exports ==> with - palgint0 : (F, K, K, F, UP) -> IR - ++ palgint0(f, x, y, d, p) returns the integral of \spad{f(x,y)dx} - ++ where y is an algebraic function of x satisfying - ++ \spad{d(x)\^2 y(x)\^2 = P(x)}. - palgint0 : (F, K, K, K, F, RF) -> IR - ++ palgint0(f, x, y, z, t, c) returns the integral of \spad{f(x,y)dx} - ++ where y is an algebraic function of x satisfying - ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. - ++ Argument z is a dummy variable not appearing in \spad{f(x,y)}. - palgextint0: (F, K, K, F, F, UP) -> U2 - ++ palgextint0(f, x, y, g, d, p) returns functions \spad{[h, c]} such - ++ that \spad{dh/dx = f(x,y) - c g}, where y is an algebraic function - ++ of x satisfying \spad{d(x)\^2 y(x)\^2 = P(x)}, - ++ or "failed" if no such functions exist. - palgextint0: (F, K, K, F, K, F, RF) -> U2 - ++ palgextint0(f, x, y, g, z, t, c) returns functions \spad{[h, d]} such - ++ that \spad{dh/dx = f(x,y) - d g}, where y is an algebraic function - ++ of x satisfying \spad{f(x,y)dx = c f(t,y) dy}, and c and t are rational - ++ functions of y. - ++ Argument z is a dummy variable not appearing in \spad{f(x,y)}. - ++ The operation returns "failed" if no such functions exist. - palglimint0: (F, K, K, List F, F, UP) -> U3 - ++ palglimint0(f, x, y, [u1,...,un], d, p) returns functions - ++ \spad{[h,[[ci, ui]]]} such that the ui's are among \spad{[u1,...,un]} - ++ and \spad{d(h + sum(ci log(ui)))/dx = f(x,y)} if such functions exist, - ++ and "failed" otherwise. - ++ Argument y is an algebraic function of x satisfying - ++ \spad{d(x)\^2y(x)\^2 = P(x)}. - palglimint0: (F, K, K, List F, K, F, RF) -> U3 - ++ palglimint0(f, x, y, [u1,...,un], z, t, c) returns functions - ++ \spad{[h,[[ci, ui]]]} such that the ui's are among \spad{[u1,...,un]} - ++ and \spad{d(h + sum(ci log(ui)))/dx = f(x,y)} if such functions exist, - ++ and "failed" otherwise. - ++ Argument y is an algebraic function of x satisfying - ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. - palgRDE0 : (F, F, K, K, (F, F, SY) -> U1, F, UP) -> U1 - ++ palgRDE0(f, g, x, y, foo, d, p) returns a function \spad{z(x,y)} - ++ such that \spad{dz/dx + n * df/dx z(x,y) = g(x,y)} if such a z exists, - ++ and "failed" otherwise. - ++ Argument y is an algebraic function of x satisfying - ++ \spad{d(x)\^2y(x)\^2 = P(x)}. - ++ Argument foo, called by \spad{foo(a, b, x)}, is a function that solves - ++ \spad{du/dx + n * da/dx u(x) = u(x)} - ++ for an unknown \spad{u(x)} not involving y. - palgRDE0 : (F, F, K, K, (F, F, SY) -> U1, K, F, RF) -> U1 - ++ palgRDE0(f, g, x, y, foo, t, c) returns a function \spad{z(x,y)} - ++ such that \spad{dz/dx + n * df/dx z(x,y) = g(x,y)} if such a z exists, - ++ and "failed" otherwise. - ++ Argument y is an algebraic function of x satisfying - ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. - ++ Argument \spad{foo}, called by \spad{foo(a, b, x)}, is a function that - ++ solves \spad{du/dx + n * da/dx u(x) = u(x)} - ++ for an unknown \spad{u(x)} not involving y. - univariate: (F, K, K, UP) -> UPUP - ++ univariate(f,k,k,p) \undocumented - multivariate: (UPUP, K, F) -> F - ++ multivariate(u,k,f) \undocumented - lift: (UP, K) -> UPUP - ++ lift(u,k) \undocumented - if L has LinearOrdinaryDifferentialOperatorCategory F then - palgLODE0 : (L, F, K, K, F, UP) -> ODE - ++ palgLODE0(op, g, x, y, d, p) returns the solution of \spad{op f = g}. - ++ Argument y is an algebraic function of x satisfying - ++ \spad{d(x)\^2y(x)\^2 = P(x)}. - palgLODE0 : (L, F, K, K, K, F, RF) -> ODE - ++ palgLODE0(op,g,x,y,z,t,c) returns the solution of \spad{op f = g} - ++ Argument y is an algebraic function of x satisfying - ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y. - - Implementation ==> add - import RationalIntegration(F, UP) - import AlgebraicManipulations(R, F) - import IntegrationResultFunctions2(RF, F) - import ElementaryFunctionStructurePackage(R, F) - import SparseUnivariatePolynomialFunctions2(F, RF) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R, P, F) - - mkRat : (F, REC, List K) -> RF - mkRatlx : (F, K, K, F, K, RF) -> RF - quadsubst: (K, K, F, UP) -> Record(diff:F, subs:REC, newk:List K) - kerdiff : (F, F) -> List K - checkroot: (F, List K) -> F - univ : (F, List K, K) -> RF - - dummy := kernel(new()$SY)@K - - kerdiff(sa, a) == setDifference(kernels sa, kernels a) - checkroot(f, l) == (empty? l => f; rootNormalize(f, first l)) - univ(c, l, x) == univariate(checkroot(c, l), x) - univariate(f, x, y, p) == lift(univariate(f, y, p), x) - lift(p, k) == map(univariate(#1, k), p) - - palgint0(f, x, y, den, radi) == - -- y is a square root so write f as f1 y + f0 and integrate separately - ff := univariate(f, x, y, minPoly y) - f0 := reductum ff - pr := quadsubst(x, y, den, radi) - map(#1(x::F), integrate(retract(f0)@RF)) + - map(#1(pr.diff), - integrate - mkRat(multivariate(leadingMonomial ff,x,y::F), pr.subs, pr.newk)) - --- the algebraic relation is (den * y)**2 = p where p is a * x**2 + b * x + c --- if p is squarefree, then parametrize in the following form: --- u = y - x \sqrt{a} --- x = (u^2 - c) / (b - 2 u \sqrt{a}) = h(u) --- dx = h'(u) du --- y = (u + a h(u)) / den = g(u) --- if a is a perfect square, --- u = (y - \sqrt{c}) / x --- x = (b - 2 u \sqrt{c}) / (u^2 - a) = h(u) --- dx = h'(u) du --- y = (u h(u) + \sqrt{c}) / den = g(u) --- otherwise. --- if p is a square p = a t^2, then we choose only one branch for now: --- u = x --- x = u = h(u) --- dx = du --- y = t \sqrt{a} / den = g(u) --- returns [u(x,y), [h'(u), [x,y], [h(u), g(u)], l] in both cases, --- where l is empty if no new square root was needed, --- l := [k] if k is the new square root kernel that was created. - quadsubst(x, y, den, p) == - u := dummy::F - b := coefficient(p, 1) - c := coefficient(p, 0) - sa := rootSimp sqrt(a := coefficient(p, 2)) - zero?(b * b - 4 * a * c) => -- case where p = a (x + b/(2a))^2 - [x::F, [1, [x, y], [u, sa * (u + b / (2*a)) / eval(den,x,u)]], empty()] - empty? kerdiff(sa, a) => - bm2u := b - 2 * u * sa - q := eval(den, x, xx := (u**2 - c) / bm2u) - yy := (ua := u + xx * sa) / q - [y::F - x::F * sa, [2 * ua / bm2u, [x, y], [xx, yy]], empty()] - u2ma:= u**2 - a - sc := rootSimp sqrt c - q := eval(den, x, xx := (b - 2 * u * sc) / u2ma) - yy := (ux := xx * u + sc) / q - [(y::F - sc) / x::F, [- 2 * ux / u2ma, [x ,y], [xx, yy]], kerdiff(sc, c)] - - mkRatlx(f,x,y,t,z,dx) == - rat := univariate(eval(f, [x, y], [t, z::F]), z) * dx - numer(rat) / denom(rat) - - mkRat(f, rec, l) == - rat:=univariate(checkroot(rec.coeff * eval(f,rec.var,rec.val), l), dummy) - numer(rat) / denom(rat) - - palgint0(f, x, y, z, xx, dx) == - map(multivariate(#1, y), integrate mkRatlx(f, x, y, xx, z, dx)) - - palgextint0(f, x, y, g, z, xx, dx) == - map(multivariate(#1, y), - extendedint(mkRatlx(f,x,y,xx,z,dx), mkRatlx(g,x,y,xx,z,dx))) - - palglimint0(f, x, y, lu, z, xx, dx) == - map(multivariate(#1, y), limitedint(mkRatlx(f, x, y, xx, z, dx), - [mkRatlx(u, x, y, xx, z, dx) for u in lu])) - - palgRDE0(f, g, x, y, rischde, z, xx, dx) == - (u := rischde(eval(f, [x, y], [xx, z::F]), - multivariate(dx, z) * eval(g, [x, y], [xx, z::F]), - symbolIfCan(z)::SY)) case "failed" => "failed" - eval(u::F, z, y::F) - --- given p = sum_i a_i(X) Y^i, returns sum_i a_i(x) y^i - multivariate(p, x, y) == - (map(multivariate(#1, x), - p)$SparseUnivariatePolynomialFunctions2(RF, F)) - (y) - - palgextint0(f, x, y, g, den, radi) == - pr := quadsubst(x, y, den, radi) - map(#1(pr.diff), - extendedint(mkRat(f, pr.subs, pr.newk), mkRat(g, pr.subs, pr.newk))) - - palglimint0(f, x, y, lu, den, radi) == - pr := quadsubst(x, y, den, radi) - map(#1(pr.diff), - limitedint(mkRat(f, pr.subs, pr.newk), - [mkRat(u, pr.subs, pr.newk) for u in lu])) - - palgRDE0(f, g, x, y, rischde, den, radi) == - pr := quadsubst(x, y, den, radi) - (u := rischde(checkroot(eval(f, pr.subs.var, pr.subs.val), pr.newk), - checkroot(pr.subs.coeff * eval(g, pr.subs.var, pr.subs.val), - pr.newk), symbolIfCan(dummy)::SY)) case "failed" - => "failed" - eval(u::F, dummy, pr.diff) - - if L has LinearOrdinaryDifferentialOperatorCategory F then - import RationalLODE(F, UP) - - palgLODE0(eq, g, x, y, den, radi) == - pr := quadsubst(x, y, den, radi) - d := monomial(univ(inv(pr.subs.coeff), pr.newk, dummy), 1)$LODO - di:LODO := 1 -- will accumulate the powers of d - op:LODO := 0 -- will accumulate the new LODO - for i in 0..degree eq repeat - op := op + univ(eval(coefficient(eq, i), pr.subs.var, pr.subs.val), - pr.newk, dummy) * di - di := d * di - rec := ratDsolve(op,univ(eval(g,pr.subs.var,pr.subs.val),pr.newk,dummy)) - bas:List(F) := [b(pr.diff) for b in rec.basis] - rec.particular case "failed" => ["failed", bas] - [((rec.particular)::RF) (pr.diff), bas] - - palgLODE0(eq, g, x, y, kz, xx, dx) == - d := monomial(univariate(inv multivariate(dx, kz), kz), 1)$LODO - di:LODO := 1 -- will accumulate the powers of d - op:LODO := 0 -- will accumulate the new LODO - lk:List(K) := [x, y] - lv:List(F) := [xx, kz::F] - for i in 0..degree eq repeat - op := op + univariate(eval(coefficient(eq, i), lk, lv), kz) * di - di := d * di - rec := ratDsolve(op, univariate(eval(g, lk, lv), kz)) - bas:List(F) := [multivariate(b, y) for b in rec.basis] - rec.particular case "failed" => ["failed", bas] - [multivariate((rec.particular)::RF, y), bas] - -@ -\section{package INTPAF PureAlgebraicIntegration} -<>= -)abbrev package INTPAF PureAlgebraicIntegration -++ Integration of pure algebraic functions; -++ Author: Manuel Bronstein -++ Date Created: 27 May 1988 -++ Date Last Updated: 24 June 1994 -++ Description: -++ This package provides functions for integration, limited integration, -++ extended integration and the risch differential equation for -++ pure algebraic integrands; -PureAlgebraicIntegration(R, F, L): Exports == Implementation where - R: Join(GcdDomain,RetractableTo Integer,OrderedSet, CharacteristicZero, - LinearlyExplicitRingOver Integer) - F: Join(FunctionSpace R, AlgebraicallyClosedField, - TranscendentalFunctionCategory) - L: SetCategory - - SY ==> Symbol - N ==> NonNegativeInteger - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - UPUP==> SparseUnivariatePolynomial RF - IR ==> IntegrationResult F - IR2 ==> IntegrationResultFunctions2(curve, F) - ALG ==> AlgebraicIntegrate(R, F, UP, UPUP, curve) - LDALG ==> LinearOrdinaryDifferentialOperator1 curve - RDALG ==> PureAlgebraicLODE(F, UP, UPUP, curve) - LOG ==> Record(coeff:F, logand:F) - REC ==> Record(particular:U1, basis:List F) - CND ==> Record(left:UP, right:UP) - CHV ==> Record(int:UPUP, left:UP, right:UP, den:RF, deg:N) - U1 ==> Union(F, "failed") - U2 ==> Union(Record(ratpart:F, coeff:F),"failed") - U3 ==> Union(Record(mainpart:F, limitedlogs:List LOG), "failed") - FAIL==> error "failed - cannot handle that integrand" - - Exports ==> with - palgint : (F, K, K) -> IR - ++ palgint(f, x, y) returns the integral of \spad{f(x,y)dx} - ++ where y is an algebraic function of x. - palgextint: (F, K, K, F) -> U2 - ++ palgextint(f, x, y, g) returns functions \spad{[h, c]} such that - ++ \spad{dh/dx = f(x,y) - c g}, where y is an algebraic function of x; - ++ returns "failed" if no such functions exist. - palglimint: (F, K, K, List F) -> U3 - ++ palglimint(f, x, y, [u1,...,un]) returns functions - ++ \spad{[h,[[ci, ui]]]} such that the ui's are among \spad{[u1,...,un]} - ++ and \spad{d(h + sum(ci log(ui)))/dx = f(x,y)} if such functions exist, - ++ "failed" otherwise; - ++ y is an algebraic function of x. - palgRDE : (F, F, F, K, K, (F, F, SY) -> U1) -> U1 - ++ palgRDE(nfp, f, g, x, y, foo) returns a function \spad{z(x,y)} - ++ such that \spad{dz/dx + n * df/dx z(x,y) = g(x,y)} if such a z exists, - ++ "failed" otherwise; - ++ y is an algebraic function of x; - ++ \spad{foo(a, b, x)} is a function that solves - ++ \spad{du/dx + n * da/dx u(x) = u(x)} - ++ for an unknown \spad{u(x)} not involving y. - ++ \spad{nfp} is \spad{n * df/dx}. - if L has LinearOrdinaryDifferentialOperatorCategory F then - palgLODE: (L, F, K, K, SY) -> REC - ++ palgLODE(op, g, kx, y, x) returns the solution of \spad{op f = g}. - ++ y is an algebraic function of x. - - Implementation ==> add - import IntegrationTools(R, F) - import RationalIntegration(F, UP) - import GenusZeroIntegration(R, F, L) - import ChangeOfVariable(F, UP, UPUP) - import IntegrationResultFunctions2(F, F) - import IntegrationResultFunctions2(RF, F) - import SparseUnivariatePolynomialFunctions2(F, RF) - import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R, P, F) - - quadIfCan : (K, K) -> Union(Record(coef:F, poly:UP), "failed") - linearInXIfCan : (K, K) -> Union(Record(xsub:F, dxsub:RF), "failed") - prootintegrate : (F, K, K) -> IR - prootintegrate1: (UPUP, K, K, UPUP) -> IR - prootextint : (F, K, K, F) -> U2 - prootlimint : (F, K, K, List F) -> U3 - prootRDE : (F, F, F, K, K, (F, F, SY) -> U1) -> U1 - palgRDE1 : (F, F, K, K) -> U1 - palgLODE1 : (List F, F, K, K, SY) -> REC - palgintegrate : (F, K, K) -> IR - palgext : (F, K, K, F) -> U2 - palglim : (F, K, K, List F) -> U3 - UPUP2F1 : (UPUP, RF, RF, K, K) -> F - UPUP2F0 : (UPUP, K, K) -> F - RF2UPUP : (RF, UPUP) -> UPUP - algaddx : (IR, F) -> IR - chvarIfCan : (UPUP, RF, UP, RF) -> Union(UPUP, "failed") - changeVarIfCan : (UPUP, RF, N) -> Union(CHV, "failed") - rationalInt : (UPUP, N, UP) -> IntegrationResult RF - chv : (UPUP, N, F, F) -> RF - chv0 : (UPUP, N, F, F) -> F - candidates : UP -> List CND - - dummy := new()$SY - dumk := kernel(dummy)@K - - UPUP2F1(p, t, cf, kx, k) == UPUP2F0(eval(p, t, cf), kx, k) - UPUP2F0(p, kx, k) == multivariate(p, kx, k::F) - chv(f, n, a, b) == univariate(chv0(f, n, a, b), dumk) - - RF2UPUP(f, modulus) == - bc := extendedEuclidean(map(#1::UP::RF, denom f), modulus, - 1)::Record(coef1:UPUP, coef2:UPUP) - (map(#1::UP::RF, numer f) * bc.coef1) rem modulus - --- returns "failed", or (xx, c) such that f(x, y)dx = f(xx, y) c dy --- if p(x, y) = 0 is linear in x - linearInXIfCan(x, y) == - a := b := 0$UP - p := clearDenominator lift(minPoly y, x) - while p ^= 0 repeat - degree(q := numer leadingCoefficient p) > 1 => return "failed" - a := a + monomial(coefficient(q, 1), d := degree p) - b := b - monomial(coefficient(q, 0), d) - p := reductum p - xx:RF := b / a - [xx(dumk::F), differentiate(xx, differentiate)] - --- return Int(f(x,y)dx) where y is an n^th root of a rational function in x - prootintegrate(f, x, y) == - modulus := lift(p := minPoly y, x) - rf := reductum(ff := univariate(f, x, y, p)) - ((r := retractIfCan(rf)@Union(RF,"failed")) case RF) and rf ^= 0 => - -- in this case, ff := lc(ff) y^i + r so we integrate both terms - -- separately to gain time - map(#1(x::F), integrate(r::RF)) + - prootintegrate1(leadingMonomial ff, x, y, modulus) - prootintegrate1(ff, x, y, modulus) - - prootintegrate1(ff, x, y, modulus) == - chv:CHV - r := radPoly(modulus)::Record(radicand:RF, deg:N) - (uu := changeVarIfCan(ff, r.radicand, r.deg)) case CHV => - chv := uu::CHV - newalg := nthRoot((chv.left)(dumk::F), chv.deg) - kz := retract(numer newalg)@K - newf := multivariate(chv.int, ku := dumk, newalg) - vu := (chv.right)(x::F) - vz := (chv.den)(x::F) * (y::F) * denom(newalg)::F - map(eval(#1, [ku, kz], [vu, vz]), palgint(newf, ku, kz)) - cv := chvar(ff, modulus) - r := radPoly(cv.poly)::Record(radicand:RF, deg:N) - qprime := differentiate(q := retract(r.radicand)@UP)::RF - not zero? qprime and - ((u := chvarIfCan(cv.func, 1, q, inv qprime)) case UPUP) => - m := monomial(1, r.deg)$UPUP - q::RF::UPUP - map(UPUP2F1(RF2UPUP(#1, m), cv.c1, cv.c2, x, y), - rationalInt(u::UPUP, r.deg, monomial(1, 1))) - curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) - algaddx(map(UPUP2F1(lift #1, cv.c1, cv.c2, x, y), - palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F) - --- Do the rationalizing change of variable --- Int(f(x, y) dx) --> Int(n u^(n-1) f((u^n - b)/a, u) / a du) where --- u^n = y^n = g(x) = a x + b --- returns the integral as an integral of a rational function in u - rationalInt(f, n, g) == --- not one? degree g => error "rationalInt: radicand must be linear" - not ((degree g) = 1) => error "rationalInt: radicand must be linear" - a := leadingCoefficient g - integrate(n * monomial(inv a, (n-1)::N)$UP - * chv(f, n, a, leadingCoefficient reductum g)) - --- Do the rationalizing change of variable f(x,y) --> f((u^n - b)/a, u) where --- u = y = (a x + b)^(1/n). --- Returns f((u^n - b)/a,u) as an element of F - chv0(f, n, a, b) == - d := dumk::F - (f (d::UP::RF)) ((d ** n - b) / a) - --- candidates(p) returns a list of pairs [g, u] such that p(x) = g(u(x)), --- those u's are candidates for change of variables --- currently uses a dumb heuristic where the candidates u's are p itself --- and all the powers x^2, x^3, ..., x^{deg(p)}, --- will use polynomial decomposition in smarter days MB 8/93 - candidates p == - l:List(CND) := empty() - ground? p => l - for i in 2..degree p repeat - if (u := composite(p, xi := monomial(1, i))) case UP then - l := concat([u::UP, xi], l) - concat([monomial(1, 1), p], l) - --- checks whether Int(p(x, y) dx) can be rewritten as --- Int(r(u, z) du) where u is some polynomial of x, --- z = d y for some polynomial d, and z^m = g(u) --- returns either [r(u, z), g, u, d, m] or "failed" --- we have y^n = radi - changeVarIfCan(p, radi, n) == - rec := rootPoly(radi, n) - for cnd in candidates(rec.radicand) repeat - (u := chvarIfCan(p, rec.coef, cnd.right, - inv(differentiate(cnd.right)::RF))) case UPUP => - return [u::UPUP, cnd.left, cnd.right, rec.coef, rec.exponent] - "failed" - --- checks whether Int(p(x, y) dx) can be rewritten as --- Int(r(u, z) du) where u is some polynomial of x and z = d y --- we have y^n = a(x)/d(x) --- returns either "failed" or r(u, z) - chvarIfCan(p, d, u, u1) == - ans:UPUP := 0 - while p ^= 0 repeat - (v := composite(u1 * leadingCoefficient(p) / d ** degree(p), u)) - case "failed" => return "failed" - ans := ans + monomial(v::RF, degree p) - p := reductum p - ans - - algaddx(i, xx) == - elem? i => i - mkAnswer(ratpart i, logpart i, - [[- ne.integrand / (xx**2), xx] for ne in notelem i]) - - prootRDE(nfp, f, g, x, k, rde) == - modulus := lift(p := minPoly k, x) - r := radPoly(modulus)::Record(radicand:RF, deg:N) - rec := rootPoly(r.radicand, r.deg) - dqdx := inv(differentiate(q := rec.radicand)::RF) - ((uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,1)) case UPUP) and - ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx)) case UPUP) => - (u := rde(chv0(uf::UPUP, rec.exponent, 1, 0), rec.exponent * - (dumk::F) ** (rec.exponent * (rec.exponent - 1)) - * chv0(ug::UPUP, rec.exponent, 1, 0), - symbolIfCan(dumk)::SY)) case "failed" => "failed" - eval(u::F, dumk, k::F) --- one?(rec.coef) => - ((rec.coef) = 1) => - curve := RadicalFunctionField(F, UP, UPUP, q::RF, rec.exponent) - rc := algDsolve(D()$LDALG + reduce(univariate(nfp, x, k, p))::LDALG, - reduce univariate(g, x, k, p))$RDALG - rc.particular case "failed" => "failed" - UPUP2F0(lift((rc.particular)::curve), x, k) - palgRDE1(nfp, g, x, k) - - prootlimint(f, x, k, lu) == - modulus := lift(p := minPoly k, x) - r := radPoly(modulus)::Record(radicand:RF, deg:N) - rec := rootPoly(r.radicand, r.deg) - dqdx := inv(differentiate(q := rec.radicand)::RF) - (uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,dqdx)) case UPUP => - l := empty()$List(RF) - n := rec.exponent * monomial(1, (rec.exponent - 1)::N)$UP - for u in lu repeat - if ((v:=chvarIfCan(uu:=univariate(u,x,k,p),rec.coef,q,dqdx))case UPUP) - then l := concat(n * chv(v::UPUP,rec.exponent, 1, 0), l) else FAIL - m := monomial(1, rec.exponent)$UPUP - q::RF::UPUP - map(UPUP2F0(RF2UPUP(#1,m), x, k), - limitedint(n * chv(uf::UPUP, rec.exponent, 1, 0), reverse_! l)) - cv := chvar(ff, modulus) - r := radPoly(cv.poly)::Record(radicand:RF, deg:N) - dqdx := inv(differentiate(q := retract(r.radicand)@UP)::RF) - curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) - (ui := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) - case "failed" => FAIL - [UPUP2F1(lift(ui::curve), cv.c1, cv.c2, x, k), empty()] - - prootextint(f, x, k, g) == - modulus := lift(p := minPoly k, x) - r := radPoly(modulus)::Record(radicand:RF, deg:N) - rec := rootPoly(r.radicand, r.deg) - dqdx := inv(differentiate(q := rec.radicand)::RF) - ((uf:=chvarIfCan(ff:=univariate(f,x,k,p),rec.coef,q,dqdx)) case UPUP) and - ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx)) case UPUP) => - m := monomial(1, rec.exponent)$UPUP - q::RF::UPUP - n := rec.exponent * monomial(1, (rec.exponent - 1)::N)$UP - map(UPUP2F0(RF2UPUP(#1,m), x, k), - extendedint(n * chv(uf::UPUP, rec.exponent, 1, 0), - n * chv(ug::UPUP, rec.exponent, 1, 0))) - cv := chvar(ff, modulus) - r := radPoly(cv.poly)::Record(radicand:RF, deg:N) - dqdx := inv(differentiate(q := retract(r.radicand)@UP)::RF) - curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) - (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) - case "failed" => FAIL - [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0] - - palgRDE1(nfp, g, x, y) == - palgLODE1([nfp, 1], g, x, y, symbolIfCan(x)::SY).particular - - palgLODE1(eq, g, kx, y, x) == - modulus:= lift(p := minPoly y, kx) - curve := AlgebraicFunctionField(F, UP, UPUP, modulus) - neq:LDALG := 0 - for f in eq for i in 0.. repeat - neq := neq + monomial(reduce univariate(f, kx, y, p), i) - empty? remove_!(y, remove_!(kx, varselect(kernels g, x))) => - rec := algDsolve(neq, reduce univariate(g, kx, y, p))$RDALG - bas:List(F) := [UPUP2F0(lift h, kx, y) for h in rec.basis] - rec.particular case "failed" => ["failed", bas] - [UPUP2F0(lift((rec.particular)::curve), kx, y), bas] - rec := algDsolve(neq, 0) - ["failed", [UPUP2F0(lift h, kx, y) for h in rec.basis]] - - palgintegrate(f, x, k) == - modulus:= lift(p := minPoly k, x) - cv := chvar(univariate(f, x, k, p), modulus) - curve := AlgebraicFunctionField(F, UP, UPUP, cv.poly) - knownInfBasis(cv.deg) - algaddx(map(UPUP2F1(lift #1, cv.c1, cv.c2, x, k), - palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F) - - palglim(f, x, k, lu) == - modulus:= lift(p := minPoly k, x) - cv := chvar(univariate(f, x, k, p), modulus) - curve := AlgebraicFunctionField(F, UP, UPUP, cv.poly) - knownInfBasis(cv.deg) - (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) - case "failed" => FAIL - [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), empty()] - - palgext(f, x, k, g) == - modulus:= lift(p := minPoly k, x) - cv := chvar(univariate(f, x, k, p), modulus) - curve := AlgebraicFunctionField(F, UP, UPUP, cv.poly) - knownInfBasis(cv.deg) - (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG) - case "failed" => FAIL - [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0] - - palgint(f, x, y) == - (v := linearInXIfCan(x, y)) case "failed" => - (u := quadIfCan(x, y)) case "failed" => - is?(y, "nthRoot"::SY) => prootintegrate(f, x, y) - is?(y, "rootOf"::SY) => palgintegrate(f, x, y) - FAIL - palgint0(f, x, y, u.coef, u.poly) - palgint0(f, x, y, dumk, v.xsub, v.dxsub) - - palgextint(f, x, y, g) == - (v := linearInXIfCan(x, y)) case "failed" => - (u := quadIfCan(x, y)) case "failed" => - is?(y, "nthRoot"::SY) => prootextint(f, x, y, g) - is?(y, "rootOf"::SY) => palgext(f, x, y, g) - FAIL - palgextint0(f, x, y, g, u.coef, u.poly) - palgextint0(f, x, y, g, dumk, v.xsub, v.dxsub) - - palglimint(f, x, y, lu) == - (v := linearInXIfCan(x, y)) case "failed" => - (u := quadIfCan(x, y)) case "failed" => - is?(y, "nthRoot"::SY) => prootlimint(f, x, y, lu) - is?(y, "rootOf"::SY) => palglim(f, x, y, lu) - FAIL - palglimint0(f, x, y, lu, u.coef, u.poly) - palglimint0(f, x, y, lu, dumk, v.xsub, v.dxsub) - - palgRDE(nfp, f, g, x, y, rde) == - (v := linearInXIfCan(x, y)) case "failed" => - (u := quadIfCan(x, y)) case "failed" => - is?(y, "nthRoot"::SY) => prootRDE(nfp, f, g, x, y, rde) - palgRDE1(nfp, g, x, y) - palgRDE0(f, g, x, y, rde, u.coef, u.poly) - palgRDE0(f, g, x, y, rde, dumk, v.xsub, v.dxsub) - - -- returns "failed", or (d, P) such that (dy)**2 = P(x) - -- and degree(P) = 2 - quadIfCan(x, y) == - (degree(p := minPoly y) = 2) and zero?(coefficient(p, 1)) => - d := denom(ff := - univariate(- coefficient(p, 0) / coefficient(p, 2), x)) - degree(radi := d * numer ff) = 2 => [d(x::F), radi] - "failed" - "failed" - - if L has LinearOrdinaryDifferentialOperatorCategory F then - palgLODE(eq, g, kx, y, x) == - (v := linearInXIfCan(kx, y)) case "failed" => - (u := quadIfCan(kx, y)) case "failed" => - palgLODE1([coefficient(eq, i) for i in 0..degree eq], g, kx, y, x) - palgLODE0(eq, g, kx, y, u.coef, u.poly) - palgLODE0(eq, g, kx, y, dumk, v.xsub, v.dxsub) - -@ -\section{package INTAF AlgebraicIntegration} -<>= -)abbrev package INTAF AlgebraicIntegration -++ Mixed algebraic integration; -++ Author: Manuel Bronstein -++ Date Created: 12 October 1988 -++ Date Last Updated: 4 June 1988 -++ Description: -++ This package provides functions for the integration of -++ algebraic integrands over transcendental functions; -AlgebraicIntegration(R, F): Exports == Implementation where - R : Join(OrderedSet, IntegralDomain) - F : Join(AlgebraicallyClosedField, FunctionSpace R) - - SY ==> Symbol - N ==> NonNegativeInteger - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - UPUP==> SparseUnivariatePolynomial RF - IR ==> IntegrationResult F - IR2 ==> IntegrationResultFunctions2(curve, F) - ALG ==> AlgebraicIntegrate(R, F, UP, UPUP, curve) - FAIL==> error "failed - cannot handle that integrand" - - Exports ==> with - algint: (F, K, K, UP -> UP) -> IR - ++ algint(f, x, y, d) returns the integral of \spad{f(x,y)dx} - ++ where y is an algebraic function of x; - ++ d is the derivation to use on \spad{k[x]}. - - Implementation ==> add - import ChangeOfVariable(F, UP, UPUP) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R, P, F) - - rootintegrate: (F, K, K, UP -> UP) -> IR - algintegrate : (F, K, K, UP -> UP) -> IR - UPUP2F : (UPUP, RF, K, K) -> F - F2UPUP : (F, K, K, UP) -> UPUP - UP2UPUP : (UP, K) -> UPUP - - F2UPUP(f, kx, k, p) == UP2UPUP(univariate(f, k, p), kx) - - rootintegrate(f, t, k, derivation) == - r1 := mkIntegral(modulus := UP2UPUP(p := minPoly k, t)) - f1 := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1) - r := radPoly(r1.poly)::Record(radicand:RF, deg:N) - q := retract(r.radicand) - curve := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg) - map(UPUP2F(lift #1, r1.coef, t, k), - algintegrate(reduce f1, derivation)$ALG)$IR2 - - algintegrate(f, t, k, derivation) == - r1 := mkIntegral(modulus := UP2UPUP(p := minPoly k, t)) - f1 := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1) - modulus:= UP2UPUP(p := minPoly k, t) - curve := AlgebraicFunctionField(F, UP, UPUP, r1.poly) - map(UPUP2F(lift #1, r1.coef, t, k), - algintegrate(reduce f1, derivation)$ALG)$IR2 - - UP2UPUP(p, k) == - map(univariate(#1,k),p)$SparseUnivariatePolynomialFunctions2(F,RF) - - UPUP2F(p, cf, t, k) == - map(multivariate(#1, t), - p)$SparseUnivariatePolynomialFunctions2(RF, F) - (multivariate(cf, t) * k::F) - - algint(f, t, y, derivation) == - is?(y, "nthRoot"::SY) => rootintegrate(f, t, y, derivation) - is?(y, "rootOf"::SY) => algintegrate(f, t, y, derivation) - FAIL - -@ -\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/intalg.spad.pamphlet b/src/algebra/intalg.spad.pamphlet deleted file mode 100644 index a08b41f..0000000 --- a/src/algebra/intalg.spad.pamphlet +++ /dev/null @@ -1,488 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intalg.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package DBLRESP DoubleResultantPackage} -<>= -)abbrev package DBLRESP DoubleResultantPackage -++ Residue resultant -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 12 July 1990 -++ Description: -++ This package provides functions for computing the residues -++ of a function on an algebraic curve. -DoubleResultantPackage(F, UP, UPUP, R): Exports == Implementation where - F : Field - UP : UnivariatePolynomialCategory F - UPUP: UnivariatePolynomialCategory Fraction UP - R : FunctionFieldCategory(F, UP, UPUP) - - RF ==> Fraction UP - UP2 ==> SparseUnivariatePolynomial UP - UP3 ==> SparseUnivariatePolynomial UP2 - - Exports ==> with - doubleResultant: (R, UP -> UP) -> UP - ++ doubleResultant(f, ') returns p(x) whose roots are - ++ rational multiples of the residues of f at all its - ++ finite poles. Argument ' is the derivation to use. - - Implementation ==> add - import CommuteUnivariatePolynomialCategory(F, UP, UP2) - import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) - - UP22 : UP -> UP2 - UP23 : UPUP -> UP3 - remove0: UP -> UP -- removes the power of x dividing p - - remove0 p == - primitivePart((p exquo monomial(1, minimumDegree p))::UP) - - UP22 p == - map(#1::UP, p)$UnivariatePolynomialCategoryFunctions2(F,UP,UP,UP2) - - UP23 p == - map(UP22(retract(#1)@UP), - p)$UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP2, UP3) - - doubleResultant(h, derivation) == - cd := splitDenominator lift h - d := (cd.den exquo (g := gcd(cd.den, derivation(cd.den))))::UP - r := swap primitivePart swap resultant(UP23(cd.num) - - ((monomial(1, 1)$UP :: UP2) * UP22(g * derivation d))::UP3, - UP23 definingPolynomial()) - remove0 resultant(r, UP22 d) - -@ -\section{package INTHERAL AlgebraicHermiteIntegration} -<>= -)abbrev package INTHERAL AlgebraicHermiteIntegration -++ Hermite integration, algebraic case -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 25 July 1990 -++ Description: algebraic Hermite redution. -AlgebraicHermiteIntegration(F,UP,UPUP,R):Exports == Implementation where - F : Field - UP : UnivariatePolynomialCategory F - UPUP: UnivariatePolynomialCategory Fraction UP - R : FunctionFieldCategory(F, UP, UPUP) - - N ==> NonNegativeInteger - RF ==> Fraction UP - - Exports ==> with - HermiteIntegrate: (R, UP -> UP) -> Record(answer:R, logpart:R) - ++ HermiteIntegrate(f, ') returns \spad{[g,h]} such that - ++ \spad{f = g' + h} and h has a only simple finite normal poles. - - Implementation ==> add - localsolve: (Matrix UP, Vector UP, UP) -> Vector UP - --- the denominator of f should have no prime factor P s.t. P | P' --- (which happens only for P = t in the exponential case) - HermiteIntegrate(f, derivation) == - ratform:R := 0 - n := rank() - m := transpose((mat:= integralDerivationMatrix derivation).num) - inum := (cform := integralCoordinates f).num - if ((iden := cform.den) exquo (e := mat.den)) case "failed" then - iden := (coef := (e exquo gcd(e, iden))::UP) * iden - inum := coef * inum - for trm in factors squareFree iden | (j:= trm.exponent) > 1 repeat - u':=(u:=(iden exquo (v:=trm.factor)**(j::N))::UP) * derivation v - sys := ((u * v) exquo e)::UP * m - nn := minRowIndex sys - minIndex inum - while j > 1 repeat - j := j - 1 - p := - j * u' - sol := localsolve(sys + scalarMatrix(n, p), inum, v) - ratform := ratform + integralRepresents(sol, v ** (j::N)) - inum := [((qelt(inum, i) - p * qelt(sol, i) - - dot(row(sys, i - nn), sol)) - exquo v)::UP - u * derivation qelt(sol, i) - for i in minIndex inum .. maxIndex inum] - iden := u * v - [ratform, integralRepresents(inum, iden)] - - localsolve(mat, vec, modulus) == - ans:Vector(UP) := new(nrows mat, 0) - diagonal? mat => - for i in minIndex ans .. maxIndex ans - for j in minRowIndex mat .. maxRowIndex mat - for k in minColIndex mat .. maxColIndex mat repeat - (bc := extendedEuclidean(qelt(mat, j, k), modulus, - qelt(vec, i))) case "failed" => return new(0, 0) - qsetelt_!(ans, i, bc.coef1) - ans - sol := particularSolution(map(#1::RF, mat)$MatrixCategoryFunctions2(UP, - Vector UP, Vector UP, Matrix UP, RF, - Vector RF, Vector RF, Matrix RF), - map(#1::RF, vec)$VectorFunctions2(UP, - RF))$LinearSystemMatrixPackage(RF, - Vector RF, Vector RF, Matrix RF) - sol case "failed" => new(0, 0) - for i in minIndex ans .. maxIndex ans repeat - (bc := extendedEuclidean(denom qelt(sol, i), modulus, 1)) - case "failed" => return new(0, 0) - qsetelt_!(ans, i, (numer qelt(sol, i) * bc.coef1) rem modulus) - ans - -@ -\section{package INTALG AlgebraicIntegrate} -<>= -)abbrev package INTALG AlgebraicIntegrate -++ Integration of an algebraic function -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 19 May 1993 -++ Description: -++ This package provides functions for integrating a function -++ on an algebraic curve. -AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where - R0 : Join(OrderedSet, IntegralDomain, RetractableTo Integer) - F : Join(AlgebraicallyClosedField, FunctionSpace R0) - UP : UnivariatePolynomialCategory F - UPUP : UnivariatePolynomialCategory Fraction UP - R : FunctionFieldCategory(F, UP, UPUP) - - SE ==> Symbol - Z ==> Integer - Q ==> Fraction Z - SUP ==> SparseUnivariatePolynomial F - QF ==> Fraction UP - GP ==> LaurentPolynomial(F, UP) - K ==> Kernel F - IR ==> IntegrationResult R - UPQ ==> SparseUnivariatePolynomial Q - UPR ==> SparseUnivariatePolynomial R - FRQ ==> Factored UPQ - FD ==> FiniteDivisor(F, UP, UPUP, R) - FAC ==> Record(factor:UPQ, exponent:Z) - LOG ==> Record(scalar:Q, coeff:UPR, logand:UPR) - DIV ==> Record(num:R, den:UP, derivden:UP, gd:UP) - FAIL0 ==> error "integrate: implementation incomplete (constant residues)" - FAIL1==> error "integrate: implementation incomplete (non-algebraic residues)" - FAIL2 ==> error "integrate: implementation incomplete (residue poly has multiple non-linear factors)" - FAIL3 ==> error "integrate: implementation incomplete (has polynomial part)" - NOTI ==> error "Not integrable (provided residues have no relations)" - - Exports ==> with - algintegrate : (R, UP -> UP) -> IR - ++ algintegrate(f, d) integrates f with respect to the derivation d. - palgintegrate : (R, UP -> UP) -> IR - ++ palgintegrate(f, d) integrates f with respect to the derivation d. - ++ Argument f must be a pure algebraic function. - palginfieldint: (R, UP -> UP) -> Union(R, "failed") - ++ palginfieldint(f, d) returns an algebraic function g - ++ such that \spad{dg = f} if such a g exists, "failed" otherwise. - ++ Argument f must be a pure algebraic function. - - Implementation ==> add - import FD - import DoubleResultantPackage(F, UP, UPUP, R) - import PointsOfFiniteOrder(R0, F, UP, UPUP, R) - import AlgebraicHermiteIntegration(F, UP, UPUP, R) - import InnerCommonDenominator(Z, Q, List Z, List Q) - import FunctionSpaceUnivariatePolynomialFactor(R0, F, UP) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R0, SparseMultivariatePolynomial(R0, K), F) - - F2R : F -> R - F2UPR : F -> UPR - UP2SUP : UP -> SUP - SUP2UP : SUP -> UP - UPQ2F : UPQ -> UP - univ : (F, K) -> QF - pLogDeriv : (LOG, R -> R) -> R - nonLinear : List FAC -> Union(FAC, "failed") - mkLog : (UP, Q, R, F) -> List LOG - R2UP : (R, K) -> UPR - alglogint : (R, UP -> UP) -> Union(List LOG, "failed") - palglogint : (R, UP -> UP) -> Union(List LOG, "failed") - trace00 : (DIV, UP, List LOG) -> Union(List LOG,"failed") - trace0 : (DIV, UP, Q, FD) -> Union(List LOG, "failed") - trace1 : (DIV, UP, List Q, List FD, Q) -> Union(List LOG, "failed") - nonQ : (DIV, UP) -> Union(List LOG, "failed") - rlift : (F, K, K) -> R - varRoot? : (UP, F -> F) -> Boolean - algintexp : (R, UP -> UP) -> IR - algintprim : (R, UP -> UP) -> IR - - dummy:R := 0 - - dumx := kernel(new()$SE)$K - dumy := kernel(new()$SE)$K - - F2UPR f == F2R(f)::UPR - F2R f == f::UP::QF::R - - algintexp(f, derivation) == - d := (c := integralCoordinates f).den - v := c.num - vp:Vector(GP) := new(n := #v, 0) - vf:Vector(QF) := new(n, 0) - for i in minIndex v .. maxIndex v repeat - r := separate(qelt(v, i) / d)$GP - qsetelt_!(vf, i, r.fracPart) - qsetelt_!(vp, i, r.polyPart) - ff := represents(vf, w := integralBasis()) - h := HermiteIntegrate(ff, derivation) - p := represents(map(convert(#1)@QF, vp)$VectorFunctions2(GP, QF), w) - zero?(h.logpart) and zero? p => h.answer::IR - (u := alglogint(h.logpart, derivation)) case "failed" => - mkAnswer(h.answer, empty(), [[p + h.logpart, dummy]]) - zero? p => mkAnswer(h.answer, u::List(LOG), empty()) - FAIL3 - - algintprim(f, derivation) == - h := HermiteIntegrate(f, derivation) - zero?(h.logpart) => h.answer::IR - (u := alglogint(h.logpart, derivation)) case "failed" => - mkAnswer(h.answer, empty(), [[h.logpart, dummy]]) - mkAnswer(h.answer, u::List(LOG), empty()) - - -- checks whether f = +/[ci (ui)'/(ui)] - -- f dx must have no pole at infinity - palglogint(f, derivation) == - rec := algSplitSimple(f, derivation) - ground?(r := doubleResultant(f, derivation)) => "failed" --- r(z) has roots which are the residues of f at all its poles - (u := qfactor r) case "failed" => nonQ(rec, r) - (fc := nonLinear(lf := factors(u::FRQ))) case "failed" => FAIL2 --- at this point r(z) = fc(z) (z - b1)^e1 .. (z - bk)^ek --- where the ri's are rational numbers, and fc(z) is arbitrary --- (fc can be linear too) --- la = [b1....,bk] (all rational residues) - la := [- coefficient(q.factor, 0) for q in remove_!(fc::FAC, lf)] --- ld = [D1,...,Dk] where Di is the sum of places where f has residue bi - ld := [divisor(rec.num, rec.den, rec.derivden, rec.gd, b::F) for b in la] - pp := UPQ2F(fc.factor) --- bb = - sum of all the roots of fc (i.e. the other residues) - zero?(bb := coefficient(fc.factor, - (degree(fc.factor) - 1)::NonNegativeInteger)) => - -- cd = [[a1,...,ak], d] such that bi = ai/d - cd := splitDenominator la - -- g = gcd(a1,...,ak), so bi = (g/d) ci with ci = bi / g - -- so [g/d] is a basis for [a1,...,ak] over the integers - g := gcd(cd.num) - -- dv0 is the divisor +/[ci Di] corresponding to all the residues - -- of f except the ones which are root of fc(z) - dv0 := +/[(a quo g) * dv for a in cd.num for dv in ld] - trace0(rec, pp, g / cd.den, dv0) - trace1(rec, pp, la, ld, bb) - - - UPQ2F p == - map(#1::F, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP) - - UP2SUP p == - map(#1, p)$UnivariatePolynomialCategoryFunctions2(F, UP, F, SUP) - - SUP2UP p == - map(#1, p)$UnivariatePolynomialCategoryFunctions2(F, SUP, F, UP) - - varRoot?(p, derivation) == - for c in coefficients primitivePart p repeat - derivation(c) ^= 0 => return true - false - - pLogDeriv(log, derivation) == - map(derivation, log.coeff) ^= 0 => - error "can only handle logs with constant coefficients" --- one?(n := degree(log.coeff)) => - ((n := degree(log.coeff)) = 1) => - c := - (leadingCoefficient reductum log.coeff) - / (leadingCoefficient log.coeff) - ans := (log.logand) c - (log.scalar)::R * c * derivation(ans) / ans - numlog := map(derivation, log.logand) - (diflog := extendedEuclidean(log.logand, log.coeff, numlog)) case - "failed" => error "this shouldn't happen" - algans := diflog.coef1 - ans:R := 0 - for i in 0..n-1 repeat - algans := (algans * monomial(1, 1)) rem log.coeff - ans := ans + coefficient(algans, i) - (log.scalar)::R * ans - - R2UP(f, k) == - x := dumx :: F - g := (map(#1 x, lift f)$UnivariatePolynomialCategoryFunctions2(QF, - UPUP, F, UP)) (y := dumy::F) - map(rlift(#1, dumx, dumy), univariate(g, k, - minPoly k))$UnivariatePolynomialCategoryFunctions2(F,SUP,R,UPR) - - univ(f, k) == - g := univariate(f, k) - (SUP2UP numer g) / (SUP2UP denom g) - - rlift(f, kx, ky) == - reduce map(univ(#1, kx), retract(univariate(f, - ky))@SUP)$UnivariatePolynomialCategoryFunctions2(F,SUP,QF,UPUP) - - nonQ(rec, p) == - empty? rest(lf := factors ffactor primitivePart p) => - trace00(rec, first(lf).factor, empty()$List(LOG)) - FAIL1 - --- case when the irreducible factor p has roots which sum to 0 --- p is assumed doubly transitive for now - trace0(rec, q, r, dv0) == - lg:List(LOG) := - zero? dv0 => empty() - (rc0 := torsionIfCan dv0) case "failed" => NOTI - mkLog(1, r / (rc0.order::Q), rc0.function, 1) - trace00(rec, q, lg) - - trace00(rec, pp, lg) == - p0 := divisor(rec.num, rec.den, rec.derivden, rec.gd, - alpha0 := zeroOf UP2SUP pp) - q := (pp exquo (monomial(1, 1)$UP - alpha0::UP))::UP - alpha := rootOf UP2SUP q - dvr := divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha) - p0 - (rc := torsionIfCan dvr) case "failed" => - degree(pp) <= 2 => "failed" - NOTI - concat(lg, mkLog(q, inv(rc.order::Q), rc.function, alpha)) - --- case when the irreducible factor p has roots which sum <> 0 --- the residues of f are of the form [a1,...,ak] rational numbers --- plus all the roots of q(z), which is squarefree --- la is the list of residues la := [a1,...,ak] --- ld is the list of divisors [D1,...Dk] where Di is the sum of all the --- places where f has residue ai --- q(z) is assumed doubly transitive for now. --- let [alpha_1,...,alpha_m] be the roots of q(z) --- in this function, b = - alpha_1 - ... - alpha_m is <> 0 --- which implies only one generic log term - trace1(rec, q, la, ld, b) == --- cd = [[b1,...,bk], d] such that ai / b = bi / d - cd := splitDenominator [a / b for a in la] --- then, a basis for all the residues of f over the integers is --- [beta_1 = - alpha_1 / d,..., beta_m = - alpha_m / d], since: --- alpha_i = - d beta_i --- ai = (ai / b) * b = (bi / d) * b = b1 * beta_1 + ... + bm * beta_m --- linear independence is a consequence of the doubly transitive assumption --- v0 is the divisor +/[bi Di] corresponding to the residues [a1,...,ak] - v0 := +/[a * dv for a in cd.num for dv in ld] --- alpha is a generic root of q(z) - alpha := rootOf UP2SUP q --- v is the divisor corresponding to all the residues - v := v0 - cd.den * divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha) - (rc := torsionIfCan v) case "failed" => -- non-torsion case - degree(q) <= 2 => "failed" -- guaranteed doubly-transitive - NOTI -- maybe doubly-transitive - mkLog(q, inv((- rc.order * cd.den)::Q), rc.function, alpha) - - mkLog(q, scalr, lgd, alpha) == - degree(q) <= 1 => - [[scalr, monomial(1, 1)$UPR - F2UPR alpha, lgd::UPR]] - [[scalr, - map(F2R, q)$UnivariatePolynomialCategoryFunctions2(F,UP,R,UPR), - R2UP(lgd, retract(alpha)@K)]] - --- return the non-linear factor, if unique --- or any linear factor if they are all linear - nonLinear l == - found:Boolean := false - ans := first l - for q in l repeat - if degree(q.factor) > 1 then - found => return "failed" - found := true - ans := q - ans - --- f dx must be locally integral at infinity - palginfieldint(f, derivation) == - h := HermiteIntegrate(f, derivation) - zero?(h.logpart) => h.answer - "failed" - --- f dx must be locally integral at infinity - palgintegrate(f, derivation) == - h := HermiteIntegrate(f, derivation) - zero?(h.logpart) => h.answer::IR - (not integralAtInfinity?(h.logpart)) or - ((u := palglogint(h.logpart, derivation)) case "failed") => - mkAnswer(h.answer, empty(), [[h.logpart, dummy]]) - zero?(difFirstKind := h.logpart - +/[pLogDeriv(lg, - differentiate(#1, derivation)) for lg in u::List(LOG)]) => - mkAnswer(h.answer, u::List(LOG), empty()) - mkAnswer(h.answer, u::List(LOG), [[difFirstKind, dummy]]) - --- for mixed functions. f dx not assumed locally integral at infinity - algintegrate(f, derivation) == - zero? degree(x' := derivation(x := monomial(1, 1)$UP)) => - algintprim(f, derivation) - ((xx := x' exquo x) case UP) and - (retractIfCan(xx::UP)@Union(F, "failed") case F) => - algintexp(f, derivation) - error "should not happen" - - alglogint(f, derivation) == - varRoot?(doubleResultant(f, derivation), - retract(derivation(#1::UP))@F) => "failed" - FAIL0 - -@ -\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/intaux.spad.pamphlet b/src/algebra/intaux.spad.pamphlet deleted file mode 100644 index f701dc0..0000000 --- a/src/algebra/intaux.spad.pamphlet +++ /dev/null @@ -1,125 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intaux.spad} -\author{Barry Trager, Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package IR2 IntegrationResultFunctions2} -<>= -)abbrev package IR2 IntegrationResultFunctions2 -++ Internally used by the integration packages -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 12 August 1992 -++ Keywords: integration. -IntegrationResultFunctions2(E, F): Exports == Implementation where - E : Field - F : Field - - SE ==> Symbol - Q ==> Fraction Integer - IRE ==> IntegrationResult E - IRF ==> IntegrationResult F - UPE ==> SparseUnivariatePolynomial E - UPF ==> SparseUnivariatePolynomial F - NEE ==> Record(integrand:E, intvar:E) - NEF ==> Record(integrand:F, intvar:F) - LGE ==> Record(scalar:Q, coeff:UPE, logand:UPE) - LGF ==> Record(scalar:Q, coeff:UPF, logand:UPF) - NLE ==> Record(coeff:E, logand:E) - NLF ==> Record(coeff:F, logand:F) - UFE ==> Union(Record(mainpart:E, limitedlogs:List NLE), "failed") - URE ==> Union(Record(ratpart:E, coeff:E), "failed") - UE ==> Union(E, "failed") - - Exports ==> with - map: (E -> F, IRE) -> IRF - ++ map(f,ire) \undocumented - map: (E -> F, URE) -> Union(Record(ratpart:F, coeff:F), "failed") - ++ map(f,ure) \undocumented - map: (E -> F, UE) -> Union(F, "failed") - ++ map(f,ue) \undocumented - map: (E -> F, UFE) -> - Union(Record(mainpart:F, limitedlogs:List NLF), "failed") - ++ map(f,ufe) \undocumented - - Implementation ==> add - import SparseUnivariatePolynomialFunctions2(E, F) - - NEE2F: (E -> F, NEE) -> NEF - LGE2F: (E -> F, LGE) -> LGF - NLE2F: (E -> F, NLE) -> NLF - - NLE2F(func, r) == [func(r.coeff), func(r.logand)] - NEE2F(func, n) == [func(n.integrand), func(n.intvar)] - map(func:E -> F, u:UE) == (u case "failed" => "failed"; func(u::E)) - - map(func:E -> F, ir:IRE) == - mkAnswer(func ratpart ir, [LGE2F(func, f) for f in logpart ir], - [NEE2F(func, g) for g in notelem ir]) - - map(func:E -> F, u:URE) == - u case "failed" => "failed" - [func(u.ratpart), func(u.coeff)] - - map(func:E -> F, u:UFE) == - u case "failed" => "failed" - [func(u.mainpart), [NLE2F(func, f) for f in u.limitedlogs]] - - LGE2F(func, lg) == - [lg.scalar, map(func, lg.coeff), map(func, lg.logand)] - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- SPAD files for the integration world should be compiled in the --- following order: --- --- INTAUX rderf intrf rdeef intef irexpand integrat - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/intclos.spad.pamphlet b/src/algebra/intclos.spad.pamphlet deleted file mode 100644 index 4470fc4..0000000 --- a/src/algebra/intclos.spad.pamphlet +++ /dev/null @@ -1,816 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intclos.spad} -\author{Victor Miller, Barry Trager, Clifton Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package TRIMAT TriangularMatrixOperations} -<>= -)abbrev package TRIMAT TriangularMatrixOperations -++ Fraction free inverses of triangular matrices -++ Author: Victor Miller -++ Date Created: -++ Date Last Updated: 24 Jul 1990 -++ Keywords: -++ Examples: -++ References: -++ Description: -++ This package provides functions that compute "fraction-free" -++ inverses of upper and lower triangular matrices over a integral -++ domain. By "fraction-free inverses" we mean the following: -++ given a matrix B with entries in R and an element d of R such that -++ d * inv(B) also has entries in R, we return d * inv(B). Thus, -++ it is not necessary to pass to the quotient field in any of our -++ computations. - - -TriangularMatrixOperations(R,Row,Col,M): Exports == Implementation where - R : IntegralDomain - Row : FiniteLinearAggregate R - Col : FiniteLinearAggregate R - M : MatrixCategory(R,Row,Col) - - Exports ==> with - - UpTriBddDenomInv: (M,R) -> M - ++ UpTriBddDenomInv(B,d) returns M, where - ++ B is a non-singular upper triangular matrix and d is an - ++ element of R such that \spad{M = d * inv(B)} has entries in R. - LowTriBddDenomInv:(M,R) -> M - ++ LowTriBddDenomInv(B,d) returns M, where - ++ B is a non-singular lower triangular matrix and d is an - ++ element of R such that \spad{M = d * inv(B)} has entries in R. - - Implementation ==> add - - UpTriBddDenomInv(A,denom) == - AI := zero(nrows A, nrows A)$M - offset := minColIndex AI - minRowIndex AI - for i in minRowIndex AI .. maxRowIndex AI - for j in minColIndex AI .. maxColIndex AI repeat - qsetelt_!(AI,i,j,(denom exquo qelt(A,i,j))::R) - for i in minRowIndex AI .. maxRowIndex AI repeat - for j in offset + i + 1 .. maxColIndex AI repeat - qsetelt_!(AI,i,j, - (((+/[qelt(AI,i,k) * qelt(A,k-offset,j) - for k in i+offset..(j-1)]) - exquo qelt(A, j-offset, j))::R)) - AI - - LowTriBddDenomInv(A, denom) == - AI := zero(nrows A, nrows A)$M - offset := minColIndex AI - minRowIndex AI - for i in minRowIndex AI .. maxRowIndex AI - for j in minColIndex AI .. maxColIndex AI repeat - qsetelt_!(AI,i,j,(denom exquo qelt(A,i,j))::R) - for i in minColIndex AI .. maxColIndex AI repeat - for j in i - offset + 1 .. maxRowIndex AI repeat - qsetelt_!(AI,j,i, - (((+/[qelt(A,j,k+offset) * qelt(AI,k,i) - for k in i-offset..(j-1)]) - exquo qelt(A, j, j+offset))::R)) - AI - -@ -\section{package IBATOOL IntegralBasisTools} -<>= -)abbrev package IBATOOL IntegralBasisTools -++ Functions common to both integral basis packages -++ Author: Victor Miller, Barry Trager, Clifton Williamson -++ Date Created: 11 April 1990 -++ Date Last Updated: 20 September 1994 -++ Keywords: integral basis, function field, number field -++ Examples: -++ References: -++ Description: -++ This package contains functions used in the packages -++ FunctionFieldIntegralBasis and NumberFieldIntegralBasis. - -IntegralBasisTools(R,UP,F): Exports == Implementation where - R : EuclideanDomain with - squareFree: $ -> Factored $ - ++ squareFree(x) returns a square-free factorisation of x - UP : UnivariatePolynomialCategory R - F : FramedAlgebra(R,UP) - Mat ==> Matrix R - NNI ==> NonNegativeInteger - Ans ==> Record(basis: Mat, basisDen: R, basisInv:Mat) - - Exports ==> with - - diagonalProduct: Mat -> R - ++ diagonalProduct(m) returns the product of the elements on the - ++ diagonal of the matrix m - matrixGcd: (Mat,R,NNI) -> R - ++ matrixGcd(mat,sing,n) is \spad{gcd(sing,g)} where \spad{g} is the - ++ gcd of the entries of the \spad{n}-by-\spad{n} upper-triangular - ++ matrix \spad{mat}. - divideIfCan_!: (Matrix R,Matrix R,R,Integer) -> R - ++ divideIfCan!(matrix,matrixOut,prime,n) attempts to divide the - ++ entries of \spad{matrix} by \spad{prime} and store the result in - ++ \spad{matrixOut}. If it is successful, 1 is returned and if not, - ++ \spad{prime} is returned. Here both \spad{matrix} and - ++ \spad{matrixOut} are \spad{n}-by-\spad{n} upper triangular matrices. - leastPower: (NNI,NNI) -> NNI - ++ leastPower(p,n) returns e, where e is the smallest integer - ++ such that \spad{p **e >= n} - idealiser: (Mat,Mat) -> Mat - ++ idealiser(m1,m2) computes the order of an ideal defined by m1 and m2 - idealiser: (Mat,Mat,R) -> Mat - ++ idealiser(m1,m2,d) computes the order of an ideal defined by m1 and m2 - ++ where d is the known part of the denominator - idealiserMatrix: (Mat, Mat) -> Mat - ++ idealiserMatrix(m1, m2) returns the matrix representing the linear - ++ conditions on the Ring associatied with an ideal defined by m1 and m2. - moduleSum: (Ans,Ans) -> Ans - ++ moduleSum(m1,m2) returns the sum of two modules in the framed - ++ algebra \spad{F}. Each module \spad{mi} is represented as follows: - ++ F is a framed algebra with R-module basis \spad{w1,w2,...,wn} and - ++ \spad{mi} is a record \spad{[basis,basisDen,basisInv]}. If - ++ \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ a basis \spad{v1,...,vn} for \spad{mi} is given by - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of 'basis' contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - - Implementation ==> add - import ModularHermitianRowReduction(R) - import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) - - diagonalProduct m == - ans : R := 1 - for i in minRowIndex m .. maxRowIndex m - for j in minColIndex m .. maxColIndex m repeat - ans := ans * qelt(m, i, j) - ans - - matrixGcd(mat,sing,n) == - -- note: 'matrix' is upper triangular; - -- no need to do anything below the diagonal - d := sing - for i in 1..n repeat - for j in i..n repeat - if not zero?(mij := qelt(mat,i,j)) then d := gcd(d,mij) --- one? d => return d - (d = 1) => return d - d - - divideIfCan_!(matrix,matrixOut,prime,n) == - -- note: both 'matrix' and 'matrixOut' will be upper triangular; - -- no need to do anything below the diagonal - for i in 1..n repeat - for j in i..n repeat - (a := (qelt(matrix,i,j) exquo prime)) case "failed" => return prime - qsetelt_!(matrixOut,i,j,a :: R) - 1 - - leastPower(p,n) == - -- efficiency is not an issue here - e : NNI := 1; q := p - while q < n repeat (e := e + 1; q := q * p) - e - - idealiserMatrix(ideal,idealinv) == - -- computes the Order of the ideal - n := rank()$F - bigm := zero(n * n,n)$Mat - mr := minRowIndex bigm; mc := minColIndex bigm - v := basis()$F - for i in 0..n-1 repeat - r := regularRepresentation qelt(v,i + minIndex v) - m := ideal * r * idealinv - for j in 0..n-1 repeat - for k in 0..n-1 repeat - bigm(j * n + k + mr,i + mc) := qelt(m,j + mr,k + mc) - bigm - - idealiser(ideal,idealinv) == - bigm := idealiserMatrix(ideal, idealinv) - transpose squareTop rowEch bigm - - idealiser(ideal,idealinv,denom) == - bigm := (idealiserMatrix(ideal, idealinv) exquo denom)::Mat - transpose squareTop rowEchelon(bigm,denom) - - moduleSum(mod1,mod2) == - rb1 := mod1.basis; rbden1 := mod1.basisDen; rbinv1 := mod1.basisInv - rb2 := mod2.basis; rbden2 := mod2.basisDen; rbinv2 := mod2.basisInv - -- compatibility check: doesn't take much computation time - (not square? rb1) or (not square? rbinv1) or (not square? rb2) _ - or (not square? rbinv2) => - error "moduleSum: matrices must be square" - ((n := nrows rb1) ^= (nrows rbinv1)) or (n ^= (nrows rb2)) _ - or (n ^= (nrows rbinv2)) => - error "moduleSum: matrices of imcompatible dimensions" - (zero? rbden1) or (zero? rbden2) => - error "moduleSum: denominator must be non-zero" - den := lcm(rbden1,rbden2); c1 := den quo rbden1; c2 := den quo rbden2 - rb := squareTop rowEchelon(vertConcat(c1 * rb1,c2 * rb2),den) - rbinv := UpTriBddDenomInv(rb,den) - [rb,den,rbinv] - -@ -\section{package FFINTBAS FunctionFieldIntegralBasis} -<>= -)abbrev package FFINTBAS FunctionFieldIntegralBasis -++ Integral bases for function fields of dimension one -++ Author: Victor Miller -++ Date Created: 9 April 1990 -++ Date Last Updated: 20 September 1994 -++ Keywords: -++ Examples: -++ References: -++ Description: -++ In this package R is a Euclidean domain and F is a framed algebra -++ over R. The package provides functions to compute the integral -++ closure of R in the quotient field of F. It is assumed that -++ \spad{char(R/P) = char(R)} for any prime P of R. A typical instance of -++ this is when \spad{R = K[x]} and F is a function field over R. - - -FunctionFieldIntegralBasis(R,UP,F): Exports == Implementation where - R : EuclideanDomain with - squareFree: $ -> Factored $ - ++ squareFree(x) returns a square-free factorisation of x - UP : UnivariatePolynomialCategory R - F : FramedAlgebra(R,UP) - - I ==> Integer - Mat ==> Matrix R - NNI ==> NonNegativeInteger - - Exports ==> with - integralBasis : () -> Record(basis: Mat, basisDen: R, basisInv:Mat) - ++ \spad{integralBasis()} returns a record - ++ \spad{[basis,basisDen,basisInv]} containing information regarding - ++ the integral closure of R in the quotient field of F, where - ++ F is a framed algebra with R-module basis \spad{w1,w2,...,wn}. - ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ the \spad{i}th element of the integral basis is - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of \spad{basis} contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - localIntegralBasis : R -> Record(basis: Mat, basisDen: R, basisInv:Mat) - ++ \spad{integralBasis(p)} returns a record - ++ \spad{[basis,basisDen,basisInv]} containing information regarding - ++ the local integral closure of R at the prime \spad{p} in the quotient - ++ field of F, where F is a framed algebra with R-module basis - ++ \spad{w1,w2,...,wn}. - ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ the \spad{i}th element of the local integral basis is - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of \spad{basis} contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - - Implementation ==> add - import IntegralBasisTools(R, UP, F) - import ModularHermitianRowReduction(R) - import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) - - squaredFactors: R -> R - squaredFactors px == - */[(if ffe.exponent > 1 then ffe.factor else 1$R) - for ffe in factors squareFree px] - - iIntegralBasis: (Mat,R,R) -> Record(basis: Mat, basisDen: R, basisInv:Mat) - iIntegralBasis(tfm,disc,sing) == - -- tfm = trace matrix of current order - n := rank()$F; tfm0 := copy tfm; disc0 := disc - rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) - -- rb = basis matrix of current order - -- rbinv = inverse basis matrix of current order - -- these are wrt the original basis for F - rbden : R := 1; index : R := 1; oldIndex : R := 1 - -- rbden = denominator for current basis matrix - -- index = index of original order in current order - not sizeLess?(1, sing) => [rb, rbden, rbinv] - repeat - -- compute the p-radical - idinv := transpose squareTop rowEchelon(tfm, sing) - -- [u1,..,un] are the coordinates of an element of the p-radical - -- iff [u1,..,un] * idinv is in sing * R^n - id := rowEchelon LowTriBddDenomInv(idinv, sing) - -- id = basis matrix of the p-radical - idinv := UpTriBddDenomInv(id, sing) - -- id * idinv = sing * identity - -- no need to check for inseparability in this case - rbinv := idealiser(id * rb, rbinv * idinv, sing * rbden) - index := diagonalProduct rbinv - rb := rowEchelon LowTriBddDenomInv(rbinv, rbden * sing) - g := matrixGcd(rb,sing,n) - if sizeLess?(1,g) then rb := (rb exquo g) :: Mat - rbden := rbden * (sing quo g) - rbinv := UpTriBddDenomInv(rb, rbden) - disc := disc0 quo (index * index) - indexChange := index quo oldIndex; oldIndex := index - sing := gcd(indexChange, squaredFactors disc) - not sizeLess?(1, sing) => return [rb, rbden, rbinv] - tfm := ((rb * tfm0 * transpose rb) exquo (rbden * rbden)) :: Mat - - integralBasis() == - n := rank()$F; p := characteristic()$F - (not zero? p) and (n >= p) => - error "integralBasis: possible wild ramification" - tfm := traceMatrix()$F; disc := determinant tfm - sing := squaredFactors disc -- singularities of relative Spec - iIntegralBasis(tfm,disc,sing) - - localIntegralBasis prime == - n := rank()$F; p := characteristic()$F - (not zero? p) and (n >= p) => - error "integralBasis: possible wild ramification" - tfm := traceMatrix()$F; disc := determinant tfm - (disc exquo (prime * prime)) case "failed" => - [scalarMatrix(n,1),1,scalarMatrix(n,1)] - iIntegralBasis(tfm,disc,prime) - -@ -\section{package WFFINTBS WildFunctionFieldIntegralBasis} -<>= -)abbrev package WFFINTBS WildFunctionFieldIntegralBasis -++ Authors: Victor Miller, Clifton Williamson -++ Date Created: 24 July 1991 -++ Date Last Updated: 20 September 1994 -++ Basic Operations: integralBasis, localIntegralBasis -++ Related Domains: IntegralBasisTools(R,UP,F), -++ TriangularMatrixOperations(R,Vector R,Vector R,Matrix R) -++ Also See: FunctionFieldIntegralBasis, NumberFieldIntegralBasis -++ AMS Classifications: -++ Keywords: function field, integral basis -++ Examples: -++ References: -++ Description: -++ In this package K is a finite field, R is a ring of univariate -++ polynomials over K, and F is a framed algebra over R. The package -++ provides a function to compute the integral closure of R in the quotient -++ field of F as well as a function to compute a "local integral basis" -++ at a specific prime. - -WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where - K : FiniteFieldCategory - --K : Join(Field,Finite) - R : UnivariatePolynomialCategory K - UP : UnivariatePolynomialCategory R - F : FramedAlgebra(R,UP) - - I ==> Integer - Mat ==> Matrix R - NNI ==> NonNegativeInteger - SAE ==> SimpleAlgebraicExtension - RResult ==> Record(basis: Mat, basisDen: R, basisInv:Mat) - IResult ==> Record(basis: Mat, basisDen: R, basisInv:Mat,discr: R) - MATSTOR ==> StorageEfficientMatrixOperations - - Exports ==> with - integralBasis : () -> RResult - ++ \spad{integralBasis()} returns a record - ++ \spad{[basis,basisDen,basisInv]} containing information regarding - ++ the integral closure of R in the quotient field of F, where - ++ F is a framed algebra with R-module basis \spad{w1,w2,...,wn}. - ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ the \spad{i}th element of the integral basis is - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of \spad{basis} contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - localIntegralBasis : R -> RResult - ++ \spad{integralBasis(p)} returns a record - ++ \spad{[basis,basisDen,basisInv]} containing information regarding - ++ the local integral closure of R at the prime \spad{p} in the quotient - ++ field of F, where F is a framed algebra with R-module basis - ++ \spad{w1,w2,...,wn}. - ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ the \spad{i}th element of the local integral basis is - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of \spad{basis} contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - - Implementation ==> add - import IntegralBasisTools(R, UP, F) - import ModularHermitianRowReduction(R) - import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R) - import DistinctDegreeFactorize(K,R) - - listSquaredFactors: R -> List R - listSquaredFactors px == - -- returns a list of the factors of px which occur with - -- exponent > 1 - ans : List R := empty() - factored := factor(px)$DistinctDegreeFactorize(K,R) - for f in factors(factored) repeat - if f.exponent > 1 then ans := concat(f.factor,ans) - ans - - iLocalIntegralBasis: (Vector F,Vector F,Matrix R,Matrix R,R,R) -> IResult - iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) == - n := rank()$F; standardBasis := basis()$F - -- 'standardBasis' is the basis for F as a FramedAlgebra; - -- usually this is [1,y,y**2,...,y**(n-1)] - p2 := prime * prime; sae := SAE(K,R,prime) - p := characteristic()$F; q := size()$sae - lp := leastPower(q,n) - rb := scalarMatrix(n,1); rbinv := scalarMatrix(n,1) - -- rb = basis matrix of current order - -- rbinv = inverse basis matrix of current order - -- these are wrt the orginal basis for F - rbden : R := 1; index : R := 1; oldIndex : R := 1 - -- rbden = denominator for current basis matrix - -- index = index of original order in current order - repeat - -- pows = [(w1 * rbden) ** q,...,(wn * rbden) ** q], where - -- bas = [w1,...,wn] is 'rbden' times the basis for the order B = 'rb' - for i in 1..n repeat - bi : F := 0 - for j in 1..n repeat - bi := bi + qelt(rb,i,j) * qelt(standardBasis,j) - qsetelt_!(bas,i,bi) - qsetelt_!(pows,i,bi ** p) - coor0 := transpose coordinates(pows,bas) - denPow := rbden ** ((p - 1) :: NNI) - (coMat0 := coor0 exquo denPow) case "failed" => - error "can't happen" - -- the jth column of coMat contains the coordinates of (wj/rbden)**q - -- with respect to the basis [w1/rbden,...,wn/rbden] - coMat := coMat0 :: Matrix R - -- the ith column of 'pPows' contains the coordinates of the pth power - -- of the ith basis element for B/prime.B over 'sae' = R/prime.R - pPows := map(reduce,coMat)$MatrixCategoryFunctions2(R,Vector R, - Vector R,Matrix R,sae,Vector sae,Vector sae,Matrix sae) - -- 'frob' will eventually be the Frobenius matrix for B/prime.B over - -- 'sae' = R/prime.R; at each stage of the loop the ith column will - -- contain the coordinates of p^k-th powers of the ith basis element - frob := copy pPows; tmpMat : Matrix sae := new(n,n,0) - for r in 2..leastPower(p,q) repeat - for i in 1..n repeat for j in 1..n repeat - qsetelt_!(tmpMat,i,j,qelt(frob,i,j) ** p) - times_!(frob,pPows,tmpMat)$MATSTOR(sae) - frobPow := frob ** lp - -- compute the p-radical - ns := nullSpace frobPow - for i in 1..n repeat for j in 1..n repeat qsetelt_!(tfm,i,j,0) - for vec in ns for i in 1.. repeat - for j in 1..n repeat - qsetelt_!(tfm,i,j,lift qelt(vec,j)) - id := squareTop rowEchelon(tfm,prime) - -- id = basis matrix of the p-radical - idinv := UpTriBddDenomInv(id, prime) - -- id * idinv = prime * identity - -- no need to check for inseparability in this case - rbinv := idealiser(id * rb, rbinv * idinv, prime * rbden) - index := diagonalProduct rbinv - rb := rowEchelon LowTriBddDenomInv(rbinv,rbden * prime) - if divideIfCan_!(rb,matrixOut,prime,n) = 1 - then rb := matrixOut - else rbden := rbden * prime - rbinv := UpTriBddDenomInv(rb,rbden) - indexChange := index quo oldIndex - oldIndex := index - disc := disc quo (indexChange * indexChange) - (not sizeLess?(1,indexChange)) or ((disc exquo p2) case "failed") => - return [rb, rbden, rbinv, disc] - - integralBasis() == - traceMat := traceMatrix()$F; n := rank()$F - disc := determinant traceMat -- discriminant of current order - zero? disc => error "integralBasis: polynomial must be separable" - singList := listSquaredFactors disc -- singularities of relative Spec - runningRb := scalarMatrix(n,1); runningRbinv := scalarMatrix(n,1) - -- runningRb = basis matrix of current order - -- runningRbinv = inverse basis matrix of current order - -- these are wrt the original basis for F - runningRbden : R := 1 - -- runningRbden = denominator for current basis matrix - empty? singList => [runningRb, runningRbden, runningRbinv] - bas : Vector F := new(n,0); pows : Vector F := new(n,0) - -- storage for basis elements and their powers - tfm : Matrix R := new(n,n,0) - -- 'tfm' will contain the coordinates of a lifting of the kernel - -- of a power of Frobenius - matrixOut : Matrix R := new(n,n,0) - for prime in singList repeat - lb := iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) - rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen - disc := lb.discr - -- update 'running integral basis' if newly computed - -- local integral basis is non-trivial - if sizeLess?(1,rbden) then - mat := vertConcat(rbden * runningRb,runningRbden * rb) - runningRbden := runningRbden * rbden - runningRb := squareTop rowEchelon(mat,runningRbden) - runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) - [runningRb, runningRbden, runningRbinv] - - localIntegralBasis prime == - traceMat := traceMatrix()$F; n := rank()$F - disc := determinant traceMat -- discriminant of current order - zero? disc => error "localIntegralBasis: polynomial must be separable" - (disc exquo (prime * prime)) case "failed" => - [scalarMatrix(n,1), 1, scalarMatrix(n,1)] - bas : Vector F := new(n,0); pows : Vector F := new(n,0) - -- storage for basis elements and their powers - tfm : Matrix R := new(n,n,0) - -- 'tfm' will contain the coordinates of a lifting of the kernel - -- of a power of Frobenius - matrixOut : Matrix R := new(n,n,0) - lb := iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) - [lb.basis, lb.basisDen, lb.basisInv] - -@ -\section{package NFINTBAS NumberFieldIntegralBasis} -<>= -)abbrev package NFINTBAS NumberFieldIntegralBasis -++ Author: Victor Miller, Clifton Williamson -++ Date Created: 9 April 1990 -++ Date Last Updated: 20 September 1994 -++ Basic Operations: discriminant, integralBasis -++ Related Domains: IntegralBasisTools, TriangularMatrixOperations -++ Also See: FunctionFieldIntegralBasis, WildFunctionFieldIntegralBasis -++ AMS Classifications: -++ Keywords: number field, integral basis, discriminant -++ Examples: -++ References: -++ Description: -++ In this package F is a framed algebra over the integers (typically -++ \spad{F = Z[a]} for some algebraic integer a). The package provides -++ functions to compute the integral closure of Z in the quotient -++ quotient field of F. -NumberFieldIntegralBasis(UP,F): Exports == Implementation where - UP : UnivariatePolynomialCategory Integer - F : FramedAlgebra(Integer,UP) - - FR ==> Factored Integer - I ==> Integer - Mat ==> Matrix I - NNI ==> NonNegativeInteger - Ans ==> Record(basis: Mat, basisDen: I, basisInv:Mat,discr: I) - - Exports ==> with - discriminant: () -> Integer - ++ \spad{discriminant()} returns the discriminant of the integral - ++ closure of Z in the quotient field of the framed algebra F. - integralBasis : () -> Record(basis: Mat, basisDen: I, basisInv:Mat) - ++ \spad{integralBasis()} returns a record - ++ \spad{[basis,basisDen,basisInv]} - ++ containing information regarding the integral closure of Z in the - ++ quotient field of F, where F is a framed algebra with Z-module - ++ basis \spad{w1,w2,...,wn}. - ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ the \spad{i}th element of the integral basis is - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of \spad{basis} contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - localIntegralBasis : I -> Record(basis: Mat, basisDen: I, basisInv:Mat) - ++ \spad{integralBasis(p)} returns a record - ++ \spad{[basis,basisDen,basisInv]} containing information regarding - ++ the local integral closure of Z at the prime \spad{p} in the quotient - ++ field of F, where F is a framed algebra with Z-module basis - ++ \spad{w1,w2,...,wn}. - ++ If \spad{basis} is the matrix \spad{(aij, i = 1..n, j = 1..n)}, then - ++ the \spad{i}th element of the integral basis is - ++ \spad{vi = (1/basisDen) * sum(aij * wj, j = 1..n)}, i.e. the - ++ \spad{i}th row of \spad{basis} contains the coordinates of the - ++ \spad{i}th basis vector. Similarly, the \spad{i}th row of the - ++ matrix \spad{basisInv} contains the coordinates of \spad{wi} with - ++ respect to the basis \spad{v1,...,vn}: if \spad{basisInv} is the - ++ matrix \spad{(bij, i = 1..n, j = 1..n)}, then - ++ \spad{wi = sum(bij * vj, j = 1..n)}. - - Implementation ==> add - import IntegralBasisTools(I, UP, F) - import ModularHermitianRowReduction(I) - import TriangularMatrixOperations(I, Vector I, Vector I, Matrix I) - - frobMatrix : (Mat,Mat,I,NNI) -> Mat - wildPrimes : (FR,I) -> List I - tameProduct : (FR,I) -> I - iTameLocalIntegralBasis : (Mat,I,I) -> Ans - iWildLocalIntegralBasis : (Mat,I,I) -> Ans - - frobMatrix(rb,rbinv,rbden,p) == - n := rank()$F; b := basis()$F - v : Vector F := new(n,0) - for i in minIndex(v)..maxIndex(v) - for ii in minRowIndex(rb)..maxRowIndex(rb) repeat - a : F := 0 - for j in minIndex(b)..maxIndex(b) - for jj in minColIndex(rb)..maxColIndex(rb) repeat - a := a + qelt(rb,ii,jj) * qelt(b,j) - qsetelt_!(v,i,a**p) - mat := transpose coordinates v - ((transpose(rbinv) * mat) exquo (rbden ** p)) :: Mat - - wildPrimes(factoredDisc,n) == - -- returns a list of the primes <=n which divide factoredDisc to a - -- power greater than 1 - ans : List I := empty() - for f in factors(factoredDisc) repeat - if f.exponent > 1 and f.factor <= n then ans := concat(f.factor,ans) - ans - - tameProduct(factoredDisc,n) == - -- returns the product of the primes > n which divide factoredDisc - -- to a power greater than 1 - ans : I := 1 - for f in factors(factoredDisc) repeat - if f.exponent > 1 and f.factor > n then ans := f.factor * ans - ans - - integralBasis() == - traceMat := traceMatrix()$F; n := rank()$F - disc := determinant traceMat -- discriminant of current order - disc0 := disc -- this is disc(F) - factoredDisc := factor(disc0)$IntegerFactorizationPackage(Integer) - wilds := wildPrimes(factoredDisc,n) - sing := tameProduct(factoredDisc,n) - runningRb := scalarMatrix(n, 1); runningRbinv := scalarMatrix(n, 1) - -- runningRb = basis matrix of current order - -- runningRbinv = inverse basis matrix of current order - -- these are wrt the original basis for F - runningRbden : I := 1 - -- runningRbden = denominator for current basis matrix --- one? sing and empty? wilds => [runningRb, runningRbden, runningRbinv] - (sing = 1) and empty? wilds => [runningRb, runningRbden, runningRbinv] - -- id = basis matrix of the ideal (p-radical) wrt current basis - matrixOut : Mat := scalarMatrix(n,0) - for p in wilds repeat - lb := iWildLocalIntegralBasis(matrixOut,disc,p) - rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen - disc := lb.discr - -- update 'running integral basis' if newly computed - -- local integral basis is non-trivial - if sizeLess?(1,rbden) then - mat := vertConcat(rbden * runningRb,runningRbden * rb) - runningRbden := runningRbden * rbden - runningRb := squareTop rowEchelon(mat,runningRbden) - runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) - lb := iTameLocalIntegralBasis(traceMat,disc,sing) - rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen - disc := lb.discr - -- update 'running integral basis' if newly computed - -- local integral basis is non-trivial - if sizeLess?(1,rbden) then - mat := vertConcat(rbden * runningRb,runningRbden * rb) - runningRbden := runningRbden * rbden - runningRb := squareTop rowEchelon(mat,runningRbden) - runningRbinv := UpTriBddDenomInv(runningRb,runningRbden) - [runningRb,runningRbden,runningRbinv] - - localIntegralBasis p == - traceMat := traceMatrix()$F; n := rank()$F - disc := determinant traceMat -- discriminant of current order - (disc exquo (p*p)) case "failed" => - [scalarMatrix(n, 1), 1, scalarMatrix(n, 1)] - lb := - p > rank()$F => - iTameLocalIntegralBasis(traceMat,disc,p) - iWildLocalIntegralBasis(scalarMatrix(n,0),disc,p) - [lb.basis,lb.basisDen,lb.basisInv] - - iTameLocalIntegralBasis(traceMat,disc,sing) == - n := rank()$F; disc0 := disc - rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) - -- rb = basis matrix of current order - -- rbinv = inverse basis matrix of current order - -- these are wrt the original basis for F - rbden : I := 1; index : I := 1; oldIndex : I := 1 - -- rbden = denominator for current basis matrix - -- id = basis matrix of the ideal (p-radical) wrt current basis - tfm := traceMat - repeat - -- compute the p-radical = p-trace-radical - idinv := transpose squareTop rowEchelon(tfm,sing) - -- [u1,..,un] are the coordinates of an element of the p-radical - -- iff [u1,..,un] * idinv is in p * Z^n - id := rowEchelon LowTriBddDenomInv(idinv, sing) - -- id = basis matrix of the p-radical - idinv := UpTriBddDenomInv(id, sing) - -- id * idinv = sing * identity - -- no need to check for inseparability in this case - rbinv := idealiser(id * rb, rbinv * idinv, sing * rbden) - index := diagonalProduct rbinv - rb := rowEchelon LowTriBddDenomInv(rbinv, sing * rbden) - g := matrixGcd(rb,sing,n) - if sizeLess?(1,g) then rb := (rb exquo g) :: Mat - rbden := rbden * (sing quo g) - rbinv := UpTriBddDenomInv(rb, rbden) - disc := disc0 quo (index * index) - indexChange := index quo oldIndex; oldIndex := index --- one? indexChange => return [rb, rbden, rbinv, disc] - (indexChange = 1) => return [rb, rbden, rbinv, disc] - tfm := ((rb * traceMat * transpose rb) exquo (rbden * rbden)) :: Mat - - iWildLocalIntegralBasis(matrixOut,disc,p) == - n := rank()$F; disc0 := disc - rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1) - -- rb = basis matrix of current order - -- rbinv = inverse basis matrix of current order - -- these are wrt the original basis for F - rbden : I := 1; index : I := 1; oldIndex : I := 1 - -- rbden = denominator for current basis matrix - -- id = basis matrix of the ideal (p-radical) wrt current basis - p2 := p * p; lp := leastPower(p::NNI,n) - repeat - tfm := frobMatrix(rb,rbinv,rbden,p::NNI) ** lp - -- compute Rp = p-radical - idinv := transpose squareTop rowEchelon(tfm, p) - -- [u1,..,un] are the coordinates of an element of Rp - -- iff [u1,..,un] * idinv is in p * Z^n - id := rowEchelon LowTriBddDenomInv(idinv,p) - -- id = basis matrix of the p-radical - idinv := UpTriBddDenomInv(id,p) - -- id * idinv = p * identity - -- no need to check for inseparability in this case - rbinv := idealiser(id * rb, rbinv * idinv, p * rbden) - index := diagonalProduct rbinv - rb := rowEchelon LowTriBddDenomInv(rbinv, p * rbden) - if divideIfCan_!(rb,matrixOut,p,n) = 1 - then rb := matrixOut - else rbden := p * rbden - rbinv := UpTriBddDenomInv(rb, rbden) - indexChange := index quo oldIndex; oldIndex := index - disc := disc quo (indexChange * indexChange) --- one? indexChange or gcd(p2,disc) ^= p2 => - (indexChange = 1) or gcd(p2,disc) ^= p2 => - return [rb, rbden, rbinv, disc] - - discriminant() == - disc := determinant traceMatrix()$F - intBas := integralBasis() - rb := intBas.basis; rbden := intBas.basisDen - index := ((rbden ** rank()$F) exquo (determinant rb)) :: Integer - (disc exquo (index * index)) :: 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/intef.spad.pamphlet b/src/algebra/intef.spad.pamphlet deleted file mode 100644 index d248838..0000000 --- a/src/algebra/intef.spad.pamphlet +++ /dev/null @@ -1,442 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intef.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INTEF ElementaryIntegration} -<>= -)abbrev package INTEF ElementaryIntegration -++ Integration of elementary functions -++ Author: Manuel Bronstein -++ Date Created: 1 February 1988 -++ Date Last Updated: 24 October 1995 -++ Description: -++ This package provides functions for integration, limited integration, -++ extended integration and the risch differential equation for -++ elemntary functions. -++ Keywords: elementary, function, integration. -++ Examples: )r INTEF INPUT -ElementaryIntegration(R, F): Exports == Implementation where - R : Join(GcdDomain, OrderedSet, CharacteristicZero, - RetractableTo Integer, LinearlyExplicitRingOver Integer) - F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory, - FunctionSpace R) - - SE ==> Symbol - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - RF ==> Fraction UP - IR ==> IntegrationResult F - FF ==> Record(ratpart:RF, coeff:RF) - LLG ==> List Record(coeff:F, logand:F) - U2 ==> Union(Record(ratpart:F, coeff:F), "failed") - U3 ==> Union(Record(mainpart:F, limitedlogs:LLG), "failed") - ANS ==> Record(special:F, integrand:F) - FAIL==> error "failed - cannot handle that integrand" - ALGOP ==> "%alg" - OPDIFF ==> "%diff"::SE - - Exports ==> with - lfextendedint: (F, SE, F) -> U2 - ++ lfextendedint(f, x, g) returns functions \spad{[h, c]} such that - ++ \spad{dh/dx = f - cg}, if (h, c) exist, "failed" otherwise. - lflimitedint : (F, SE, List F) -> U3 - ++ lflimitedint(f,x,[g1,...,gn]) returns functions \spad{[h,[[ci, gi]]]} - ++ such that the gi's are among \spad{[g1,...,gn]}, and - ++ \spad{d(h+sum(ci log(gi)))/dx = f}, if possible, "failed" otherwise. - lfinfieldint : (F, SE) -> Union(F, "failed") - ++ lfinfieldint(f, x) returns a function g such that \spad{dg/dx = f} - ++ if g exists, "failed" otherwise. - lfintegrate : (F, SE) -> IR - ++ lfintegrate(f, x) = g such that \spad{dg/dx = f}. - lfextlimint : (F, SE, K, List K) -> U2 - ++ lfextlimint(f,x,k,[k1,...,kn]) returns functions \spad{[h, c]} - ++ such that \spad{dh/dx = f - c dk/dx}. Value h is looked for in a field - ++ containing f and k1,...,kn (the ki's must be logs). - - Implementation ==> add - import IntegrationTools(R, F) - import ElementaryRischDE(R, F) - import RationalIntegration(F, UP) - import AlgebraicIntegration(R, F) - import AlgebraicManipulations(R, F) - import ElementaryRischDESystem(R, F) - import TranscendentalIntegration(F, UP) - import PureAlgebraicIntegration(R, F, F) - import IntegrationResultFunctions2(F, F) - import IntegrationResultFunctions2(RF, F) - import FunctionSpacePrimitiveElement(R, F) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R, P, F) - - alglfint : (F, K, List K, SE) -> IR - alglfextint : (F, K, List K, SE, F) -> U2 - alglflimint : (F, K, List K, SE, List F) -> U3 - primextint : (F, SE, K, F) -> U2 - expextint : (F, SE, K, F) -> U2 - primlimint : (F, SE, K, List F) -> U3 - explimint : (F, SE, K, List F) -> U3 - algprimint : (F, K, K, SE) -> IR - algexpint : (F, K, K, SE) -> IR - primint : (F, SE, K) -> IR - expint : (F, SE, K) -> IR - tanint : (F, SE, K) -> IR - prim? : (K, SE) -> Boolean - isx? : (F, SE) -> Boolean - addx : (IR, F) -> IR - cfind : (F, LLG) -> F - lfintegrate0: (F, SE) -> IR - unknownint : (F, SE) -> IR - unkextint : (F, SE, F) -> U2 - unklimint : (F, SE, List F) -> U3 - tryChangeVar: (F, K, SE) -> Union(IR, "failed") - droponex : (F, F, K, F) -> Union(F, "failed") - - prim?(k, x) == is?(k, "log"::SE) or has?(operator k, "prim") - - tanint(f, x, k) == - eta' := differentiate(eta := first argument k, x) - r1 := tanintegrate(univariate(f, k), differentiate(#1, - differentiate(#1, x), monomial(eta', 2) + eta'::UP), - rischDEsys(#1, 2 * eta, #2, #3, x, lflimitedint(#1, x, #2), - lfextendedint(#1, x, #2))) - map(multivariate(#1, k), r1.answer) + lfintegrate(r1.a0, x) - --- tries various tricks since the integrand contains something not elementary - unknownint(f, x) == - ((r := retractIfCan(f)@Union(K, "failed")) case K) and - is?(k := r::K, OPDIFF) and - ((ka:=retractIfCan(a:=second(l:=argument k))@Union(K,"failed"))case K) - and ((z := retractIfCan(zz := third l)@Union(SE, "failed")) case SE) - and (z::SE = x) - and ((u := droponex(first l, a, ka, zz)) case F) => u::F::IR - (da := differentiate(a := denom(f)::F, x)) ^= 0 and - zero? differentiate(c := numer(f)::F / da, x) => (c * log a)::IR - mkAnswer(0, empty(), [[f, x::F]]) - - droponex(f, a, ka, x) == - (r := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed" - is?(op := operator(k := r::K), OPDIFF) => - (z := third(arg := argument k)) = a => op [first arg, second arg, x] - (u := droponex(first arg, a, ka, x)) case "failed" => "failed" - op [u::F, second arg, z] - eval(f, [ka], [x]) - - unklimint(f, x, lu) == - for u in lu | u ^= 0 repeat - zero? differentiate(c := f * u / differentiate(u, x), x) => [0,[[c,u]]] - "failed" - - unkextint(f, x, g) == - zero?(g' := differentiate(g, x)) => "failed" - zero? differentiate(c := f / g', x) => [0, c] - "failed" - - isx?(f, x) == - (k := retractIfCan(f)@Union(K, "failed")) case "failed" => false - (r := symbolIfCan(k::K)) case "failed" => false - r::SE = x - - alglfint(f, k, l, x) == - xf := x::F - symbolIfCan(kx := ksec(k,l,x)) case SE => addx(palgint(f, kx, k), xf) - is?(kx, "exp"::SE) => addx(algexpint(f, kx, k, x), xf) - prim?(kx, x) => addx(algprimint(f, kx, k, x), xf) - has?(operator kx, ALGOP) => - rec := primitiveElement(kx::F, k::F) - y := rootOf(rec.prim) - map(eval(#1, retract(y)@K, rec.primelt), - lfintegrate(eval(f, [kx,k], [(rec.pol1) y, (rec.pol2) y]), x)) - unknownint(f, x) - - alglfextint(f, k, l, x, g) == - symbolIfCan(kx := ksec(k,l,x)) case SE => palgextint(f, kx, k, g) - has?(operator kx, ALGOP) => - rec := primitiveElement(kx::F, k::F) - y := rootOf(rec.prim) - lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F) - (u := lfextendedint(eval(f, [kx, k], lrhs), x, - eval(g, [kx, k], lrhs))) case "failed" => "failed" - ky := retract(y)@K - r := u::Record(ratpart:F, coeff:F) - [eval(r.ratpart,ky,rec.primelt), eval(r.coeff,ky,rec.primelt)] - is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL - unkextint(f, x, g) - - alglflimint(f, k, l, x, lu) == - symbolIfCan(kx := ksec(k,l,x)) case SE => palglimint(f, kx, k, lu) - has?(operator kx, ALGOP) => - rec := primitiveElement(kx::F, k::F) - y := rootOf(rec.prim) - lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F) - (u := lflimitedint(eval(f, [kx, k], lrhs), x, - map(eval(#1, [kx, k], lrhs), lu))) case "failed" => "failed" - ky := retract(y)@K - r := u::Record(mainpart:F, limitedlogs:LLG) - [eval(r.mainpart, ky, rec.primelt), - [[eval(rc.coeff, ky, rec.primelt), - eval(rc.logand,ky, rec.primelt)] for rc in r.limitedlogs]] - is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL - unklimint(f, x, lu) - - if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) - and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then - import PatternMatchIntegration(R, F) - lfintegrate(f, x) == intPatternMatch(f, x, lfintegrate0, pmintegrate) - - else lfintegrate(f, x) == lfintegrate0(f, x) - - lfintegrate0(f, x) == - zero? f => 0 - xf := x::F - empty?(l := varselect(kernels f, x)) => (xf * f)::IR - symbolIfCan(k := kmax l) case SE => - map(multivariate(#1, k), integrate univariate(f, k)) - is?(k, "tan"::SE) => addx(tanint(f, x, k), xf) - is?(k, "exp"::SE) => addx(expint(f, x, k), xf) - prim?(k, x) => addx(primint(f, x, k), xf) - has?(operator k, ALGOP) => alglfint(f, k, l, x) - unknownint(f, x) - - addx(i, x) == - elem? i => i - mkAnswer(ratpart i, logpart i, - [[ne.integrand, x] for ne in notelem i]) - - tryChangeVar(f, t, x) == - z := new()$Symbol - g := subst(f / differentiate(t::F, x), [t], [z::F]) - freeOf?(g, x) => -- can we do change of variables? - map(eval(#1, kernel z, t::F), lfintegrate(g, z)) - "failed" - - algexpint(f, t, y, x) == - (u := tryChangeVar(f, t, x)) case IR => u::IR - algint(f, t, y, differentiate(#1, differentiate(#1, x), - monomial(differentiate(first argument t, x), 1))) - - algprimint(f, t, y, x) == - (u := tryChangeVar(f, t, x)) case IR => u::IR - algint(f, t, y, differentiate(#1, differentiate(#1, x), - differentiate(t::F, x)::UP)) - -@ -Bug \#100 is an infinite loop that eventually kills Axiom -from the input -\begin{verbatim} - integrate((z^a+1)^b,z) -\end{verbatim} - -Line 2 of this function used to read: -\begin{verbatim} - symbolIfCan(k := kmax(l := union(l, varselect(kernels g, x)))) -\end{verbatim} - -The loop occurs when the call to union causes -\begin{verbatim} - a log(z) - %e -\end{verbatim} -to get added to the list every time. This gives the argument to kmax -\begin{verbatim} - a log(z) - arg1= [z,%e ] -\end{verbatim} -and the result being -\begin{verbatim} - a log(z) - %e -\end{verbatim} -We keep coming back to process this term, which ends up -putting the same term back on the list and we loop. -Waldek's solution is to remove the union call. - -The original patch fixed the infinite regression mentioned above -but caused Axiom to return a closed form of the integral: -\[integrate(asech(x)/x,x)\] -which should not have a closed form. This is referenced in -the FriCAS SVN revision 279. - -Essentially this new patch uses only logarithms of rational functions -when integrating rational functions. It is unclear whether this is -the correct fix. - -<>= - lfextendedint(f, x, g) == - empty?(l := varselect(kernels f, x)) => [x::F * f, 0] - symbolIfCan(k := kmax(l)) - case SE => - g1 := - empty?(l1 := varselect(kernels g,x)) => 0::F - kmax(l1) = k => g - 0::F - map(multivariate(#1, k), extendedint(univariate(f, k), - univariate(g1, k))) - is?(k, "exp"::SE) => expextint(f, x, k, g) - prim?(k, x) => primextint(f, x, k, g) - has?(operator k, ALGOP) => alglfextint(f, k, l, x, g) - unkextint(f, x, g) - -@ -This is part of the fix for bug 100. Line 2 of this function used to read: -\begin{verbatim} - symbolIfCan(k := kmax(l := union(l, vark(lu, x)))) case SE => -\end{verbatim} -See the above discussion for why this causes an infinite loop. -<>= - lflimitedint(f, x, lu) == - empty?(l := varselect(kernels f, x)) => [x::F * f, empty()] - symbolIfCan(k := kmax(l)) case SE => - map(multivariate(#1, k), limitedint(univariate(f, k), - [univariate(u, k) for u in lu])) - is?(k, "exp"::SE) => explimint(f, x, k, lu) - prim?(k, x) => primlimint(f, x, k, lu) - has?(operator k, ALGOP) => alglflimint(f, k, l, x, lu) - unklimint(f, x, lu) - - lfinfieldint(f, x) == - (u := lfextendedint(f, x, 0)) case "failed" => "failed" - u.ratpart - - primextint(f, x, k, g) == - lk := varselect([a for a in tower f - | k ^= a and is?(a, "log"::SE)], x) - (u1 := primextendedint(univariate(f, k), differentiate(#1, - differentiate(#1, x), differentiate(k::F, x)::UP), - lfextlimint(#1, x, k, lk), univariate(g, k))) case "failed" - => "failed" - u1 case FF => - [multivariate(u1.ratpart, k), multivariate(u1.coeff, k)] - (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed" - [multivariate(u1.answer, k) + u2.ratpart, u2.coeff] - - expextint(f, x, k, g) == - (u1 := expextendedint(univariate(f, k), differentiate(#1, - differentiate(#1, x), - monomial(differentiate(first argument k, x), 1)), - rischDE(#1, first argument k, #2, x, lflimitedint(#1, x, #2), - lfextendedint(#1, x, #2)), univariate(g, k))) - case "failed" => "failed" - u1 case FF => - [multivariate(u1.ratpart, k), multivariate(u1.coeff, k)] - (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed" - [multivariate(u1.answer, k) + u2.ratpart, u2.coeff] - - primint(f, x, k) == - lk := varselect([a for a in tower f - | k ^= a and is?(a, "log"::SE)], x) - r1 := primintegrate(univariate(f, k), differentiate(#1, - differentiate(#1, x), differentiate(k::F, x)::UP), - lfextlimint(#1, x, k, lk)) - map(multivariate(#1, k), r1.answer) + lfintegrate(r1.a0, x) - - lfextlimint(f, x, k, lk) == - not((u1 := lfextendedint(f, x, differentiate(k::F, x))) - case "failed") => u1 - twr := tower f - empty?(lg := [kk for kk in lk | not member?(kk, twr)]) => "failed" - is?(k, "log"::SE) => - (u2 := lflimitedint(f, x, - [first argument u for u in union(lg, [k])])) case "failed" - => "failed" - cf := cfind(first argument k, u2.limitedlogs) - [u2.mainpart - cf * k::F + - +/[c.coeff * log(c.logand) for c in u2.limitedlogs], cf] - "failed" - - cfind(f, l) == - for u in l repeat - f = u.logand => return u.coeff - 0 - - expint(f, x, k) == - eta := first argument k - r1 := expintegrate(univariate(f, k), differentiate(#1, - differentiate(#1, x), monomial(differentiate(eta, x), 1)), - rischDE(#1, eta, #2, x, lflimitedint(#1, x, #2), - lfextendedint(#1, x, #2))) - map(multivariate(#1, k), r1.answer) + lfintegrate(r1.a0, x) - - primlimint(f, x, k, lu) == - lk := varselect([a for a in tower f - | k ^= a and is?(a, "log"::SE)], x) - (u1 := primlimitedint(univariate(f, k), differentiate(#1, - differentiate(#1, x), differentiate(k::F, x)::UP), - lfextlimint(#1, x, k, lk), [univariate(u, k) for u in lu])) - case "failed" => "failed" - l := [[multivariate(lg.coeff, k),multivariate(lg.logand, k)] - for lg in u1.answer.limitedlogs]$LLG - (u2 := lflimitedint(u1.a0, x, lu)) case "failed" => "failed" - [multivariate(u1.answer.mainpart, k) + u2.mainpart, - concat(u2.limitedlogs, l)] - - explimint(f, x, k, lu) == - eta := first argument k - (u1 := explimitedint(univariate(f, k), differentiate(#1, - differentiate(#1, x), monomial(differentiate(eta, x), 1)), - rischDE(#1, eta, #2, x, - lflimitedint(#1, x, #2), lfextendedint(#1, x, #2)), - [univariate(u, k) for u in lu])) case "failed" => "failed" - l := [[multivariate(lg.coeff, k),multivariate(lg.logand, k)] - for lg in u1.answer.limitedlogs]$LLG - (u2 := lflimitedint(u1.a0, x, lu)) case "failed" => "failed" - [multivariate(u1.answer.mainpart, k) + u2.mainpart, - concat(u2.limitedlogs, l)] - -@ -\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 intpm INTEF irexpand integrat - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet deleted file mode 100644 index 4632e79..0000000 --- a/src/algebra/integer.spad.pamphlet +++ /dev/null @@ -1,102 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra integer.spad} -\author{James Davenport} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INTSLPE IntegerSolveLinearPolynomialEquation} -<>= -)abbrev package INTSLPE IntegerSolveLinearPolynomialEquation -++ Author: Davenport -++ Date Created: 1991 -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This package provides the implementation for the -++ \spadfun{solveLinearPolynomialEquation} -++ operation over the integers. It uses a lifting technique -++ from the package GenExEuclid -IntegerSolveLinearPolynomialEquation(): C ==T - where - ZP ==> SparseUnivariatePolynomial Integer - C == with - solveLinearPolynomialEquation: (List ZP,ZP) -> Union(List ZP,"failed") - ++ solveLinearPolynomialEquation([f1, ..., fn], g) - ++ (where the fi are relatively prime to each other) - ++ returns a list of ai such that - ++ \spad{g/prod fi = sum ai/fi} - ++ or returns "failed" if no such list of ai's exists. - T == add - oldlp:List ZP := [] - slpePrime:Integer:=(2::Integer) - oldtable:Vector List ZP := empty() - solveLinearPolynomialEquation(lp,p) == - if (oldlp ^= lp) then - -- we have to generate a new table - deg:= _+/[degree u for u in lp] - ans:Union(Vector List ZP,"failed"):="failed" - slpePrime:=2147483647::Integer -- 2**31 -1 : a prime - -- a good test case for this package is - -- ([x**31-1,x-2],2) - while (ans case "failed") repeat - ans:=tablePow(deg,slpePrime,lp)$GenExEuclid(Integer,ZP) - if (ans case "failed") then - slpePrime:= prevPrime(slpePrime)$IntegerPrimesPackage(Integer) - oldtable:=(ans:: Vector List ZP) - answer:=solveid(p,slpePrime,oldtable) - answer - -@ -\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/integrat.spad.pamphlet b/src/algebra/integrat.spad.pamphlet deleted file mode 100644 index f70dfe1..0000000 --- a/src/algebra/integrat.spad.pamphlet +++ /dev/null @@ -1,269 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra integrat.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package FSCINT FunctionSpaceComplexIntegration} -<>= -)abbrev package FSCINT FunctionSpaceComplexIntegration -++ Top-level complex function integration -++ Author: Manuel Bronstein -++ Date Created: 4 February 1988 -++ Date Last Updated: 11 June 1993 -++ Description: -++ \spadtype{FunctionSpaceComplexIntegration} provides functions for the -++ indefinite integration of complex-valued functions. -++ Keywords: function, integration. -FunctionSpaceComplexIntegration(R, F): Exports == Implementation where - R : Join(EuclideanDomain, OrderedSet, CharacteristicZero, - RetractableTo Integer, LinearlyExplicitRingOver Integer) - F : Join(TranscendentalFunctionCategory, - AlgebraicallyClosedFunctionSpace R) - - SE ==> Symbol - G ==> Complex R - FG ==> Expression G - IR ==> IntegrationResult F - - Exports ==> with - internalIntegrate : (F, SE) -> IR - ++ internalIntegrate(f, x) returns the integral of \spad{f(x)dx} - ++ where x is viewed as a complex variable. - internalIntegrate0: (F, SE) -> IR - ++ internalIntegrate0 should be a local function, but is conditional. - complexIntegrate : (F, SE) -> F - ++ complexIntegrate(f, x) returns the integral of \spad{f(x)dx} - ++ where x is viewed as a complex variable. - - Implementation ==> add - import IntegrationTools(R, F) - import ElementaryIntegration(R, F) - import ElementaryIntegration(G, FG) - import AlgebraicManipulations(R, F) - import AlgebraicManipulations(G, FG) - import TrigonometricManipulations(R, F) - import IntegrationResultToFunction(R, F) - import IntegrationResultFunctions2(FG, F) - import ElementaryFunctionStructurePackage(R, F) - import ElementaryFunctionStructurePackage(G, FG) - import InnerTrigonometricManipulations(R, F, FG) - - K2KG: Kernel F -> Kernel FG - - K2KG k == retract(tan F2FG first argument k)@Kernel(FG) - - complexIntegrate(f, x) == - removeConstantTerm(complexExpand internalIntegrate(f, x), x) - - if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer) - and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then - import PatternMatchIntegration(R, F) - internalIntegrate0(f, x) == - intPatternMatch(f, x, lfintegrate, pmComplexintegrate) - - else internalIntegrate0(f, x) == lfintegrate(f, x) - - internalIntegrate(f, x) == - f := distribute(f, x::F) - any?(has?(operator #1, "rtrig"), - [k for k in tower(g := realElementary(f, x)) - | member?(x, variables(k::F))]$List(Kernel F))$List(Kernel F) => - h := trigs2explogs(F2FG g, [K2KG k for k in tower f - | is?(k, "tan"::SE) or is?(k, "cot"::SE)], [x]) - real?(g := FG2F h) => - internalIntegrate0(rootSimp(rischNormalize(g, x).func), x) - real?(g := FG2F(h := rootSimp(rischNormalize(h, x).func))) => - internalIntegrate0(g, x) - map(FG2F, lfintegrate(h, x)) - internalIntegrate0(rootSimp(rischNormalize(g, x).func), x) - -@ -\section{package FSINT FunctionSpaceIntegration} -<>= -)abbrev package FSINT FunctionSpaceIntegration -++ Top-level real function integration -++ Author: Manuel Bronstein -++ Date Created: 4 February 1988 -++ Date Last Updated: 11 June 1993 -++ Keywords: function, integration. -++ Description: -++ \spadtype{FunctionSpaceIntegration} provides functions for the -++ indefinite integration of real-valued functions. -++ Examples: )r INTEF INPUT -FunctionSpaceIntegration(R, F): Exports == Implementation where - R : Join(EuclideanDomain, OrderedSet, CharacteristicZero, - RetractableTo Integer, LinearlyExplicitRingOver Integer) - F : Join(TranscendentalFunctionCategory, PrimitiveFunctionCategory, - AlgebraicallyClosedFunctionSpace R) - - B ==> Boolean - G ==> Complex R - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - SE ==> Symbol - IR ==> IntegrationResult F - FG ==> Expression G - ALGOP ==> "%alg" - TANTEMP ==> "%temptan"::SE - - Exports ==> with - integrate: (F, SE) -> Union(F, List F) - ++ integrate(f, x) returns the integral of \spad{f(x)dx} - ++ where x is viewed as a real variable. - - Implementation ==> add - import IntegrationTools(R, F) - import ElementaryIntegration(R, F) - import ElementaryIntegration(G, FG) - import AlgebraicManipulations(R, F) - import TrigonometricManipulations(R, F) - import IntegrationResultToFunction(R, F) - import TranscendentalManipulations(R, F) - import IntegrationResultFunctions2(FG, F) - import FunctionSpaceComplexIntegration(R, F) - import ElementaryFunctionStructurePackage(R, F) - import InnerTrigonometricManipulations(R, F, FG) - import PolynomialCategoryQuotientFunctions(IndexedExponents K, - K, R, SparseMultivariatePolynomial(R, K), F) - - K2KG : K -> Kernel FG - postSubst : (F, List F, List K, B, List K, SE) -> F - rinteg : (IR, F, SE, B, B) -> Union(F, List F) - mkPrimh : (F, SE, B, B) -> F - trans? : F -> B - goComplex?: (B, List K, List K) -> B - halfangle : F -> F - Khalf : K -> F - tan2temp : K -> K - - optemp:BasicOperator := operator(TANTEMP, 1) - - K2KG k == retract(tan F2FG first argument k)@Kernel(FG) - tan2temp k == kernel(optemp, argument k, height k)$K - - trans? f == - any?(is?(#1,"log"::SE) or is?(#1,"exp"::SE) or is?(#1,"atan"::SE), - operators f)$List(BasicOperator) - - mkPrimh(f, x, h, comp) == - f := real f - if comp then f := removeSinSq f - g := mkPrim(f, x) - h and trans? g => htrigs g - g - - rinteg(i, f, x, h, comp) == - not elem? i => integral(f, x)$F - empty? rest(l := [mkPrimh(f, x, h, comp) for f in expand i]) => first l - l - --- replace tan(a/2)**2 by (1-cos a)/(1+cos a) if tan(a/2) is in ltan - halfangle a == - a := 2 * a - (1 - cos a) / (1 + cos a) - - Khalf k == - a := 2 * first argument k - sin(a) / (1 + cos a) - --- ltan = list of tangents in the integrand after real normalization - postSubst(f, lv, lk, comp, ltan, x) == - for v in lv for k in lk repeat - if ((u := retractIfCan(v)@Union(K, "failed")) case K) then - if has?(operator(kk := u::K), ALGOP) then - f := univariate(f, kk, minPoly kk) (kk::F) - f := eval(f, [u::K], [k::F]) - if not(comp or empty? ltan) then - ltemp := [tan2temp k for k in ltan] - f := eval(f, ltan, [k::F for k in ltemp]) - f := eval(f, TANTEMP, 2, halfangle) - f := eval(f, ltemp, [Khalf k for k in ltemp]) - removeConstantTerm(f, x) - --- can handle a single unnested tangent directly, otherwise go complex for now --- l is the list of all the kernels containing x --- ltan is the list of all the tangents in l - goComplex?(rt, l, ltan) == - empty? ltan => rt - not empty? rest rest l - - integrate(f, x) == - not real? f => complexIntegrate(f, x) - f := distribute(f, x::F) - tf := [k for k in tower f | member?(x, variables(k::F)@List(SE))]$List(K) - ltf := select(is?(operator #1, "tan"::SE), tf) - ht := any?(has?(operator #1, "htrig"), tf) - rec := rischNormalize(realElementary(f, x), x) - g := rootSimp(rec.func) - tg := [k for k in tower g | member?(x, variables(k::F))]$List(K) - ltg := select(is?(operator #1, "tan"::SE), tg) - rtg := any?(has?(operator #1, "rtrig"), tg) - el := any?(has?(operator #1, "elem"), tg) - i:IR - if (comp := goComplex?(rtg, tg, ltg)) then - i := map(FG2F, lfintegrate(trigs2explogs(F2FG g, - [K2KG k for k in tf | is?(k, "tan"::SE) or - is?(k, "cot"::SE)], [x]), x)) - else i := lfintegrate(g, x) - ltg := setDifference(ltg, ltf) -- tan's added by normalization - (u := rinteg(i, f, x, el and ht, comp)) case F => - postSubst(u::F, rec.vals, rec.kers, comp, ltg, x) - [postSubst(h, rec.vals, rec.kers, comp, ltg, x) for h in u::List(F)] - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- 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/intfact.spad.pamphlet b/src/algebra/intfact.spad.pamphlet deleted file mode 100644 index fd43be1..0000000 --- a/src/algebra/intfact.spad.pamphlet +++ /dev/null @@ -1,938 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intfact.spad} -\author{Michael Monagan} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package PRIMES IntegerPrimesPackage} -We've expanded the list of small primes to include those between 1 and 10000. -<>= -)abbrev package PRIMES IntegerPrimesPackage -++ Author: Michael Monagan -++ Date Created: August 1987 -++ Date Last Updated: 31 May 1993 -++ Updated by: James Davenport -++ Updated Because: of problems with strong pseudo-primes -++ and for some efficiency reasons. -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: integer, prime -++ Examples: -++ References: Davenport's paper in ISSAC 1992 -++ AXIOM Technical Report ATR/6 -++ Description: -++ The \spadtype{IntegerPrimesPackage} implements a modification of -++ Rabin's probabilistic -++ primality test and the utility functions \spadfun{nextPrime}, -++ \spadfun{prevPrime} and \spadfun{primes}. -IntegerPrimesPackage(I:IntegerNumberSystem): with - prime?: I -> Boolean - ++ \spad{prime?(n)} returns true if n is prime and false if not. - ++ The algorithm used is Rabin's probabilistic primality test - ++ (reference: Knuth Volume 2 Semi Numerical Algorithms). - ++ If \spad{prime? n} returns false, n is proven composite. - ++ If \spad{prime? n} returns true, prime? may be in error - ++ however, the probability of error is very low. - ++ and is zero below 25*10**9 (due to a result of Pomerance et al), - ++ below 10**12 and 10**13 due to results of Pinch, - ++ and below 341550071728321 due to a result of Jaeschke. - ++ Specifically, this implementation does at least 10 pseudo prime - ++ tests and so the probability of error is \spad{< 4**(-10)}. - ++ The running time of this method is cubic in the length - ++ of the input n, that is \spad{O( (log n)**3 )}, for n<10**20. - ++ beyond that, the algorithm is quartic, \spad{O( (log n)**4 )}. - ++ Two improvements due to Davenport have been incorporated - ++ which catches some trivial strong pseudo-primes, such as - ++ [Jaeschke, 1991] 1377161253229053 * 413148375987157, which - ++ the original algorithm regards as prime - nextPrime: I -> I - ++ \spad{nextPrime(n)} returns the smallest prime strictly larger than n - prevPrime: I -> I - ++ \spad{prevPrime(n)} returns the largest prime strictly smaller than n - primes: (I,I) -> List I - ++ \spad{primes(a,b)} returns a list of all primes p with - ++ \spad{a <= p <= b} - == add -@ -\subsection{smallPrimes} -This is a table of all of the primes in [2..10000]. It is used by the -prime? function to check for primality. It is used by the primes function -to generate arrays of primes in a given range. Changing the range included -in this table implies changing the value of the nextSmallPrime variable. -There is a constant in the function squareFree from IntegerFactorizationPackage -that is the square of the upper bound of the table range, in this case -10000000. -<>= - smallPrimes: List I := - [2::I, 3::I, 5::I, 7::I, 11::I, 13::I, 17::I, 19::I,_ - 23::I, 29::I, 31::I, 37::I, 41::I, 43::I, 47::I, 53::I,_ - 59::I, 61::I, 67::I, 71::I, 73::I, 79::I, 83::I, 89::I,_ - 97::I, 101::I, 103::I, 107::I, 109::I, 113::I, 127::I,_ - 131::I, 137::I, 139::I, 149::I, 151::I, 157::I, 163::I,_ - 167::I, 173::I, 179::I, 181::I, 191::I, 193::I, 197::I,_ - 199::I, 211::I, 223::I, 227::I, 229::I, 233::I, 239::I,_ - 241::I, 251::I, 257::I, 263::I, 269::I, 271::I, 277::I,_ - 281::I, 283::I, 293::I, 307::I, 311::I, 313::I, 317::I,_ - 331::I, 337::I, 347::I, 349::I, 353::I, 359::I, 367::I,_ - 373::I, 379::I, 383::I, 389::I, 397::I, 401::I, 409::I,_ - 419::I, 421::I, 431::I, 433::I, 439::I, 443::I, 449::I,_ - 457::I, 461::I, 463::I, 467::I, 479::I, 487::I, 491::I,_ - 499::I, 503::I, 509::I, 521::I, 523::I, 541::I, 547::I,_ - 557::I, 563::I, 569::I, 571::I, 577::I, 587::I, 593::I,_ - 599::I, 601::I, 607::I, 613::I, 617::I, 619::I, 631::I,_ - 641::I, 643::I, 647::I, 653::I, 659::I, 661::I, 673::I,_ - 677::I, 683::I, 691::I, 701::I, 709::I, 719::I, 727::I,_ - 733::I, 739::I, 743::I, 751::I, 757::I, 761::I, 769::I,_ - 773::I, 787::I, 797::I, 809::I, 811::I, 821::I, 823::I,_ - 827::I, 829::I, 839::I, 853::I, 857::I, 859::I, 863::I,_ - 877::I, 881::I, 883::I, 887::I, 907::I, 911::I, 919::I,_ - 929::I, 937::I, 941::I, 947::I, 953::I, 967::I, 971::I,_ - 977::I, 983::I, 991::I, 997::I, 1009::I, 1013::I,_ - 1019::I, 1021::I, 1031::I, 1033::I, 1039::I, 1049::I,_ - 1051::I, 1061::I, 1063::I, 1069::I, 1087::I, 1091::I,_ - 1093::I, 1097::I, 1103::I, 1109::I, 1117::I, 1123::I,_ - 1129::I, 1151::I, 1153::I, 1163::I, 1171::I, 1181::I,_ - 1187::I, 1193::I, 1201::I, 1213::I, 1217::I, 1223::I,_ - 1229::I, 1231::I, 1237::I, 1249::I, 1259::I, 1277::I,_ - 1279::I, 1283::I, 1289::I, 1291::I, 1297::I, 1301::I,_ - 1303::I, 1307::I, 1319::I, 1321::I, 1327::I, 1361::I,_ - 1367::I, 1373::I, 1381::I, 1399::I, 1409::I, 1423::I,_ - 1427::I, 1429::I, 1433::I, 1439::I, 1447::I, 1451::I,_ - 1453::I, 1459::I, 1471::I, 1481::I, 1483::I, 1487::I,_ - 1489::I, 1493::I, 1499::I, 1511::I, 1523::I, 1531::I,_ - 1543::I, 1549::I, 1553::I, 1559::I, 1567::I, 1571::I,_ - 1579::I, 1583::I, 1597::I, 1601::I, 1607::I, 1609::I,_ - 1613::I, 1619::I, 1621::I, 1627::I, 1637::I, 1657::I,_ - 1663::I, 1667::I, 1669::I, 1693::I, 1697::I, 1699::I,_ - 1709::I, 1721::I, 1723::I, 1733::I, 1741::I, 1747::I,_ - 1753::I, 1759::I, 1777::I, 1783::I, 1787::I, 1789::I,_ - 1801::I, 1811::I, 1823::I, 1831::I, 1847::I, 1861::I,_ - 1867::I, 1871::I, 1873::I, 1877::I, 1879::I, 1889::I,_ - 1901::I, 1907::I, 1913::I, 1931::I, 1933::I, 1949::I,_ - 1951::I, 1973::I, 1979::I, 1987::I, 1993::I, 1997::I,_ - 1999::I, 2003::I, 2011::I, 2017::I, 2027::I, 2029::I,_ - 2039::I, 2053::I, 2063::I, 2069::I, 2081::I, 2083::I,_ - 2087::I, 2089::I, 2099::I, 2111::I, 2113::I, 2129::I,_ - 2131::I, 2137::I, 2141::I, 2143::I, 2153::I, 2161::I,_ - 2179::I, 2203::I, 2207::I, 2213::I, 2221::I, 2237::I,_ - 2239::I, 2243::I, 2251::I, 2267::I, 2269::I, 2273::I,_ - 2281::I, 2287::I, 2293::I, 2297::I, 2309::I, 2311::I,_ - 2333::I, 2339::I, 2341::I, 2347::I, 2351::I, 2357::I,_ - 2371::I, 2377::I, 2381::I, 2383::I, 2389::I, 2393::I,_ - 2399::I, 2411::I, 2417::I, 2423::I, 2437::I, 2441::I,_ - 2447::I, 2459::I, 2467::I, 2473::I, 2477::I, 2503::I,_ - 2521::I, 2531::I, 2539::I, 2543::I, 2549::I, 2551::I,_ - 2557::I, 2579::I, 2591::I, 2593::I, 2609::I, 2617::I,_ - 2621::I, 2633::I, 2647::I, 2657::I, 2659::I, 2663::I,_ - 2671::I, 2677::I, 2683::I, 2687::I, 2689::I, 2693::I,_ - 2699::I, 2707::I, 2711::I, 2713::I, 2719::I, 2729::I,_ - 2731::I, 2741::I, 2749::I, 2753::I, 2767::I, 2777::I,_ - 2789::I, 2791::I, 2797::I, 2801::I, 2803::I, 2819::I,_ - 2833::I, 2837::I, 2843::I, 2851::I, 2857::I, 2861::I,_ - 2879::I, 2887::I, 2897::I, 2903::I, 2909::I, 2917::I,_ - 2927::I, 2939::I, 2953::I, 2957::I, 2963::I, 2969::I,_ - 2971::I, 2999::I, 3001::I, 3011::I, 3019::I, 3023::I,_ - 3037::I, 3041::I, 3049::I, 3061::I, 3067::I, 3079::I,_ - 3083::I, 3089::I, 3109::I, 3119::I, 3121::I, 3137::I,_ - 3163::I, 3167::I, 3169::I, 3181::I, 3187::I, 3191::I,_ - 3203::I, 3209::I, 3217::I, 3221::I, 3229::I, 3251::I,_ - 3253::I, 3257::I, 3259::I, 3271::I, 3299::I, 3301::I,_ - 3307::I, 3313::I, 3319::I, 3323::I, 3329::I, 3331::I,_ - 3343::I, 3347::I, 3359::I, 3361::I, 3371::I, 3373::I,_ - 3389::I, 3391::I, 3407::I, 3413::I, 3433::I, 3449::I,_ - 3457::I, 3461::I, 3463::I, 3467::I, 3469::I, 3491::I,_ - 3499::I, 3511::I, 3517::I, 3527::I, 3529::I, 3533::I,_ - 3539::I, 3541::I, 3547::I, 3557::I, 3559::I, 3571::I,_ - 3581::I, 3583::I, 3593::I, 3607::I, 3613::I, 3617::I,_ - 3623::I, 3631::I, 3637::I, 3643::I, 3659::I, 3671::I,_ - 3673::I, 3677::I, 3691::I, 3697::I, 3701::I, 3709::I,_ - 3719::I, 3727::I, 3733::I, 3739::I, 3761::I, 3767::I,_ - 3769::I, 3779::I, 3793::I, 3797::I, 3803::I, 3821::I,_ - 3823::I, 3833::I, 3847::I, 3851::I, 3853::I, 3863::I,_ - 3877::I, 3881::I, 3889::I, 3907::I, 3911::I, 3917::I,_ - 3919::I, 3923::I, 3929::I, 3931::I, 3943::I, 3947::I,_ - 3967::I, 3989::I, 4001::I, 4003::I, 4007::I, 4013::I,_ - 4019::I, 4021::I, 4027::I, 4049::I, 4051::I, 4057::I,_ - 4073::I, 4079::I, 4091::I, 4093::I, 4099::I, 4111::I,_ - 4127::I, 4129::I, 4133::I, 4139::I, 4153::I, 4157::I,_ - 4159::I, 4177::I, 4201::I, 4211::I, 4217::I, 4219::I,_ - 4229::I, 4231::I, 4241::I, 4243::I, 4253::I, 4259::I,_ - 4261::I, 4271::I, 4273::I, 4283::I, 4289::I, 4297::I,_ - 4327::I, 4337::I, 4339::I, 4349::I, 4357::I, 4363::I,_ - 4373::I, 4391::I, 4397::I, 4409::I, 4421::I, 4423::I,_ - 4441::I, 4447::I, 4451::I, 4457::I, 4463::I, 4481::I,_ - 4483::I, 4493::I, 4507::I, 4513::I, 4517::I, 4519::I,_ - 4523::I, 4547::I, 4549::I, 4561::I, 4567::I, 4583::I,_ - 4591::I, 4597::I, 4603::I, 4621::I, 4637::I, 4639::I,_ - 4643::I, 4649::I, 4651::I, 4657::I, 4663::I, 4673::I,_ - 4679::I, 4691::I, 4703::I, 4721::I, 4723::I, 4729::I,_ - 4733::I, 4751::I, 4759::I, 4783::I, 4787::I, 4789::I,_ - 4793::I, 4799::I, 4801::I, 4813::I, 4817::I, 4831::I,_ - 4861::I, 4871::I, 4877::I, 4889::I, 4903::I, 4909::I,_ - 4919::I, 4931::I, 4933::I, 4937::I, 4943::I, 4951::I,_ - 4957::I, 4967::I, 4969::I, 4973::I, 4987::I, 4993::I,_ - 4999::I, 5003::I, 5009::I, 5011::I, 5021::I, 5023::I,_ - 5039::I, 5051::I, 5059::I, 5077::I, 5081::I, 5087::I,_ - 5099::I, 5101::I, 5107::I, 5113::I, 5119::I, 5147::I,_ - 5153::I, 5167::I, 5171::I, 5179::I, 5189::I, 5197::I,_ - 5209::I, 5227::I, 5231::I, 5233::I, 5237::I, 5261::I,_ - 5273::I, 5279::I, 5281::I, 5297::I, 5303::I, 5309::I,_ - 5323::I, 5333::I, 5347::I, 5351::I, 5381::I, 5387::I,_ - 5393::I, 5399::I, 5407::I, 5413::I, 5417::I, 5419::I,_ - 5431::I, 5437::I, 5441::I, 5443::I, 5449::I, 5471::I,_ - 5477::I, 5479::I, 5483::I, 5501::I, 5503::I, 5507::I,_ - 5519::I, 5521::I, 5527::I, 5531::I, 5557::I, 5563::I,_ - 5569::I, 5573::I, 5581::I, 5591::I, 5623::I, 5639::I,_ - 5641::I, 5647::I, 5651::I, 5653::I, 5657::I, 5659::I,_ - 5669::I, 5683::I, 5689::I, 5693::I, 5701::I, 5711::I,_ - 5717::I, 5737::I, 5741::I, 5743::I, 5749::I, 5779::I,_ - 5783::I, 5791::I, 5801::I, 5807::I, 5813::I, 5821::I,_ - 5827::I, 5839::I, 5843::I, 5849::I, 5851::I, 5857::I,_ - 5861::I, 5867::I, 5869::I, 5879::I, 5881::I, 5897::I,_ - 5903::I, 5923::I, 5927::I, 5939::I, 5953::I, 5981::I,_ - 5987::I, 6007::I, 6011::I, 6029::I, 6037::I, 6043::I,_ - 6047::I, 6053::I, 6067::I, 6073::I, 6079::I, 6089::I,_ - 6091::I, 6101::I, 6113::I, 6121::I, 6131::I, 6133::I,_ - 6143::I, 6151::I, 6163::I, 6173::I, 6197::I, 6199::I,_ - 6203::I, 6211::I, 6217::I, 6221::I, 6229::I, 6247::I,_ - 6257::I, 6263::I, 6269::I, 6271::I, 6277::I, 6287::I,_ - 6299::I, 6301::I, 6311::I, 6317::I, 6323::I, 6329::I,_ - 6337::I, 6343::I, 6353::I, 6359::I, 6361::I, 6367::I,_ - 6373::I, 6379::I, 6389::I, 6397::I, 6421::I, 6427::I,_ - 6449::I, 6451::I, 6469::I, 6473::I, 6481::I, 6491::I,_ - 6521::I, 6529::I, 6547::I, 6551::I, 6553::I, 6563::I,_ - 6569::I, 6571::I, 6577::I, 6581::I, 6599::I, 6607::I,_ - 6619::I, 6637::I, 6653::I, 6659::I, 6661::I, 6673::I,_ - 6679::I, 6689::I, 6691::I, 6701::I, 6703::I, 6709::I,_ - 6719::I, 6733::I, 6737::I, 6761::I, 6763::I, 6779::I,_ - 6781::I, 6791::I, 6793::I, 6803::I, 6823::I, 6827::I,_ - 6829::I, 6833::I, 6841::I, 6857::I, 6863::I, 6869::I,_ - 6871::I, 6883::I, 6899::I, 6907::I, 6911::I, 6917::I,_ - 6947::I, 6949::I, 6959::I, 6961::I, 6967::I, 6971::I,_ - 6977::I, 6983::I, 6991::I, 6997::I, 7001::I, 7013::I,_ - 7019::I, 7027::I, 7039::I, 7043::I, 7057::I, 7069::I,_ - 7079::I, 7103::I, 7109::I, 7121::I, 7127::I, 7129::I,_ - 7151::I, 7159::I, 7177::I, 7187::I, 7193::I, 7207::I,_ - 7211::I, 7213::I, 7219::I, 7229::I, 7237::I, 7243::I,_ - 7247::I, 7253::I, 7283::I, 7297::I, 7307::I, 7309::I,_ - 7321::I, 7331::I, 7333::I, 7349::I, 7351::I, 7369::I,_ - 7393::I, 7411::I, 7417::I, 7433::I, 7451::I, 7457::I,_ - 7459::I, 7477::I, 7481::I, 7487::I, 7489::I, 7499::I,_ - 7507::I, 7517::I, 7523::I, 7529::I, 7537::I, 7541::I,_ - 7547::I, 7549::I, 7559::I, 7561::I, 7573::I, 7577::I,_ - 7583::I, 7589::I, 7591::I, 7603::I, 7607::I, 7621::I,_ - 7639::I, 7643::I, 7649::I, 7669::I, 7673::I, 7681::I,_ - 7687::I, 7691::I, 7699::I, 7703::I, 7717::I, 7723::I,_ - 7727::I, 7741::I, 7753::I, 7757::I, 7759::I, 7789::I,_ - 7793::I, 7817::I, 7823::I, 7829::I, 7841::I, 7853::I,_ - 7867::I, 7873::I, 7877::I, 7879::I, 7883::I, 7901::I,_ - 7907::I, 7919::I, 7927::I, 7933::I, 7937::I, 7949::I,_ - 7951::I, 7963::I, 7993::I, 8009::I, 8011::I, 8017::I,_ - 8039::I, 8053::I, 8059::I, 8069::I, 8081::I, 8087::I,_ - 8089::I, 8093::I, 8101::I, 8111::I, 8117::I, 8123::I,_ - 8147::I, 8161::I, 8167::I, 8171::I, 8179::I, 8191::I,_ - 8209::I, 8219::I, 8221::I, 8231::I, 8233::I, 8237::I,_ - 8243::I, 8263::I, 8269::I, 8273::I, 8287::I, 8291::I,_ - 8293::I, 8297::I, 8311::I, 8317::I, 8329::I, 8353::I,_ - 8363::I, 8369::I, 8377::I, 8387::I, 8389::I, 8419::I,_ - 8423::I, 8429::I, 8431::I, 8443::I, 8447::I, 8461::I,_ - 8467::I, 8501::I, 8513::I, 8521::I, 8527::I, 8537::I,_ - 8539::I, 8543::I, 8563::I, 8573::I, 8581::I, 8597::I,_ - 8599::I, 8609::I, 8623::I, 8627::I, 8629::I, 8641::I,_ - 8647::I, 8663::I, 8669::I, 8677::I, 8681::I, 8689::I,_ - 8693::I, 8699::I, 8707::I, 8713::I, 8719::I, 8731::I,_ - 8737::I, 8741::I, 8747::I, 8753::I, 8761::I, 8779::I,_ - 8783::I, 8803::I, 8807::I, 8819::I, 8821::I, 8831::I,_ - 8837::I, 8839::I, 8849::I, 8861::I, 8863::I, 8867::I,_ - 8887::I, 8893::I, 8923::I, 8929::I, 8933::I, 8941::I,_ - 8951::I, 8963::I, 8969::I, 8971::I, 8999::I, 9001::I,_ - 9007::I, 9011::I, 9013::I, 9029::I, 9041::I, 9043::I,_ - 9049::I, 9059::I, 9067::I, 9091::I, 9103::I, 9109::I,_ - 9127::I, 9133::I, 9137::I, 9151::I, 9157::I, 9161::I,_ - 9173::I, 9181::I, 9187::I, 9199::I, 9203::I, 9209::I,_ - 9221::I, 9227::I, 9239::I, 9241::I, 9257::I, 9277::I,_ - 9281::I, 9283::I, 9293::I, 9311::I, 9319::I, 9323::I,_ - 9337::I, 9341::I, 9343::I, 9349::I, 9371::I, 9377::I,_ - 9391::I, 9397::I, 9403::I, 9413::I, 9419::I, 9421::I,_ - 9431::I, 9433::I, 9437::I, 9439::I, 9461::I, 9463::I,_ - 9467::I, 9473::I, 9479::I, 9491::I, 9497::I, 9511::I,_ - 9521::I, 9533::I, 9539::I, 9547::I, 9551::I, 9587::I,_ - 9601::I, 9613::I, 9619::I, 9623::I, 9629::I, 9631::I,_ - 9643::I, 9649::I, 9661::I, 9677::I, 9679::I, 9689::I,_ - 9697::I, 9719::I, 9721::I, 9733::I, 9739::I, 9743::I,_ - 9749::I, 9767::I, 9769::I, 9781::I, 9787::I, 9791::I,_ - 9803::I, 9811::I, 9817::I, 9829::I, 9833::I, 9839::I,_ - 9851::I, 9857::I, 9859::I, 9871::I, 9883::I, 9887::I,_ - 9901::I, 9907::I, 9923::I, 9929::I, 9931::I, 9941::I,_ - 9949::I, 9967::I, 9973::I] - - productSmallPrimes := */smallPrimes - nextSmallPrime := 10007::I - nextSmallPrimeSquared := nextSmallPrime**2 - two := 2::I - tenPowerTwenty:=(10::I)**20 - PomeranceList:= [25326001::I, 161304001::I, 960946321::I, 1157839381::I, - -- 3215031751::I, -- has a factor of 151 - 3697278427::I, 5764643587::I, 6770862367::I, - 14386156093::I, 15579919981::I, 18459366157::I, - 19887974881::I, 21276028621::I ]::(List I) - PomeranceLimit:=27716349961::I -- replaces (25*10**9) due to Pinch - PinchList:= _ - [3215031751::I, 118670087467::I, 128282461501::I, 354864744877::I, - 546348519181::I, 602248359169::I, 669094855201::I ] - PinchLimit:= (10**12)::I - PinchList2:= [2152302898747::I, 3474749660383::I] - PinchLimit2:= (10**13)::I - JaeschkeLimit:=341550071728321::I - rootsMinus1:Set I := empty() - -- used to check whether we detect too many roots of -1 - count2Order:Vector NonNegativeInteger := new(1,0) - -- used to check whether we observe an element of maximal two-order - -@ -\subsection{primes} -<>= - primes(m, n) == - -- computes primes from m to n inclusive using prime? - l:List(I) := - m <= two => [two] - empty() - n < two or n < m => empty() - if even? m then m := m + 1 - ll:List(I) := [k::I for k in - convert(m)@Integer..convert(n)@Integer by 2 | prime?(k::I)] - reverse_! concat_!(ll, l) - - rabinProvesComposite : (I,I,I,I,NonNegativeInteger) -> Boolean - rabinProvesCompositeSmall : (I,I,I,I,NonNegativeInteger) -> Boolean - - -@ -\subsection{rabinProvesCompositeSmall} -<>= - rabinProvesCompositeSmall(p,n,nm1,q,k) == - -- probability n prime is > 3/4 for each iteration - -- for most n this probability is much greater than 3/4 - t := powmod(p, q, n) - -- neither of these cases tells us anything - if not ((t = 1) or t = nm1) then - for j in 1..k-1 repeat - oldt := t - t := mulmod(t, t, n) - (t = 1) => return true - -- we have squared someting not -1 and got 1 - t = nm1 => - leave - not (t = nm1) => return true - false - -@ -\subsection{rabinProvesComposite} -<>= - rabinProvesComposite(p,n,nm1,q,k) == - -- probability n prime is > 3/4 for each iteration - -- for most n this probability is much greater than 3/4 - t := powmod(p, q, n) - -- neither of these cases tells us anything - if t=nm1 then count2Order(1):=count2Order(1)+1 - if not ((t = 1) or t = nm1) then - for j in 1..k-1 repeat - oldt := t - t := mulmod(t, t, n) - (t = 1) => return true - -- we have squared someting not -1 and got 1 - t = nm1 => - rootsMinus1:=union(rootsMinus1,oldt) - count2Order(j+1):=count2Order(j+1)+1 - leave - not (t = nm1) => return true - # rootsMinus1 > 2 => true -- Z/nZ can't be a field - false - -@ -\subsection{prime?} -<>= - prime? n == - n < two => false - n < nextSmallPrime => member?(n, smallPrimes) - not (gcd(n, productSmallPrimes) = 1) => false - n < nextSmallPrimeSquared => true - - nm1 := n-1 - q := (nm1) quo two - for k in 1.. while not odd? q repeat q := q quo two - -- q = (n-1) quo 2**k for largest possible k - - n < JaeschkeLimit => - rabinProvesCompositeSmall(2::I,n,nm1,q,k) => return false - rabinProvesCompositeSmall(3::I,n,nm1,q,k) => return false - - n < PomeranceLimit => - rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false - member?(n,PomeranceList) => return false - true - - rabinProvesCompositeSmall(7::I,n,nm1,q,k) => return false - n < PinchLimit => - rabinProvesCompositeSmall(10::I,n,nm1,q,k) => return false - member?(n,PinchList) => return false - true - - rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false - rabinProvesCompositeSmall(11::I,n,nm1,q,k) => return false - n < PinchLimit2 => - member?(n,PinchList2) => return false - true - - rabinProvesCompositeSmall(13::I,n,nm1,q,k) => return false - rabinProvesCompositeSmall(17::I,n,nm1,q,k) => return false - true - - rootsMinus1:= empty() - count2Order := new(k,0) -- vector of k zeroes - - mn := minIndex smallPrimes - for i in mn+1..mn+10 repeat - rabinProvesComposite(smallPrimes i,n,nm1,q,k) => return false - import IntegerRoots(I) - q > 1 and perfectSquare?(3*n+1) => false - ((n9:=n rem (9::I))=1 or n9 = -1) and perfectSquare?(8*n+1) => false - -- Both previous tests from Damgard & Landrock - currPrime:=smallPrimes(mn+10) - probablySafe:=tenPowerTwenty - while count2Order(k) = 0 or n > probablySafe repeat - currPrime := nextPrime currPrime - probablySafe:=probablySafe*(100::I) - rabinProvesComposite(currPrime,n,nm1,q,k) => return false - true - -@ -\subsection{nextPrime} -<>= - nextPrime n == - -- computes the first prime after n - n < two => two - if odd? n then n := n + two else n := n + 1 - while not prime? n repeat n := n + two - n - -@ -\subsection{prevPrime} -<>= - prevPrime n == - -- computes the first prime before n - n < 3::I => error "no primes less than 2" - n = 3::I => two - if odd? n then n := n - two else n := n - 1 - while not prime? n repeat n := n - two - n - -@ -\section{package IROOT IntegerRoots} -<>= -)abbrev package IROOT IntegerRoots -++ Author: Michael Monagan -++ Date Created: November 1987 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: integer roots -++ Examples: -++ References: -++ Description: The \spadtype{IntegerRoots} package computes square roots and -++ nth roots of integers efficiently. -IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where - NNI ==> NonNegativeInteger - - Exports ==> with - perfectNthPower?: (I, NNI) -> Boolean - ++ \spad{perfectNthPower?(n,r)} returns true if n is an \spad{r}th - ++ power and false otherwise - perfectNthRoot: (I,NNI) -> Union(I,"failed") - ++ \spad{perfectNthRoot(n,r)} returns the \spad{r}th root of n if n - ++ is an \spad{r}th power and returns "failed" otherwise - perfectNthRoot: I -> Record(base:I, exponent:NNI) - ++ \spad{perfectNthRoot(n)} returns \spad{[x,r]}, where \spad{n = x\^r} - ++ and r is the largest integer such that n is a perfect \spad{r}th power - approxNthRoot: (I,NNI) -> I - ++ \spad{approxRoot(n,r)} returns an approximation x - ++ to \spad{n**(1/r)} such that \spad{-1 < x - n**(1/r) < 1} - perfectSquare?: I -> Boolean - ++ \spad{perfectSquare?(n)} returns true if n is a perfect square - ++ and false otherwise - perfectSqrt: I -> Union(I,"failed") - ++ \spad{perfectSqrt(n)} returns the square root of n if n is a - ++ perfect square and returns "failed" otherwise - approxSqrt: I -> I - ++ \spad{approxSqrt(n)} returns an approximation x - ++ to \spad{sqrt(n)} such that \spad{-1 < x - sqrt(n) < 1}. - ++ Compute an approximation s to \spad{sqrt(n)} such that - ++ \spad{-1 < s - sqrt(n) < 1} - ++ A variable precision Newton iteration is used. - ++ The running time is \spad{O( log(n)**2 )}. - - Implementation ==> add - import IntegerPrimesPackage(I) - - resMod144: List I := [0::I,1::I,4::I,9::I,16::I,25::I,36::I,49::I,_ - 52::I,64::I,73::I,81::I,97::I,100::I,112::I,121::I] - two := 2::I - -@ -\subsection{perfectSquare?} -<>= - perfectSquare? a == (perfectSqrt a) case I - -@ -\subsection{perfectNthPower?} -<>= - perfectNthPower?(b, n) == perfectNthRoot(b, n) case I - -@ -\subsection{perfectNthRoot} -<>= - perfectNthRoot n == -- complexity (log log n)**2 (log n)**2 - m:NNI - (n = 1) or zero? n or n = -1 => [n, 1] - e:NNI := 1 - p:NNI := 2 - while p::I <= length(n) + 1 repeat - for m in 0.. while (r := perfectNthRoot(n, p)) case I repeat - n := r::I - e := e * p ** m - p := convert(nextPrime(p::I))@Integer :: NNI - [n, e] - -@ -\subsection{approxNthRoot} -<>= - approxNthRoot(a, n) == -- complexity (log log n) (log n)**2 - zero? n => error "invalid arguments" - (n = 1) => a - n=2 => approxSqrt a - negative? a => - odd? n => - approxNthRoot(-a, n) - 0 - zero? a => 0 - (a = 1) => 1 - -- quick check for case of large n - ((3*n) quo 2)::I >= (l := length a) => two - -- the initial approximation must be >= the root - y := max(two, shift(1, (n::I+l-1) quo (n::I))) - z:I := 1 - n1:= (n-1)::NNI - while z > 0 repeat - x := y - xn:= x**n1 - y := (n1*x*xn+a) quo (n*xn) - z := x-y - x - -@ -\subsection{perfectNthRoot} -<>= - perfectNthRoot(b, n) == - (r := approxNthRoot(b, n)) ** n = b => r - "failed" - -@ -\subsection{perfectSqrt} -<>= - perfectSqrt a == - a < 0 or not member?(a rem (144::I), resMod144) => "failed" - (s := approxSqrt a) * s = a => s - "failed" - -@ -\subsection{approxSqrt} -<>= - approxSqrt a == - a < 1 => 0 - if (n := length a) > (100::I) then - -- variable precision newton iteration - n := n quo (4::I) - s := approxSqrt shift(a, -2 * n) - s := shift(s, n) - return ((1 + s + a quo s) quo two) - -- initial approximation for the root is within a factor of 2 - (new, old) := (shift(1, n quo two), 1) - while new ^= old repeat - (new, old) := ((1 + new + a quo new) quo two, new) - new - -@ -\section{package INTFACT IntegerFactorizationPackage} -<>= -)abbrev package INTFACT IntegerFactorizationPackage -++ This Package contains basic methods for integer factorization. -++ The factor operation employs trial division up to 10,000. It -++ then tests to see if n is a perfect power before using Pollards -++ rho method. Because Pollards method may fail, the result -++ of factor may contain composite factors. We should also employ -++ Lenstra's eliptic curve method. - -IntegerFactorizationPackage(I): Exports == Implementation where - I: IntegerNumberSystem - - B ==> Boolean - FF ==> Factored I - NNI ==> NonNegativeInteger - LMI ==> ListMultiDictionary I - FFE ==> Record(flg:Union("nil","sqfr","irred","prime"), - fctr:I, xpnt:Integer) - - Exports ==> with - factor : I -> FF - ++ factor(n) returns the full factorization of integer n - squareFree : I -> FF - ++ squareFree(n) returns the square free factorization of integer n - BasicMethod : I -> FF - ++ BasicMethod(n) returns the factorization - ++ of integer n by trial division - PollardSmallFactor: I -> Union(I,"failed") - ++ PollardSmallFactor(n) returns a factor - ++ of n or "failed" if no one is found - - Implementation ==> add - import IntegerRoots(I) - - BasicSieve: (I, I) -> FF - -@ -\subsection{squareFree} -<>= - squareFree(n:I):FF == - u:I - if n<0 then (m := -n; u := -1) - else (m := n; u := 1) - (m > 1) and ((v := perfectSqrt m) case I) => - for rec in (l := factorList(sv := squareFree(v::I))) repeat - rec.xpnt := 2 * rec.xpnt - makeFR(u * unit sv, l) - -- avoid using basic sieve when the lim is too big - -- we know the sieve constants up to sqrt(100000000) - lim := 1 + approxSqrt(m) - lim > (100000000::I) => makeFR(u, factorList factor m) - x := BasicSieve(m, lim) - y := - ((m:= unit x) = 1) => factorList x - (v := perfectSqrt m) case I => - concat_!(factorList x, ["sqfr",v,2]$FFE) - concat_!(factorList x, ["sqfr",m,1]$FFE) - makeFR(u, y) - -@ -\subsection{PollardSmallFactor} -This is Brent's\cite{1} optimization of Pollard's\cite{2} rho factoring. -Brent's algorithm is about 24 percent faster than Pollard's. Pollard;s -algorithm has complexity $O(p^{1/2})$ where $p$ is the smallest prime -factor of the composite number $N$. - -Pollard's idea is based on the observation that two numbers $x$ and $y$ -are congruent modulo $p$ with probability 0.5 after $1.177*\sqrt{p}$ numbers -have been randomly chosen. If we try to factor $n$ and $p$ is a factor of -$n$, then -$$1 < gcd(\vert x-y\vert,n) \le n$$ since $p$ divides both $\vert x-y\vert$ -and $n$. - -Given a function $f$ which generates a pseudo-random sequence of numbers -we allow $x$ to walk the sequence in order and $y$ to walk the sequence -at twice the rate. At each cycle we compute $gcd(\vert x-y\vert,n)$. -If this GCD ever equals $n$ then $x=y$ which means that we have walked -"all the way around the pseudo-random cycle" and we terminate with failure. - -This algorithm returns failure on all primes but also fails on some -composite numbers. - -Quoting Brent's back-tracking idea: -\begin{quote} -The best-known algorithm for finding GCDs is the Euclidean algorithm -which takes $O(\log N)$ times as long as one multiplication mod $N$. Pollard -showed that most of the GCD computations in Floyd's algorithm could be -dispensed with. ... The idea is simple: if $P_F$ computes $GCD(z_1,N)$, -$GCD(z_2,N)$,$\ldots$, then we compute -$$q_i=\prod_{j=1}^i{z_j}(\textrm{mod }N)$$ -and only compute $GCD(q_i,N)$ when $i$ is a multiple of $m$, where -$\log N < < m < < N^{1/4}$. Since $q_{i+1}=q_i \times z_{i+1}(\textrm{mod }N)$, -the work required for each GCD computation in algorithm $P_F$ is effectively -reduced to that for a multiplication mod $N$ in the modified algorithm. -The probability of the algorithm failing because $q_i=0$ increases, so it -is best not to choose $m$ too large. This problem can be minimized by -backtracking to the state after the previous GCD computation and setting -$m=1$. -\end{quote} -Brent incorporates back-tracking, omits the random choice of u, and -makes some minor modifications. His algorithm (p192-183) reads: - -\noindent -$y:=x_0; r:=1; q:=1;$ - -\noindent -\hbox{\hskip 0.5cm}{\bf repeat} $x:=y;$ - -\noindent -\hbox{\hskip 1.0cm}{\bf for} $i:=1$ {\bf to} $r$ {\bf do} $y:=f(y); k:=0;$ - -\noindent -\hbox{\hskip 1.0cm}{\bf repeat} $ys:=y;$ - -\noindent -\hbox{\hskip 1.5cm}{\bf for} $i:=1$ {\bf to} $min(m,r-k)$ {\bf do} - -\noindent -\hbox{\hskip 2.0cm}{\bf begin} $y:=f(y); q:=q*\vert x-y\vert mod N$ - -\noindent -\hbox{\hskip 2.0cm}{\bf end}; - -\noindent -\hbox{\hskip 1.5cm}$G:=GCD(q,N); k:=k+m$ - -\noindent -\hbox{\hskip 1.0cm}{\bf until} $(k \ge r)$ {\bf or} $(G > 1); r:=2*r$ - -\noindent -\hbox{\hskip 0.5cm}{\bf until} $G > 1$; - -\noindent -\hbox{\hskip 0.5cm}{\bf if} $G=N$ {\bf then} - -\noindent -\hbox{\hskip 1.0cm}{\bf repeat} $ys:=f(ys); G:=GCD(\vert y-yx\vert,N)$ - -\noindent -\hbox{\hskip 1.0cm}{\bf until} $G > 1$; - -\noindent -\hbox{\hskip 0.5cm}{\bf if} $G=N$ {\bf then} failure {\bf else} success - -Here we use the function -$$(y*y+5::I)~{\textrm rem}~ n$$ -as our pseudo-random sequence with a random starting value for y. - -On possible optimization to explore is to keep a hash table for the -computed values of the function $y_{i+1}:=f(y_i)$ since we effectively -walk the sequence several times. And we walk the sequence in a loop -many times. But because we are generating a very large number of -numbers the array can be a simple array of fixed size that captures -the last n values. So if we make a fixed array F of, say $2^q$ -elements we can store $f(y_i)$ in F[$y_i$ mod $2^q$]. - -One property that this algorithm assumes is that the function used -to generate the numbers has a long, hopefully complete, period. It -is not clear that the recommended function has that property. - -<>= - PollardSmallFactor(n:I):Union(I,"failed") == - -- Use the Brent variation - x0 := random()$I - m := 100::I - y := x0 rem n - r:I := 1 - q:I := 1 - G:I := 1 - until G > 1 repeat - x := y - for i in 1..convert(r)@Integer repeat - y := (y*y+5::I) rem n - k:I := 0 - until (k>=r) or (G>1) repeat - ys := y - for i in 1..convert(min(m,r-k))@Integer repeat - y := (y*y+5::I) rem n - q := q*abs(x-y) rem n - G := gcd(q,n) - k := k+m - r := 2*r - if G=n then - until G>1 repeat - ys := (ys*ys+5::I) rem n - G := gcd(abs(x-ys),n) - G=n => "failed" - G - -@ -\subsection{BasicSieve} -We create a list of prime numbers up to the limit given. The prior code -used a circular list but tests of that list show that on average more -than 50% of those numbers are not prime. Now we call primes to generate -the required prime numbers. Overall this is a small percentage of the -time needed to factor. - -This loop uses three pieces of information -\begin{enumerate} -\item n which is the number we are testing -\item d which is the current prime to test -\item lim which is the upper limit of the primes to test -\end{enumerate} - -We loop d over the list of primes. If the remaining number n is -smaller than the square of d then n must be prime and if it is -not one, we add it to the list of primes. If the remaining number -is larger than the square of d we remove all factors of d, reducing -n each time. Then we add a record of the new factor and its multiplicity, m. -We continue the loop until we run out of primes. - -Annoyingly enough, primes does not return an ordered list so we fix this. - -The sieve works up to a given limit, reducing out the factors that it -finds. If it can find all of the factors than it returns a factored -result where the first element is the unit 1. If there is still a -part of the number unfactored it returns the number and a list of -the factors found and their multiplicity. - -Basically we just loop thru the prime factors checking to see if -they are a component of the number, n. If so, we remove the factor from -the number n (possibly m times) and continue thru the list of primes. -<>= - BasicSieve(n, lim) == - p:=primes(1::I,lim::I)$IntegerPrimesPackage(I) - l:List(I) := append([first p],reverse rest p) - ls := empty()$List(FFE) - for d in l repeat - if n1 then ls := concat_!(ls, ["prime",n,1]$FFE) - return makeFR(1, ls) - for m in 0.. while zero?(n rem d) repeat n := n quo d - if m>0 then ls := concat_!(ls, ["prime",d,convert m]$FFE) - makeFR(n,ls) - -@ -\subsection{BasicMethod} -<>= - BasicMethod n == - u:I - if n<0 then (m := -n; u := -1) - else (m := n; u := 1) - x := BasicSieve(m, 1 + approxSqrt m) - makeFR(u, factorList x) - -@ -\subsection{factor} -The factor function is many orders of magnitude slower than the results -of other systems. A posting on sci.math.symbolic showed that NTL could -factor the final value (t6) in about 11 seconds. Axiom takes about 8 hours. -\begin{verbatim} -a1:=101 -a2:=109 -t1:=a1*a2 -factor t1 - -a3:=21525175387 -t2:=t1*a3 -factor t2 - -a4:=218301576858349 -t3:=t2*a4 -factor t3 - -a5:=13731482973783137 -t4:=t3*a5 -factor t4 - -a6:=23326138687706820109 -t5:=t4*a6 -factor t5 - -a7:=4328240801173188438252813716944518369161 -t6:=t5*a7 -factor t6 -\end{verbatim} -<>= - factor m == - u:I - zero? m => 0 - if negative? m then (n := -m; u := -1) - else (n := m; u := 1) - b := BasicSieve(n, 10000::I) - flb := factorList b - ((n := unit b) = 1) => makeFR(u, flb) - a:LMI := dictionary() -- numbers yet to be factored - b:LMI := dictionary() -- prime factors found - f:LMI := dictionary() -- number which could not be factored - insert_!(n, a) - while not empty? a repeat - n := inspect a; c := count(n, a); remove_!(n, a) - prime?(n)$IntegerPrimesPackage(I) => insert_!(n, b, c) - -- test for a perfect power - (s := perfectNthRoot n).exponent > 1 => - insert_!(s.base, a, c * s.exponent) - -- test for a difference of square - x:=approxSqrt n - if (x**2 - insert_!(x+y,a,c) - insert_!(x-y,a,c) - (d := PollardSmallFactor n) case I => - for m in 0.. while zero?(n rem d) repeat n := n quo d - insert_!(d, a, m * c) - if n > 1 then insert_!(n, a, c) - -- an elliptic curve factorization attempt should be made here - insert_!(n, f, c) - -- insert prime factors found - while not empty? b repeat - n := inspect b; c := count(n, b); remove_!(n, b) - flb := concat_!(flb, ["prime",n,convert c]$FFE) - -- insert non-prime factors found - while not empty? f repeat - n := inspect f; c := count(n, f); remove_!(n, f) - flb := concat_!(flb, ["nil",n,convert c]$FFE) - makeFR(u, flb) - -@ -\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} Brent, Richard, ``An Improved Monte Carlo Factorization -Algorithm'', BIT 20, 1980, pp176-184, -http://web.comlab.ox.ac.uk/oucl/work/richard.brent/pd/rpb051i.pdf -\bibitem{2} Pollard, J.M., ``A Monte Carlo method for factorization'' -BIT Numerical Mathematics 15(3), 1975, pp331-334 -\end{thebibliography} -\end{document} diff --git a/src/algebra/intpm.spad.pamphlet b/src/algebra/intpm.spad.pamphlet deleted file mode 100644 index 49f03db..0000000 --- a/src/algebra/intpm.spad.pamphlet +++ /dev/null @@ -1,377 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intpm.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package INTPM PatternMatchIntegration} -<>= -)abbrev package INTPM PatternMatchIntegration -++ Author: Manuel Bronstein -++ Date Created: 5 May 1992 -++ Date Last Updated: 27 September 1995 -++ Description: -++ \spadtype{PatternMatchIntegration} provides functions that use -++ the pattern matcher to find some indefinite and definite integrals -++ involving special functions and found in the litterature. -PatternMatchIntegration(R, F): Exports == Implementation where - R : Join(OrderedSet, RetractableTo Integer, GcdDomain, - LinearlyExplicitRingOver Integer) - F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory, - FunctionSpace R) - - N ==> NonNegativeInteger - Z ==> Integer - SY ==> Symbol - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - SUP ==> SparseUnivariatePolynomial F - PAT ==> Pattern Z - RES ==> PatternMatchResult(Z, F) - OFE ==> OrderedCompletion F - REC ==> Record(which: Z, exponent: F, coeff: F) - ANS ==> Record(special:F, integrand:F) - NONE ==> 0 - EI ==> 1 - ERF ==> 2 - SI ==> 3 - CI ==> 4 - GAM2 ==> 5 - CI0 ==> 6 - - Exports ==> with - splitConstant: (F, SY) -> Record(const:F, nconst:F) - ++ splitConstant(f, x) returns \spad{[c, g]} such that - ++ \spad{f = c * g} and \spad{c} does not involve \spad{t}. - if R has ConvertibleTo Pattern Integer and - R has PatternMatchable Integer then - if F has LiouvillianFunctionCategory then - pmComplexintegrate: (F, SY) -> Union(ANS, "failed") - ++ pmComplexintegrate(f, x) returns either "failed" or - ++ \spad{[g,h]} such that - ++ \spad{integrate(f,x) = g + integrate(h,x)}. - ++ It only looks for special complex integrals that pmintegrate - ++ does not return. - pmintegrate: (F, SY) -> Union(ANS, "failed") - ++ pmintegrate(f, x) returns either "failed" or \spad{[g,h]} such - ++ that \spad{integrate(f,x) = g + integrate(h,x)}. - if F has SpecialFunctionCategory then - pmintegrate: (F, SY, OFE, OFE) -> Union(F, "failed") - ++ pmintegrate(f, x = a..b) returns the integral of - ++ \spad{f(x)dx} from a to b - ++ if it can be found by the built-in pattern matching rules. - - Implementation ==> add - import PatternMatch(Z, F, F) - import ElementaryFunctionSign(R, F) - import FunctionSpaceAssertions(R, F) - import TrigonometricManipulations(R, F) - import FunctionSpaceAttachPredicates(R, F, F) - - mkalist : RES -> AssociationList(SY, F) - - pm := new()$SY - pmw := new pm - pmm := new pm - pms := new pm - pmc := new pm - pma := new pm - pmb := new pm - - c := optional(pmc::F) - w := suchThat(optional(pmw::F), empty? variables #1) - s := suchThat(optional(pms::F), empty? variables #1 and real? #1) - m := suchThat(optional(pmm::F), - (retractIfCan(#1)@Union(Z,"failed") case Z) and #1 >= 0) - - spi := sqrt(pi()$F) - - half := 1::F / 2::F - - mkalist res == construct destruct res - - splitConstant(f, x) == - not member?(x, variables f) => [f, 1] - (retractIfCan(f)@Union(K, "failed")) case K => [1, f] - (u := isTimes f) case List(F) => - cc := nc := 1$F - for g in u::List(F) repeat - rec := splitConstant(g, x) - cc := cc * rec.const - nc := nc * rec.nconst - [cc, nc] - (u := isPlus f) case List(F) => - rec := splitConstant(first(u::List(F)), x) - cc := rec.const - nc := rec.nconst - for g in rest(u::List(F)) repeat - rec := splitConstant(g, x) - if rec.nconst = nc then cc := cc + rec.const - else if rec.nconst = -nc then cc := cc - rec.const - else return [1, f] - [cc, nc] - if (v := isPower f) case Record(val:F, exponent:Z) then - vv := v::Record(val:F, exponent:Z) - (vv.exponent ^= 1) => - rec := splitConstant(vv.val, x) - return [rec.const ** vv.exponent, rec.nconst ** vv.exponent] - error "splitConstant: should not happen" - - if R has ConvertibleTo Pattern Integer and - R has PatternMatchable Integer then - if F has LiouvillianFunctionCategory then - import ElementaryFunctionSign(R, F) - - insqrt : F -> F - matchei : (F, SY) -> REC - matcherfei : (F, SY, Boolean) -> REC - matchsici : (F, SY) -> REC - matchli : (F, SY) -> List F - matchli0 : (F, K, SY) -> List F - matchdilog : (F, SY) -> List F - matchdilog0: (F, K, SY, P, F) -> List F - goodlilog? : (K, P) -> Boolean - gooddilog? : (K, P, P) -> Boolean - --- goodlilog?(k, p) == is?(k, "log"::SY) and one? minimumDegree(p, k) - goodlilog?(k, p) == is?(k, "log"::SY) and (minimumDegree(p, k) = 1) - - gooddilog?(k, p, q) == --- is?(k, "log"::SY) and one? degree(p, k) and zero? degree(q, k) - is?(k, "log"::SY) and (degree(p, k) = 1) and zero? degree(q, k) - --- matches the integral to a result of the form d * erf(u) or d * ei(u) --- returns [case, u, d] - matcherfei(f, x, comp?) == - res0 := new()$RES - pat := c * exp(pma::F) - failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - comp? => [NONE, 0,0] - matchei(f,x) - l := mkalist res - da := differentiate(a := l.pma, x) - d := a * (cc := l.pmc) / da - zero? differentiate(d, x) => [EI, a, d] - comp? or (((u := sign a) case Z) and (u::Z) < 0) => - d := cc * (sa := insqrt(- a)) / da - zero? differentiate(d, x) => [ERF, sa, - d * spi] - [NONE, 0, 0] - [NONE, 0, 0] - --- matches the integral to a result of the form d * ei(k * log u) --- returns [case, k * log u, d] - matchei(f, x) == - res0 := new()$RES - a := pma::F - pat := c * a**w / log a - failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - [NONE, 0, 0] - l := mkalist res - da := differentiate(a := l.pma, x) - d := (cc := l.pmc) / da - zero? differentiate(d, x) => [EI, (1 + l.pmw) * log a, d] - [NONE, 0, 0] - --- matches the integral to a result of the form d * dilog(u) + int(v), --- returns [u,d,v] or [] - matchdilog(f, x) == - n := numer f - df := (d := denom f)::F - for k in select_!(gooddilog?(#1, n, d), variables n)$List(K) repeat - not empty?(l := matchdilog0(f, k, x, n, df)) => return l - empty() - --- matches the integral to a result of the form d * dilog(a) + int(v) --- where k = log(a) --- returns [a,d,v] or [] - matchdilog0(f, k, x, p, q) == - zero?(da := differentiate(a := first argument k, x)) => empty() - a1 := 1 - a - d := coefficient(univariate(p, k), 1)::F * a1 / (q * da) - zero? differentiate(d, x) => [a, d, f - d * da * (k::F) / a1] - empty() - --- matches the integral to a result of the form d * li(u) + int(v), --- returns [u,d,v] or [] - matchli(f, x) == - d := denom f - for k in select_!(goodlilog?(#1, d), variables d)$List(K) repeat - not empty?(l := matchli0(f, k, x)) => return l - empty() - --- matches the integral to a result of the form d * li(a) + int(v) --- where k = log(a) --- returns [a,d,v] or [] - matchli0(f, k, x) == - g := (lg := k::F) * f - zero?(da := differentiate(a := first argument k, x)) => empty() - zero? differentiate(d := g / da, x) => [a, d, 0] - ug := univariate(g, k) - (u:=retractIfCan(ug)@Union(SUP,"failed")) case "failed" => empty() - degree(p := u::SUP) > 1 => empty() - zero? differentiate(d := coefficient(p, 0) / da, x) => - [a, d, leadingCoefficient p] - empty() - --- matches the integral to a result of the form d * Si(u) or d * Ci(u) --- returns [case, u, d] - matchsici(f, x) == - res0 := new()$RES - b := pmb::F - t := tan(a := pma::F) - patsi := c * t / (patden := b + b * t**2) - patci := (c - c * t**2) / patden - patci0 := c / patden - ci0?:Boolean - (ci? := failed?(res := patternMatch(f, convert(patsi)@PAT, res0))) - and (ci0?:=failed?(res:=patternMatch(f,convert(patci)@PAT,res0))) - and failed?(res := patternMatch(f,convert(patci0)@PAT,res0)) => - [NONE, 0, 0] - l := mkalist res - (b := l.pmb) ^= 2 * (a := l.pma) => [NONE, 0, 0] - db := differentiate(b, x) - d := (cc := l.pmc) / db - zero? differentiate(d, x) => - ci? => - ci0? => [CI0, b, d / (2::F)] - [CI, b, d] - [SI, b, d / (2::F)] - [NONE, 0, 0] - --- returns a simplified sqrt(y) - insqrt y == - rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F) --- one?(rec.exponent) => rec.coef * rec.radicand - ((rec.exponent) = 1) => rec.coef * rec.radicand - rec.exponent ^=2 => error "insqrt: hould not happen" - rec.coef * sqrt(rec.radicand) - - pmintegrate(f, x) == - (rc := splitConstant(f, x)).const ^= 1 => - (u := pmintegrate(rc.nconst, x)) case "failed" => "failed" - rec := u::ANS - [rc.const * rec.special, rc.const * rec.integrand] - not empty?(l := matchli(f, x)) => [second l * li first l, third l] - not empty?(l := matchdilog(f, x)) => - [second l * dilog first l, third l] - cse := (rec := matcherfei(f, x, false)).which - cse = EI => [rec.coeff * Ei(rec.exponent), 0] - cse = ERF => [rec.coeff * erf(rec.exponent), 0] - cse := (rec := matchsici(f, x)).which - cse = SI => [rec.coeff * Si(rec.exponent), 0] - cse = CI => [rec.coeff * Ci(rec.exponent), 0] - cse = CI0 => [rec.coeff * Ci(rec.exponent) - + rec.coeff * log(rec.exponent), 0] - "failed" - - pmComplexintegrate(f, x) == - (rc := splitConstant(f, x)).const ^= 1 => - (u := pmintegrate(rc.nconst, x)) case "failed" => "failed" - rec := u::ANS - [rc.const * rec.special, rc.const * rec.integrand] - cse := (rec := matcherfei(f, x, true)).which - cse = ERF => [rec.coeff * erf(rec.exponent), 0] - "failed" - - if F has SpecialFunctionCategory then - match1 : (F, SY, F, F) -> List F - formula1 : (F, SY, F, F) -> Union(F, "failed") - --- tries only formula (1) of the Geddes & al, AAECC 1 (1990) paper - formula1(f, x, t, cc) == - empty?(l := match1(f, x, t, cc)) => "failed" - mw := first l - zero?(ms := third l) or ((sgs := sign ms) case "failed")=> "failed" - ((sgz := sign(z := (mw + 1) / ms)) case "failed") or (sgz::Z < 0) - => "failed" - mmi := retract(mm := second l)@Z - sgs * (last l) * ms**(- mmi - 1) * - eval(differentiate(Gamma(x::F), x, mmi::N), [kernel(x)@K], [z]) - --- returns [w, m, s, c] or [] --- matches only formula (1) of the Geddes & al, AAECC 1 (1990) paper - match1(f, x, t, cc) == - res0 := new()$RES - pat := cc * log(t)**m * exp(-t**s) - not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - l := mkalist res - [0, l.pmm, l.pms, l.pmc] - pat := cc * t**w * exp(-t**s) - not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - l := mkalist res - [l.pmw, 0, l.pms, l.pmc] - pat := cc / t**w * exp(-t**s) - not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - l := mkalist res - [- l.pmw, 0, l.pms, l.pmc] - pat := cc * t**w * log(t)**m * exp(-t**s) - not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - l := mkalist res - [l.pmw, l.pmm, l.pms, l.pmc] - pat := cc / t**w * log(t)**m * exp(-t**s) - not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) => - l := mkalist res - [- l.pmw, l.pmm, l.pms, l.pmc] - empty() - - pmintegrate(f, x, a, b) == --- zero? a and one? whatInfinity b => - zero? a and ((whatInfinity b) = 1) => - formula1(f, x, constant(x::F), suchThat(c, freeOf?(#1, x))) - "failed" - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- SPAD files for the integration world should be compiled in the --- following order: --- --- intaux rderf intrf curve curvepkg divisor pfo --- intalg intaf efstruc rdeef INTPM intef irexpand integrat - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/intrf.spad.pamphlet b/src/algebra/intrf.spad.pamphlet deleted file mode 100644 index 17f2116..0000000 --- a/src/algebra/intrf.spad.pamphlet +++ /dev/null @@ -1,911 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra intrf.spad} -\author{Barry Trager, Renaud Rioboo, Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package SUBRESP SubResultantPackage} -<>= -)abbrev package SUBRESP SubResultantPackage -++ Subresultants -++ Author: Barry Trager, Renaud Rioboo -++ Date Created: 1987 -++ Date Last Updated: August 2000 -++ Description: -++ This package computes the subresultants of two polynomials which is needed -++ for the `Lazard Rioboo' enhancement to Tragers integrations formula -++ For efficiency reasons this has been rewritten to call Lionel Ducos -++ package which is currently the best one. -++ -SubResultantPackage(R, UP): Exports == Implementation where - R : IntegralDomain - UP: UnivariatePolynomialCategory R - - Z ==> Integer - N ==> NonNegativeInteger - - Exports ==> with - subresultantVector: (UP, UP) -> PrimitiveArray UP - ++ subresultantVector(p, q) returns \spad{[p0,...,pn]} - ++ where pi is the i-th subresultant of p and q. - ++ In particular, \spad{p0 = resultant(p, q)}. - if R has EuclideanDomain then - primitivePart : (UP, R) -> UP - ++ primitivePart(p, q) reduces the coefficient of p - ++ modulo q, takes the primitive part of the result, - ++ and ensures that the leading coefficient of that - ++ result is monic. - - Implementation ==> add - - Lionel ==> PseudoRemainderSequence(R,UP) - - if R has EuclideanDomain then - primitivePart(p, q) == - rec := extendedEuclidean(leadingCoefficient p, q, - 1)::Record(coef1:R, coef2:R) - unitCanonical primitivePart map((rec.coef1 * #1) rem q, p) - - subresultantVector(p1, p2) == - F : UP -- auxiliary stuff ! - res : PrimitiveArray(UP) := new(2+max(degree(p1),degree(p2)), 0) - -- - -- kind of stupid interface to Lionel's Package !!!!!!!!!!!! - -- might have been wiser to rewrite the loop ... - -- But I'm too lazy. [rr] - -- - l := chainSubResultants(p1,p2)$Lionel - -- - -- this returns the chain of non null subresultants ! - -- we must rebuild subresultants from this. - -- we really hope Lionel Ducos minded what he wrote - -- since we are fully blind ! - -- - null l => - -- Hum it seems that Lionel returns [] when min(|p1|,|p2|) = 0 - zero?(degree(p1)) => - res.degree(p2) := p2 - if degree(p2) > 0 - then - res.((degree(p2)-1)::NonNegativeInteger) := p1 - res.0 := (leadingCoefficient(p1)**(degree p2)) :: UP - else - -- both are of degree 0 the resultant is 1 according to Loos - res.0 := 1 - res - zero?(degree(p2)) => - if degree(p1) > 0 - then - res.((degree(p1)-1)::NonNegativeInteger) := p2 - res.0 := (leadingCoefficient(p2)**(degree p1)) :: UP - else - -- both are of degree 0 the resultant is 1 according to Loos - res.0 := 1 - res - error "SUBRESP: strange Subresultant chain from PRS" - Sn := first(l) - -- - -- as of Loos definitions last subresultant should not be defective - -- - l := rest(l) - n := degree(Sn) - F := Sn - null l => error "SUBRESP: strange Subresultant chain from PRS" - zero? Sn => error "SUBRESP: strange Subresultant chain from PRS" - while (l ^= []) repeat - res.(n) := Sn - F := first(l) - l := rest(l) - -- F is potentially defective - if degree(F) = n - then - -- - -- F is defective - -- - null l => error "SUBRESP: strange Subresultant chain from PRS" - Sn := first(l) - l := rest(l) - n := degree(Sn) - res.((n-1)::NonNegativeInteger) := F - else - -- - -- F is non defective - -- - degree(F) < n => error "strange result !" - Sn := F - n := degree(Sn) - -- - -- Lionel forgets about p1 if |p1| > |p2| - -- forgets about p2 if |p2| > |p1| - -- but he reminds p2 if |p1| = |p2| - -- a glance at Loos should correct this ! - -- - res.n := Sn - -- - -- Loos definition - -- - if degree(p1) = degree(p2) - then - res.((degree p1)+1) := p1 - else - if degree(p1) > degree(p2) - then - res.(degree p1) := p1 - else - res.(degree p2) := p2 - res - -@ -\section{package MONOTOOL MonomialExtensionTools} -<>= -)abbrev package MONOTOOL MonomialExtensionTools -++ Tools for handling monomial extensions -++ Author: Manuel Bronstein -++ Date Created: 18 August 1992 -++ Date Last Updated: 3 June 1993 -++ Description: Tools for handling monomial extensions. -MonomialExtensionTools(F, UP): Exports == Implementation where - F : Field - UP: UnivariatePolynomialCategory F - - RF ==> Fraction UP - FR ==> Factored UP - - Exports ==> with - split : (UP, UP -> UP) -> Record(normal:UP, special:UP) - ++ split(p, D) returns \spad{[n,s]} such that \spad{p = n s}, - ++ all the squarefree factors of n are normal w.r.t. D, - ++ and s is special w.r.t. D. - ++ D is the derivation to use. - splitSquarefree: (UP, UP -> UP) -> Record(normal:FR, special:FR) - ++ splitSquarefree(p, D) returns - ++ \spad{[n_1 n_2\^2 ... n_m\^m, s_1 s_2\^2 ... s_q\^q]} such that - ++ \spad{p = n_1 n_2\^2 ... n_m\^m s_1 s_2\^2 ... s_q\^q}, each - ++ \spad{n_i} is normal w.r.t. D and each \spad{s_i} is special - ++ w.r.t D. - ++ D is the derivation to use. - normalDenom: (RF, UP -> UP) -> UP - ++ normalDenom(f, D) returns the product of all the normal factors - ++ of \spad{denom(f)}. - ++ D is the derivation to use. - decompose : (RF, UP -> UP) -> Record(poly:UP, normal:RF, special:RF) - ++ decompose(f, D) returns \spad{[p,n,s]} such that \spad{f = p+n+s}, - ++ all the squarefree factors of \spad{denom(n)} are normal w.r.t. D, - ++ \spad{denom(s)} is special w.r.t. D, - ++ and n and s are proper fractions (no pole at infinity). - ++ D is the derivation to use. - - Implementation ==> add - normalDenom(f, derivation) == split(denom f, derivation).normal - - split(p, derivation) == - pbar := (gcd(p, derivation p) exquo gcd(p, differentiate p))::UP - zero? degree pbar => [p, 1] - rec := split((p exquo pbar)::UP, derivation) - [rec.normal, pbar * rec.special] - - splitSquarefree(p, derivation) == - s:Factored(UP) := 1 - n := s - q := squareFree p - for rec in factors q repeat - r := rec.factor - g := gcd(r, derivation r) - if not ground? g then s := s * sqfrFactor(g, rec.exponent) - h := (r exquo g)::UP - if not ground? h then n := n * sqfrFactor(h, rec.exponent) - [n, unit(q) * s] - - decompose(f, derivation) == - qr := divide(numer f, denom f) --- rec.normal * rec.special = denom f - rec := split(denom f, derivation) --- eeu.coef1 * rec.normal + eeu.coef2 * rec.special = qr.remainder --- and degree(eeu.coef1) < degree(rec.special) --- and degree(eeu.coef2) < degree(rec.normal) --- qr.remainder/denom(f) = eeu.coef1 / rec.special + eeu.coef2 / rec.normal - eeu := extendedEuclidean(rec.normal, rec.special, - qr.remainder)::Record(coef1:UP, coef2:UP) - [qr.quotient, eeu.coef2 / rec.normal, eeu.coef1 / rec.special] - -@ -\section{package INTHERTR TranscendentalHermiteIntegration} -<>= -)abbrev package INTHERTR TranscendentalHermiteIntegration -++ Hermite integration, transcendental case -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 12 August 1992 -++ Description: Hermite integration, transcendental case. -TranscendentalHermiteIntegration(F, UP): Exports == Implementation where - F : Field - UP : UnivariatePolynomialCategory F - - N ==> NonNegativeInteger - RF ==> Fraction UP - REC ==> Record(answer:RF, lognum:UP, logden:UP) - HER ==> Record(answer:RF, logpart:RF, specpart:RF, polypart:UP) - - Exports ==> with - HermiteIntegrate: (RF, UP -> UP) -> HER - ++ HermiteIntegrate(f, D) returns \spad{[g, h, s, p]} - ++ such that \spad{f = Dg + h + s + p}, - ++ h has a squarefree denominator normal w.r.t. D, - ++ and all the squarefree factors of the denominator of s are - ++ special w.r.t. D. Furthermore, h and s have no polynomial parts. - ++ D is the derivation to use on \spadtype{UP}. - - Implementation ==> add - import MonomialExtensionTools(F, UP) - - normalHermiteIntegrate: (RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP) - - HermiteIntegrate(f, derivation) == - rec := decompose(f, derivation) - hi := normalHermiteIntegrate(rec.normal, derivation) - qr := divide(hi.lognum, hi.logden) - [hi.answer, qr.remainder / hi.logden, rec.special, qr.quotient + rec.poly] - --- Hermite Reduction on f, every squarefree factor of denom(f) is normal wrt D --- this is really a "parallel" Hermite reduction, in the sense that --- every multiple factor of the denominator gets reduced at each pass --- so if the denominator is P1 P2**2 ... Pn**n, this requires O(n) --- reduction steps instead of O(n**2), like Mack's algorithm --- (D.Mack, On Rational Integration, Univ. of Utah C.S. Tech.Rep. UCP-38,1975) --- returns [g, b, d] s.t. f = g' + b/d and d is squarefree and normal wrt D - normalHermiteIntegrate(f, derivation) == - a := numer f - q := denom f - p:UP := 0 - mult:UP := 1 - qhat := (q exquo (g0 := g := gcd(q, differentiate q)))::UP - while(degree(qbar := g) > 0) repeat - qbarhat := (qbar exquo (g := gcd(qbar, differentiate qbar)))::UP - qtil:= - ((qhat * (derivation qbar)) exquo qbar)::UP - bc := - extendedEuclidean(qtil, qbarhat, a)::Record(coef1:UP, coef2:UP) - qr := divide(bc.coef1, qbarhat) - a := bc.coef2 + qtil * qr.quotient - derivation(qr.remainder) - * (qhat exquo qbarhat)::UP - p := p + mult * qr.remainder - mult:= mult * qbarhat - [p / g0, a, qhat] - -@ -\section{package INTTR TranscendentalIntegration} -<>= -)abbrev package INTTR TranscendentalIntegration -++ Risch algorithm, transcendental case -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 24 October 1995 -++ Description: -++ This package provides functions for the transcendental -++ case of the Risch algorithm. --- Internally used by the integrator -TranscendentalIntegration(F, UP): Exports == Implementation where - F : Field - UP : UnivariatePolynomialCategory F - - N ==> NonNegativeInteger - Z ==> Integer - Q ==> Fraction Z - GP ==> LaurentPolynomial(F, UP) - UP2 ==> SparseUnivariatePolynomial UP - RF ==> Fraction UP - UPR ==> SparseUnivariatePolynomial RF - IR ==> IntegrationResult RF - LOG ==> Record(scalar:Q, coeff:UPR, logand:UPR) - LLG ==> List Record(coeff:RF, logand:RF) - NE ==> Record(integrand:RF, intvar:RF) - NL ==> Record(mainpart:RF, limitedlogs:LLG) - UPF ==> Record(answer:UP, a0:F) - RFF ==> Record(answer:RF, a0:F) - IRF ==> Record(answer:IR, a0:F) - NLF ==> Record(answer:NL, a0:F) - GPF ==> Record(answer:GP, a0:F) - UPUP==> Record(elem:UP, notelem:UP) - GPGP==> Record(elem:GP, notelem:GP) - RFRF==> Record(elem:RF, notelem:RF) - FF ==> Record(ratpart:F, coeff:F) - FFR ==> Record(ratpart:RF, coeff:RF) - UF ==> Union(FF, "failed") - UF2 ==> Union(List F, "failed") - REC ==> Record(ir:IR, specpart:RF, polypart:UP) - PSOL==> Record(ans:F, right:F, sol?:Boolean) - FAIL==> error "Sorry - cannot handle that integrand yet" - - Exports ==> with - primintegrate : (RF, UP -> UP, F -> UF) -> IRF - ++ primintegrate(f, ', foo) returns \spad{[g, a]} such that - ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in UP. - ++ Argument foo is an extended integration function on F. - expintegrate : (RF, UP -> UP, (Z, F) -> PSOL) -> IRF - ++ expintegrate(f, ', foo) returns \spad{[g, a]} such that - ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in F; - ++ Argument foo is a Risch differential equation solver on F; - tanintegrate : (RF, UP -> UP, (Z, F, F) -> UF2) -> IRF - ++ tanintegrate(f, ', foo) returns \spad{[g, a]} such that - ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in F; - ++ Argument foo is a Risch differential system solver on F; - primextendedint:(RF, UP -> UP, F->UF, RF) -> Union(RFF,FFR,"failed") - ++ primextendedint(f, ', foo, g) returns either \spad{[v, c]} such that - ++ \spad{f = v' + c g} and \spad{c' = 0}, or \spad{[v, a]} such that - ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in UP. - ++ Returns "failed" if neither case can hold. - ++ Argument foo is an extended integration function on F. - expextendedint:(RF,UP->UP,(Z,F)->PSOL, RF) -> Union(RFF,FFR,"failed") - ++ expextendedint(f, ', foo, g) returns either \spad{[v, c]} such that - ++ \spad{f = v' + c g} and \spad{c' = 0}, or \spad{[v, a]} such that - ++ \spad{f = g' + a}, and \spad{a = 0} or \spad{a} has no integral in F. - ++ Returns "failed" if neither case can hold. - ++ Argument foo is a Risch differential equation function on F. - primlimitedint:(RF, UP -> UP, F->UF, List RF) -> Union(NLF,"failed") - ++ primlimitedint(f, ', foo, [u1,...,un]) returns - ++ \spad{[v, [c1,...,cn], a]} such that \spad{ci' = 0}, - ++ \spad{f = v' + a + reduce(+,[ci * ui'/ui])}, - ++ and \spad{a = 0} or \spad{a} has no integral in UP. - ++ Returns "failed" if no such v, ci, a exist. - ++ Argument foo is an extended integration function on F. - explimitedint:(RF, UP->UP,(Z,F)->PSOL,List RF) -> Union(NLF,"failed") - ++ explimitedint(f, ', foo, [u1,...,un]) returns - ++ \spad{[v, [c1,...,cn], a]} such that \spad{ci' = 0}, - ++ \spad{f = v' + a + reduce(+,[ci * ui'/ui])}, - ++ and \spad{a = 0} or \spad{a} has no integral in F. - ++ Returns "failed" if no such v, ci, a exist. - ++ Argument foo is a Risch differential equation function on F. - primextintfrac : (RF, UP -> UP, RF) -> Union(FFR, "failed") - ++ primextintfrac(f, ', g) returns \spad{[v, c]} such that - ++ \spad{f = v' + c g} and \spad{c' = 0}. - ++ Error: if \spad{degree numer f >= degree denom f} or - ++ if \spad{degree numer g >= degree denom g} or - ++ if \spad{denom g} is not squarefree. - primlimintfrac : (RF, UP -> UP, List RF) -> Union(NL, "failed") - ++ primlimintfrac(f, ', [u1,...,un]) returns \spad{[v, [c1,...,cn]]} - ++ such that \spad{ci' = 0} and \spad{f = v' + +/[ci * ui'/ui]}. - ++ Error: if \spad{degree numer f >= degree denom f}. - primintfldpoly : (UP, F -> UF, F) -> Union(UP, "failed") - ++ primintfldpoly(p, ', t') returns q such that \spad{p' = q} or - ++ "failed" if no such q exists. Argument \spad{t'} is the derivative of - ++ the primitive generating the extension. - expintfldpoly : (GP, (Z, F) -> PSOL) -> Union(GP, "failed") - ++ expintfldpoly(p, foo) returns q such that \spad{p' = q} or - ++ "failed" if no such q exists. - ++ Argument foo is a Risch differential equation function on F. - monomialIntegrate : (RF, UP -> UP) -> REC - ++ monomialIntegrate(f, ') returns \spad{[ir, s, p]} such that - ++ \spad{f = ir' + s + p} and all the squarefree factors of the - ++ denominator of s are special w.r.t the derivation '. - monomialIntPoly : (UP, UP -> UP) -> Record(answer:UP, polypart:UP) - ++ monomialIntPoly(p, ') returns [q, r] such that - ++ \spad{p = q' + r} and \spad{degree(r) < degree(t')}. - ++ Error if \spad{degree(t') < 2}. - - Implementation ==> add - import SubResultantPackage(UP, UP2) - import MonomialExtensionTools(F, UP) - import TranscendentalHermiteIntegration(F, UP) - import CommuteUnivariatePolynomialCategory(F, UP, UP2) - - primintegratepoly : (UP, F -> UF, F) -> Union(UPF, UPUP) - expintegratepoly : (GP, (Z, F) -> PSOL) -> Union(GPF, GPGP) - expextintfrac : (RF, UP -> UP, RF) -> Union(FFR, "failed") - explimintfrac : (RF, UP -> UP, List RF) -> Union(NL, "failed") - limitedLogs : (RF, RF -> RF, List RF) -> Union(LLG, "failed") - logprmderiv : (RF, UP -> UP) -> RF - logexpderiv : (RF, UP -> UP, F) -> RF - tanintegratespecial: (RF, RF -> RF, (Z, F, F) -> UF2) -> Union(RFF, RFRF) - UP2UP2 : UP -> UP2 - UP2UPR : UP -> UPR - UP22UPR : UP2 -> UPR - notelementary : REC -> IR - kappa : (UP, UP -> UP) -> UP - - dummy:RF := 0 - - logprmderiv(f, derivation) == differentiate(f, derivation) / f - - UP2UP2 p == - map(#1::UP, p)$UnivariatePolynomialCategoryFunctions2(F, UP, UP, UP2) - - UP2UPR p == - map(#1::UP::RF, p)$UnivariatePolynomialCategoryFunctions2(F, UP, RF, UPR) - - UP22UPR p == map(#1::RF, p)$SparseUnivariatePolynomialFunctions2(UP, RF) - --- given p in k[z] and a derivation on k[t] returns the coefficient lifting --- in k[z] of the restriction of D to k. - kappa(p, derivation) == - ans:UP := 0 - while p ^= 0 repeat - ans := ans + derivation(leadingCoefficient(p)::UP)*monomial(1,degree p) - p := reductum p - ans - --- works in any monomial extension - monomialIntegrate(f, derivation) == - zero? f => [0, 0, 0] - r := HermiteIntegrate(f, derivation) - zero?(inum := numer(r.logpart)) => [r.answer::IR, r.specpart, r.polypart] - iden := denom(r.logpart) - x := monomial(1, 1)$UP - resultvec := subresultantVector(UP2UP2 inum - - (x::UP2) * UP2UP2 derivation iden, UP2UP2 iden) - respoly := primitivePart leadingCoefficient resultvec 0 - rec := splitSquarefree(respoly, kappa(#1, derivation)) - logs:List(LOG) := [ - [1, UP2UPR(term.factor), - UP22UPR swap primitivePart(resultvec(term.exponent),term.factor)] - for term in factors(rec.special)] - dlog := --- one? derivation x => r.logpart - ((derivation x) = 1) => r.logpart - differentiate(mkAnswer(0, logs, empty()), - differentiate(#1, derivation)) - (u := retractIfCan(p := r.logpart - dlog)@Union(UP, "failed")) case UP => - [mkAnswer(r.answer, logs, empty), r.specpart, r.polypart + u::UP] - [mkAnswer(r.answer, logs, [[p, dummy]]), r.specpart, r.polypart] - --- returns [q, r] such that p = q' + r and degree(r) < degree(dt) --- must have degree(derivation t) >= 2 - monomialIntPoly(p, derivation) == - (d := degree(dt := derivation monomial(1,1))::Z) < 2 => - error "monomIntPoly: monomial must have degree 2 or more" - l := leadingCoefficient dt - ans:UP := 0 - while (n := 1 + degree(p)::Z - d) > 0 repeat - ans := ans + (term := monomial(leadingCoefficient(p) / (n * l), n::N)) - p := p - derivation term -- degree(p) must drop here - [ans, p] - --- returns either --- (q in GP, a in F) st p = q' + a, and a=0 or a has no integral in F --- or (q in GP, r in GP) st p = q' + r, and r has no integral elem/UP - expintegratepoly(p, FRDE) == - coef0:F := 0 - notelm := answr := 0$GP - while p ^= 0 repeat - ans1 := FRDE(n := degree p, a := leadingCoefficient p) - answr := answr + monomial(ans1.ans, n) - if ~ans1.sol? then -- Risch d.e. has no complete solution - missing := a - ans1.right - if zero? n then coef0 := missing - else notelm := notelm + monomial(missing, n) - p := reductum p - zero? notelm => [answr, coef0] - [answr, notelm] - --- f is either 0 or of the form p(t)/(1 + t**2)**n --- returns either --- (q in RF, a in F) st f = q' + a, and a=0 or a has no integral in F --- or (q in RF, r in RF) st f = q' + r, and r has no integral elem/UP - tanintegratespecial(f, derivation, FRDE) == - ans:RF := 0 - p := monomial(1, 2)$UP + 1 - while (n := degree(denom f) quo 2) ^= 0 repeat - r := numer(f) rem p - a := coefficient(r, 1) - b := coefficient(r, 0) - (u := FRDE(n, a, b)) case "failed" => return [ans, f] - l := u::List(F) - term:RF := (monomial(first l, 1)$UP + second(l)::UP) / denom f - ans := ans + term - f := f - derivation term -- the order of the pole at 1+t^2 drops - zero?(c0 := retract(retract(f)@UP)@F) or - (u := FRDE(0, c0, 0)) case "failed" => [ans, c0] - [ans + first(u::List(F))::UP::RF, 0::F] - --- returns (v in RF, c in RF) s.t. f = v' + cg, and c' = 0, or "failed" --- g must have a squarefree denominator (always possible) --- g must have no polynomial part and no pole above t = 0 --- f must have no polynomial part and no pole above t = 0 - expextintfrac(f, derivation, g) == - zero? f => [0, 0] - degree numer f >= degree denom f => error "Not a proper fraction" - order(denom f,monomial(1,1)) ^= 0 => error "Not integral at t = 0" - r := HermiteIntegrate(f, derivation) - zero? g => - r.logpart ^= 0 => "failed" - [r.answer, 0] - degree numer g >= degree denom g => error "Not a proper fraction" - order(denom g,monomial(1,1)) ^= 0 => error "Not integral at t = 0" - differentiate(c := r.logpart / g, derivation) ^= 0 => "failed" - [r.answer, c] - - limitedLogs(f, logderiv, lu) == - zero? f => empty() - empty? lu => "failed" - empty? rest lu => - logderiv(c0 := f / logderiv(u0 := first lu)) ^= 0 => "failed" - [[c0, u0]] - num := numer f - den := denom f - l1:List Record(logand2:RF, contrib:UP) := --- [[u, numer v] for u in lu | one? denom(v := den * logderiv u)] - [[u, numer v] for u in lu | (denom(v := den * logderiv u) = 1)] - rows := max(degree den, - 1 + reduce(max, [degree(u.contrib) for u in l1], 0)$List(N)) - m:Matrix(F) := zero(rows, cols := 1 + #l1) - for i in 0..rows-1 repeat - for pp in l1 for j in minColIndex m .. maxColIndex m - 1 repeat - qsetelt_!(m, i + minRowIndex m, j, coefficient(pp.contrib, i)) - qsetelt_!(m,i+minRowIndex m, maxColIndex m, coefficient(num, i)) - m := rowEchelon m - ans := empty()$LLG - for i in minRowIndex m .. maxRowIndex m | - qelt(m, i, maxColIndex m) ^= 0 repeat - OK := false - for pp in l1 for j in minColIndex m .. maxColIndex m - 1 - while not OK repeat - if qelt(m, i, j) ^= 0 then - OK := true - c := qelt(m, i, maxColIndex m) / qelt(m, i, j) - logderiv(c0 := c::UP::RF) ^= 0 => return "failed" - ans := concat([c0, pp.logand2], ans) - not OK => return "failed" - ans - --- returns q in UP s.t. p = q', or "failed" - primintfldpoly(p, extendedint, t') == - (u := primintegratepoly(p, extendedint, t')) case UPUP => "failed" - u.a0 ^= 0 => "failed" - u.answer - --- returns q in GP st p = q', or "failed" - expintfldpoly(p, FRDE) == - (u := expintegratepoly(p, FRDE)) case GPGP => "failed" - u.a0 ^= 0 => "failed" - u.answer - --- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0, --- and f = v' + a + +/[ci * ui'/ui] --- and a = 0 or a has no integral in UP - primlimitedint(f, derivation, extendedint, lu) == - qr := divide(numer f, denom f) - (u1 := primlimintfrac(qr.remainder / (denom f), derivation, lu)) - case "failed" => "failed" - (u2 := primintegratepoly(qr.quotient, extendedint, - retract derivation monomial(1, 1))) case UPUP => "failed" - [[u1.mainpart + u2.answer::RF, u1.limitedlogs], u2.a0] - --- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0, --- and f = v' + a + +/[ci * ui'/ui] --- and a = 0 or a has no integral in F - explimitedint(f, derivation, FRDE, lu) == - qr := separate(f)$GP - (u1 := explimintfrac(qr.fracPart,derivation, lu)) case "failed" => - "failed" - (u2 := expintegratepoly(qr.polyPart, FRDE)) case GPGP => "failed" - [[u1.mainpart + convert(u2.answer)@RF, u1.limitedlogs], u2.a0] - --- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui] --- f must have no polynomial part (degree numer f < degree denom f) - primlimintfrac(f, derivation, lu) == - zero? f => [0, empty()] - degree numer f >= degree denom f => error "Not a proper fraction" - r := HermiteIntegrate(f, derivation) - zero?(r.logpart) => [r.answer, empty()] - (u := limitedLogs(r.logpart, logprmderiv(#1, derivation), lu)) - case "failed" => "failed" - [r.answer, u::LLG] - --- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui] --- f must have no polynomial part (degree numer f < degree denom f) --- f must be integral above t = 0 - explimintfrac(f, derivation, lu) == - zero? f => [0, empty()] - degree numer f >= degree denom f => error "Not a proper fraction" - order(denom f, monomial(1,1)) > 0 => error "Not integral at t = 0" - r := HermiteIntegrate(f, derivation) - zero?(r.logpart) => [r.answer, empty()] - eta' := coefficient(derivation monomial(1, 1), 1) - (u := limitedLogs(r.logpart, logexpderiv(#1,derivation,eta'), lu)) - case "failed" => "failed" - [r.answer - eta'::UP * - +/[((degree numer(v.logand))::Z - (degree denom(v.logand))::Z) * - v.coeff for v in u], u::LLG] - - logexpderiv(f, derivation, eta') == - (differentiate(f, derivation) / f) - - (((degree numer f)::Z - (degree denom f)::Z) * eta')::UP::RF - - notelementary rec == - rec.ir + integral(rec.polypart::RF + rec.specpart, monomial(1,1)$UP :: RF) - --- returns --- (g in IR, a in F) st f = g'+ a, and a=0 or a has no integral in UP - primintegrate(f, derivation, extendedint) == - rec := monomialIntegrate(f, derivation) - not elem?(i1 := rec.ir) => [notelementary rec, 0] - (u2 := primintegratepoly(rec.polypart, extendedint, - retract derivation monomial(1, 1))) case UPUP => - [i1 + u2.elem::RF::IR - + integral(u2.notelem::RF, monomial(1,1)$UP :: RF), 0] - [i1 + u2.answer::RF::IR, u2.a0] - --- returns --- (g in IR, a in F) st f = g' + a, and a = 0 or a has no integral in F - expintegrate(f, derivation, FRDE) == - rec := monomialIntegrate(f, derivation) - not elem?(i1 := rec.ir) => [notelementary rec, 0] --- rec.specpart is either 0 or of the form p(t)/t**n - special := rec.polypart::GP + - (numer(rec.specpart)::GP exquo denom(rec.specpart)::GP)::GP - (u2 := expintegratepoly(special, FRDE)) case GPGP => - [i1 + convert(u2.elem)@RF::IR + integral(convert(u2.notelem)@RF, - monomial(1,1)$UP :: RF), 0] - [i1 + convert(u2.answer)@RF::IR, u2.a0] - --- returns --- (g in IR, a in F) st f = g' + a, and a = 0 or a has no integral in F - tanintegrate(f, derivation, FRDE) == - rec := monomialIntegrate(f, derivation) - not elem?(i1 := rec.ir) => [notelementary rec, 0] - r := monomialIntPoly(rec.polypart, derivation) - t := monomial(1, 1)$UP - c := coefficient(r.polypart, 1) / leadingCoefficient(derivation t) - derivation(c::UP) ^= 0 => - [i1 + mkAnswer(r.answer::RF, empty(), - [[r.polypart::RF + rec.specpart, dummy]$NE]), 0] - logs:List(LOG) := - zero? c => empty() - [[1, monomial(1,1)$UPR - (c/(2::F))::UP::RF::UPR, (1 + t**2)::RF::UPR]] - c0 := coefficient(r.polypart, 0) - (u := tanintegratespecial(rec.specpart, differentiate(#1, derivation), - FRDE)) case RFRF => - [i1 + mkAnswer(r.answer::RF + u.elem, logs, [[u.notelem,dummy]$NE]), c0] - [i1 + mkAnswer(r.answer::RF + u.answer, logs, empty()), u.a0 + c0] - --- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 --- or (v in RF, a in F) s.t. f = v' + a --- and a = 0 or a has no integral in UP - primextendedint(f, derivation, extendedint, g) == - fqr := divide(numer f, denom f) - gqr := divide(numer g, denom g) - (u1 := primextintfrac(fqr.remainder / (denom f), derivation, - gqr.remainder / (denom g))) case "failed" => "failed" - zero?(gqr.remainder) => - -- the following FAIL cannot occur if the primitives are all logs - degree(gqr.quotient) > 0 => FAIL - (u3 := primintegratepoly(fqr.quotient, extendedint, - retract derivation monomial(1, 1))) case UPUP => "failed" - [u1.ratpart + u3.answer::RF, u3.a0] - (u2 := primintfldpoly(fqr.quotient - retract(u1.coeff)@UP * - gqr.quotient, extendedint, retract derivation monomial(1, 1))) - case "failed" => "failed" - [u2::UP::RF + u1.ratpart, u1.coeff] - --- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 --- or (v in RF, a in F) s.t. f = v' + a --- and a = 0 or a has no integral in F - expextendedint(f, derivation, FRDE, g) == - qf := separate(f)$GP - qg := separate g - (u1 := expextintfrac(qf.fracPart, derivation, qg.fracPart)) - case "failed" => "failed" - zero?(qg.fracPart) => - --the following FAIL's cannot occur if the primitives are all logs - retractIfCan(qg.polyPart)@Union(F,"failed") case "failed"=> FAIL - (u3 := expintegratepoly(qf.polyPart,FRDE)) case GPGP => "failed" - [u1.ratpart + convert(u3.answer)@RF, u3.a0] - (u2 := expintfldpoly(qf.polyPart - retract(u1.coeff)@UP :: GP - * qg.polyPart, FRDE)) case "failed" => "failed" - [convert(u2::GP)@RF + u1.ratpart, u1.coeff] - --- returns either --- (q in UP, a in F) st p = q'+ a, and a=0 or a has no integral in UP --- or (q in UP, r in UP) st p = q'+ r, and r has no integral elem/UP - primintegratepoly(p, extendedint, t') == - zero? p => [0, 0$F] - ans:UP := 0 - while (d := degree p) > 0 repeat - (ans1 := extendedint leadingCoefficient p) case "failed" => - return([ans, p]) - p := reductum p - monomial(d * t' * ans1.ratpart, (d - 1)::N) - ans := ans + monomial(ans1.ratpart, d) - + monomial(ans1.coeff / (d + 1)::F, d + 1) - (ans1:= extendedint(rp := retract(p)@F)) case "failed" => [ans,rp] - [monomial(ans1.coeff, 1) + ans1.ratpart::UP + ans, 0$F] - --- returns (v in RF, c in RF) s.t. f = v' + cg, and c' = 0 --- g must have a squarefree denominator (always possible) --- g must have no polynomial part (degree numer g < degree denom g) --- f must have no polynomial part (degree numer f < degree denom f) - primextintfrac(f, derivation, g) == - zero? f => [0, 0] - degree numer f >= degree denom f => error "Not a proper fraction" - r := HermiteIntegrate(f, derivation) - zero? g => - r.logpart ^= 0 => "failed" - [r.answer, 0] - degree numer g >= degree denom g => error "Not a proper fraction" - differentiate(c := r.logpart / g, derivation) ^= 0 => "failed" - [r.answer, c] - -@ -\section{package INTRAT RationalIntegration} -<>= -)abbrev package INTRAT RationalIntegration -++ Rational function integration -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 24 October 1995 -++ Description: -++ This package provides functions for the base -++ case of the Risch algorithm. --- Used internally bt the integration packages -RationalIntegration(F, UP): Exports == Implementation where - F : Join(Field, CharacteristicZero, RetractableTo Integer) - UP: UnivariatePolynomialCategory F - - RF ==> Fraction UP - IR ==> IntegrationResult RF - LLG ==> List Record(coeff:RF, logand:RF) - URF ==> Union(Record(ratpart:RF, coeff:RF), "failed") - U ==> Union(Record(mainpart:RF, limitedlogs:LLG), "failed") - - Exports ==> with - integrate : RF -> IR - ++ integrate(f) returns g such that \spad{g' = f}. - infieldint : RF -> Union(RF, "failed") - ++ infieldint(f) returns g such that \spad{g' = f} or "failed" - ++ if the integral of f is not a rational function. - extendedint: (RF, RF) -> URF - ++ extendedint(f, g) returns fractions \spad{[h, c]} such that - ++ \spad{c' = 0} and \spad{h' = f - cg}, - ++ if \spad{(h, c)} exist, "failed" otherwise. - limitedint : (RF, List RF) -> U - ++ \spad{limitedint(f, [g1,...,gn])} returns - ++ fractions \spad{[h,[[ci, gi]]]} - ++ such that the gi's are among \spad{[g1,...,gn]}, \spad{ci' = 0}, and - ++ \spad{(h+sum(ci log(gi)))' = f}, if possible, "failed" otherwise. - - Implementation ==> add - import TranscendentalIntegration(F, UP) - - infieldint f == - rec := baseRDE(0, f)$TranscendentalRischDE(F, UP) - rec.nosol => "failed" - rec.ans - - integrate f == - rec := monomialIntegrate(f, differentiate) - integrate(rec.polypart)::RF::IR + rec.ir - - limitedint(f, lu) == - quorem := divide(numer f, denom f) - (u := primlimintfrac(quorem.remainder / (denom f), differentiate, - lu)) case "failed" => "failed" - [u.mainpart + integrate(quorem.quotient)::RF, u.limitedlogs] - - extendedint(f, g) == - fqr := divide(numer f, denom f) - gqr := divide(numer g, denom g) - (i1 := primextintfrac(fqr.remainder / (denom f), differentiate, - gqr.remainder / (denom g))) case "failed" => "failed" - i2:=integrate(fqr.quotient-retract(i1.coeff)@UP *gqr.quotient)::RF - [i2 + i1.ratpart, i1.coeff] - -@ -\section{package INTRF RationalFunctionIntegration} -<>= -)abbrev package INTRF RationalFunctionIntegration -++ Integration of rational functions -++ Author: Manuel Bronstein -++ Date Created: 1987 -++ Date Last Updated: 29 Mar 1990 -++ Keywords: polynomial, fraction, integration. -++ Description: -++ This package provides functions for the integration -++ of rational functions. -++ Examples: )r INTRF INPUT -RationalFunctionIntegration(F): Exports == Implementation where - F: Join(IntegralDomain, RetractableTo Integer, CharacteristicZero) - - SE ==> Symbol - P ==> Polynomial F - Q ==> Fraction P - UP ==> SparseUnivariatePolynomial Q - QF ==> Fraction UP - LGQ ==> List Record(coeff:Q, logand:Q) - UQ ==> Union(Record(ratpart:Q, coeff:Q), "failed") - ULQ ==> Union(Record(mainpart:Q, limitedlogs:LGQ), "failed") - - Exports ==> with - internalIntegrate: (Q, SE) -> IntegrationResult Q - ++ internalIntegrate(f, x) returns g such that \spad{dg/dx = f}. - infieldIntegrate : (Q, SE) -> Union(Q, "failed") - ++ infieldIntegrate(f, x) returns a fraction - ++ g such that \spad{dg/dx = f} - ++ if g exists, "failed" otherwise. - limitedIntegrate : (Q, SE, List Q) -> ULQ - ++ \spad{limitedIntegrate(f, x, [g1,...,gn])} returns fractions - ++ \spad{[h, [[ci,gi]]]} such that the gi's are among - ++ \spad{[g1,...,gn]}, - ++ \spad{dci/dx = 0}, and \spad{d(h + sum(ci log(gi)))/dx = f} - ++ if possible, "failed" otherwise. - extendedIntegrate: (Q, SE, Q) -> UQ - ++ extendedIntegrate(f, x, g) returns fractions \spad{[h, c]} such that - ++ \spad{dc/dx = 0} and \spad{dh/dx = f - cg}, if \spad{(h, c)} exist, - ++ "failed" otherwise. - - Implementation ==> add - import RationalIntegration(Q, UP) - import IntegrationResultFunctions2(QF, Q) - import PolynomialCategoryQuotientFunctions(IndexedExponents SE, - SE, F, P, Q) - - infieldIntegrate(f, x) == - map(multivariate(#1, x), infieldint univariate(f, x)) - - internalIntegrate(f, x) == - map(multivariate(#1, x), integrate univariate(f, x)) - - extendedIntegrate(f, x, g) == - map(multivariate(#1, x), - extendedint(univariate(f, x), univariate(g, x))) - - limitedIntegrate(f, x, lu) == - map(multivariate(#1, x), - limitedint(univariate(f, x), [univariate(u, x) for u in lu])) - -@ -\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 intpm intef irexpand integrat - -<> -<> -<> -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/irexpand.spad.pamphlet b/src/algebra/irexpand.spad.pamphlet deleted file mode 100644 index 2a39f76..0000000 --- a/src/algebra/irexpand.spad.pamphlet +++ /dev/null @@ -1,343 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra irexpand.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package IR2F IntegrationResultToFunction} -<>= -)abbrev package IR2F IntegrationResultToFunction -++ Conversion of integration results to top-level expressions -++ Author: Manuel Bronstein -++ Date Created: 4 February 1988 -++ Date Last Updated: 9 October 1991 -++ Description: -++ This package allows a sum of logs over the roots of a polynomial -++ to be expressed as explicit logarithms and arc tangents, provided -++ that the indexing polynomial can be factored into quadratics. -++ Keywords: integration, expansion, function. -IntegrationResultToFunction(R, F): Exports == Implementation where - R: Join(GcdDomain, RetractableTo Integer, OrderedSet, - LinearlyExplicitRingOver Integer) - F: Join(AlgebraicallyClosedFunctionSpace R, - TranscendentalFunctionCategory) - - N ==> NonNegativeInteger - Z ==> Integer - Q ==> Fraction Z - K ==> Kernel F - P ==> SparseMultivariatePolynomial(R, K) - UP ==> SparseUnivariatePolynomial F - IR ==> IntegrationResult F - REC ==> Record(ans1:F, ans2:F) - LOG ==> Record(scalar:Q, coeff:UP, logand:UP) - - Exports ==> with - split : IR -> IR - ++ split(u(x) + sum_{P(a)=0} Q(a,x)) returns - ++ \spad{u(x) + sum_{P1(a)=0} Q(a,x) + ... + sum_{Pn(a)=0} Q(a,x)} - ++ where P1,...,Pn are the factors of P. - expand : IR -> List F - ++ expand(i) returns the list of possible real functions - ++ corresponding to i. - complexExpand: IR -> F - ++ complexExpand(i) returns the expanded complex function - ++ corresponding to i. - - Implementation ==> add - import AlgebraicManipulations(R, F) - import ElementaryFunctionSign(R, F) - - IR2F : IR -> F - insqrt : F -> Record(sqrt:REC, sgn:Z) - pairsum : (List F, List F) -> List F - pairprod : (F, List F) -> List F - quadeval : (UP, F, F, F) -> REC - linear : (UP, UP) -> F - tantrick : (F, F) -> F - ilog : (F, F, List K) -> F - ilog0 : (F, F, UP, UP, F) -> F - nlogs : LOG -> List LOG - lg2func : LOG -> List F - quadratic : (UP, UP) -> List F - mkRealFunc : List LOG -> List F - lg2cfunc : LOG -> F - loglist : (Q, UP, UP) -> List LOG - cmplex : (F, UP) -> F - evenRoots : F -> List F - compatible?: (List F, List F) -> Boolean - - cmplex(alpha, p) == alpha * log p alpha - IR2F i == retract mkAnswer(ratpart i, empty(), notelem i) - pairprod(x, l) == [x * y for y in l] - - evenRoots x == - [first argument k for k in tower x | - is?(k,"nthRoot"::Symbol) and even?(retract(second argument k)@Z) - and (not empty? variables first argument k)] - - expand i == - j := split i - pairsum([IR2F j], mkRealFunc logpart j) - - split i == - mkAnswer(ratpart i,concat [nlogs l for l in logpart i],notelem i) - - complexExpand i == - j := split i - IR2F j + +/[lg.scalar::F * lg2cfunc lg for lg in logpart j] - --- p = a t^2 + b t + c --- Expands sum_{p(t) = 0} t log(lg(t)) - quadratic(p, lg) == - zero?(delta := (b := coefficient(p, 1))**2 - 4 * - (a := coefficient(p,2)) * (p0 := coefficient(p, 0))) => - [linear(monomial(1, 1) + (b / a)::UP, lg)] - e := (q := quadeval(lg, c := - b * (d := inv(2*a)),d, delta)).ans1 - lgp := c * log(nrm := (e**2 - delta * (f := q.ans2)**2)) - s := (sqr := insqrt delta).sqrt - pp := nn := 0$F - if sqr.sgn >= 0 then - sqrp := s.ans1 * rootSimp sqrt(s.ans2) - pp := lgp + d * sqrp * log(((2 * e * f) / nrm) * sqrp - + (e**2 + delta * f**2) / nrm) - if sqr.sgn <= 0 then - sqrn := s.ans1 * rootSimp sqrt(-s.ans2) - nn := lgp + d * sqrn * ilog(e, f * sqrn, - setUnion(setUnion(kernels a, kernels b), kernels p0)) - sqr.sgn > 0 => [pp] - sqr.sgn < 0 => [nn] - [pp, nn] - --- returns 2 atan(a/b) or 2 atan(-b/a) whichever looks better --- they differ by a constant so it's ok to do it from an IR - tantrick(a, b) == - retractIfCan(a)@Union(Q, "failed") case Q => 2 * atan(-b/a) - 2 * atan(a/b) - --- transforms i log((a + i b) / (a - i b)) into a sum of real --- arc-tangents using Rioboo's algorithm --- lk is a list of kernels which are parameters for the integral - ilog(a, b, lk) == - l := setDifference(setUnion(variables numer a, variables numer b), - setUnion(lk, setUnion(variables denom a, variables denom b))) - empty? l => tantrick(a, b) - k := "max"/l - ilog0(a, b, numer univariate(a, k), numer univariate(b, k), k::F) - --- transforms i log((a + i b) / (a - i b)) into a sum of real --- arc-tangents using Rioboo's algorithm --- the arc-tangents will not have k in the denominator --- we always keep upa(k) = a and upb(k) = b - ilog0(a, b, upa, upb, k) == - if degree(upa) < degree(upb) then - (upa, upb) := (-upb, upa) - (a, b) := (-b, a) - zero? degree upb => tantrick(a, b) - r := extendedEuclidean(upa, upb) - (g:= retractIfCan(r.generator)@Union(F,"failed")) case "failed" => - tantrick(a, b) - if degree(r.coef1) >= degree upb then - qr := divide(r.coef1, upb) - r.coef1 := qr.remainder - r.coef2 := r.coef2 + qr.quotient * upa - aa := (r.coef2) k - bb := -(r.coef1) k - tantrick(aa * a + bb * b, g::F) + ilog0(aa,bb,r.coef2,-r.coef1,k) - - lg2func lg == - zero?(d := degree(p := lg.coeff)) => error "poly has degree 0" --- one? d => [linear(p, lg.logand)] - (d = 1) => [linear(p, lg.logand)] - d = 2 => quadratic(p, lg.logand) - odd? d and - ((r := retractIfCan(reductum p)@Union(F, "failed")) case F) => - pairsum([cmplex(alpha := rootSimp zeroOf p, lg.logand)], - lg2func [lg.scalar, - (p exquo (monomial(1, 1)$UP - alpha::UP))::UP, - lg.logand]) - [lg2cfunc lg] - - lg2cfunc lg == - +/[cmplex(alpha, lg.logand) for alpha in zerosOf(lg.coeff)] - - mkRealFunc l == - ans := empty()$List(F) - for lg in l repeat - ans := pairsum(ans, pairprod(lg.scalar::F, lg2func lg)) - ans - --- returns a log(b) - linear(p, lg) == - alpha := - coefficient(p, 0) / coefficient(p, 1) - alpha * log lg alpha - --- returns (c, d) s.t. p(a + b t) = c + d t, where t^2 = delta - quadeval(p, a, b, delta) == - zero? p => [0, 0] - bi := c := d := 0$F - ai := 1$F - v := vectorise(p, 1 + degree p) - for i in minIndex v .. maxIndex v repeat - c := c + qelt(v, i) * ai - d := d + qelt(v, i) * bi - temp := a * ai + b * bi * delta - bi := a * bi + b * ai - ai := temp - [c, d] - - compatible?(lx, ly) == - empty? ly => true - for x in lx repeat - for y in ly repeat - ((s := sign(x*y)) case Z) and (s::Z < 0) => return false - true - - pairsum(lx, ly) == - empty? lx => ly - empty? ly => lx - l := empty()$List(F) - for x in lx repeat - ls := evenRoots x - if not empty?(ln := - [x + y for y in ly | compatible?(ls, evenRoots y)]) then - l := removeDuplicates concat(l, ln) - l - --- returns [[a, b], s] where sqrt(y) = a sqrt(b) and --- s = 1 if b > 0, -1 if b < 0, 0 if the sign of b cannot be determined - insqrt y == - rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F) --- one?(rec.exponent) => [[rec.coef * rec.radicand, 1], 1] - ((rec.exponent) = 1) => [[rec.coef * rec.radicand, 1], 1] - rec.exponent ^=2 => error "Should not happen" - [[rec.coef, rec.radicand], - ((s := sign(rec.radicand)) case "failed" => 0; s::Z)] - - nlogs lg == - [[f.exponent * lg.scalar, f.factor, lg.logand] for f in factors - ffactor(primitivePart(lg.coeff) - )$FunctionSpaceUnivariatePolynomialFactor(R, F, UP)] - -@ -\section{package IRRF2F IntegrationResultRFToFunction} -<>= -)abbrev package IRRF2F IntegrationResultRFToFunction -++ Conversion of integration results to top-level expressions -++ Author: Manuel Bronstein -++ Description: -++ This package allows a sum of logs over the roots of a polynomial -++ to be expressed as explicit logarithms and arc tangents, provided -++ that the indexing polynomial can be factored into quadratics. -++ Date Created: 21 August 1988 -++ Date Last Updated: 4 October 1993 -IntegrationResultRFToFunction(R): Exports == Implementation where - R: Join(GcdDomain, RetractableTo Integer, OrderedSet, - LinearlyExplicitRingOver Integer) - - RF ==> Fraction Polynomial R - F ==> Expression R - IR ==> IntegrationResult RF - - Exports ==> with - split : IR -> IR - ++ split(u(x) + sum_{P(a)=0} Q(a,x)) returns - ++ \spad{u(x) + sum_{P1(a)=0} Q(a,x) + ... + sum_{Pn(a)=0} Q(a,x)} - ++ where P1,...,Pn are the factors of P. - expand : IR -> List F - ++ expand(i) returns the list of possible real functions - ++ corresponding to i. - complexExpand : IR -> F - ++ complexExpand(i) returns the expanded complex function - ++ corresponding to i. - if R has CharacteristicZero then - integrate : (RF, Symbol) -> Union(F, List F) - ++ integrate(f, x) returns the integral of \spad{f(x)dx} - ++ where x is viewed as a real variable.. - complexIntegrate: (RF, Symbol) -> F - ++ complexIntegrate(f, x) returns the integral of \spad{f(x)dx} - ++ where x is viewed as a complex variable. - - Implementation ==> add - import IntegrationTools(R, F) - import TrigonometricManipulations(R, F) - import IntegrationResultToFunction(R, F) - - toEF: IR -> IntegrationResult F - - toEF i == map(#1::F, i)$IntegrationResultFunctions2(RF, F) - expand i == expand toEF i - complexExpand i == complexExpand toEF i - - split i == - map(retract, split toEF i)$IntegrationResultFunctions2(F, RF) - - if R has CharacteristicZero then - import RationalFunctionIntegration(R) - - complexIntegrate(f, x) == complexExpand internalIntegrate(f, x) - --- do not use real integration if R is complex - if R has imaginary: () -> R then integrate(f, x) == complexIntegrate(f, x) - else - integrate(f, x) == - l := [mkPrim(real g, x) for g in expand internalIntegrate(f, x)] - empty? rest l => first l - l - -@ -\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/irsn.spad.pamphlet b/src/algebra/irsn.spad.pamphlet deleted file mode 100644 index 369e7fc..0000000 --- a/src/algebra/irsn.spad.pamphlet +++ /dev/null @@ -1,365 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra irsn.spad} -\author{Johannes Grabmeier, Thorsten Werther} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package IRSN IrrRepSymNatPackage} -<>= -)abbrev package IRSN IrrRepSymNatPackage -++ Authors: Johannes Grabmeier, Thorsten Werther -++ Date Created: 04 August 1988 -++ Date Last Updated: 24 May 1991 -++ Basic Operations: dimensionOfIrreducibleRepresentation -++ irreducibleRepresentation -++ Related Constructors: RepresentationTheoryPackage1 -++ RepresentationTheoryPackage2 -++ Also See: SymmetricGroupCombinatoricFunctions -++ AMS Classifications: -++ Keywords: -++ References: -++ G. James, A. Kerber: The Representation Theory of the Symmetric -++ Group. Encycl. of Math. and its Appl. Vol 16., Cambr. Univ Press 1981; -++ J. Grabmeier, A. Kerber: The Evaluation of Irreducible -++ Polynomial Representations of the General Linear Groups -++ and of the Unitary Groups over Fields of Characteristic 0, -++ Acta Appl. Math. 8 (1987), 271-291; -++ H. Gollan, J. Grabmeier: Algorithms in Representation Theory and -++ their Realization in the Computer Algebra System Scratchpad, -++ Bayreuther Mathematische Schriften, Heft 33, 1990, 1-23 -++ Description: -++ IrrRepSymNatPackage contains functions for computing -++ the ordinary irreducible representations of symmetric groups on -++ n letters {\em {1,2,...,n}} in Young's natural form and their dimensions. -++ These representations can be labelled by number partitions of n, -++ i.e. a weakly decreasing sequence of integers summing up to n, e.g. -++ {\em [3,3,3,1]} labels an irreducible representation for n equals 10. -++ Note: whenever a \spadtype{List Integer} appears in a signature, -++ a partition required. --- NOT TRUE in current system, but should: --- also could be an element of \spadtype(Partition) - -IrrRepSymNatPackage(): public == private where - NNI ==> NonNegativeInteger - I ==> Integer - L ==> List - M ==> Matrix - V ==> Vector - B ==> Boolean - SGCF ==> SymmetricGroupCombinatoricFunctions - ICF ==> IntegerCombinatoricFunctions Integer - PP ==> PartitionsAndPermutations - PERM ==> Permutation - - public ==> with - - dimensionOfIrreducibleRepresentation : L I -> NNI - ++ dimensionOfIrreducibleRepresentation(lambda) is the dimension - ++ of the ordinary irreducible representation of the symmetric group - ++ corresponding to {\em lambda}. - ++ Note: the Robinson-Thrall hook formula is implemented. - irreducibleRepresentation : (L I, PERM I) -> M I - ++ irreducibleRepresentation(lambda,pi) is the irreducible representation - ++ corresponding to partition {\em lambda} in Young's natural form of the - ++ permutation {\em pi} in the symmetric group, whose elements permute - ++ {\em {1,2,...,n}}. - irreducibleRepresentation : L I -> L M I - ++ irreducibleRepresentation(lambda) is the list of the two - ++ irreducible representations corresponding to the partition {\em lambda} - ++ in Young's natural form for the following two generators - ++ of the symmetric group, whose elements permute - ++ {\em {1,2,...,n}}, namely {\em (1 2)} (2-cycle) and - ++ {\em (1 2 ... n)} (n-cycle). - irreducibleRepresentation : (L I, L PERM I) -> L M I - ++ irreducibleRepresentation(lambda,listOfPerm) is the list of the - ++ irreducible representations corresponding to {\em lambda} - ++ in Young's natural form for the list of permutations - ++ given by {\em listOfPerm}. - - private ==> add - - -- local variables - oldlambda : L I := nil$(L I) - flambda : NNI := 0 -- dimension of the irreducible repr. - younglist : L M I := nil$(L M I) -- list of all standard tableaus - lprime : L I := nil$(L I) -- conjugated partition of lambda - n : NNI := 0 -- concerning symmetric group S_n - rows : NNI := 0 -- # of rows of standard tableau - columns : NNI := 0 -- # of columns of standard tableau - aId : M I := new(1,1,0) - - -- declaration of local functions - - aIdInverse : () -> Void - -- computes aId, the inverse of the matrix - -- (signum(k,l,id))_1 <= k,l <= flambda, where id - -- denotes the identity permutation - - alreadyComputed? : L I -> Void - -- test if the last calling of an exported function concerns - -- the same partition lambda as the previous call - - listPermutation : PERM I -> L I -- should be in Permutation - -- converts a permutation pi into the list - -- [pi(1),pi(2),..,pi(n)] - - signum : (NNI, NNI, L I) -> I - -- if there exists a vertical permutation v of the tableau - -- tl := pi o younglist(l) (l-th standard tableau) - -- and a horizontal permutation h of the tableau - -- tk := younglist(k) (k-th standard tableau) such that - -- v o tl = h o tk, - -- then - -- signum(k,l,pi) = sign(v), - -- otherwise - -- signum(k,l,pi) = 0. - - sumPartition : L I -> NNI - -- checks if lambda is a proper partition and results in - -- the sum of the entries - - testPermutation : L I -> NNI - -- testPermutation(pi) checks if pi is an element of S_n, - -- the set of permutations of the set {1,2,...,n}. - -- If not, an error message will occur, if yes it replies n. - - - -- definition of local functions - - - aIdInverse() == - - aId := new(flambda,flambda,0) - for k in 1..flambda repeat - aId(k,k) := 1 - if n < 5 then return aId - - idperm : L I := nil$(L I) - for k in n..1 by -1 repeat - idperm := cons(k,idperm) - for k in 1..(flambda-1) repeat - for l in (k+1)..flambda repeat - aId(k::NNI,l::NNI) := signum(k::NNI,l::NNI,idperm) - - -- invert the upper triangular matrix aId - for j in flambda..2 by -1 repeat - for i in (j-1)..1 by -1 repeat - aId(i::NNI,j:NNI) := -aId(i::NNI,j::NNI) - for k in (j+1)..flambda repeat - for i in (j-1)..1 by -1 repeat - aId(i::NNI,k:NNI) := aId(i::NNI,k::NNI) + - aId(i::NNI,j:NNI) * aId(j::NNI,k::NNI) - - - alreadyComputed?(lambda) == - if not(lambda = oldlambda) then - oldlambda := lambda - lprime := conjugate(lambda)$PP - rows := (first(lprime)$(L I))::NNI - columns := (first(lambda)$(L I))::NNI - n := (+/lambda)::NNI - younglist := listYoungTableaus(lambda)$SGCF - flambda := #younglist - aIdInverse() -- side effect: creates actual aId - - listPermutation(pi) == - li : L I := nil$(L I) - for k in n..1 by -1 repeat - li := cons(eval(pi,k)$(PERM I),li) - li - - signum(numberOfRowTableau, numberOfColumnTableau,pi) == - - rowtab : M I := copy younglist numberOfRowTableau - columntab : M I := copy younglist numberOfColumnTableau - swap : I - sign : I := 1 - end : B := false - endk : B - ctrl : B - - -- k-loop for all rows of tableau rowtab - k : NNI := 1 - while (k <= rows) and (not end) repeat - -- l-loop along the k-th row of rowtab - l : NNI := 1 - while (l <= oldlambda(k)) and (not end) repeat - z : NNI := l - endk := false - -- z-loop for k-th row of rowtab beginning at column l. - -- test wether the entry rowtab(k,z) occurs in the l-th column - -- beginning at row k of pi o columntab - while (z <= oldlambda(k)) and (not endk) repeat - s : NNI := k - ctrl := true - while ctrl repeat - if (s <= lprime(l)) - then - if (1+rowtab(k,z) = pi(1+columntab(s,l))) - -- if entries in the tableaus were from 1,..,n, then - -- it should be ..columntab(s,l)... . - then ctrl := false - else s := s + 1 - else ctrl := false - -- end of ctrl-loop - endk := (s <= lprime(l)) -- same entry found ? - if not endk - then -- try next entry - z := z + 1 - else - if k < s - then -- verticalpermutation - sign := -sign - swap := columntab(s,l) - columntab(s,l) := columntab(k,l) - columntab(k,l) := swap - if l < z - then -- horizontalpermutation - swap := rowtab(k,z) - rowtab(k,z) := rowtab(k,l) - rowtab(k,l) := swap - -- end of else - -- end of z-loop - if (z > oldlambda(k)) -- no coresponding entry found - then - sign := 0 - end := true - l := l + 1 - -- end of l-loop - k := k + 1 - -- end of k-loop - - sign - - - sumPartition(lambda) == - ok : B := true - prev : I := first lambda - sum : I := 0 - for x in lambda repeat - sum := sum + x - ok := ok and (prev >= x) - prev := x - if not ok then - error("No proper partition ") - sum::NNI - - - testPermutation(pi : L I) : NNI == - ok : B := true - n : I := 0 - for i in pi repeat - if i > n then n := i -- find the largest entry n in pi - if i < 1 then ok := false -- check whether there are entries < 1 - -- now n should be the number of permuted objects - if (not (n=#pi)) or (not ok) then - error("No permutation of 1,2,..,n") - -- now we know that pi has n Elements ranging from 1 to n - test : Vector(B) := new((n)::NNI,false) - for i in pi repeat - test(i) := true -- this means that i occurs in pi - if member?(false,test) then error("No permutation") -- pi not surjective - n::NNI - - - -- definitions of exported functions - - - dimensionOfIrreducibleRepresentation(lambda) == - nn : I := sumPartition(lambda)::I --also checks whether lambda - dd : I := 1 --is a partition - lambdaprime : L I := conjugate(lambda)$PP - -- run through all rows of the Youngtableau corr. to lambda - for i in 1..lambdaprime.1 repeat - -- run through all nodes in row i of the Youngtableau - for j in 1..lambda.i repeat - -- the hooklength of node (i,j) of the Youngtableau - -- is the new factor, remember counting starts with 1 - dd := dd * (lambda.i + lambdaprime.j - i - j + 1) - (factorial(nn)$ICF quo dd)::NNI - - - irreducibleRepresentation(lambda:(L I),pi:(PERM I)) == - nn : NNI := sumPartition(lambda) - alreadyComputed?(lambda) - piList : L I := listPermutation pi - if not (nn = testPermutation(piList)) then - error("Partition and permutation are not consistent") - aPi : M I := new(flambda,flambda,0) - for k in 1..flambda repeat - for l in 1..flambda repeat - aPi(k,l) := signum(k,l,piList) - aId * aPi - - - irreducibleRepresentation(lambda) == - listperm : L PERM I := nil$(L PERM I) - li : L I := nil$(L I) - sumPartition(lambda) - alreadyComputed?(lambda) - listperm := - n = 1 => cons(1$(PERM I),listperm) - n = 2 => cons(cycle([1,2])$(PERM I),listperm) - -- the n-cycle (1,2,..,n) and the 2-cycle (1,2) generate S_n - for k in n..1 by -1 repeat - li := cons(k,li) -- becomes n-cycle (1,2,..,n) - listperm := cons(cycle(li)$(PERM I),listperm) - -- 2-cycle (1,2) - cons(cycle([1,2])$(PERM I),listperm) - irreducibleRepresentation(lambda,listperm) - - - irreducibleRepresentation(lambda:(L I),listperm:(L PERM I)) == - sumPartition(lambda) - alreadyComputed?(lambda) - [irreducibleRepresentation(lambda, pi) for pi in listperm] - -@ -\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/ituple.spad.pamphlet b/src/algebra/ituple.spad.pamphlet deleted file mode 100644 index eb62d72..0000000 --- a/src/algebra/ituple.spad.pamphlet +++ /dev/null @@ -1,100 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra ituple.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package ITFUN2 InfiniteTupleFunctions2} -<>= -)abbrev package ITFUN2 InfiniteTupleFunctions2 -InfiniteTupleFunctions2(A:Type,B:Type): Exports == Implementation where - ++ Functions defined on streams with entries in two sets. - IT ==> InfiniteTuple - - Exports ==> with - map: ((A -> B),IT A) -> IT B - ++ \spad{map(f,[x0,x1,x2,...])} returns \spad{[f(x0),f(x1),f(x2),..]}. - - Implementation ==> add - - map(f,x) == - map(f,x pretend Stream(A))$StreamFunctions2(A,B) pretend IT(B) - -@ -\section{package ITFUN3 InfiniteTupleFunctions3} -<>= -)abbrev package ITFUN3 InfiniteTupleFunctions3 -InfiniteTupleFunctions3(A:Type, B:Type,C:Type): Exports - == Implementation where - ++ Functions defined on streams with entries in two sets. - IT ==> InfiniteTuple - ST ==> Stream - SF3 ==> StreamFunctions3(A,B,C) - FUN ==> ((A,B)->C) - Exports ==> with - map: (((A,B)->C), IT A, IT B) -> IT C - ++ map(f,a,b) \undocumented - map: (((A,B)->C), ST A, IT B) -> ST C - ++ map(f,a,b) \undocumented - map: (((A,B)->C), IT A, ST B) -> ST C - ++ map(f,a,b) \undocumented - - Implementation ==> add - - map(f:FUN, s1:IT A, s2:IT B):IT C == - map(f, s1 pretend Stream(A), s2 pretend Stream(B))$SF3 pretend IT(C) - map(f:FUN, s1:ST A, s2:IT B):ST C == - map(f, s1, s2 pretend Stream(B))$SF3 - map(f:FUN, s1:IT A, s2:ST B):ST C == - map(f, s1 pretend Stream(A), s2)$SF3 - -@ -\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/kl.spad.pamphlet b/src/algebra/kl.spad.pamphlet deleted file mode 100644 index 1d37837..0000000 --- a/src/algebra/kl.spad.pamphlet +++ /dev/null @@ -1,158 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra kl.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package SCACHE SortedCache} -<>= -)abbrev package SCACHE SortedCache -++ Cache of elements in a set -++ Author: Manuel Bronstein -++ Date Created: 31 Oct 1988 -++ Date Last Updated: 14 May 1991 -++ A sorted cache of a cachable set S is a dynamic structure that -++ keeps the elements of S sorted and assigns an integer to each -++ element of S once it is in the cache. This way, equality and ordering -++ on S are tested directly on the integers associated with the elements -++ of S, once they have been entered in the cache. -SortedCache(S:CachableSet): Exports == Implementation where - N ==> NonNegativeInteger - DIFF ==> 1024 - - Exports ==> with - clearCache : () -> Void - ++ clearCache() empties the cache. - cache : () -> List S - ++ cache() returns the current cache as a list. - enterInCache: (S, S -> Boolean) -> S - ++ enterInCache(x, f) enters x in the cache, calling \spad{f(y)} to - ++ determine whether x is equal to y. It returns x with an integer - ++ associated with it. - enterInCache: (S, (S, S) -> Integer) -> S - ++ enterInCache(x, f) enters x in the cache, calling \spad{f(x, y)} to - ++ determine whether \spad{x < y (f(x,y) < 0), x = y (f(x,y) = 0)}, or - ++ \spad{x > y (f(x,y) > 0)}. - ++ It returns x with an integer associated with it. - - Implementation ==> add - shiftCache : (List S, N) -> Void - insertInCache: (List S, List S, S, N) -> S - - cach := [nil()]$Record(cche:List S) - - cache() == cach.cche - - shiftCache(l, n) == - for x in l repeat setPosition(x, n + position x) - void - - clearCache() == - for x in cache repeat setPosition(x, 0) - cach.cche := nil() - void - - enterInCache(x:S, equal?:S -> Boolean) == - scan := cache() - while not null scan repeat - equal?(y := first scan) => - setPosition(x, position y) - return y - scan := rest scan - setPosition(x, 1 + #cache()) - cach.cche := concat(cache(), x) - x - - enterInCache(x:S, triage:(S, S) -> Integer) == - scan := cache() - pos:N:= 0 - for i in 1..#scan repeat - zero?(n := triage(x, y := first scan)) => - setPosition(x, position y) - return y - n<0 => return insertInCache(first(cache(),(i-1)::N),scan,x,pos) - scan := rest scan - pos := position y - setPosition(x, pos + DIFF) - cach.cche := concat(cache(), x) - x - - insertInCache(before, after, x, pos) == - if ((pos+1) = position first after) then shiftCache(after, DIFF) - setPosition(x, pos + (((position first after) - pos)::N quo 2)) - cach.cche := concat(before, concat(x, after)) - x - -@ -\section{package KERNEL2 KernelFunctions2} -<>= -)abbrev package KERNEL2 KernelFunctions2 -++ Description: -++ This package exports some auxiliary functions on kernels -KernelFunctions2(R:OrderedSet, S:OrderedSet): with - constantKernel: R -> Kernel S - ++ constantKernel(r) \undocumented - constantIfCan : Kernel S -> Union(R, "failed") - ++ constantIfCan(k) \undocumented - - == add - import BasicOperatorFunctions1(R) - - constantKernel r == kernel(constantOperator r, nil(), 1) - constantIfCan k == constantOpIfCan operator k - -@ -\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 expr function - -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/kovacic.spad.pamphlet b/src/algebra/kovacic.spad.pamphlet deleted file mode 100644 index 9a330d2..0000000 --- a/src/algebra/kovacic.spad.pamphlet +++ /dev/null @@ -1,152 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra kovacic.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{package KOVACIC Kovacic} -<>= -)abbrev package KOVACIC Kovacic -++ Author: Manuel Bronstein -++ Date Created: 14 January 1992 -++ Date Last Updated: 3 February 1994 -++ Description: -++ \spadtype{Kovacic} provides a modified Kovacic's algorithm for -++ solving explicitely irreducible 2nd order linear ordinary -++ differential equations. -++ Keywords: differential equation, ODE -Kovacic(F, UP): Exports == Impl where - F : Join(CharacteristicZero, AlgebraicallyClosedField, - RetractableTo Integer, RetractableTo Fraction Integer) - UP : UnivariatePolynomialCategory F - - RF ==> Fraction UP - SUP ==> SparseUnivariatePolynomial RF - LF ==> List Record(factor:UP, exponent:Integer) - LODO==> LinearOrdinaryDifferentialOperator1 RF - - Exports ==> with - kovacic: (RF, RF, RF) -> Union(SUP, "failed") - ++ kovacic(a_0,a_1,a_2) returns either "failed" or P(u) such that - ++ \spad{$e^{\int(-a_1/2a_2)} e^{\int u}$} is a solution of - ++ \spad{a_2 y'' + a_1 y' + a0 y = 0} - ++ whenever \spad{u} is a solution of \spad{P u = 0}. - ++ The equation must be already irreducible over the rational functions. - kovacic: (RF, RF, RF, UP -> Factored UP) -> Union(SUP, "failed") - ++ kovacic(a_0,a_1,a_2,ezfactor) returns either "failed" or P(u) such - ++ that \spad{$e^{\int(-a_1/2a_2)} e^{\int u}$} is a solution of - ++ \spad{$a_2 y'' + a_1 y' + a0 y = 0$} - ++ whenever \spad{u} is a solution of \spad{P u = 0}. - ++ The equation must be already irreducible over the rational functions. - ++ Argument \spad{ezfactor} is a factorisation in \spad{UP}, - ++ not necessarily into irreducibles. - - Impl ==> add - import RationalRicDE(F, UP) - - case2 : (RF, LF, UP -> Factored UP) -> Union(SUP, "failed") - cannotCase2?: LF -> Boolean - - kovacic(a0, a1, a2) == kovacic(a0, a1, a2, squareFree) - - -- it is assumed here that a2 y'' + a1 y' + a0 y is already irreducible - -- over the rational functions, i.e. that the associated Riccati equation - -- does NOT have rational solutions (so we don't check case 1 of Kovacic's - -- algorithm) - -- currently only check case 2, not 3 - kovacic(a0, a1, a2, ezfactor) == - -- transform first the equation to the form y'' = r y - -- which makes the Galois group unimodular - -- this does not change irreducibility over the rational functions - -- the following is split into 5 lines in order to save a couple of - -- hours of compile time. - r:RF := a1**2 - r := r + 2 * a2 * differentiate a1 - r := r - 2 * a1 * differentiate a2 - r := r - 4 * a0 * a2 - r := r / (4 * a2**2) - lf := factors squareFree denom r - case2(r, lf, ezfactor) - - -- this is case 2 of Kovacic's algorithm, i.e. look for a solution - -- of the associated Riccati equation in a quadratic extension - -- lf is the squarefree factorisation of denom(r) and is used to - -- check the necessary condition - case2(r, lf, ezfactor) == - cannotCase2? lf => "failed" - -- build the symmetric square of the operator L = y'' - r y - -- which is L2 = y''' - 4 r y' - 2 r' y - l2:LODO := monomial(1, 3) - monomial(4*r, 1) - 2 * differentiate(r)::LODO - -- no solution in this case if L2 has no rational solution - empty?(sol := ricDsolve(l2, ezfactor)) => "failed" - -- otherwise the defining polynomial for an algebraic solution - -- of the Ricatti equation associated with L is - -- u^2 - b u + (1/2 b' + 1/2 b^2 - r) = 0 - -- where b is a rational solution of the Ricatti of L2 - b := first sol - monomial(1, 2)$SUP - monomial(b, 1)$SUP - + ((differentiate(b) + b**2 - 2 * r) / (2::RF))::SUP - - -- checks the necessary condition for case 2 - -- returns true if case 2 cannot have solutions - -- the necessary condition is that there is either a factor with - -- exponent 2 or odd exponent > 2 - cannotCase2? lf == - for rec in lf repeat - rec.exponent = 2 or (odd?(rec.exponent) and rec.exponent > 2) => - return false - true - -@ -\section{License} -<>= ---Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ---All rights reserved. --- ---Redistribution and use in source and binary forms, with or without ---modification, are permitted provided that the following conditions are ---met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- ---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ---IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ---TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ---PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ---OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ---EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ---PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ---PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ---LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ---NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ---SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> - --- Compile order for the differential equation solver: --- oderf.spad odealg.spad nlode.spad nlinsol.spad riccati.spad --- kovacic.spad odeef.spad - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 9c0a93c..ca10868 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -919,5 +919,7 @@ i-funsel.boot document mmCost
help documentation fixes and packages
20090131.01.tpd.patch help documentation fixes and packages
+20090201.01.tpd.patch +bookvol10.4 add packages