From d25e6afd1bed18994110266ad184b265f0ee0271 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Tue, 4 Aug 2015 10:30:00 -0400 Subject: [PATCH] books/bookvol10.* add COQ stanzas Goal: Proving Axiom Correct Stanzas were added to the algebra that contain the executable code with associated signatures. These stanzas are automatically extracted to the obj/sys/proofs/coq.v file. This file is piped through coqtop to run the proofs. Building stanzas is not complete but is (maybe) sufficient to construct a first proof. --- books/Makefile.pamphlet | 7 +- books/bookvol10.2.pamphlet |19616 ++++++++++++++++++++++++++++++++++++-------- books/bookvol10.3.pamphlet | 8706 +++++++++++++++++++- books/bookvol10.4.pamphlet | 4696 +++++++++++- books/bookvolbib.pamphlet | 29 +- 5 files changed, 29523 insertions(+), 3531 deletions(-) diff --git a/books/Makefile.pamphlet b/books/Makefile.pamphlet index 76a54f4..3091e6b 100644 --- a/books/Makefile.pamphlet +++ b/books/Makefile.pamphlet @@ -71,11 +71,12 @@ ${PROOFS}/coq.lisp: @ echo =========================================== @ echo making ${PROOFS}/coq.lisp @ echo =========================================== - @ ${BOOKS}/tanglec ${BOOKS}/bookvol10.2.pamphlet coq \ - >${PROOFS}/coq.lisp + @ ${BOOKS}/tanglec ${BOOKS}/bookvol10.2.pamphlet coq >${PROOFS}/coq.v + @ ${BOOKS}/tanglec ${BOOKS}/bookvol10.3.pamphlet coq >>${PROOFS}/coq.v + @ ${BOOKS}/tanglec ${BOOKS}/bookvol10.4.pamphlet coq >>${PROOFS}/coq.v @ if [ .${COQ} = .coq ] ; \ then \ - ( cd ${PROOFS} ; echo "Insert COQ commands here" >coq.lisp ) ; \ + ( cd ${PROOFS} ; cat coq.v | coqtop >coq.console 2>&1 ) ; \ fi ; ${PDF}/axiom.bib: diff --git a/books/bookvol10.2.pamphlet b/books/bookvol10.2.pamphlet index 03c8a4b..a8f2a63 100644 --- a/books/bookvol10.2.pamphlet +++ b/books/bookvol10.2.pamphlet @@ -100,11 +100,13 @@ This is the root of the category hierarchy and is not represented by code. [color=lightblue,href="bookvol10.2.pdf#nameddest=CATEGORY"]; \end{chunk} + \begin{chunk}{CATEGORY.dotfull} "Category" [color=lightblue,href="bookvol10.2.pdf#nameddest=CATEGORY"]; \end{chunk} + \begin{chunk}{CATEGORY.dotpic} digraph pic { fontsize=10; @@ -115,9 +117,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AdditiveValuationAttribute}{ATADDVA} \pagepic{ps/v102additivevaluationattribute.eps}{ATADDVA}{1.00} + \begin{chunk}{AdditiveValuationAttribute.input} )set break resume )sys rm -f AdditiveValuationAttribute.output @@ -148,6 +152,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AdditiveValuationAttribute.help} ==================================================================== AdditiveValuationAttribute @@ -170,18 +175,21 @@ o )show AdditiveValuationAttribute AdditiveValuationAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATADDVA.dotabb} "ATADDVA" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATADDVA"]; "ATADDVA" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATADDVA.dotfull} "AdditiveValuationAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATADDVA"]; "AdditiveValuationAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATADDVA.dotpic} digraph pic { fontsize=10; @@ -195,9 +203,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ApproximateAttribute}{ATAPPRO} \pagepic{ps/v102approximateattribute.eps}{ATAPPRO}{1.00} + \begin{chunk}{ApproximateAttribute.input} )set break resume )sys rm -f ApproximateAttribute.output @@ -229,6 +239,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{ApproximateAttribute.help} ==================================================================== ApproximateAttribute @@ -249,18 +260,21 @@ o )show ApproximateAttribute ApproximateAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATAPPRO.dotabb} "ATAPPRO" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATAPPRO"]; "ATAPPRO" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATAPPRO.dotfull} "ApproximateAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATAPPRO"]; "ApproximateAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATAPPRO.dotpic} digraph pic { fontsize=10; @@ -274,9 +288,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ArbitraryExponentAttribute}{ATARBEX} \pagepic{ps/v102arbitraryexponentattribute.eps}{ATARBEX}{1.00} + \begin{chunk}{ArbitraryExponentAttribute.input} )set break resume )sys rm -f ArbitraryExponentAttribute.output @@ -308,6 +324,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{ArbitraryExponentAttribute.help} ==================================================================== ArbitraryExponentAttribute @@ -328,18 +345,21 @@ o )show ArbitraryExponentAttribute ArbitraryExponentAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATARBEX.dotabb} "ATARBEX" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBEX"]; "ATARBEX" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATARBEX.dotfull} "ArbitraryExponentAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBEX"]; "ArbitraryExponentAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATARBEX.dotpic} digraph pic { fontsize=10; @@ -353,9 +373,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ArbitraryPrecisionAttribute}{ATARBPR} \pagepic{ps/v102arbitraryprecisionattribute.eps}{ATARBPR}{1.00} + \begin{chunk}{ArbitraryPrecisionAttribute.input} )set break resume )sys rm -f ArbitraryPrecisionAttribute.output @@ -387,6 +409,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{ArbitraryPrecisionAttribute.help} ==================================================================== ArbitraryPrecisionAttribute @@ -409,18 +432,21 @@ o )show ArbitraryPrecisionAttribute ArbitraryPrecisionAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATARBPR.dotabb} "ATARBPR" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBPR"]; "ATARBPR" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATARBPR.dotfull} "ArbitraryPrecisionAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBPR"]; "ArbitraryPrecisionAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATARBPR.dotpic} digraph pic { fontsize=10; @@ -434,9 +460,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ArcHyperbolicFunctionCategory}{AHYP} \pagepic{ps/v102archyperbolicfunctioncategory.ps}{AHYP}{1.00} + \begin{chunk}{ArcHyperbolicFunctionCategory.input} )set break resume )sys rm -f ArcHyperbolicFunctionCategory.output @@ -463,6 +491,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ArcHyperbolicFunctionCategory.help} ==================================================================== ArcHyperbolicFunctionCategory examples @@ -516,18 +545,21 @@ ArcHyperbolicFunctionCategory(): Category == with atanh: $ -> $ ++ atanh(x) returns the hyperbolic arc-tangent of x. \end{chunk} + \begin{chunk}{AHYP.dotabb} "AHYP" [color=lightblue,href="bookvol10.2.pdf#nameddest=AHYP"]; "AHYP" -> "CATEGORY" \end{chunk} + \begin{chunk}{AHYP.dotfull} "ArcHyperbolicFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=AHYP"]; "ArcHyperbolicFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{AHYP.dotpic} digraph pic { fontsize=10; @@ -541,6 +573,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ArcTrigonometricFunctionCategory}{ATRIG} \pagepic{ps/v102arctrigonometricfunctioncategory.ps}{ATRIG}{1.00} @@ -574,6 +607,7 @@ intermediate test to check that the argument has a reciprocal values. )spool )lisp (bye) \end{chunk} + \begin{chunk}{ArcTrigonometricFunctionCategory.help} ==================================================================== ArcTrigonometricFunctionCategory examples @@ -638,18 +672,21 @@ ArcTrigonometricFunctionCategory(): Category == with asin(a::$) \end{chunk} + \begin{chunk}{ATRIG.dotabb} "ATRIG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRIG"]; "ATRIG" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATRIG.dotfull} "ArcTrigonometricFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRIG"]; "ArcTrigonometricFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{ATRIG.dotpic} digraph pic { fontsize=10; @@ -663,9 +700,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AttributeRegistry}{ATTREG} \pagepic{ps/v102attributeregistry.ps}{ATTREG}{1.00} + \begin{chunk}{AttributeRegistry.input} )set break resume )sys rm -f AttributeRegistry.output @@ -698,6 +737,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AttributeRegistry.help} ==================================================================== AttributeRegistry examples @@ -851,18 +891,21 @@ AttributeRegistry(): Category == with ++ \spad{approximate} means "is an approximation to the real numbers". \end{chunk} + \begin{chunk}{ATTREG.dotabb} "ATTREG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATTREG"]; "ATTREG" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATTREG.dotfull} "AttributeRegistry()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATTREG"]; "AttributeRegistry()" -> "Category" \end{chunk} + \begin{chunk}{ATTREG.dotpic} digraph pic { fontsize=10; @@ -876,6 +919,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BasicType}{BASTYPE} \pagepic{ps/v102basictype.ps}{BASTYPE}{1.00} @@ -904,6 +948,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{BasicType.help} ==================================================================== BasicType examples @@ -953,18 +998,35 @@ BasicType(): Category == with _~_=(x:%,y:%) : Boolean == not(x=y) \end{chunk} + +\begin{chunk}{COQ BASTYPE} +(* category BASTYPE *) +(* From the Coq.Init.Logic library we know that + Definition not (A:Prop) := A -> False + and + Notation "~ x" := (not x) : type_scope. *) + +(* + ~=: (%,%) -> Boolean + ~=(x:%,y:%) : Boolean == not(x=y) +*) + +\end{chunk} + \begin{chunk}{BASTYPE.dotabb} "BASTYPE" [color=lightblue,href="bookvol10.2.pdf#nameddest=BASTYPE"]; "BASTYPE" -> "CATEGORY" \end{chunk} + \begin{chunk}{BASTYPE.dotfull} "BasicType()" [color=lightblue,href="bookvol10.2.pdf#nameddest=BASTYPE"]; "BasicType()" -> "Category" \end{chunk} + \begin{chunk}{BASTYPE.dotpic} digraph pic { fontsize=10; @@ -978,9 +1040,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CanonicalAttribute}{ATCANON} \pagepic{ps/v102canonicalattribute.eps}{ATCANON}{1.00} + \begin{chunk}{CanonicalAttribute.input} )set break resume )sys rm -f CanonicalAttribute.output @@ -1012,6 +1076,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{CanonicalAttribute.help} ==================================================================== CanonicalAttribute @@ -1034,18 +1099,21 @@ o )show CanonicalAttribute CanonicalAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATCANON.dotabb} "ATCANON" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANON"]; "ATCANON" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATCANON.dotfull} "CanonicalAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANON"]; "CanonicalAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATCANON.dotpic} digraph pic { fontsize=10; @@ -1059,9 +1127,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CanonicalClosedAttribute}{ATCANCL} \pagepic{ps/v102canonicalclosedattribute.eps}{ATCANCL}{1.00} + \begin{chunk}{CanonicalClosedAttribute.input} )set break resume )sys rm -f CanonicalClosedAttribute.output @@ -1092,6 +1162,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CanonicalClosedAttribute.help} ==================================================================== CanonicalClosedAttribute @@ -1114,18 +1185,21 @@ o )show CanonicalClosedAttribute CanonicalClosedAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATCANCL.dotabb} "ATCANCL" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANCL"]; "ATCANCL" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATCANCL.dotfull} "CanonicalClosedAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANCL"]; "CanonicalClosedAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATCANCL.dotpic} digraph pic { fontsize=10; @@ -1139,9 +1213,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CanonicalUnitNormalAttribute}{ATCUNOR} \pagepic{ps/v102canonicalunitnormalattribute.eps}{ATCUNOR}{1.00} + \begin{chunk}{CanonicalUnitNormalAttribute.input} )set break resume )sys rm -f CanonicalUnitNormalAttribute.output @@ -1173,6 +1249,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{CanonicalUnitNormalAttribute.help} ==================================================================== CanonicalUnitNormalAttribute @@ -1199,18 +1276,21 @@ o )show CanonicalUnitNormalAttribute CanonicalUnitNormalAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATCUNOR.dotabb} "ATCUNOR" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCUNOR"]; "ATCUNOR" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATCUNOR.dotfull} "CanonicalUnitNormalAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCUNOR"]; "CanonicalUnitNormalAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATCUNOR.dotpic} digraph pic { fontsize=10; @@ -1224,9 +1304,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CentralAttribute}{ATCENRL} \pagepic{ps/v102centralattribute.eps}{ATCENRL}{1.00} + \begin{chunk}{CentralAttribute.input} )set break resume )sys rm -f CentralAttribute.output @@ -1258,6 +1340,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{CentralAttribute.help} ==================================================================== CentralAttribute @@ -1284,18 +1367,21 @@ o )show CentralAttribute CentralAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATCENRL.dotabb} "ATCENRL" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCENRL"]; "ATCENRL" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATCENRL.dotfull} "CentralAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCENRL"]; "CentralAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATCENRL.dotpic} digraph pic { fontsize=10; @@ -1309,6 +1395,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CoercibleTo}{KOERCE} \pagepic{ps/v102koerce.ps}{KOERCE}{1.00} @@ -1337,6 +1424,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CoercibleTo.help} ==================================================================== CoercibleTo examples @@ -1382,12 +1470,14 @@ CoercibleTo(S:Type): Category == with ++ coerce(a) transforms a into an element of S. \end{chunk} + \begin{chunk}{KOERCE.dotabb} "KOERCE" [color=lightblue,href="bookvol10.2.pdf#nameddest=KOERCE"]; "KOERCE" -> "CATEGORY" \end{chunk} + \begin{chunk}{KOERCE.dotfull} "CoercibleTo(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=KOERCE"]; @@ -1404,6 +1494,7 @@ CoercibleTo(S:Type): Category == with -> "CoercibleTo(a:Type)" \end{chunk} + \begin{chunk}{KOERCE.dotpic} digraph pic { fontsize=10; @@ -1417,6 +1508,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CombinatorialFunctionCategory}{CFCAT} \pagepic{ps/v102combinatorialfunctioncategory.ps}{CFCAT}{1.00} @@ -1446,6 +1538,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CombinatorialFunctionCategory.help} ==================================================================== CombinatorialFunctionCategory examples @@ -1502,18 +1595,21 @@ CombinatorialFunctionCategory(): Category == with ++ Note that \spad{permutation(n,m) = n!/(n-m)!}. \end{chunk} + \begin{chunk}{CFCAT.dotabb} "CFCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=CFCAT"]; "CFCAT" -> "CATEGORY" \end{chunk} + \begin{chunk}{CFCAT.dotfull} "CombinatorialFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=CFCAT"]; "CombinatorialFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{CFCAT.dotpic} digraph pic { fontsize=10; @@ -1527,9 +1623,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CommutativeStarAttribute}{ATCS} \pagepic{ps/v102commutativestarattribute.eps}{ATCS}{1.00} + \begin{chunk}{CommutativeStarAttribute.input} )set break resume )sys rm -f CommutativeStarAttribute.output @@ -1561,6 +1659,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{CommutativeStarAttribute.help} ==================================================================== CommutativeStarAttribute @@ -1585,18 +1684,21 @@ o )show CommutativeStarAttribute CommutativeStarAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATCS.dotabb} "ATCS" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCS"]; "ATCS" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATCS.dotfull} "CommutativeStarAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCS"]; "CommutativeStarAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATCS.dotpic} digraph pic { fontsize=10; @@ -1610,6 +1712,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ConvertibleTo}{KONVERT} \pagepic{ps/v102konvert.ps}{KONVERT}{1.00} @@ -1638,6 +1741,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ConvertibleTo.help} ==================================================================== ConvertibleTo examples @@ -1684,12 +1788,14 @@ ConvertibleTo(S:Type): Category == with ++ convert(a) transforms a into an element of S. \end{chunk} + \begin{chunk}{KONVERT.dotabb} "KONVERT" [color=lightblue,href="bookvol10.2.pdf#nameddest=KONVERT"]; "KONVERT" -> "CATEGORY" \end{chunk} + \begin{chunk}{KONVERT.dotfull} "ConvertibleTo(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=KONVERT"]; @@ -1757,6 +1863,7 @@ ConvertibleTo(S:Type): Category == with "ConvertibleTo(a:Type)" \end{chunk} + \begin{chunk}{KONVERT.dotpic} digraph pic { fontsize=10; @@ -1770,6 +1877,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ElementaryFunctionCategory}{ELEMFUN} \pagepic{ps/v102elementaryfunctioncategory.ps}{ELEMFUN}{1.00} @@ -1799,6 +1907,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ElementaryFunctionCategory.help} ==================================================================== ElementaryFunctionCategory examples @@ -1851,18 +1960,32 @@ ElementaryFunctionCategory(): Category == with x ** y == exp(y * log x) \end{chunk} + +\begin{chunk}{COQ ELEMFUN} +(* category ELEMFUN *) +(* + if $ has Monoid then + + **: ($, $) -> $ ++ x**y returns x to the power y. + x ** y == exp(y * log x) +*) + +\end{chunk} + \begin{chunk}{ELEMFUN.dotabb} "ELEMFUN" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELEMFUN"]; "ELEMFUN" -> "CATEGORY" \end{chunk} + \begin{chunk}{ELEMFUN.dotfull} "ElementaryFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELEMFUN"]; "ElementaryFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{ELEMFUN.dotpic} digraph pic { fontsize=10; @@ -1876,6 +1999,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Eltable}{ELTAB} \pagepic{ps/v102eltab.ps}{ELTAB}{1.00} @@ -1904,6 +2028,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Eltable.help} ==================================================================== Eltable examples @@ -1953,11 +2078,13 @@ Eltable(S:SetCategory, Index:Type): Category == with ++ Error: if i is not an index of u. \end{chunk} + \begin{chunk}{ELTAB.dotabb} "ELTAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAB"]; "ELTAB" -> "CATEGORY" \end{chunk} + \begin{chunk}{ELTAB.dotfull} "Eltable(a:SetCategory,b:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAB"]; @@ -1979,6 +2106,7 @@ Eltable(S:SetCategory, Index:Type): Category == with "Eltable(a:SetCategory,b:Type)" \end{chunk} + \begin{chunk}{ELTAB.dotpic} digraph pic { fontsize=10; @@ -1992,9 +2120,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteAggregateAttribute}{ATFINAG} \pagepic{ps/v102finiteaggregateattribute.eps}{ATFINAG}{1.00} + \begin{chunk}{FiniteAggregateAttribute.input} )set break resume )sys rm -f FiniteAggregateAttribute.output @@ -2026,6 +2156,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{FiniteAggregateAttribute.help} ==================================================================== FiniteAggregateAttribute @@ -2046,18 +2177,21 @@ o )show FiniteAggregateAttribute FiniteAggregateAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATFINAG.dotabb} "ATFINAG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATFINAG"]; "ATFINAG" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATFINAG.dotfull} "FiniteAggregateAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATFINAG"]; "FiniteAggregateAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATFINAG.dotpic} digraph pic { fontsize=10; @@ -2071,6 +2205,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{HyperbolicFunctionCategory}{HYPCAT} \pagepic{ps/v102hyperbolicfunctioncategory.ps}{HYPCAT}{1.00} @@ -2104,6 +2239,7 @@ intermediate test to check that the argument has a reciprocal values. )spool )lisp (bye) \end{chunk} + \begin{chunk}{HyperbolicFunctionCategory.help} ==================================================================== HyperbolicFunctionCategory examples @@ -2172,18 +2308,57 @@ HyperbolicFunctionCategory(): Category == with (e - recip(e)::$) * recip(2::$)::$ \end{chunk} + +\begin{chunk}{COQ HYPCAT} +(* category HYPCAT *) +(* + if $ has Ring then + + csch: $ -> $ + csch x == + (a := recip(sinh x)) case "failed" => error "csch: no reciprocal" + a::$ + + sech: $ -> $ + sech x == + (a := recip(cosh x)) case "failed" => error "sech: no reciprocal" + a::$ + + tanh: $ -> $ + tanh x == sinh x * sech x + + coth: $ -> $ + coth x == cosh x * csch x + + if $ has ElementaryFunctionCategory then + + cosh: $ -> $ + cosh x == + e := exp x + (e + recip(e)::$) * recip(2::$)::$ + + sinh: $ -> $ + sinh(x):$ == + e := exp x + (e - recip(e)::$) * recip(2::$)::$ +*) + +\end{chunk} + \begin{chunk}{HYPCAT.dotabb} "HYPCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=HYPCAT"]; "HYPCAT" -> "CATEGORY" \end{chunk} + \begin{chunk}{HYPCAT.dotfull} "HyperbolicFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=HYPCAT"]; "HyperbolicFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{HYPCAT.dotpic} digraph pic { fontsize=10; @@ -2197,6 +2372,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{InnerEvalable}{IEVALAB} \pagepic{ps/v102innerevalable.ps}{IEVALAB}{1.00} @@ -2225,6 +2401,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{InnerEvalable.help} ==================================================================== InnerEvalable examples @@ -2286,12 +2463,23 @@ InnerEvalable(A:SetCategory, B:Type): Category == with eval(f:$, x:A, v:B) == eval(f, [x], [v]) \end{chunk} + +\begin{chunk}{COQ IEVALAB} +(* category IEVALAB *) +(* + eval: ($, A, B) -> $ + eval(f:$, x:A, v:B) == eval(f, [x], [v]) +*) + +\end{chunk} + \begin{chunk}{IEVALAB.dotabb} "IEVALAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=IEVALAB"]; "IEVALAB" -> "CATEGORY" \end{chunk} + \begin{chunk}{IEVALAB.dotfull} "InnerEvalable(a:SetCategory,b:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=IEVALAB"]; @@ -2323,6 +2511,7 @@ InnerEvalable(A:SetCategory, B:Type): Category == with "InnerEvalable(a:SetCategory,b:Type)" \end{chunk} + \begin{chunk}{IEVALAB.dotpic} digraph pic { fontsize=10; @@ -2336,9 +2525,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{JacobiIdentityAttribute}{ATJACID} \pagepic{ps/v102jacobiidentityattribute.eps}{ATJACID}{1.00} + \begin{chunk}{JacobiIdentityAttribute.input} )set break resume )sys rm -f JacobiIdentityAttribute.output @@ -2370,6 +2561,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{JacobiIdentityAttribute.help} ==================================================================== JacobiIdentityAttribute @@ -2392,18 +2584,31 @@ o )show JacobiIdentityAttribute JacobiIdentityAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATJACID} +(* category ATJACID *} +(* +Axiom + [x,[y,z]]+[y,[z,x]]+[z,[x,y]] = 0 + +*) + +\end{chunk} + \begin{chunk}{ATJACID.dotabb} "ATJACID" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATJACID"]; "ATJACID" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATJACID.dotfull} "JacobiIdentityAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATJACID"]; "JacobiIdentityAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATJACID.dotpic} digraph pic { fontsize=10; @@ -2417,9 +2622,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LazyRepresentationAttribute}{ATLR} \pagepic{ps/v102lazyrepresentationattribute.eps}{ATLR}{1.00} + \begin{chunk}{LazyRepresentationAttribute.input} )set break resume )sys rm -f LazyRepresentationAttribute.output @@ -2451,6 +2658,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{LazyRepresentationAttribute.help} ==================================================================== LazyRepresentationAttribute @@ -2471,18 +2679,21 @@ o )show LazyRepresentationAttribute LazyRepresentationAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATLR.dotabb} "ATLR" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLR"]; "ATLR" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATLR.dotfull} "LazyRepresentationAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLR"]; "LazyRepresentationAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATLR.dotpic} digraph pic { fontsize=10; @@ -2496,9 +2707,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LeftUnitaryAttribute}{ATLUNIT} \pagepic{ps/v102leftunitaryattribute.eps}{ATLUNIT}{1.00} + \begin{chunk}{LeftUnitaryAttribute.input} )set break resume )sys rm -f LeftUnitaryAttribute.output @@ -2530,6 +2743,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{LeftUnitaryAttribute.help} ==================================================================== LeftUnitaryAttribute @@ -2550,18 +2764,29 @@ o )show LeftUnitaryAttribute LeftUnitaryAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATLUNIT} +(* category ATLUNIT *) +(* + LeftUnitary is true if 1 * x = x for all x. + +*) +\end{chunk} + \begin{chunk}{ATLUNIT.dotabb} "ATLUNIT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLUNIT"]; "ATLUNIT" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATLUNIT.dotfull} "LeftUnitaryAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLUNIT"]; "LeftUnitaryAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATLUNIT.dotpic} digraph pic { fontsize=10; @@ -2575,6 +2800,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ModularAlgebraicGcdOperations}{MAGCDOC} \pagepic{ps/v102modularalgebraicgcdoperations.ps}{MAGCDOC}{1.00} @@ -2609,6 +2835,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ModularAlgebraicGcdOperations.help} ==================================================================== ModularAlgebraicGcdOperations @@ -2699,18 +2926,21 @@ ModularAlgebraicGcdOperations(MPT : Type, MD : Type) : Category == ++ by packExps. \end{chunk} + \begin{chunk}{MAGCDOC.dotabb} "MAGCDOC" [color=lightblue,href="bookvol10.2.pdf#nameddest=MAGCDOC"]; "MAGCDOC" -> "CATEGORY" \end{chunk} + \begin{chunk}{MAGCDOC.dotfull} "ModularAlgebraicGcdOperations()" [color=lightblue,href="bookvol10.2.pdf#nameddest=MAGCDOC"]; "ModularAlgebraicGcdOperations(a:Type,b:Type)" -> "Category" \end{chunk} + \begin{chunk}{MAGCDOC.dotpic} digraph pic { fontsize=10; @@ -2724,9 +2954,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MultiplicativeValuationAttribute}{ATMULVA} \pagepic{ps/v102multiplicativevaluationattribute.eps}{ATMULVA}{1.00} + \begin{chunk}{MultiplicativeValuationAttribute.input} )set break resume )sys rm -f MultiplicativeValuationAttribute.output @@ -2758,6 +2990,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{MultiplicativeValuationAttribute.help} ==================================================================== MultiplicativeValuationAttribute @@ -2780,18 +3013,30 @@ o )show MultiplicativeValuationAttribute MultiplicativeValuationAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATMULVA} +(* category ATMULVA *) +(* +Axiom + euclideanSize(a*b)=euclideanSize(a)*euclideanSize(b) + +*) +\end{chunk} + \begin{chunk}{ATMULVA.dotabb} "ATMULVA" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATMULVA"]; "ATMULVA" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATMULVA.dotfull} "MultiplicativeValuationAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATMULVA"]; "MultiplicativeValuationAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATMULVA.dotpic} digraph pic { fontsize=10; @@ -2805,9 +3050,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NotherianAttribute}{ATNOTHR} \pagepic{ps/v102notherianattribute.eps}{ATNOTHR}{1.00} + \begin{chunk}{NotherianAttribute.input} )set break resume )sys rm -f NotherianAttribute.output @@ -2839,6 +3086,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{NotherianAttribute.help} ==================================================================== NotherianAttribute @@ -2859,18 +3107,21 @@ o )show NotherianAttribute NotherianAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATNOTHR.dotabb} "ATNOTHR" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNOTHR"]; "ATNOTHR" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATNOTHR.dotfull} "NotherianAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNOTHR"]; "NotherianAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATNOTHR.dotpic} digraph pic { fontsize=10; @@ -2884,9 +3135,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NoZeroDivisorsAttribute}{ATNZDIV} \pagepic{ps/v102nozerodivisorsattribute.eps}{ATNZDIV}{1.00} + \begin{chunk}{NoZeroDivisorsAttribute.input} )set break resume )sys rm -f NoZeroDivisorsAttribute.output @@ -2918,6 +3171,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{NoZeroDivisorsAttribute.help} ==================================================================== NoZeroDivisorsAttribute @@ -2940,18 +3194,31 @@ o )show NoZeroDivisorsAttribute NoZeroDivisorsAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATNZDIV} +(* category ATNZDIV *) +(* +Axiom + The class of all semirings such that x * y ~= 0 implies + both x and y are non-zero. + +*) +\end{chunk} + \begin{chunk}{ATNZDIV.dotabb} "ATNZDIV" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNZDIV"]; "ATNZDIV" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATNZDIV.dotfull} "NoZeroDivisorsAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNZDIV"]; "NoZeroDivisorsAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATNZDIV.dotpic} digraph pic { fontsize=10; @@ -2965,9 +3232,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NullSquareAttribute}{ATNULSQ} \pagepic{ps/v102nullsquareattribute.eps}{ATNULSQ}{1.00} + \begin{chunk}{NullSquareAttribute.input} )set break resume )sys rm -f NullSquareAttribute.output @@ -2999,6 +3268,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{NullSquareAttribute.help} ==================================================================== NullSquareAttribute @@ -3019,18 +3289,30 @@ o )show NullSquareAttribute NullSquareAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATNULSQ} +(* category ATNULSQ *) +(* +Axiom + NullSquare means that [x,x] = 0 holds. See LieAlgebra. + +*) +\end{chunk} + \begin{chunk}{ATNULSQ.dotabb} "ATNULSQ" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNULSQ"]; "ATNULSQ" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATNULSQ.dotfull} "NullSquareAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNULSQ"]; "NullSquareAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATNULSQ.dotpic} digraph pic { fontsize=10; @@ -3044,6 +3326,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OpenMath}{OM} \pagepic{ps/v102openmath.ps}{OM}{1.00} @@ -3074,6 +3357,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OpenMath.help} ==================================================================== OpenMath examples @@ -3129,18 +3413,21 @@ OpenMath(): Category == with ++ OMwrite(dev, u, false) writes the object as an OpenMath fragment. \end{chunk} + \begin{chunk}{OM.dotabb} "OM" [color=lightblue,href="bookvol10.2.pdf#nameddest=OM"]; "OM" -> "CATEGORY" \end{chunk} + \begin{chunk}{OM.dotfull} "OpenMath()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OM"]; "OpenMath()" -> "Category" \end{chunk} + \begin{chunk}{OM.dotpic} digraph pic { fontsize=10; @@ -3154,9 +3441,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PartiallyOrderedSetAttribute}{ATPOSET} \pagepic{ps/v102partiallyorderedsetattribute.eps}{ATPOSET}{1.00} + \begin{chunk}{PartiallyOrderedSetAttribute.input} )set break resume )sys rm -f PartiallyOrderedSetAttribute.output @@ -3188,6 +3477,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{PartiallyOrderedSetAttribute.help} ==================================================================== PartiallyOrderedSetAttribute @@ -3210,18 +3500,31 @@ o )show PartiallyOrderedSetAttribute PartiallyOrderedSetAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATPOSET} +(* category ATPOSET *) +(* +Axiom + PartiallyOrderedSet is true if a set with < is transitive, + but not(a "CATEGORY" \end{chunk} + \begin{chunk}{ATPOSET.dotfull} "PartiallyOrderedSetAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATPOSET"]; "PartiallyOrderedSetAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATPOSET.dotpic} digraph pic { fontsize=10; @@ -3235,6 +3538,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PartialTranscendentalFunctions}{PTRANFN} \pagepic{ps/v102partialtranscendentalfunctions.ps}{PTRANFN}{1.00} @@ -3276,6 +3580,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PartialTranscendentalFunctions.help} ==================================================================== PartialTranscendentalFunctions examples @@ -3443,12 +3748,14 @@ PartialTranscendentalFunctions(K): Category == Definition where ++ acschIfCan(z) returns acsch(z) if possible, and "failed" otherwise. \end{chunk} + \begin{chunk}{PTRANFN.dotabb} "PTRANFN" [color=lightblue,href="bookvol10.2.pdf#nameddest=PTRANFN"]; "PTRANFN" -> "CATEGORY" \end{chunk} + \begin{chunk}{PTRANFN.dotfull} "PartialTranscendentalFunctions(TranscendentalFunctionCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PTRANFN"]; @@ -3456,6 +3763,7 @@ PartialTranscendentalFunctions(K): Category == Definition where "Category()" \end{chunk} + \begin{chunk}{PTRANFN.dotpic} digraph pic { fontsize=10; @@ -3472,6 +3780,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Patternable}{PATAB} \pagepic{ps/v102patternable.ps}{PATAB}{1.00} @@ -3501,6 +3810,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Patternable.help} ==================================================================== Patternable examples @@ -3556,12 +3866,14 @@ Patternable(R:Type): Category == with ConvertibleTo Pattern Float \end{chunk} + \begin{chunk}{PATAB.dotabb} "PATAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=PATAB"]; "PATAB" -> "CATEGORY" \end{chunk} + \begin{chunk}{PATAB.dotfull} "Patternable(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PATAB"]; @@ -3580,6 +3892,7 @@ Patternable(R:Type): Category == with "Patternable(CommutativeRing)" -> "Patternable(a:Type)" \end{chunk} + \begin{chunk}{PATAB.dotpic} digraph pic { fontsize=10; @@ -3593,6 +3906,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PrimitiveFunctionCategory}{PRIMCAT} \pagepic{ps/v102primitivefunctioncategory.ps}{PRIMCAT}{1.00} @@ -3622,6 +3936,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PrimitiveFunctionCategory.help} ==================================================================== PrimitiveFunctionCategory examples @@ -3665,18 +3980,21 @@ PrimitiveFunctionCategory(): Category == with ++ of f dx for x between \spad{a} and b. \end{chunk} + \begin{chunk}{PRIMCAT.dotabb} "PRIMCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PRIMCAT"]; "PRIMCAT" -> "CATEGORY" \end{chunk} + \begin{chunk}{PRIMCAT.dotfull} "PrimitiveFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PRIMCAT"]; "PrimitiveFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{PRIMCAT.dotpic} digraph pic { fontsize=10; @@ -3690,6 +4008,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RadicalCategory}{RADCAT} \pagepic{ps/v102radicalcategory.ps}{RADCAT}{1.00} @@ -3719,6 +4038,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{RadicalCategory.help} ==================================================================== RadicalCategory examples @@ -3776,18 +4096,34 @@ RadicalCategory(): Category == with nthRoot(x, n) == x ** inv(n::Fraction(Integer)) \end{chunk} + +\begin{chunk}{COQ RADCAT} +(* category RADCAT *) +(* + sqrt : % -> % + sqrt x == x ** inv(2::Fraction(Integer)) + + nthRoot: (%, Integer) -> % + nthRoot(x, n) == x ** inv(n::Fraction(Integer)) + +*) + +\end{chunk} + \begin{chunk}{RADCAT.dotabb} "RADCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=RADCAT"]; "RADCAT" -> "CATEGORY" \end{chunk} + \begin{chunk}{RADCAT.dotfull} "RadicalCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=RADCAT"]; "RadicalCategory()" -> "Category" \end{chunk} + \begin{chunk}{RADCAT.dotpic} digraph pic { fontsize=10; @@ -3801,6 +4137,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RetractableTo}{RETRACT} \pagepic{ps/v102retractableto.ps}{RETRACT}{1.00} @@ -3830,6 +4167,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{RetractableTo.help} ==================================================================== RetractableTo examples @@ -3908,12 +4246,26 @@ RetractableTo(S: Type): Category == with u \end{chunk} + +\begin{chunk}{COQ RETRACT} +(* category RETRACT *) +(* + retract: % -> S + retract(s) == + (u:=retractIfCan s) case "failed" => error "not retractable" + u + +*) + +\end{chunk} + \begin{chunk}{RETRACT.dotabb} "RETRACT" [color=lightblue,href="bookvol10.2.pdf#nameddest=RETRACT"]; "RETRACT" -> "CATEGORY" \end{chunk} + \begin{chunk}{RETRACT.dotfull} "RetractableTo(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=RETRACT"]; @@ -3973,6 +4325,7 @@ RetractableTo(S: Type): Category == with "RetractableTo(OrderedFreeMonoid(OrderedSet))" -> "RetractableTo(a:Type)" \end{chunk} + \begin{chunk}{RETRACT.dotpic} digraph pic { fontsize=10; @@ -3986,9 +4339,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RightUnitaryAttribute}{ATRUNIT} \pagepic{ps/v102rightunitaryattribute.eps}{ATRUNIT}{1.00} + \begin{chunk}{RightUnitaryAttribute.input} )set break resume )sys rm -f RightUnitaryAttribute.output @@ -4019,6 +4374,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{RightUnitaryAttribute.help} ==================================================================== RightUnitaryAttribute @@ -4039,18 +4395,31 @@ o )show RightUnitaryAttribute RightUnitaryAttribute(): Category == with nil \end{chunk} + +\begin{chunk}{COQ ATRUNIT} +(* category ATRUNIT *) +(* +Axiom + RightUnitary is true if x * 1 = x for all x. + +*) + +\end{chunk} + \begin{chunk}{ATRUNIT.dotabb} "ATRUNIT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRUNIT"]; "ATRUNIT" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATRUNIT.dotfull} "RightUnitaryAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRUNIT"]; "RightUnitaryAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATRUNIT.dotpic} digraph pic { fontsize=10; @@ -4064,9 +4433,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ShallowlyMutableAttribute}{ATSHMUT} \pagepic{ps/v102shallowlymutableattribute.eps}{ATSHMUT}{1.00} + \begin{chunk}{ShallowlyMutableAttribute.input} )set break resume )sys rm -f ShallowlyMutableAttribute.output @@ -4098,6 +4469,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{ShallowlyMutableAttribute.help} ==================================================================== ShallowlyMutableAttribute @@ -4122,18 +4494,21 @@ o )show ShallowlyMutableAttribute ShallowlyMutableAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATSHMUT.dotabb} "ATSHMUT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATSHMUT"]; "ATSHMUT" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATSHMUT.dotfull} "ShallowlyMutableAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATSHMUT"]; "ShallowlyMutableAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATSHMUT.dotpic} digraph pic { fontsize=10; @@ -4147,6 +4522,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SpecialFunctionCategory}{SPFCAT} \pagepic{ps/v102specialfunctioncategory.ps}{SPFCAT}{1.00} @@ -4180,6 +4556,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SpecialFunctionCategory.help} ==================================================================== SpecialFunctionCategory examples @@ -4263,18 +4640,21 @@ SpecialFunctionCategory(): Category == with ++ airyBi(x) is the Airy function \spad{Bi(x)}. \end{chunk} + \begin{chunk}{SPFCAT.dotabb} "SPFCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SPFCAT"]; "SPFCAT" -> "CATEGORY" \end{chunk} + \begin{chunk}{SPFCAT.dotfull} "SpecialFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=SPFCAT"]; "SpecialFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{SPFCAT.dotpic} digraph pic { fontsize=10; @@ -4288,6 +4668,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{TrigonometricFunctionCategory}{TRIGCAT} \pagepic{ps/v102trigonometricfunctioncategory.ps}{TRIGCAT}{1.00} @@ -4321,6 +4702,7 @@ intermediate test to check that the argument has a reciprocal values. )spool )lisp (bye) \end{chunk} + \begin{chunk}{TrigonometricFunctionCategory.help} ==================================================================== TrigonometricFunctionCategory examples @@ -4387,18 +4769,45 @@ TrigonometricFunctionCategory(): Category == with cot x == cos x * csc x \end{chunk} + +\begin{chunk}{COQ TRIGCAT} +(* category TRIGCAT *) +(* + if $ has Ring then + + csc: $ -> $ ++ csc(x) returns the cosecant of x. + csc x == + (a := recip(sin x)) case "failed" => error "csc: no reciprocal" + a::$ + + sec: $ -> $ ++ sec(x) returns the secant of x. + sec x == + (a := recip(cos x)) case "failed" => error "sec: no reciprocal" + a::$ + + tan: $ -> $ ++ tan(x) returns the tangent of x. + tan x == sin x * sec x + + cot: $ -> $ ++ cot(x) returns the cotangent of x. + cot x == cos x * csc x + +*) +\end{chunk} + \begin{chunk}{TRIGCAT.dotabb} "TRIGCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=TRIGCAT"]; "TRIGCAT" -> "CATEGORY" \end{chunk} + \begin{chunk}{TRIGCAT.dotfull} "TrigonometricFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=TRIGCAT"]; "TrigonometricFunctionCategory()" -> "Category" \end{chunk} + \begin{chunk}{TRIGCAT.dotpic} digraph pic { fontsize=10; @@ -4412,6 +4821,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Type}{TYPE} \pagepic{ps/v102type.ps}{TYPE}{1.00} @@ -4448,7 +4858,6 @@ digraph pic { )lisp (bye) \end{chunk} - \begin{chunk}{Type.help} ==================================================================== Type examples @@ -4484,16 +4893,19 @@ o )show Type Type(): Category == with nil \end{chunk} + \begin{chunk}{TYPE.dotabb} "TYPE" [color=lightblue,href="bookvol10.2.pdf#nameddest=TYPE"]; "TYPE" -> "CATEGORY" \end{chunk} + \begin{chunk}{TYPE.dotfull} "Type()" [color=lightblue,href="bookvol10.2.pdf#nameddest=TYPE"]; "Type()" -> "Category" \end{chunk} + \begin{chunk}{TYPE.dotpic} digraph pic { fontsize=10; @@ -4507,9 +4919,11 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnitsKnownAttribute}{ATUNIKN} \pagepic{ps/v102unitsknownattribute.eps}{ATUNIKN}{1.00} + \begin{chunk}{UnitsKnownAttribute.input} )set break resume )sys rm -f UnitsKnownAttribute.output @@ -4541,6 +4955,7 @@ digraph pic { )lisp (bye) \end{chunk} + \begin{chunk}{UnitsKnownAttribute.help} ==================================================================== UnitsKnownAttribute @@ -4565,18 +4980,21 @@ o )show UnitsKnownAttribute UnitsKnownAttribute(): Category == with nil \end{chunk} + \begin{chunk}{ATUNIKN.dotabb} "ATUNIKN" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATUNIKN"]; "ATUNIKN" -> "CATEGORY" \end{chunk} + \begin{chunk}{ATUNIKN.dotfull} "UnitsKnownAttribute()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ATUNIKN"]; "UnitsKnownAttribute()" -> "Category" \end{chunk} + \begin{chunk}{ATUNIKN.dotpic} digraph pic { fontsize=10; @@ -4591,6 +5009,7 @@ digraph pic { \end{chunk} \chapter{Category Layer 2} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Aggregate}{AGG} \pagepic{ps/v102agg.ps}{AGG}{1.00} @@ -4625,6 +5044,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Aggregate.help} ==================================================================== Aggregate examples @@ -4745,17 +5165,46 @@ Aggregate: Category == Type with size?(a,n) == #a = n \end{chunk} + +\begin{chunk}{COQ AGG} +(* category AGG *) +(* + + eq?: (%,%) -> Boolean + eq?(a,b) == EQ(a,b)$Lisp + + sample: constant -> % + sample() == empty() + + if % has finiteAggregate then + + empty?: % -> Boolean + empty? a == #a = 0 + + less?: (%,NonNegativeInteger) -> Boolean + less?(a,n) == #a < n + + more?: (%,NonNegativeInteger) -> Boolean + more?(a,n) == #a > n + + size?: (%,NonNegativeInteger) -> Boolean + size?(a,n) == #a = n + +*) + \begin{chunk}{AGG.dotabb} "AGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=AGG"]; "AGG" -> "TYPE" \end{chunk} + \begin{chunk}{AGG.dotfull} "Aggregate()" [color=lightblue,href="bookvol10.2.pdf#nameddest=AGG"]; "Aggregate()" -> "Type()" \end{chunk} + \begin{chunk}{AGG.dotpic} digraph pic { fontsize=10; @@ -4772,6 +5221,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CombinatorialOpsCategory}{COMBOPC} \pagepic{ps/v102combinatorialopscategory.ps}{COMBOPC}{1.00} @@ -4805,6 +5255,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CombinatorialOpsCategory.help} ==================================================================== CombinatorialOpsCategory examples @@ -4879,18 +5330,21 @@ CombinatorialOpsCategory(): Category == ++ formal product; \end{chunk} + \begin{chunk}{COMBOPC.dotabb} "COMBOPC" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMBOPC"]; "COMBOPC" -> "CFCAT" \end{chunk} + \begin{chunk}{COMBOPC.dotfull} "CombinatorialOpsCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMBOPC"]; "CombinatorialOpsCategory()" -> "CombinatorialFunctionCategory()" \end{chunk} + \begin{chunk}{COMBOPC.dotpic} digraph pic { fontsize=10; @@ -4907,6 +5361,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Comparable}{COMPAR} \pagepic{ps/v102compar.eps}{COMPAR}{1.00} @@ -4937,6 +5392,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Comparable.help} ==================================================================== Comparable examples @@ -4968,17 +5424,20 @@ Comparable(): Category == SetCategory with ++ smaller?(x, y) is a strict total ordering on the elements of the set. \end{chunk} + \begin{chunk}{COMPAR.dotabb} "COMPAR" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPAR"]; "COMPAR" -> "SETCAT" \end{chunk} + \begin{chunk}{COMPAR.dotfull} "Comparable()" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPAR"]; "Comparable()" -> "SetCategory()" \end{chunk} + \begin{chunk}{COMPAR.dotpic} digraph pic { fontsize=10; @@ -5005,6 +5464,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{EltableAggregate}{ELTAGG} \pagepic{ps/v102eltableaggregate.ps}{ELTAGG}{0.75} @@ -5036,6 +5496,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{EltableAggregate.help} ==================================================================== EltableAggregate examples @@ -5131,23 +5592,45 @@ EltableAggregate(Dom:SetCategory, Im:Type): Category == ++ the domain of \axiom{u}. ++ If such a check is required use the function \axiom{setelt}. add + + qelt(a, x) == elt(a, x) + + if % has shallowlyMutable then + + qsetelt_!(a, x, y) == (a.x := y) + +\end{chunk} + +\begin{chunk}{COQ ELTAGG} +(* category ELTAGG *) +(* + + qelt: (%, Dom) -> Im qelt(a, x) == elt(a, x) + if % has shallowlyMutable then + + qsetelt_!: (%, Dom, Im) -> Im qsetelt_!(a, x, y) == (a.x := y) +*) + \end{chunk} + \begin{chunk}{ELTAGG.dotabb} "ELTAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAGG"]; "ELTAGG" -> "ELTAB" \end{chunk} + \begin{chunk}{ELTAGG.dotfull} "EltableAggregate(a:SetCategory,b:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAGG"]; "EltableAggregate(a:SetCategory,b:Type)" -> "Eltable(a:SetCategory,b:Type)" \end{chunk} + \begin{chunk}{ELTAGG.dotpic} digraph pic { fontsize=10; @@ -5164,6 +5647,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Evalable}{EVALAB} \pagepic{ps/v102evalable.ps}{EVALAB}{1.00} @@ -5193,6 +5677,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Evalable.help} ==================================================================== Evalable examples @@ -5252,12 +5737,27 @@ Evalable(R:SetCategory): Category == InnerEvalable(R,R) with eval(f:$, xs:List R,vs:List R) == eval(f,[x=v for x in xs for v in vs]) \end{chunk} + +\begin{chunk}{COQ EVALAB} +(* category EVALAB *) +(* + eval: ($, Equation R) -> $ + eval(f:$, eq:Equation R) == eval(f, [eq]) + + eval: ($, List Equation R) -> $ + eval(f:$, xs:List R,vs:List R) == eval(f,[x=v for x in xs for v in vs]) + +*) + +\end{chunk} + \begin{chunk}{EVALAB.dotabb} "EVALAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=EVALAB"]; "EVALAB" -> "IEVALAB" \end{chunk} + \begin{chunk}{EVALAB.dotfull} "Evalable(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=EVALAB"]; @@ -5278,6 +5778,7 @@ Evalable(R:SetCategory): Category == InnerEvalable(R,R) with -> "Evalable(a:SetCategory)" \end{chunk} + \begin{chunk}{EVALAB.dotpic} digraph pic { fontsize=10; @@ -5298,6 +5799,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranProgramCategory}{FORTCAT} \pagepic{ps/v102fortranprogramcategory.ps}{FORTCAT}{1.00} @@ -5326,6 +5828,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranProgramCategory.help} ==================================================================== FortranProgramCategory examples @@ -5384,6 +5887,7 @@ FortranProgramCategory():Category == Join(Type,CoercibleTo OutputForm) with ++ subprogram. \end{chunk} + \begin{chunk}{FORTCAT.dotabb} "FORTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTCAT"]; @@ -5391,6 +5895,7 @@ FortranProgramCategory():Category == Join(Type,CoercibleTo OutputForm) with "FORTCAT" -> "TYPE" \end{chunk} + \begin{chunk}{FORTCAT.dotfull} "FortranProgramCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTCAT"]; @@ -5421,6 +5926,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FullyRetractableTo}{FRETRCT} \pagepic{ps/v102fullyretractableto.ps}{FRETRCT}{1.00} @@ -5550,6 +6056,44 @@ FullyRetractableTo(S: Type): Category == RetractableTo(S) with retractIfCan(u::S) \end{chunk} + +\begin{chunk}{COQ FRETRCT} +(* category FRETRCT *) +(* + if not(S is Integer) then + + if (S has RetractableTo Integer) then -- induction + + coerce : Integer -> % + coerce(n:Integer):% == n::S::% + + retract : % -> Integer + retract(r:%):Integer == retract(retract(r)@S) + + retractIfCan : % -> Union(Integer,"failed") + retractIfCan(r:%):Union(Integer, "failed") == + (u:= retractIfCan(r)@Union(S,"failed")) case "failed"=> "failed" + retractIfCan(u::S) + + if not(S is Fraction Integer) then + + if (S has RetractableTo Fraction Integer) then -- induction + + coerce : Fraction Integer -> % + coerce(n:Fraction Integer):% == n::S::% + + retract : % -> Fraction Integer + retract(r:%):Fraction(Integer) == retract(retract(r)@S) + + retractIfCan : % -> Union(Fraction Integer,"failed") + retractIfCan(r:%):Union(Fraction Integer, "failed") == + (u:=retractIfCan(r)@Union(S,"failed")) case "failed"=>"failed" + retractIfCan(u::S) + +*) + +\end{chunk} + \begin{chunk}{FRETRCT.dotabb} "FRETRCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FRETRCT"]; @@ -5578,6 +6122,7 @@ FullyRetractableTo(S: Type): Category == RetractableTo(S) with "FullyRetractableTo(Fraction(Integer))" -> "FullyRetractableTo(a:Type)" \end{chunk} + \begin{chunk}{FRETRCT.dotpic} digraph pic { fontsize=10; @@ -5594,6 +6139,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FullyPatternMatchable}{FPATMAB} \pagepic{ps/v102fullypatternmatchable.ps}{FPATMAB}{1.00} @@ -5712,12 +6258,14 @@ FullyPatternMatchable(R:Type): Category == Type with if R has PatternMatchable Float then PatternMatchable Float \end{chunk} + \begin{chunk}{FPATMAB.dotabb} "FPATMAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=FPATMAB"]; "FPATMAB" -> "TYPE" \end{chunk} + \begin{chunk}{FPATMAB.dotfull} "FullyPatternMatchable(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FPATMAB"]; @@ -5739,6 +6287,7 @@ FullyPatternMatchable(R:Type): Category == Type with "FullyPatternMatchable(a:Type)" \end{chunk} + \begin{chunk}{FPATMAB.dotpic} digraph pic { fontsize=10; @@ -5755,6 +6304,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Logic}{LOGIC} \pagepic{ps/v102logic.ps}{LOGIC}{1.00} @@ -5845,6 +6395,17 @@ Logic: Category == BasicType with _\_/(x: %,y: %) == _~( _/_\(_~(x), _~(y))) \end{chunk} + +\begin{chunk}{COQ LOGIC} +(* category LOGIC *) +(* + _\_/: (%, %) -> % + _\_/(x: %,y: %) == _~( _/_\(_~(x), _~(y))) + +*) + +\end{chunk} + \begin{chunk}{LOGIC.dotabb} "LOGIC" [color=lightblue,href="bookvol10.2.pdf#nameddest=LOGIC"]; @@ -5873,6 +6434,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PlottablePlaneCurveCategory}{PPCURVE} \pagepic{ps/v102plottableplanecurvecategory.ps}{PPCURVE}{1.00} @@ -5969,18 +6531,21 @@ PlottablePlaneCurveCategory(): Category == Definition where ++ on the curve c. \end{chunk} + \begin{chunk}{PPCURVE.dotabb} "PPCURVE" [color=lightblue,href="bookvol10.2.pdf#nameddest=PPCURVE"]; "PPCURVE" -> "KOERCE" \end{chunk} + \begin{chunk}{PPCURVE.dotfull} "PlottablePlaneCurveCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PPCURVE"]; "PlottablePlaneCurveCategory()" -> "CoercibleTo(OutputForm)" \end{chunk} + \begin{chunk}{PPCURVE.dotpic} digraph pic { fontsize=10; @@ -6000,6 +6565,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PlottableSpaceCurveCategory}{PSCURVE} \pagepic{ps/v102plottablespacecurvecategory.ps}{PSCURVE}{1.00} @@ -6106,18 +6672,21 @@ PlottableSpaceCurveCategory(): Category == Definition where ++ on the curve c. \end{chunk} + \begin{chunk}{PSCURVE.dotabb} "PSCURVE" [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCURVE"]; "PSCURVE" -> "KOERCE" \end{chunk} + \begin{chunk}{PSCURVE.dotfull} "PlottableSpaceCurveCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCURVE"]; "PlottableSpaceCurveCategory()" -> "CoercibleTo(OutputForm)" \end{chunk} + \begin{chunk}{PSCURVE.dotpic} digraph pic { fontsize=10; @@ -6137,6 +6706,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RealConstant}{REAL} \pagepic{ps/v102realconstant.ps}{REAL}{1.00} @@ -6208,12 +6778,14 @@ RealConstant(): Category == Join(ConvertibleTo DoubleFloat, ConvertibleTo Float) \end{chunk} + \begin{chunk}{REAL.dotabb} "REAL" [color=lightblue,href="bookvol10.2.pdf#nameddest=REAL"]; "REAL" -> "KONVERT" \end{chunk} + \begin{chunk}{REAL.dotfull} "RealConstant()" [color=lightblue,href="bookvol10.2.pdf#nameddest=REAL"]; @@ -6221,6 +6793,7 @@ RealConstant(): Category == "RealConstant()" -> "ConvertibleTo(Float)" \end{chunk} + \begin{chunk}{REAL.dotpic} digraph pic { fontsize=10; @@ -6244,6 +6817,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SegmentCategory}{SEGCAT} \pagepic{ps/v102segmentcategory.ps}{SEGCAT}{1.00} @@ -6362,12 +6936,14 @@ SegmentCategory(S:Type): Category == Type with ++ convert(i) creates the segment \spad{i..i}. \end{chunk} + \begin{chunk}{SEGCAT.dotabb} "SEGCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGCAT"]; "SEGCAT" -> "TYPE" \end{chunk} + \begin{chunk}{SEGCAT.dotfull} "SegmentCategory(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGCAT"]; @@ -6378,6 +6954,7 @@ SegmentCategory(S:Type): Category == Type with "SegmentCategory(OrderedRing)" -> "SegmentCategory(a:Type)" \end{chunk} + \begin{chunk}{SEGCAT.dotpic} digraph pic { fontsize=10; @@ -6394,6 +6971,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SetCategory}{SETCAT} \pagepic{ps/v102setcategory.ps}{SETCAT}{1.00} @@ -6514,6 +7092,21 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with latex(s : %): String == "\mbox{\bf Unimplemented}" \end{chunk} + +\begin{chunk}{COQ SETCAT} +(* category SETCAT *) +(* + + hash: % -> SingleInteger + hash(s : %): SingleInteger == SXHASH(s)$Lisp + + latex: % -> String + latex(s : %): String == "\mbox{\bf Unimplemented}" + +*) + +\end{chunk} + \begin{chunk}{SETCAT.dotabb} "SETCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCAT"]; @@ -6521,6 +7114,7 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with "SETCAT" -> "KOERCE" \end{chunk} + \begin{chunk}{SETCAT.dotfull} "SetCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCAT"]; @@ -6528,6 +7122,7 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with "SetCategory()" -> "CoercibleTo(OutputForm)" \end{chunk} + \begin{chunk}{SETCAT.dotpic} digraph pic { fontsize=10; @@ -6552,6 +7147,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{TranscendentalFunctionCategory}{TRANFUN} \pagepic{ps/v102transcendentalfunctioncategory.ps}{TRANFUN}{0.75} @@ -6739,6 +7335,54 @@ TranscendentalFunctionCategory(): Category == atanh x == (log(1+x)-log(1-x))/2::$ \end{chunk} + +\begin{chunk}{COQ TRANFUN} +(* category TRANFUN *) +(* + if $ has Ring then + + pi : () -> $ ++ pi() returns the constant pi. + pi() == 2*asin(1) + + acsch : % -> % + acsch x == + (a := recip x) case "failed" => error "acsch: no reciprocal" + asinh(a::$) + + asech : % -> % + asech x == + (a := recip x) case "failed" => error "asech: no reciprocal" + acosh(a::$) + + acoth : % -> % + acoth x == + (a := recip x) case "failed" => error "acoth: no reciprocal" + atanh(a::$) + + if $ has Field and $ has sqrt: $ -> $ then + + asin : % -> % + asin x == atan(x/sqrt(1-x**2)) + + acos : % -> % + acos x == pi()/2::$ - asin x + + acot : % -> % + acot x == pi()/2::$ - atan x + + asinh : % -> % + asinh x == log(x + sqrt(x**2 + 1)) + + acosh : % -> % + acosh x == 2*log(sqrt((x+1)/2::$) + sqrt((x-1)/2::$)) + + atanh : % -> % + atanh x == (log(1+x)-log(1-x))/2::$ + +*) + +\end{chunk} + \begin{chunk}{TRANFUN.dotabb} "TRANFUN" [color=lightblue,href="bookvol10.2.pdf#nameddest=TRANFUN"]; @@ -6903,10 +7547,26 @@ AbelianSemiGroup(): Category == SetCategory with ++ integer n. This is equivalent to adding x to itself n times. add import RepeatedDoubling(%) + + if not (% has Ring) then + n:PositiveInteger * x:% == double(n,x) + +\end{chunk} + +\begin{chunk}{COQ ABELSG} +(* category ABELSG *) +(* + import RepeatedDoubling(%) + if not (% has Ring) then + + "*": (PositiveInteger,%) -> % n:PositiveInteger * x:% == double(n,x) +*) + \end{chunk} + \begin{chunk}{ABELSG.dotabb} "ABELSG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELSG"]; @@ -6914,6 +7574,7 @@ AbelianSemiGroup(): Category == SetCategory with "ABELSG" -> "REPDB" \end{chunk} + \begin{chunk}{ABELSG.dotfull} "AbelianSemiGroup()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELSG"]; @@ -6921,6 +7582,7 @@ AbelianSemiGroup(): Category == SetCategory with "AbelianSemiGroup()" -> "RepeatedDoubling(a:SetCategory)" \end{chunk} + \begin{chunk}{ABELSG.dotpic} digraph pic { fontsize=10; @@ -6957,6 +7619,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BlowUpMethodCategory}{BLMETCT} \pagepic{ps/v102blowupmethodcategory.ps}{BLMETCT}{0.75} @@ -6991,6 +7654,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{BlowUpMethodCategory.help} ==================================================================== BlowUpMethodCategory examples @@ -7071,18 +7735,21 @@ BlowUpMethodCategory:Category == SetCategory with type: % -> Union("left","center","right","vertical","horizontal") \end{chunk} + \begin{chunk}{BLMETCT.dotabb} "BLMETCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=BLMETCT"]; "BLMETCT" -> "SETCAT" \end{chunk} + \begin{chunk}{BLMETCT.dotfull} "BlowUpMethodCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=BLMETCT"]; "BlowUpMethodCategory()" -> "SetCategory()" \end{chunk} + \begin{chunk}{BLMETCT.dotpic} digraph pic { fontsize=10; @@ -7110,6 +7777,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DesingTreeCategory}{DSTRCAT} \pagepic{ps/v102desingtreecategory.eps}{DSTRCAT}{0.75} @@ -7313,18 +7981,21 @@ DesingTreeCategory(S: SetCategory):Category == RecursiveAggregate(S) with ++ tree(l) creates a chain tree from the list l \end{chunk} + \begin{chunk}{DSTRCAT.dotabb} "DSTRCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DSTRCAT"]; "EVALAB" [color="#4488FF",href="bookvol10.2.pdf#nameddest=EVALAB"] "DSTRCAT" -> "EVALAB" \end{chunk} + \begin{chunk}{DSTRCAT.dotfull} "DesingTreeCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=DSTRCAT"]; "DesingTreeCategory()" -> "Evalable()" \end{chunk} + \begin{chunk}{DSTRCAT.dotpic} digraph pic { fontsize=10; @@ -7349,6 +8020,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranFunctionCategory}{FORTFN} \pagepic{ps/v102fortranfunctioncategory.ps}{FORTFN}{1.00} @@ -7389,6 +8061,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranFunctionCategory.help} ==================================================================== FortranFunctionCategory examples @@ -7505,18 +8178,21 @@ FortranFunctionCategory():Category == FortranProgramCategory with -- of FortranExpression. \end{chunk} + \begin{chunk}{FORTFN.dotabb} "FORTFN" [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTFN"]; "FORTFN" -> "FORTCAT" \end{chunk} + \begin{chunk}{FORTFN.dotfull} "FortranFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTFN"]; "FortranFunctionCategory()" -> "FortranProgramCategory()" \end{chunk} + \begin{chunk}{FORTFN.dotpic} digraph pic { fontsize=10; @@ -7543,6 +8219,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranMatrixCategory}{FMC} \pagepic{ps/v102fortranmatrixcategory.ps}{FMC}{1.00} @@ -7574,6 +8251,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranMatrixCategory.help} ==================================================================== FortranMatrixCategory examples @@ -7642,18 +8320,21 @@ FortranMatrixCategory():Category == FortranProgramCategory with ++ making the declarations in the \spadtype{SymbolTable} component. \end{chunk} + \begin{chunk}{FMC.dotabb} "FMC" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMC"]; "FMC" -> "FORTCAT" \end{chunk} + \begin{chunk}{FMC.dotfull} "FortranMatrixCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMC"]; "FortranMatrixCategory()" -> "FortranProgramCategory()" \end{chunk} + \begin{chunk}{FMC.dotpic} digraph pic { fontsize=10; @@ -7680,6 +8361,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranMatrixFunctionCategory}{FMFUN} \pagepic{ps/v102fortranmatrixfunctioncategory.ps}{FMFUN}{1.00} @@ -7722,6 +8404,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranMatrixFunctionCategory.help} ==================================================================== FortranMatrixFunctionCategory examples @@ -7838,18 +8521,21 @@ FortranMatrixFunctionCategory():Category == FortranProgramCategory with -- of Matrix FortranExpression. \end{chunk} + \begin{chunk}{FMFUN.dotabb} "FMFUN" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMFUN"]; "FMFUN" -> "FORTCAT" \end{chunk} + \begin{chunk}{FMFUN.dotfull} "FortranMatrixFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMFUN"]; "FortranMatrixFunctionCategory()" -> "FortranProgramCategory()" \end{chunk} + \begin{chunk}{FMFUN.dotpic} digraph pic { fontsize=10; @@ -7876,6 +8562,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranVectorCategory}{FVC} \pagepic{ps/v102fortranvectorcategory.ps}{FVC}{1.00} @@ -7907,6 +8594,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranVectorCategory.help} ==================================================================== FortranVectorCategory examples @@ -7974,18 +8662,21 @@ FortranVectorCategory():Category == FortranProgramCategory with ++ making the declarations in the \spadtype{SymbolTable} component. \end{chunk} + \begin{chunk}{FVC.dotabb} "FVC" [color=lightblue,href="bookvol10.2.pdf#nameddest=FVC"]; "FVC" -> "FORTCAT" \end{chunk} + \begin{chunk}{FVC.dotfull} "FortranVectorCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FVC"]; "FortranVectorCategory()" -> "FortranProgramCategory()" \end{chunk} + \begin{chunk}{FVC.dotpic} digraph pic { fontsize=10; @@ -8012,6 +8703,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranVectorFunctionCategory}{FVFUN} \pagepic{ps/v102fortranvectorfunctioncategory.ps}{FVFUN}{1.00} @@ -8054,6 +8746,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranVectorFunctionCategory.help} ==================================================================== FortranVectorFunctionCategory examples @@ -8170,18 +8863,21 @@ FortranVectorFunctionCategory():Category == FortranProgramCategory with -- of Vector FortranExpression. \end{chunk} + \begin{chunk}{FVFUN.dotabb} "FVFUN" [color=lightblue,href="bookvol10.2.pdf#nameddest=FVFUN"]; "FVFUN" -> "FORTCAT" \end{chunk} + \begin{chunk}{FVFUN.dotfull} "FortranVectorFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FVFUN"]; "FortranVectorFunctionCategory()" -> "FortranProgramCategory()" \end{chunk} + \begin{chunk}{FVFUN.dotpic} digraph pic { fontsize=10; @@ -8208,6 +8904,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FullyEvalableOver}{FEVALAB} \pagepic{ps/v102fullyevalableover.ps}{FEVALAB}{0.75} @@ -8243,6 +8940,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FullyEvalableOver.help} ==================================================================== FullyEvalableOver examples @@ -8319,6 +9017,28 @@ FullyEvalableOver(R:SetCategory): Category == with eval(x:$, ls:List Symbol, lv:List R) == map(y +-> eval(y, ls, lv), x) \end{chunk} + +\begin{chunk}{COQ FEVALAB} +(* category FEVALAB *) +(* + if R has Eltable(R, R) then + + elt(x:$, r:R) == map(y +-> y(r), x) + + if R has Evalable(R) then + + eval : (%,List(Equation(R))) -> % + eval(x:$, l:List Equation R) == map(y +-> eval(y, l), x) + + if R has InnerEvalable(Symbol, R) then + + eval : (%,List(Symbol),List(R)) -> % + eval(x:$, ls:List Symbol, lv:List R) == map(y +-> eval(y, ls, lv), x) + +*) + +\end{chunk} + \begin{chunk}{FEVALAB.dotabb} "FEVALAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=FEVALAB"]; @@ -8328,6 +9048,7 @@ FullyEvalableOver(R:SetCategory): Category == with "FEVALAB" -> "CATEGORY" \end{chunk} + \begin{chunk}{FEVALAB.dotfull} "FullyEvalableOver(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FEVALAB"]; @@ -8346,6 +9067,7 @@ FullyEvalableOver(R:SetCategory): Category == with "FullyEvalableOver(a:SetCategory)" \end{chunk} + \begin{chunk}{FEVALAB.dotpic} digraph pic { fontsize=10; @@ -8380,6 +9102,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FileCategory}{FILECAT} \pagepic{ps/v102filecategory.ps}{FILECAT}{1.00} @@ -8414,6 +9137,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FileCategory.help} ==================================================================== FileCategory examples @@ -8522,18 +9246,21 @@ FileCategory(Name, S): Category == FCdefinition where ++ flush(f) makes sure that buffered data is written out \end{chunk} + \begin{chunk}{FILECAT.dotabb} "FILECAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FILECAT"]; "FILECAT" -> "SETCAT" \end{chunk} + \begin{chunk}{FILECAT.dotfull} "FileCategory(a:SetCategory,b:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FILECAT"]; "FileCategory(a:SetCategory,b:SetCategory)" -> "SetCategory()" \end{chunk} + \begin{chunk}{FILECAT.dotpic} digraph pic { fontsize=10; @@ -8561,6 +9288,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Finite}{FINITE} \pagepic{ps/v102finite.ps}{FINITE}{1.00} @@ -8593,6 +9321,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Finite.help} ==================================================================== Finite examples @@ -8691,18 +9420,39 @@ Finite(): Category == SetCategory with enumerate() == [index(i::PositiveInteger) for i in 1..size()] \end{chunk} + +\begin{chunk}{COQ FINITE} +(* category FINITE *) +(* + +Axioms: + lookup(index(n)) = n + index(lookup(s)) = s + + random: () -> % + random() == index((1+random(size()$%))::PositiveInteger) + + enumerate: () -> List % + enumerate() == [index(i::PositiveInteger) for i in 1..size()] + +*) + +\end{chunk} + \begin{chunk}{FINITE.dotabb} "FINITE" [color=lightblue,href="bookvol10.2.pdf#nameddest=FINITE"]; "FINITE" -> "SETCAT" \end{chunk} + \begin{chunk}{FINITE.dotfull} "Finite()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FINITE"]; "Finite()" -> "SetCategory()" \end{chunk} + \begin{chunk}{FINITE.dotpic} digraph pic { fontsize=10; @@ -8730,6 +9480,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FileNameCategory}{FNCAT} \pagepic{ps/v102filenamecategory.ps}{FNCAT}{0.70} @@ -8765,6 +9516,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FileNameCategory.help} ==================================================================== FileNameCategory examples @@ -8864,18 +9616,21 @@ FileNameCategory(): Category == SetCategory with ++ directory. \end{chunk} + \begin{chunk}{FNCAT.dotabb} "FNCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FNCAT"]; "FNCAT" -> "SETCAT" \end{chunk} + \begin{chunk}{FNCAT.dotfull} "FileNameCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FNCAT"]; "FileNameCategory()" -> "SetCategory()" \end{chunk} + \begin{chunk}{FNCAT.dotpic} digraph pic { fontsize=10; @@ -8904,6 +9659,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{GradedModule}{GRMOD} \pagepic{ps/v102gradedmodule.ps}{GRMOD}{1.00} @@ -8937,6 +9693,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{GradedModule.help} ==================================================================== GradedModule examples @@ -9051,18 +9808,32 @@ GradedModule(R: CommutativeRing, E: AbelianMonoid): Category == (x: %) - (y: %) == x+(-y) \end{chunk} + +\begin{chunk}{COQ GRMOD} +(* category GRMOD *) +(* + + -: (%, %) -> % + (x: %) - (y: %) == x+(-y) + +*) + +\end{chunk} + \begin{chunk}{GRMOD.dotabb} "GRMOD" [color=lightblue,href="bookvol10.2.pdf#nameddest=GRMOD"]; "GRMOD" -> "SETCAT" \end{chunk} + \begin{chunk}{GRMOD.dotfull} "GradedModule(a:CommutativeRing,b:AbelianMonoid)" [color=lightblue,href="bookvol10.2.pdf#nameddest=GRMOD"]; "GradedModule(a:CommutativeRing,b:AbelianMonoid)" -> "SetCategory()" \end{chunk} + \begin{chunk}{GRMOD.dotpic} digraph pic { fontsize=10; @@ -9090,6 +9861,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LeftOreRing}{LORER} \pagepic{ps/v102leftorering.eps}{LORER}{1.00} @@ -9161,18 +9933,21 @@ LeftOreRing : Category == EntireRing with ++ and llcm_res = coeff1*c1 = coeff2*c2 \end{chunk} + \begin{chunk}{LORER.dotabb} "LORER" [color=lightblue,href="bookvol10.2.pdf#nameddest=LORER"]; "LORER" -> "BMODULE" \end{chunk} + \begin{chunk}{LORER.dotfull} "LeftOreRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=LORER"]; "LeftOreRing()" -> "EntireRing()" \end{chunk} + \begin{chunk}{LORER.dotpic} digraph pic { fontsize=10; @@ -9186,6 +9961,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{HomogeneousAggregate}{HOAGG} \pagepic{ps/v102homogeneousaggregate.ps}{HOAGG}{1.00} @@ -9237,6 +10013,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{HomogeneousAggregate.help} ==================================================================== HomogeneousAggregate examples @@ -9436,6 +10213,53 @@ HomogeneousAggregate(S:Type): Category == Aggregate with commaSeparate [a::OutputForm for a in parts x]$List(OutputForm) \end{chunk} + +\begin{chunk}{COQ HOAGG} +(* category HOAGG *) +(* + if S has Evalable S then + + eval : (%,List(Equation(S))) -> % + eval(u:%,l:List Equation S):% == map(x +-> eval(x,l),u) + + if % has finiteAggregate then + + #? : % -> NonNegativeInteger + #c == # parts c + + any?: (S->Boolean,%) -> Boolean + any?(f, c) == _or/[f x for x in parts c] + + every?: (S->Boolean,%) -> Boolean + every?(f, c) == _and/[f x for x in parts c] + + count: (S->Boolean,%) -> NonNegativeInteger + count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x] + + members: % -> List S + members x == parts x + + if S has SetCategory then + + count: (S,%) -> NonNegativeInteger + count(s:S, x:%) == count(y +-> s = y, x) + + member?: (S,%) -> Boolean + member?(e, c) == any?(x +-> e = x,c) + + ?=? : (%,%) -> Boolean + x = y == + size?(x, #y) and _and/[a = b for a in parts x for b in parts y] + + coerce : % -> OutputForm + coerce(x:%):OutputForm == + bracket + commaSeparate [a::OutputForm for a in parts x]$List(OutputForm) + +*) + +\end{chunk} + \begin{chunk}{HOAGG.dotabb} "HOAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=HOAGG"]; "HOAGG" -> "AGG" @@ -9452,6 +10276,7 @@ HomogeneousAggregate(S:Type): Category == Aggregate with -> "HomogeneousAggregate(a:Type)" \end{chunk} + \begin{chunk}{HOAGG.dotpic} digraph pic { fontsize=10; @@ -9489,6 +10314,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{IndexedDirectProductCategory}{IDPC} \pagepic{ps/v102liouvillianfunctioncategory.ps}{IDPC}{1.00} @@ -9521,6 +10347,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{IndexedDirectProductCategory.help} ==================================================================== IndexedDirectProductCategory examples @@ -9600,12 +10427,14 @@ IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category == ++ Error: if z has no support. \end{chunk} + \begin{chunk}{IDPC.dotabb} "IDPC" [color=lightblue,href="bookvol10.2.pdf#nameddest=IDPC"]; "IDPC" -> "SETCAT" \end{chunk} + \begin{chunk}{IDPC.dotfull} "IndexedDirectProductCategory(a:SetCategory,b:OrderedSet)" [color=lightblue,href="bookvol10.2.pdf#nameddest=IDPC"]; @@ -9613,6 +10442,7 @@ IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category == "SetCategory()" \end{chunk} + \begin{chunk}{IDPC.dotpic} digraph pic { fontsize=10; @@ -9641,6 +10471,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LiouvillianFunctionCategory}{LFCAT} \pagepic{ps/v102liouvillianfunctioncategory.ps}{LFCAT}{0.60} @@ -9688,6 +10519,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LiouvillianFunctionCategory.help} ==================================================================== LiouvillianFunctionCategory examples @@ -9840,6 +10672,7 @@ LiouvillianFunctionCategory(): Category == ++ C(x) = integrate(cos(t^2),t=0..x) \end{chunk} + \begin{chunk}{LFCAT.dotabb} "LFCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=LFCAT"]; @@ -9847,6 +10680,7 @@ LiouvillianFunctionCategory(): Category == "LFCAT" -> "TRANFUN" \end{chunk} + \begin{chunk}{LFCAT.dotfull} "LiouvillianFunctionCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=LFCAT"]; @@ -9854,6 +10688,7 @@ LiouvillianFunctionCategory(): Category == "LiouvillianFunctionCategory()" -> "TranscendentalFunctionCategory()" \end{chunk} + \begin{chunk}{LFCAT.dotpic} digraph pic { fontsize=10; @@ -9898,6 +10733,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Monad}{MONAD} \pagepic{ps/v102monad.ps}{MONAD}{0.70} @@ -9931,6 +10767,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Monad.help} ==================================================================== Monad examples @@ -10033,12 +10870,41 @@ Monad(): Category == SetCategory with res \end{chunk} + +\begin{chunk}{COQ MONAD} +(* category MONAD *) +(* + + import RepeatedSquaring(%) + + "**": (%,PositiveInteger) -> % + x:% ** n:PositiveInteger == expt(x,n) + + rightPower: (%,PositiveInteger) -> % + rightPower(a,n) == + (n = 1) => a + res := a + for i in 1..(n-1) repeat res := res * a + res + + leftPower: (%,PositiveInteger) -> % + leftPower(a,n) == + (n = 1) => a + res := a + for i in 1..(n-1) repeat res := a * res + res + +*) + +\end{chunk} + \begin{chunk}{MONAD.dotabb} "MONAD" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONAD"]; "MONAD" -> "SETCAT" \end{chunk} + \begin{chunk}{MONAD.dotfull} "Monad()" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONAD"]; @@ -10046,6 +10912,7 @@ Monad(): Category == SetCategory with "Monad()" -> "RepeatedSquaring(Monad)" \end{chunk} + \begin{chunk}{MONAD.dotpic} digraph pic { fontsize=10; @@ -10082,6 +10949,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NumericalIntegrationCategory}{NUMINT} \pagepic{ps/v102numericalintegrationcategory.ps}{NUMINT}{1.00} @@ -10116,6 +10984,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{NumericalIntegrationCategory.help} ==================================================================== NumericalIntegrationCategory examples @@ -10282,6 +11151,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NumericalOptimizationCategory}{OPTCAT} \pagepic{ps/v102numericaloptimizationcategory.ps}{OPTCAT}{1.00} @@ -10316,6 +11186,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{NumericalOptimizationCategory.help} ==================================================================== NumericalOptimizationCategory examples @@ -10437,18 +11308,21 @@ NumericalOptimizationCategory(): Category == Exports where ++ function given the strategy or method returned by \axiomFun{measure}. \end{chunk} + \begin{chunk}{OPTCAT.dotabb} "OPTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=OPTCAT"]; "OPTCAT" -> "SETCAT" \end{chunk} + \begin{chunk}{OPTCAT.dotfull} "NumericalOptimizationCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OPTCAT"]; "NumericalOptimizationCategory()" -> "SetCategory()" \end{chunk} + \begin{chunk}{OPTCAT.dotpic} digraph pic { fontsize=10; @@ -10476,6 +11350,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrdinaryDifferentialEquationsSolverCategory}{ODECAT} \pagepic{ps/v102ordinarydifferentialequationssolvercategory.ps}{ODECAT}{1.00} @@ -10508,6 +11383,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrdinaryDifferentialEquationsSolverCategory.help} ==================================================================== OrdinaryDifferentialEquationsSolverCategory examples @@ -10608,6 +11484,7 @@ OrdinaryDifferentialEquationsSolverCategory(): Category == Exports where ++ function given the strategy or method returned by \axiomFun{measure}. \end{chunk} + \begin{chunk}{ODECAT.dotabb} "ODECAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ODECAT"]; @@ -10648,6 +11525,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedSet}{ORDSET} \pagepic{ps/v102orderedset.ps}{ORDSET}{1.00} @@ -10681,6 +11559,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedSet.help} ==================================================================== OrderedSet examples @@ -10796,18 +11675,51 @@ OrderedSet(): Category == SetCategory with ((x: %) <= (y: %)) : Boolean == not (y < x) \end{chunk} + +\begin{chunk}{COQ ORDSET} +(* category ORDSET *) +(* + x,y: % + + -- These really ought to become some sort of macro + + max: (%,%) -> % + max(x,y) == + x > y => x + y + + min: (%,%) -> % + min(x,y) == + x > y => y + x + + ">": (%, %) -> Boolean + ((x: %) > (y: %)) : Boolean == y < x + + ">=": (%, %) -> Boolean + ((x: %) >= (y: %)) : Boolean == not (x < y) + + "<=": (%, %) -> Boolean + ((x: %) <= (y: %)) : Boolean == not (y < x) + +*) + +\end{chunk} + \begin{chunk}{ORDSET.dotabb} "ORDSET" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDSET"]; "ORDSET" -> "SETCAT" \end{chunk} + \begin{chunk}{ORDSET.dotfull} "OrderedSet()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDSET"]; "OrderedSet()" -> "SetCategory()" \end{chunk} + \begin{chunk}{ORDSET.dotpic} digraph pic { fontsize=10; @@ -10834,6 +11746,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PartialDifferentialEquationsSolverCategory}{PDECAT} \pagepic{ps/v102partialdifferentialequationssolvercategory.ps}{PDECAT}{1.00} @@ -10866,6 +11779,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PartialDifferentialEquationsSolverCategory.help} ==================================================================== PartialDifferentialEquationsSolverCategory examples @@ -11035,6 +11949,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PatternMatchable}{PATMAB} \pagepic{ps/v102patternmatchable.ps}{PATMAB}{1.00} @@ -11130,12 +12045,14 @@ PatternMatchable(S:SetCategory): Category == SetCategory with ++ which is an empty list of matches. \end{chunk} + \begin{chunk}{PATMAB.dotabb} "PATMAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=PATMAB"]; "PATMAB" -> "SETCAT" \end{chunk} + \begin{chunk}{PATMAB.dotfull} "PatternMatchable(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PATMAB"]; @@ -11150,6 +12067,7 @@ PatternMatchable(S:SetCategory): Category == SetCategory with "PatternMatchable(Float)" -> "PatternMatchable(a:SetCategory)" \end{chunk} + \begin{chunk}{PATMAB.dotpic} digraph pic { fontsize=10; @@ -11178,6 +12096,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RealRootCharacterizationCategory}{RRCC} \pagepic{ps/v102realrootcharacterizationcategory.ps}{RRCC}{0.60} @@ -11215,6 +12134,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{RealRootCharacterizationCategory.help} ==================================================================== RealRootCharacterizationCategory examples @@ -11360,12 +12280,54 @@ RealRootCharacterizationCategory(TheField, ThePols ) : Category == PUB where d.coef.2 \end{chunk} + +\begin{chunk}{COQ RRCC} +(* category RRCC *) +(* + + zero? : ( ThePols, $ ) -> Boolean + zero?(toTest, rootChar) == + sign(toTest, rootChar) = 0 + + negative?: ( ThePols, $ ) -> Boolean + negative?(toTest, rootChar) == + sign(toTest, rootChar) < 0 + + positive?: ( ThePols, $ ) -> Boolean + positive?(toTest, rootChar) == + sign(toTest, rootChar) > 0 + + rootOf: ( ThePols, N ) -> Union($,"failed") + rootOf(pol,n) == + liste:List($):= allRootsOf(pol) + # liste > n => "failed" + liste.n + + recip: ( ThePols, $ ) -> Union(ThePols,"failed") + recip(toInv,rootChar) == + degree(toInv) = 0 => + res := recip(leadingCoefficient(toInv)) + if (res case "failed") then "failed" else (res::TheField::ThePols) + defPol := definingPolynomial(rootChar) + d := principalIdeal([defPol,toInv]) + zero?(d.generator,rootChar) => "failed" + if (degree(d.generator) ^= 0 ) + then + defPol := (defPol exquo (d.generator))::ThePols + d := principalIdeal([defPol,toInv]) + d.coef.2 + +*) + +\end{chunk} + \begin{chunk}{RRCC.dotabb} "RRCC" [color=lightblue,href="bookvol10.2.pdf#nameddest=RRCC"]; "RRCC" -> "SETCAT" \end{chunk} + \begin{chunk}{RRCC.dotfull} "RealRootCharacterizationCategory(a:Join(OrderedRing,Field),b:UnivariatePolynomialCategory(a))" [color=lightblue,href="bookvol10.2.pdf#nameddest=RRCC"]; @@ -11373,6 +12335,7 @@ RealRootCharacterizationCategory(TheField, ThePols ) : Category == PUB where -> "SetCategory()" \end{chunk} + \begin{chunk}{RRCC.dotpic} digraph pic { fontsize=10; @@ -11402,6 +12365,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SegmentExpansionCategory}{SEGXCAT} \pagepic{ps/v102segmentexpansioncategory.ps}{SEGXCAT}{0.75} @@ -11435,6 +12399,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SegmentExpansionCategory.help} ==================================================================== SegmentExpansionCategory examples @@ -11467,7 +12432,6 @@ o )show SegmentExpansionCategory \cross{SEGXCAT}{?..?} &&&& \end{tabular} - {\bf Attributes exported:} \begin{itemize} \item {\bf nil} @@ -11518,12 +12482,14 @@ SegmentExpansionCategory(S: OrderedRing, L: StreamAggregate(S)): Category == ++ \spad{[f(l), f(l+k), ..., f(lN)]}, where \spad{lN <= h < lN+k}. \end{chunk} + \begin{chunk}{SEGXCAT.dotabb} "SEGXCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGXCAT"]; "SEGXCAT" -> "SEGCAT" \end{chunk} + \begin{chunk}{SEGXCAT.dotfull} "SegmentExpansionCategory(a:OrderedRing,b:StreamAggregate(OrderedRing))" [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGXCAT"]; @@ -11531,6 +12497,7 @@ SegmentExpansionCategory(S: OrderedRing, L: StreamAggregate(S)): Category == -> "SegmentCategory(OrderedRing)" \end{chunk} + \begin{chunk}{SEGXCAT.dotpic} digraph pic { fontsize=10; @@ -11556,6 +12523,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SemiGroup}{SGROUP} \pagepic{ps/v102semigroup.ps}{SGROUP}{0.75} @@ -11594,6 +12562,7 @@ operator ``*''. A Semigroup $G(S,*)$ is: )spool )lisp (bye) \end{chunk} + \begin{chunk}{SemiGroup.help} ==================================================================== SemiGroup examples @@ -11683,12 +12652,29 @@ SemiGroup(): Category == SetCategory with _^(x:%, n:PositiveInteger):% == x ** n \end{chunk} + +\begin{chunk}{COQ SGROUP} +(* category SGROUP *) +(* + import RepeatedSquaring(%) + + "**": (%,PositiveInteger) -> % + x:% ** n:PositiveInteger == expt(x,n) + + "^": (%,PositiveInteger) -> % + _^(x:%, n:PositiveInteger):% == x ** n + +*) + +\end{chunk} + \begin{chunk}{SGROUP.dotabb} "SGROUP" [color=lightblue,href="bookvol10.2.pdf#nameddest=SGROUP"]; "SGROUP" -> "SETCAT" \end{chunk} + \begin{chunk}{SGROUP.dotfull} "SemiGroup()" [color=lightblue,href="bookvol10.2.pdf#nameddest=SGROUP"]; @@ -11696,6 +12682,7 @@ SemiGroup(): Category == SetCategory with "SemiGroup()" -> "RepeatedSquaring(a:SemiGroup)" \end{chunk} + \begin{chunk}{SGROUP.dotpic} digraph pic { fontsize=10; @@ -11732,6 +12719,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SetCategoryWithDegree}{SETCATD} \pagepic{ps/v102setcategorywithdegree.ps}{SETCATD}{0.75} @@ -11762,6 +12750,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SetCategoryWithDegree.help} ==================================================================== SetCategoryWithDegree examples @@ -11817,18 +12806,21 @@ SetCategoryWithDegree:Category == SetCategory with degree: % -> PositiveInteger \end{chunk} + \begin{chunk}{SETCATD.dotabb} "SETCATD" [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCATD"]; "SETCATD" -> "SETCAT" \end{chunk} + \begin{chunk}{SETCATD.dotfull} "SetCategoryWithDegree()" [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCATD"]; "SetCategoryWithDegree()" -> "SetCategory()" \end{chunk} + \begin{chunk}{SETCATD.dotpic} digraph pic { fontsize=10; @@ -11858,6 +12850,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SExpressionCategory}{SEXCAT} \pagepic{ps/v102sexpressioncategory.ps}{SEXCAT}{0.60} @@ -11901,6 +12894,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SExpressionCategory.help} ==================================================================== SExpressionCategory examples @@ -12063,12 +13057,14 @@ SExpressionCategory(Str, Sym, Int, Flt, Expr): Category == Decl where ++ elt((a1,...,an), [i1,...,im]) returns \spad{(a_i1,...,a_im)}. \end{chunk} + \begin{chunk}{SEXCAT.dotabb} "SEXCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SEXCAT"]; "SEXCAT" -> "SETCAT" \end{chunk} + \begin{chunk}{SEXCAT.dotfull} "SExpressionCategory(a:SetCategory,b:SetCategory,c:SetCategory,d:SetCategory,e:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=SEXCAT"]; @@ -12076,6 +13072,7 @@ SExpressionCategory(Str, Sym, Int, Flt, Expr): Category == Decl where "SetCategory()" \end{chunk} + \begin{chunk}{SEXCAT.dotpic} digraph pic { fontsize=10; @@ -12105,6 +13102,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{StepThrough}{STEP} \pagepic{ps/v102stepthrough.ps}{STEP}{1.00} @@ -12136,6 +13134,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{StepThrough.help} ==================================================================== StepThrough examples @@ -12253,6 +13252,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ThreeSpaceCategory}{SPACEC} \pagepic{ps/v102threespacecategory.ps}{SPACEC}{1.00} @@ -12316,6 +13316,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ThreeSpaceCategory.help} ==================================================================== ThreeSpaceCategory examples @@ -12777,18 +13778,21 @@ ThreeSpaceCategory(R:Ring): Exports == Implementation where ++ coerce(s) returns the \spadtype{ThreeSpace} s to Output format. \end{chunk} + \begin{chunk}{SPACEC.dotabb} "SPACEC" [color=lightblue,href="bookvol10.2.pdf#nameddest=SPACEC"]; "SPACEC" -> "SETCAT" \end{chunk} + \begin{chunk}{SPACEC.dotfull} "ThreeSpaceCategory(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=SPACEC"]; "ThreeSpaceCategory(a:Ring)" -> "SetCategory()" \end{chunk} + \begin{chunk}{SPACEC.dotpic} digraph pic { fontsize=10; @@ -12816,6 +13820,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 4} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AbelianMonoid}{ABELMON} @@ -12850,6 +13855,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AbelianMonoid.help} ==================================================================== AbelianMonoid examples @@ -12935,15 +13941,46 @@ AbelianMonoid(): Category == AbelianSemiGroup with ++ n * x is left-multiplication by a non negative integer add import RepeatedDoubling(%) + zero? x == x = 0 + n:PositiveInteger * x:% == (n::NonNegativeInteger) * x + + sample() == 0 + + if not (% has Ring) then + + n:NonNegativeInteger * x:% == + zero? n => 0 + double(n pretend PositiveInteger,x) + +\end{chunk} + +\begin{chunk}{COQ ABELMON} +(* category ABELMON *) +(* + import RepeatedDoubling(%) + + zero?: % -> Boolean + zero? x == x = 0 + + ?*? : (PositiveInteger,%) -> % + n:PositiveInteger * x:% == (n::NonNegativeInteger) * x + + sample: constant -> % sample() == 0 + if not (% has Ring) then + + "*": (NonNegativeInteger,%) -> % n:NonNegativeInteger * x:% == zero? n => 0 double(n pretend PositiveInteger,x) +*) + \end{chunk} + \begin{chunk}{ABELMON.dotabb} "ABELMON" [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELMON"]; @@ -12995,6 +14032,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AffineSpaceCategory}{AFSPCAT} \pagepic{ps/v102affinespacecategory.ps}{AFSPCAT}{0.75} @@ -13036,6 +14074,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AffineSpaceCategory.help} ==================================================================== AffineSpaceCategory examples @@ -13181,18 +14220,21 @@ AffineSpaceCategory(K:Field):Category == Implementation where ++ of origin that represent an infinitly close point \end{chunk} + \begin{chunk}{AFSPCAT.dotabb} "AFSPCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=AFSPCAT"]; "AFSPCAT" -> "SETCATD" \end{chunk} + \begin{chunk}{AFSPCAT.dotfull} "AffineSpaceCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=AFSPCAT"]; "AffineSpaceCategory()" -> "SetCategoryWithDegree()" \end{chunk} + \begin{chunk}{AFSPCAT.dotpic} digraph pic { fontsize=10; @@ -13227,6 +14269,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BagAggregate}{BGAGG} \pagepic{ps/v102bagaggregate.ps}{BGAGG}{1.00} @@ -13280,6 +14323,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{BagAggregate.help} ==================================================================== BagAggregate examples @@ -13423,11 +14467,26 @@ BagAggregate(S:Type): Category == HomogeneousAggregate S with x \end{chunk} + +\begin{chunk}{COQ BGAGG} +(* category BGAGG *) +(* + + bag: List S -> % + bag(l) == + x:=empty() + for s in l repeat x:=insert_!(s,x) + x +*) + +\end{chunk} + \begin{chunk}{BGAGG.dotabb} "BGAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=BGAGG"]; "BGAGG" -> "HOAGG" \end{chunk} + \begin{chunk}{BGAGG.dotfull} "BagAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=BGAGG"]; @@ -13438,6 +14497,7 @@ BagAggregate(S:Type): Category == HomogeneousAggregate S with "BagAggregate(a:SetCategory)" -> "BagAggregate(a:Type)" \end{chunk} + \begin{chunk}{BGAGG.dotpic} digraph pic { fontsize=10; @@ -13460,6 +14520,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CachableSet}{CACHSET} \pagepic{ps/v102cachableset.ps}{CACHSET}{1.00} @@ -13494,6 +14555,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CachableSet.help} ==================================================================== CachableSet examples @@ -13565,18 +14627,21 @@ CachableSet: Category == OrderedSet with ++ setPosition(x, n) associates the integer n to x. \end{chunk} + \begin{chunk}{CACHSET.dotabb} "CACHSET" [color=lightblue,href="bookvol10.2.pdf#nameddest=CACHSET"]; "CACHSET" -> "ORDSET" \end{chunk} + \begin{chunk}{CACHSET.dotfull} "CachableSet()" [color=lightblue,href="bookvol10.2.pdf#nameddest=CACHSET"]; "CachableSet()" -> "OrderedSet()" \end{chunk} + \begin{chunk}{CACHSET.dotpic} digraph pic { fontsize=10; @@ -13606,6 +14671,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Collection}{CLAGG} \pagepic{ps/v102collection.ps}{CLAGG}{1.00} @@ -13666,6 +14732,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Collection.help} ==================================================================== Collection examples @@ -13885,11 +14952,61 @@ Collection(S:Type): Category == HomogeneousAggregate(S) with removeDuplicates(x) == construct removeDuplicates parts x \end{chunk} + +\begin{chunk}{COQ CLAGG} +(* category CLAGG *) +(* + if % has finiteAggregate then + + #? : % -> NonNegativeInteger + #c == # parts c + + count : ((S -> Boolean),%) -> NonNegativeInteger + count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x] + + any? : ((S -> Boolean),%) -> Boolean + any?(f, c) == _or/[f x for x in parts c] + + every? : ((S -> Boolean),%) -> Boolean + every?(f, c) == _and/[f x for x in parts c] + + find: (S->Boolean, %) -> Union(S, "failed") + find(f:S -> Boolean, c:%) == find(f, parts c) + + reduce: ((S,S)->S,%) -> S + reduce(f:(S,S)->S, x:%) == reduce(f, parts x) + + reduce: ((S,S)->S,%,S) -> S + reduce(f:(S,S)->S, x:%, s:S) == reduce(f, parts x, s) + + remove: (S->Boolean,%) -> % + remove(f:S->Boolean, x:%) == + construct remove(f, parts x) + + select: (S->Boolean,%) -> % + select(f:S->Boolean, x:%) == + construct select(f, parts x) + + if S has SetCategory then + + remove: (S,%) -> % + remove(s:S, x:%) == remove(y +-> y = s, x) + + reduce: ((S,S)->S,%,S,S) -> S + reduce(f:(S,S)->S, x:%, s1:S, s2:S) == reduce(f, parts x, s1, s2) + + removeDuplicates: % -> % + removeDuplicates(x) == construct removeDuplicates parts x +*) + +\end{chunk} + \begin{chunk}{CLAGG.dotabb} "CLAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=CLAGG"]; "CLAGG" -> "HOAGG" \end{chunk} + \begin{chunk}{CLAGG.dotfull} "Collection(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=CLAGG"]; @@ -13905,6 +15022,7 @@ Collection(S:Type): Category == HomogeneousAggregate(S) with -> "Collection(a:Type)" \end{chunk} + \begin{chunk}{CLAGG.dotpic} digraph pic { fontsize=10; @@ -13934,6 +15052,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DifferentialVariableCategory}{DVARCAT} \pagepic{ps/v102differentialvariablecategory.ps}{DVARCAT}{1.00} @@ -13973,6 +15092,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DifferentialVariableCategory.help} ==================================================================== DifferentialVariableCategory examples @@ -14194,6 +15314,52 @@ DifferentialVariableCategory(S:OrderedSet): Category == -- the default weight is just the order \end{chunk} + +\begin{chunk}{COQ DVARCAT} +(* category DVARCAT *) +(* + import NumberFormats + + coerce : S -> % + coerce (s:S):$ == makeVariable(s, 0) + + differentiate : $ -> $ + differentiate v == differentiate(v, 1) + + differentiate : ($, NonNegativeInteger) -> $ + differentiate(v, n) == makeVariable(variable v, n + order v) + + retractIfCan : % -> Union(S,"failed") + retractIfCan v == (zero?(order v) => variable v; "failed") + + ?=? : (%,%) -> Boolean + v = u == (variable v = variable u) and (order v = order u) + + coerce : % -> OutputForm + coerce(v:$):OutputForm == + a := variable(v)::OutputForm + zero?(nn := order v) => a + sub(a, outputForm nn) + + retract : % -> S + retract v == + zero?(order v) => variable v + error "Not retractable" + + ? Boolean + v < u == + -- the ranking below is orderly, and is the default -- + order v = order u => variable v < variable u + order v < order u + + weight : $ -> NonNegativeInteger + weight v == order v + -- the default weight is just the order + +*) + +\end{chunk} + \begin{chunk}{DVARCAT.dotabb} "DVARCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DVARCAT"]; @@ -14201,6 +15367,7 @@ DifferentialVariableCategory(S:OrderedSet): Category == "DVARCAT" -> "RETRACT" \end{chunk} + \begin{chunk}{DVARCAT.dotfull} "DifferentialVariableCategory(a:OrderedSet)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DVARCAT"]; @@ -14208,6 +15375,7 @@ DifferentialVariableCategory(S:OrderedSet): Category == "DifferentialVariableCategory(a:OrderedSet)" -> "RetractableTo(OrderedSet)" \end{chunk} + \begin{chunk}{DVARCAT.dotpic} digraph pic { fontsize=10; @@ -14244,6 +15412,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ExpressionSpace}{ES} \pagepic{ps/v102expressionspace.ps}{ES}{0.35} @@ -14311,6 +15480,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ExpressionSpace.help} ==================================================================== ExpressionSpace examples @@ -14771,6 +15941,239 @@ ExpressionSpace(): Category == Defn where and pred?(u::Integer) \end{chunk} + +\begin{chunk}{COQ ES} +(* category ES *) +(* + +-- the 7 functions not provided are: +-- kernels minPoly definingPolynomial +-- coerce:K -> % eval:(%, List K, List %) -> % +-- subst:(%, List K, List %) -> % +-- eval:(%, List Symbol, List(List % -> %)) -> % + + oppren := operator(PAREN)$CommonOperators() + opbox := operator(BOX)$CommonOperators() + + box : % -> % + box(x:%) == box [x] + + paren : % -> % + paren(x:%) == paren [x] + + belong? : OP -> Boolean + belong? op == op = oppren or op = opbox + + listk : % -> List K + listk f == parts allKernels f + + tower : % -> List K + tower f == sort_! listk f + + allk : List % -> Set K + allk l == reduce("union", [allKernels f for f in l], {}) + + operators : % -> List OP + operators f == [operator k for k in listk f] + + height : % -> N + height f == reduce("max", [height k for k in kernels f], 0) + + freeOf? : (%, SY) -> Boolean + freeOf?(x:%, s:SY) == not member?(s, [name k for k in listk x]) + + distribute : % -> % + distribute x == unwrap([k for k in listk x | is?(k, oppren)], x) + + box : List % -> % + box(l:List %) == opbox l + + paren : List % -> % + paren(l:List %) == oppren l + + freeOf? : (%, %) -> Boolean + freeOf?(x:%, k:%) == not member?(retract k, listk x) + + kernel : (OP, %) -> % + kernel(op:OP, arg:%) == kernel(op, [arg]) + + elt : (OP, %) -> % + elt(op:OP, x:%) == op [x] + + elt : (OP, %, %) -> % + elt(op:OP, x:%, y:%) == op [x, y] + + elt : (OP, %, %, %) -> % + elt(op:OP, x:%, y:%, z:%) == op [x, y, z] + + elt : (OP, %, %, %, %) -> % + elt(op:OP, x:%, y:%, z:%, t:%) == op [x, y, z, t] + + eval : (%, SY, List % -> %) -> % + eval(x:%, s:SY, f:List % -> %) == eval(x, [s], [f]) + + eval : (%, OP, List % -> %) -> % + eval(x:%, s:OP, f:List % -> %) == eval(x, [name s], [f]) + + eval : (%, SY, % -> %) -> % + eval(x:%, s:SY, f:% -> %) == + eval(x, [s], [(y:List %):% +-> f(first y)]) + + eval : (%, OP, % -> %) -> % + eval(x:%, s:OP, f:% -> %) == + eval(x, [s], [(y:List %):% +-> f(first y)]) + + subst : (%, Equation %) -> % + subst(x:%, e:Equation %) == subst(x, [e]) + + eval : (%, List OP, List(% -> %)) -> % + eval(x:%, ls:List OP, lf:List(% -> %)) == + eval(x, ls, [y +-> f(first y) for f in lf]$List(List % -> %)) + + eval : (%,List(Symbol),List((% -> %))) -> % + eval(x:%, ls:List SY, lf:List(% -> %)) == + eval(x, ls, [y +-> f(first y) for f in lf]$List(List % -> %)) + + eval : (%, List SY, List(% -> %)) -> % + eval(x:%, ls:List OP, lf:List(List % -> %)) == + eval(x, [name s for s in ls]$List(SY), lf) + + map : (% -> %, K) -> % + map(fn, k) == + (l := [fn x for x in argument k]$List(%)) = argument k => k::% + (operator k) l + + operator : BasicOperator -> BasicOperator + operator op == + is?(op, PAREN) => oppren + is?(op, BOX) => opbox + error "Unknown operator" + + mainKernel : % -> Union(K, "failed") + mainKernel x == + empty?(l := kernels x) => "failed" + n := height(k := first l) + for kk in rest l repeat + if height(kk) > n then + n := height kk + k := kk + k + +-- takes all the kernels except for the dummy variables, which are second +-- arguments of rootOf's, integrals, sums and products which appear only in +-- their first arguments + + allKernels: % -> Set K + allKernels f == + s := brace(l := kernels f) + for k in l repeat + t := + (u := property(operator k, DUMMYVAR)) case None => + arg := argument k + s0 := remove_!(retract(second arg)@K, allKernels first arg) + arg := rest rest arg + n := (u::None) pretend N + if n > 1 then arg := rest arg + union(s0, allk arg) + allk argument k + s := union(s, t) + s + + kernel : (BasicOperator,List(%)) -> % + kernel(op:OP, args:List %) == + not belong? op => error "Unknown operator" + okkernel(op, args) + + okkernel : (BasicOperator, List %) -> % + okkernel(op, l) == + kernel(op, l, 1 + reduce("max", [height f for f in l], 0))$K :: % + + elt : (BasicOperator, List %) -> % + elt(op:OP, args:List %) == + not belong? op => error "Unknown operator" + ((u := arity op) case N) and (#args ^= u::N) + => error "Wrong number of arguments" + (v := evaluate(op,args)$BasicOperatorFunctions1(%)) case % => v::% + okkernel(op, args) + + retract : % -> Kernel(%) + retract f == + (k := mainKernel f) case "failed" => error "not a kernel" + k::K::% ^= f => error "not a kernel" + k::K + + retractIfCan : % -> Union(Kernel(%),"failed") + retractIfCan f == + (k := mainKernel f) case "failed" => "failed" + k::K::% ^= f => "failed" + k + + is? : (%, Symbol) -> Boolean + is?(f:%, s:SY) == + (k := retractIfCan f) case "failed" => false + is?(k::K, s) + + is? : (%, BasicOperator) -> Boolean + is?(f:%, op:OP) == + (k := retractIfCan f) case "failed" => false + is?(k::K, op) + + unwrap : (List K, %) -> % + unwrap(l, x) == + for k in reverse_! l repeat + x := eval(x, k, first argument k) + x + + distribute : (%, %) -> % + distribute(x, y) == + ky := retract y + unwrap([k for k in listk x | + is?(k, "%paren"::SY) and member?(ky, listk(k::%))], x) + + -- in case of conflicting substitutions e.g. [x = a, x = b], + -- the first one prevails. + -- this is not part of the semantics of the function, but just + -- a feature of this implementation. + + eval : (%,List(Equation(%))) -> % + eval(f:%, leq:List Equation %) == + rec := mkKerLists leq + eval(f, rec.lstk, rec.lstv) + + subst : (%, List Equation %) -> % + subst(f:%, leq:List Equation %) == + rec := mkKerLists leq + subst(f, rec.lstk, rec.lstv) + + mkKerLists: List Equation % -> Record(lstk: List K, lstv:List %) + mkKerLists leq == + lk := empty()$List(K) + lv := empty()$List(%) + for eq in leq repeat + (k := retractIfCan(lhs eq)@Union(K, "failed")) case "failed" => + error "left hand side must be a single kernel" + if not member?(k::K, lk) then + lk := concat(k::K, lk) + lv := concat(rhs eq, lv) + [lk, lv] + + if % has RetractableTo Integer then + + even?: % -> Boolean + even? x == intpred?(x, even?) + + odd? : % -> Boolean + odd? x == intpred?(x, odd?) + + intpred?: (%, Integer -> Boolean) -> Boolean + intpred?(x, pred?) == + (u := retractIfCan(x)@Union(Integer, "failed")) case Integer + and pred?(u::Integer) + +*) + +\end{chunk} + \begin{chunk}{ES.dotabb} "ES" [color=lightblue,href="bookvol10.2.pdf#nameddest=ES"]; @@ -14780,6 +16183,7 @@ ExpressionSpace(): Category == Defn where "ES" -> "EVALAB" \end{chunk} + \begin{chunk}{ES.dotfull} "ExpressionSpace()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ES"]; @@ -14790,6 +16194,7 @@ ExpressionSpace(): Category == Defn where "ExpressionSpace()" -> "Evalable(ExpressionSpace)" \end{chunk} + \begin{chunk}{ES.dotpic} digraph pic { fontsize=10; @@ -14846,6 +16251,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{GradedAlgebra}{GRALG} \pagepic{ps/v102gradedalgebra.ps}{GRALG}{0.75} @@ -14882,6 +16288,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{GradedAlgebra.help} ==================================================================== GradedAlgebra examples @@ -14997,6 +16404,28 @@ GradedAlgebra(R: CommutativeRing, E: AbelianMonoid): Category == (x: %)*(r: R) == product(x, r::%) \end{chunk} + +\begin{chunk}{COQ GRALG} +(* category GRALG *) +(* + if not (R is %) then + + 0 : () -> % + 0: % == (0$R)::% + + 1 : () -> % + 1: % == 1$R::% + + ?*? : (R,%) -> % + (r: R)*(x: %) == product(r::%, x) + + ?*? : (%,R) -> % + (x: %)*(r: R) == product(x, r::%) + +*) + +\end{chunk} + \begin{chunk}{GRALG.dotabb} "GRALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=GRALG"]; @@ -15004,6 +16433,7 @@ GradedAlgebra(R: CommutativeRing, E: AbelianMonoid): Category == "GRALG" -> "RETRACT" \end{chunk} + \begin{chunk}{GRALG.dotfull} "GradedAlgebra(a:CommutativeRing,b:AbelianMonoid)" [color=lightblue,href="bookvol10.2.pdf#nameddest=GRALG"]; @@ -15012,6 +16442,7 @@ GradedAlgebra(R: CommutativeRing, E: AbelianMonoid): Category == "GradedAlgebra(a:CommutativeRing,b:AbelianMonoid)" -> "RetractableTo(CommutativeRing)" \end{chunk} + \begin{chunk}{GRALG.dotpic} digraph pic { fontsize=10; @@ -15051,6 +16482,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{IndexedAggregate}{IXAGG} \pagepic{ps/v102indexedaggregate.ps}{IXAGG}{0.90} @@ -15113,6 +16545,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{IndexedAggregate.help} ==================================================================== IndexedAggregate examples @@ -15343,12 +16776,68 @@ IndexedAggregate(Index: SetCategory, Entry: Type): Category == void \end{chunk} + +\begin{chunk}{COQ IXAGG} +(* category IXAGG *) +(* + + elt : (%,Index,Entry) -> Entry + elt(a, i, x) == (index?(i, a) => qelt(a, i); x) + + if % has finiteAggregate then + + entries: % -> List Entry + entries x == parts x + + if Entry has SetCategory then + + entry?: (Entry,%) -> Boolean + entry?(x, a) == member?(x, a) + + if Index has OrderedSet then + + maxIndex: % -> Index + maxIndex a == "max"/indices(a) + + minIndex: % -> Index + minIndex a == "min"/indices(a) + + first : % -> Entry + first a == a minIndex a + + if % has shallowlyMutable then + + map : ((Entry -> Entry),%) -> % + map(f, a) == map_!(f, copy a) + + map! : ((Entry -> Entry),%) -> % + map_!(f, a) == + for i in indices a repeat qsetelt_!(a, i, f qelt(a, i)) + a + + fill_!: (%,Entry) -> % + fill_!(a, x) == + for i in indices a repeat qsetelt_!(a, i, x) + a + + swap_!: (%,Index,Index) -> Void + swap_!(a, i, j) == + t := a.i + qsetelt_!(a, i, a.j) + qsetelt_!(a, j, t) + void + +*) + +\end{chunk} + \begin{chunk}{IXAGG.dotabb} "IXAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=IXAGG"]; "IXAGG" -> "HOAGG" "IXAGG" -> "ELTAGG" \end{chunk} + \begin{chunk}{IXAGG.dotfull} "IndexedAggregate(a:SetCategory,b:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=IXAGG"]; @@ -15368,6 +16857,7 @@ IndexedAggregate(Index: SetCategory, Entry: Type): Category == "IndexedAggregate(a:SetCategory,b:Type)" \end{chunk} + \begin{chunk}{IXAGG.dotpic} digraph pic { fontsize=10; @@ -15399,6 +16889,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MonadWithUnit}{MONADWU} \pagepic{ps/v102monadwithunit.ps}{MONADWU}{0.75} @@ -15437,6 +16928,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{MonadWithUnit.help} ==================================================================== MonadWithUnit examples @@ -15589,18 +17081,58 @@ MonadWithUnit(): Category == Monad with res \end{chunk} + +\begin{chunk}{COQ MONADWU} +(* category MONADWU *) +(* + +Axioms: + leftIdentity("*":(%,%)->%,1) 1*x=x + rightIdentity("*":(%,%)->%,1) x*1=x + unitsKnown - if "recip" says "failed", it PROVES input wasn't a unit + + import RepeatedSquaring(%) + + one?: % -> Boolean + one? x == x = 1 + + "**": (%,NonNegativeInteger) -> % + x:% ** n:NonNegativeInteger == + zero? n => 1 + expt(x,n pretend PositiveInteger) + + rightPower: (%,NonNegativeInteger) -> % + rightPower(a,n) == + zero? n => 1 + res := 1 + for i in 1..n repeat res := res * a + res + + leftPower: (%,NonNegativeInteger) -> % + leftPower(a,n) == + zero? n => 1 + res := 1 + for i in 1..n repeat res := a * res + res + +*) + +\end{chunk} + \begin{chunk}{MONADWU.dotabb} "MONADWU" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONADWU"]; "MONADWU" -> "MONAD" \end{chunk} + \begin{chunk}{MONADWU.dotfull} "MonadWithUnit()" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONADWU"]; "MonadWithUnit()" -> "Monad()" \end{chunk} + \begin{chunk}{MONADWU.dotpic} digraph pic { fontsize=10; @@ -15640,6 +17172,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Monoid}{MONOID} \pagepic{ps/v102monoid.ps}{MONOID}{0.75} @@ -15674,6 +17207,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Monoid.help} ==================================================================== Monoid examples @@ -15787,18 +17321,53 @@ Monoid(): Category == SemiGroup with expt(x,n pretend PositiveInteger) \end{chunk} + +\begin{chunk}{COQ MONOID} +(* category MONOID *) +(* +Axioms: + leftIdentity("*":(%,%)->%,1) 1*x=x + rightIdentity("*":(%,%)->%,1) x*1=x + + import RepeatedSquaring(%) + + "^" : (%,NonNegativeInteger) -> % + _^(x:%, n:NonNegativeInteger):% == x ** n + + one?: % -> Boolean + one? x == x = 1 + + sample: constant -> % + sample() == 1 + + recip: % -> Union(%,"failed") + recip x == + (x = 1) => x + "failed" + + "**": (%,NonNegativeInteger) -> % + x:% ** n:NonNegativeInteger == + zero? n => 1 + expt(x,n pretend PositiveInteger) + +*) + +\end{chunk} + \begin{chunk}{MONOID.dotabb} "MONOID" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOID"]; "MONOID" -> "SGROUP" \end{chunk} + \begin{chunk}{MONOID.dotfull} "Monoid()" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOID"]; "Monoid()" -> "SemiGroup()" \end{chunk} + \begin{chunk}{MONOID.dotpic} digraph pic { fontsize=10; @@ -15838,6 +17407,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedFinite}{ORDFIN} \pagepic{ps/v102orderedfinite.ps}{ORDFIN}{1.00} @@ -15873,6 +17443,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedFinite.help} ==================================================================== OrderedFinite examples @@ -15940,6 +17511,7 @@ These exports come from \refto{Finite}(): OrderedFinite(): Category == Join(OrderedSet, Finite) \end{chunk} + \begin{chunk}{ORDFIN.dotabb} "ORDFIN" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDFIN"]; @@ -15947,6 +17519,7 @@ OrderedFinite(): Category == Join(OrderedSet, Finite) "ORDFIN" -> "FINITE" \end{chunk} + \begin{chunk}{ORDFIN.dotfull} "OrderedFinite()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDFIN"]; @@ -15954,6 +17527,7 @@ OrderedFinite(): Category == Join(OrderedSet, Finite) "OrderedFinite()" -> "Finite()" \end{chunk} + \begin{chunk}{ORDFIN.dotpic} digraph pic { fontsize=10; @@ -15987,6 +17561,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PlacesCategory}{PLACESC} \pagepic{ps/v102placescategory.eps}{PLACESC}{0.75} @@ -16030,6 +17605,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PlacesCategory.help} ==================================================================== PlacesCategory examples @@ -16164,17 +17740,20 @@ PlacesCategory(K:Field,PCS:LocalPowerSeriesCategory(K)):Category ++ correspnd to a simple point \end{chunk} + \begin{chunk}{PLACESC.dotabb} "PLACESC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PLACESC"]; "SETCATD" [color="#4488FF",href="bookvol10.2.pdf#nameddest=SETCATD"] "PLACESC" -> "SETCATD" \end{chunk} + \begin{chunk}{PLACESC.dotfull} "PlacesCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PLACESC"]; "PlacesCategory()" -> "SetCategoryWithDegree()" \end{chunk} + \begin{chunk}{PLACESC.dotpic} digraph pic { fontsize=10; @@ -16209,6 +17788,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ProjectiveSpaceCategory}{PRSPCAT} \pagepic{ps/v102projectivespacecategory.ps}{PRSPCAT}{0.75} @@ -16252,6 +17832,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ProjectiveSpaceCategory.help} ==================================================================== ProjectiveSpaceCategory examples @@ -16414,18 +17995,21 @@ ProjectiveSpaceCategory(K:Field):Category == Implementation where ++ of origin that represent an infinitly close point \end{chunk} + \begin{chunk}{PRSPCAT.dotabb} "PRSPCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PRSPCAT"]; "PRSPCAT" -> "SETCATD" \end{chunk} + \begin{chunk}{PRSPCAT.dotfull} "ProjectiveSpaceCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PRSPCAT"]; "ProjectiveSpaceCategory()" -> "SetCategoryWithDegree()" \end{chunk} + \begin{chunk}{PRSPCAT.dotpic} digraph pic { fontsize=10; @@ -16460,6 +18044,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RecursiveAggregate}{RCAGG} \pagepic{ps/v102recursiveaggregate.ps}{RCAGG}{1.00} @@ -16520,6 +18105,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{RecursiveAggregate.help} ==================================================================== RecursiveAggregate examples @@ -16716,17 +18302,41 @@ RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with child?(x,l) == member?(x,children(l)) \end{chunk} + +\begin{chunk}{COQ RCAGG} +(* category RCAGG *) +(* + + elt: (%,"value") -> S + elt(x,"value") == value x + + if % has shallowlyMutable then + + setelt: (%,"value",S) -> S + setelt(x,"value",y) == setvalue_!(x,y) + + if S has SetCategory then + + child?: (%,%) -> Boolean + child?(x,l) == member?(x,children(l)) + +*) + +\end{chunk} + \begin{chunk}{RCAGG.dotabb} "RCAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=RCAGG"]; "RCAGG" -> "HOAGG" \end{chunk} + \begin{chunk}{RCAGG.dotfull} "RecursiveAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=RCAGG"]; "RecursiveAggregate(a:Type)" -> "HomogeneousAggregate(a:Type)" \end{chunk} + \begin{chunk}{RCAGG.dotpic} digraph pic { fontsize=10; @@ -16749,6 +18359,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{TwoDimensionalArrayCategory}{ARR2CAT} \pagepic{ps/v102twodimensionalarraycategory.ps}{ARR2CAT}{0.65} @@ -16819,6 +18430,7 @@ first column in an array and vice versa. )spool )lisp (bye) \end{chunk} + \begin{chunk}{TwoDimensionalArrayCategory.help} ==================================================================== TwoDimensionalArrayCategory examples @@ -17306,12 +18918,201 @@ TwoDimensionalArrayCategory(R,Row,Col): Category == Definition where matrix l \end{chunk} + +\begin{chunk}{COQ ARR2CAT} +(* category ARR2CAT *) +(* + +--% Predicates + + any? : ((R -> Boolean),%) -> Boolean + any?(f,m) == + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + f(qelt(m,i,j)) => return true + false + + every? : ((R -> Boolean),%) -> Boolean + every?(f,m) == + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + not f(qelt(m,i,j)) => return false + true + + size? : (%,NonNegativeInteger) -> Boolean + size?(m,n) == nrows(m) * ncols(m) = n + + less? : (%,NonNegativeInteger) -> Boolean + less?(m,n) == nrows(m) * ncols(m) < n + + more? : (%,NonNegativeInteger) -> Boolean + more?(m,n) == nrows(m) * ncols(m) > n + +--% Size inquiries + + #? : % -> NonNegativeInteger + # m == nrows(m) * ncols(m) + +--% Part extractions + + elt: (%,Integer,Integer,R) -> R + elt(m,i,j,r) == + i < minRowIndex(m) or i > maxRowIndex(m) => r + j < minColIndex(m) or j > maxColIndex(m) => r + qelt(m,i,j) + + count : ((R -> Boolean),%) -> NonNegativeInteger + count(f:R -> Boolean,m:%) == + num : NonNegativeInteger := 0 + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + if f(qelt(m,i,j)) then num := num + 1 + num + + parts: % -> List R + parts m == + entryList : List R := nil() + for i in maxRowIndex(m)..minRowIndex(m) by -1 repeat + for j in maxColIndex(m)..minColIndex(m) by -1 repeat + entryList := concat(qelt(m,i,j),entryList) + entryList + +--% Creation + + copy : % -> % + copy m == + ans := new(nrows m,ncols m,NIL$Lisp) + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + qsetelt_!(ans,i,j,qelt(m,i,j)) + ans + + fill_!: (%,R) -> % + fill_!(m,r) == + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + qsetelt_!(m,i,j,r) + m + + map: (R -> R,%) -> % + map(f,m) == + ans := new(nrows m,ncols m,NIL$Lisp) + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + qsetelt_!(ans,i,j,f(qelt(m,i,j))) + ans + + map_!: (R -> R,%) -> % + map_!(f,m) == + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + qsetelt_!(m,i,j,f(qelt(m,i,j))) + m + + map:((R,R) -> R,%,%) -> % + map(f,m,n) == + (nrows(m) ^= nrows(n)) or (ncols(m) ^= ncols(n)) => + error "map: arguments must have same dimensions" + ans := new(nrows m,ncols m,NIL$Lisp) + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + qsetelt_!(ans,i,j,f(qelt(m,i,j),qelt(n,i,j))) + ans + + map:((R,R) -> R,%,%,R) -> % + map(f,m,n,r) == + maxRow := max(maxRowIndex m,maxRowIndex n) + maxCol := max(maxColIndex m,maxColIndex n) + ans := new(max(nrows m,nrows n),max(ncols m,ncols n),NIL$Lisp) + for i in minRowIndex(m)..maxRow repeat + for j in minColIndex(m)..maxCol repeat + qsetelt_!(ans,i,j,f(elt(m,i,j,r),elt(n,i,j,r))) + ans + + setRow_!: (%,Integer,Row) -> % + setRow_!(m,i,v) == + i < minRowIndex(m) or i > maxRowIndex(m) => + error "setRow!: index out of range" + for j in minColIndex(m)..maxColIndex(m) _ + for k in minIndex(v)..maxIndex(v) repeat + qsetelt_!(m,i,j,v.k) + m + + setColumn_!: (%,Integer,Col) -> % + setColumn_!(m,j,v) == + j < minColIndex(m) or j > maxColIndex(m) => + error "setColumn!: index out of range" + for i in minRowIndex(m)..maxRowIndex(m) _ + for k in minIndex(v)..maxIndex(v) repeat + qsetelt_!(m,i,j,v.k) + m + + if R has _= : (R,R) -> Boolean then + + ?=? : (%,%) -> Boolean + m = n == + eq?(m,n) => true + (nrows(m) ^= nrows(n)) or (ncols(m) ^= ncols(n)) => false + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + not (qelt(m,i,j) = qelt(n,i,j)) => return false + true + + member? : (R,%) -> Boolean + member?(r,m) == + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + qelt(m,i,j) = r => return true + false + + count : (R,%) -> NonNegativeInteger + count(r:R,m:%) == count(x +-> x = r,m) + + if Row has shallowlyMutable then + + row: (%,Integer) -> Row + row(m,i) == + i < minRowIndex(m) or i > maxRowIndex(m) => + error "row: index out of range" + v : Row := new(ncols m,NIL$Lisp) + for j in minColIndex(m)..maxColIndex(m) _ + for k in minIndex(v)..maxIndex(v) repeat + qsetelt_!(v,k,qelt(m,i,j)) + v + + if Col has shallowlyMutable then + + column: (%,Integer) -> Col + column(m,j) == + j < minColIndex(m) or j > maxColIndex(m) => + error "column: index out of range" + v : Col := new(nrows m,NIL$Lisp) + for i in minRowIndex(m)..maxRowIndex(m) _ + for k in minIndex(v)..maxIndex(v) repeat + qsetelt_!(v,k,qelt(m,i,j)) + v + + if R has CoercibleTo(OutputForm) then + + coerce : % -> OutputForm + coerce(m:%) == + l : List List OutputForm + l := [[qelt(m,i,j) :: OutputForm _ + for j in minColIndex(m)..maxColIndex(m)] _ + for i in minRowIndex(m)..maxRowIndex(m)] + matrix l + +*) + +\end{chunk} + \begin{chunk}{ARR2CAT.dotabb} "ARR2CAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ARR2CAT"]; "ARR2CAT" -> "HOAGG" \end{chunk} + \begin{chunk}{ARR2CAT.dotfull} "TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" [color=lightblue,href="bookvol10.2.pdf#nameddest=ARR2CAT"]; @@ -17324,6 +19125,7 @@ TwoDimensionalArrayCategory(R,Row,Col): Category == Definition where -> "TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" \end{chunk} + \begin{chunk}{ARR2CAT.dotpic} digraph pic { fontsize=10; @@ -17366,6 +19168,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 5} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BinaryRecursiveAggregate}{BRAGG} @@ -17433,6 +19236,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{BinaryRecursiveAggregate.help} ==================================================================== BinaryRecursiveAggregate examples @@ -17689,11 +19493,127 @@ BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with setelt(x,"right",b) == setright_!(x,b) \end{chunk} + +\begin{chunk}{COQ BRAGG} +(* category BRAGG *) +(* + cycleMax ==> 1000 + + elt: (%,"left") -> % + elt(x,"left") == left x + + elt: (%,"right") -> % + elt(x,"right") == right x + + leaf? : % -> Boolean + leaf? x == empty? x or empty? left x and empty? right x + + leaves : % -> List(S) + leaves t == + empty? t => empty()$List(S) + leaf? t => [value t] + concat(leaves left t,leaves right t) + + nodes : % -> List(%) + nodes x == + l := empty()$List(%) + empty? x => l + concat(nodes left x,concat([x],nodes right x)) + + children : % -> List(%) + children x == + l := empty()$List(%) + empty? x => l + empty? left x => [right x] + empty? right x => [left x] + [left x, right x] + + if % has SetAggregate(S) and S has SetCategory then + + node? : (%,%) -> Boolean + node?(u,v) == + empty? v => false + u = v => true + for y in children v repeat node?(u,y) => return true + false + + ?=? : (%,%) -> Boolean + x = y == + empty?(x) => empty?(y) + empty?(y) => false + value x = value y and left x = left y and right x = right y + + if % has finiteAggregate then + + member? : (S,%) -> Boolean + member?(x,u) == + empty? u => false + x = value u => true + member?(x,left u) or member?(x,right u) + + if S has SetCategory then + + coerce : % -> OutputForm + coerce(t:%): OutputForm == + empty? t => "[]"::OutputForm + v := value(t):: OutputForm + empty? left t => + empty? right t => v + r := coerce(right t)@OutputForm + bracket ["."::OutputForm, v, r] + l := coerce(left t)@OutputForm + r := + empty? right t => "."::OutputForm + coerce(right t)@OutputForm + bracket [l, v, r] + + if % has finiteAggregate then + + #? : % -> NonNegativeInteger + #x == aggCount(x,0) + + aggCount: (%,NonNegativeInteger) -> NonNegativeInteger + aggCount(x,k) == + empty? x => 0 + k := k + 1 + k = cycleMax and cyclic? x => error "cyclic tree" + for y in children x repeat k := aggCount(y,k) + k + + cyclic? : % -> Boolean + cyclic? x == not empty? x and isCycle?(x,empty()$(List %)) + + isCycle?: (%, List %) -> Boolean + isCycle?(x,acc) == + empty? x => false + eqMember?(x,acc) => true + for y in children x | not empty? y repeat + isCycle?(y,acc) => return true + false + + eqMember?: (%, List %) -> Boolean + eqMember?(y,l) == + for x in l repeat eq?(x,y) => return true + false + + if % has shallowlyMutable then + + setelt: (%,"left",%) -> % + setelt(x,"left",b) == setleft_!(x,b) + + setelt: (%,"right",%) -> % + setelt(x,"right",b) == setright_!(x,b) + +*) + +\end{chunk} + \begin{chunk}{BRAGG.dotabb} "BRAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=BRAGG"]; "BRAGG" -> "RCAGG" \end{chunk} + \begin{chunk}{BRAGG.dotfull} "BinaryRecursiveAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=BRAGG"]; @@ -17705,6 +19625,7 @@ BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with "BinaryRecursiveAggregate(a:Type)" \end{chunk} + \begin{chunk}{BRAGG.dotpic} digraph pic { fontsize=10; @@ -17730,6 +19651,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CancellationAbelianMonoid}{CABMON} \pagepic{ps/v102cancellationabelianmonoid.ps}{CABMON}{0.75} @@ -17764,6 +19686,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CancellationAbelianMonoid.help} ==================================================================== CancellationAbelianMonoid examples @@ -17837,18 +19760,21 @@ CancellationAbelianMonoid(): Category == AbelianMonoid with ++ or "failed" if no such element exists. \end{chunk} + \begin{chunk}{CABMON.dotabb} "CABMON" [color=lightblue,href="bookvol10.2.pdf#nameddest=CABMON"]; "CABMON" -> "ABELMON" \end{chunk} + \begin{chunk}{CABMON.dotfull} "CancellationAbelianMonoid()" [color=lightblue,href="bookvol10.2.pdf#nameddest=CABMON"]; "CancellationAbelianMonoid()" -> "AbelianMonoid()" \end{chunk} + \begin{chunk}{CABMON.dotpic} digraph pic { fontsize=10; @@ -17891,6 +19817,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DictionaryOperations}{DIOPS} \pagepic{ps/v102dictionaryoperations.ps}{DIOPS}{1.00} @@ -17957,6 +19884,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DictionaryOperations.help} ==================================================================== DictionaryOperations examples @@ -18149,12 +20077,38 @@ DictionaryOperations(S:SetCategory): Category == [x::OutputForm for x in parts s]) \end{chunk} + +\begin{chunk}{COQ DIOPS} +(* category DIOPS *) +(* + + construct : List(S) -> % + construct l == dictionary l + + dictionary: () -> % + dictionary() == empty() + + if % has finiteAggregate then + + copy : % -> % + copy d == dictionary parts d + + coerce : % -> OutputForm + coerce(s:%):OutputForm == + prefix("dictionary"@String :: OutputForm, + [x::OutputForm for x in parts s]) + +*) + +\end{chunk} + \begin{chunk}{DIOPS.dotabb} "DIOPS" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIOPS"]; "DIOPS" -> "BGAGG" "DIOPS" -> "CLAGG" \end{chunk} + \begin{chunk}{DIOPS.dotfull} "DictionaryOperations(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIOPS"]; @@ -18162,6 +20116,7 @@ DictionaryOperations(S:SetCategory): Category == "DictionaryOperations(a:SetCategory)" -> "Collection(a:SetCategory)" \end{chunk} + \begin{chunk}{DIOPS.dotpic} digraph pic { fontsize=10; @@ -18197,6 +20152,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DoublyLinkedAggregate}{DLAGG} \pagepic{ps/v102doublylinkedaggregate.ps}{DLAGG}{1.00} @@ -18262,6 +20218,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DoublyLinkedAggregate.help} ==================================================================== DoublyLinkedAggregate examples @@ -18448,17 +20405,20 @@ DoublyLinkedAggregate(S:Type): Category == RecursiveAggregate S with ++ aggregate u to v, returning v. \end{chunk} + \begin{chunk}{DLAGG.dotabb} "DLAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=DLAGG"]; "DLAGG" -> "RCAGG" \end{chunk} + \begin{chunk}{DLAGG.dotfull} "DoublyLinkedAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DLAGG"]; "DoublyLinkedAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" \end{chunk} + \begin{chunk}{DLAGG.dotpic} digraph pic { fontsize=10; @@ -18521,6 +20481,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Group.help} ==================================================================== Group examples @@ -18643,18 +20604,55 @@ Group(): Category == Monoid with commutator(p,q) == inv(p) * inv(q) * p * q \end{chunk} + +\begin{chunk}{COQ GROUP} +(* category GROUP *) +(* +Axioms: + leftInverse("*":(%,%)->%,inv) inv(x)*x = 1 + rightInverse("*":(%,%)->%,inv) x*inv(x) = 1 + + import RepeatedSquaring(%) + + "/": (%,%) -> % + x:% / y:% == x*inv(y) + + recip : % -> Union(%,"failed") + recip(x:%) == inv(x) + + "^": (%,Integer) -> % + _^(x:%, n:Integer):% == x ** n + + "**": (%,Integer) -> % + x:% ** n:Integer == + zero? n => 1 + n<0 => expt(inv(x),(-n) pretend PositiveInteger) + expt(x,n pretend PositiveInteger) + + conjugate: (%,%) -> % + conjugate(p,q) == inv(q) * p * q + + commutator: (%,%) -> % + commutator(p,q) == inv(p) * inv(q) * p * q + +*) + +\end{chunk} + \begin{chunk}{GROUP.dotabb} "GROUP" [color=lightblue,href="bookvol10.2.pdf#nameddest=GROUP"]; "GROUP" -> "MONOID" \end{chunk} + \begin{chunk}{GROUP.dotfull} "Group()" [color=lightblue,href="bookvol10.2.pdf#nameddest=GROUP"]; "Group()" -> "Monoid()" \end{chunk} + \begin{chunk}{GROUP.dotpic} digraph pic { fontsize=10; @@ -18701,6 +20699,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LinearAggregate}{LNAGG} \pagepic{ps/v102linearaggregate.ps}{LNAGG}{0.90} @@ -18780,6 +20779,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LinearAggregate.help} ==================================================================== LinearAggregate examples @@ -19049,12 +21049,44 @@ LinearAggregate(S:Type): Category == --if % has shallowlyMutable then new(n, s) == fill_!(new n, s) \end{chunk} + +\begin{chunk}{COQ LNAGG} +(* category LNAGG *) +(* + + indices : % -> List(Integer) + indices a == [i for i in minIndex a .. maxIndex a] + + index? : (Integer,%) -> Boolean + index?(i, a) == i >= minIndex a and i <= maxIndex a + + concat: (%,S) -> % + concat(a:%, x:S) == concat(a, new(1, x)) + + concat: (S,%) -> % + concat(x:S, y:%) == concat(new(1, x), y) + + insert: (S,%,Integer) -> % + insert(x:S, a:%, i:Integer) == insert(new(1, x), a, i) + + if % has finiteAggregate then + + maxIndex : % -> Integer + maxIndex l == #l - 1 + minIndex l + +--if % has shallowlyMutable then new(n, s) == fill_!(new n, s) + +*) + +\end{chunk} + \begin{chunk}{LNAGG.dotabb} "LNAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=LNAGG"]; "LNAGG" -> "IXAGG" "LNAGG" -> "CLAGG" \end{chunk} + \begin{chunk}{LNAGG.dotfull} "LinearAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LNAGG"]; @@ -19062,6 +21094,7 @@ LinearAggregate(S:Type): Category == "LinearAggregate(a:Type)" -> "Collection(a:Type)" \end{chunk} + \begin{chunk}{LNAGG.dotpic} digraph pic { fontsize=10; @@ -19096,6 +21129,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MatrixCategory}{MATCAT} \pagepic{ps/v102matrixcategory.ps}{MATCAT}{0.60} @@ -19993,6 +22027,7 @@ inverse matrix [[j**i for i in 0..4] for j in 1..5] )lisp (bye) \end{chunk} + \begin{chunk}{MatrixCategory.help} ==================================================================== MatrixCategory examples @@ -21262,163 +23297,611 @@ MatrixCategory(R,Row,Col): Category == Definition where positivePower(xInv :: %,-n) \end{chunk} -\begin{chunk}{MATCAT.dotabb} -"MATCAT" - [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"]; -"MATCAT" -> "ARR2CAT" - -\end{chunk} -\begin{chunk}{MATCAT.dotfull} -"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" - [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"]; -"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" - -> -"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" -\end{chunk} -\begin{chunk}{MATCAT.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; +\begin{chunk}{COQ MATCAT} +(* category MATCAT *) +(* + minr ==> minRowIndex + maxr ==> maxRowIndex + minc ==> minColIndex + maxc ==> maxColIndex + mini ==> minIndex + maxi ==> maxIndex -"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" - [color=lightblue]; -"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" - -> -"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" +--% Predicates -"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" - [color=lightblue]; -"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" - -> "HomogeneousAggregate(a:Type)" + square? : % -> Boolean + square? x == nrows x = ncols x -"HomogeneousAggregate(a:Type)" [color=lightblue]; -"HomogeneousAggregate(a:Type)" -> "Aggregate()" -"HomogeneousAggregate(a:Type)" -> "Evalable(a:Type)" -"HomogeneousAggregate(a:Type)" -> "SetCategory()" + diagonal?: % -> Boolean + diagonal? x == + not square? x => false + for i in minr x .. maxr x repeat + for j in minc x .. maxc x | (j - minc x) ^= (i - minr x) repeat + not zero? qelt(x, i, j) => return false + true -"Evalable(a:Type)" [color="#00EE00"]; + symmetric?: % -> Boolean + symmetric? x == + (nRows := nrows x) ^= ncols x => false + mr := minRowIndex x; mc := minColIndex x + for i in 0..(nRows - 1) repeat + for j in (i + 1)..(nRows - 1) repeat + qelt(x,mr + i,mc + j) ^= qelt(x,mr + j,mc + i) => return false + true -"SetCategory()" [color=lightblue]; -"SetCategory()" -> "BasicType()" -"SetCategory()" -> "CoercibleTo(OutputForm)" + antisymmetric?: % -> Boolean + antisymmetric? x == + (nRows := nrows x) ^= ncols x => false + mr := minRowIndex x; mc := minColIndex x + for i in 0..(nRows - 1) repeat + for j in i..(nRows - 1) repeat + qelt(x,mr + i,mc + j) ^= -qelt(x,mr + j,mc + i) => + return false + true -"BasicType()" [color=lightblue]; -"BasicType()" -> "Category" +--% Creation of matrices -"CoercibleTo(OutputForm)" [color=seagreen]; -"CoercibleTo(OutputForm)" -> "CoercibleTo(a:Type)" + zero: (NonNegativeInteger,NonNegativeInteger) -> % + zero(rows,cols) == new(rows,cols,0) -"CoercibleTo(a:Type)" [color=lightblue]; -"CoercibleTo(a:Type)" -> "Category" + matrix: List List R -> % + matrix(l: List List R) == + null l => new(0,0,0) + -- error check: this is a top level function + rows : NonNegativeInteger := 1; cols := # first l + cols = 0 => error "matrices with zero columns are not supported" + for ll in rest l repeat + cols ^= # ll => error "matrix: rows of different lengths" + rows := rows + 1 + ans := new(rows,cols,0) + for i in minr(ans)..maxr(ans) for ll in l repeat + for j in minc(ans)..maxc(ans) for r in ll repeat + qsetelt_!(ans,i,j,r) + ans -"Aggregate()" [color=lightblue]; -"Aggregate()" -> "Type()" + matrix: (NonNegativeInteger,NonNegativeInteger,(Integer,Integer)->R) -> % + matrix(n,m,f) == + mat := new(n,m,0) + for i in minr mat..maxr mat repeat + for j in minc mat..maxc mat repeat + qsetelt!(mat,i,j,f(i,j)) + mat -"Type()" [color=lightblue]; -"Type()" -> "Category" + scalarMatrix: (NonNegativeInteger,R) -> % + scalarMatrix(n,r) == + ans := zero(n,n) + for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) repeat + qsetelt_!(ans,i,j,r) + ans -"Category" [color=lightblue]; + diagonalMatrix: List R -> % + diagonalMatrix(l: List R) == + n := #l; ans := zero(n,n) + for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) _ + for r in l repeat qsetelt_!(ans,i,j,r) + ans -} + diagonalMatrix: List % -> % + diagonalMatrix(list: List %) == + rows : NonNegativeInteger := 0 + cols : NonNegativeInteger := 0 + for mat in list repeat + rows := rows + nrows mat + cols := cols + ncols mat + ans := zero(rows,cols) + loR := minr ans; loC := minc ans + for mat in list repeat + hiR := loR + nrows(mat) - 1; hiC := loC + nrows(mat) - 1 + for i in loR..hiR for k in minr(mat)..maxr(mat) repeat + for j in loC..hiC for l in minc(mat)..maxc(mat) repeat + qsetelt_!(ans,i,j,qelt(mat,k,l)) + loR := hiR + 1; loC := hiC + 1 + ans -\end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{OrderedAbelianSemiGroup}{OASGP} -\pagepic{ps/v102orderedabeliansemigroup.ps}{OASGP}{0.75} + coerce: Col -> % + coerce(v:Col) == + x := new(#v,1,0) + one := minc(x) + for i in minr(x)..maxr(x) for k in mini(v)..maxi(v) repeat + qsetelt_!(x,i,one,qelt(v,k)) + x -\begin{chunk}{OrderedAbelianSemiGroup.input} -)set break resume -)sys rm -f OrderedAbelianSemiGroup.output -)spool OrderedAbelianSemiGroup.output -)set message test on -)set message auto off -)clear all + transpose: Row -> % + transpose(v:Row) == + x := new(1,#v,0) + one := minr(x) + for j in minc(x)..maxc(x) for k in mini(v)..maxi(v) repeat + qsetelt_!(x,one,j,qelt(v,k)) + x ---S 1 of 1 -)show OrderedAbelianSemiGroup ---R ---R OrderedAbelianSemiGroup is a category constructor ---R Abbreviation for OrderedAbelianSemiGroup is OASGP ---R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for OASGP ---R ---R------------------------------- Operations -------------------------------- ---R ?*? : (PositiveInteger,%) -> % ?+? : (%,%) -> % ---R ? Boolean ?<=? : (%,%) -> Boolean ---R ?=? : (%,%) -> Boolean ?>? : (%,%) -> Boolean ---R ?>=? : (%,%) -> Boolean coerce : % -> OutputForm ---R hash : % -> SingleInteger latex : % -> String ---R max : (%,%) -> % min : (%,%) -> % ---R ?~=? : (%,%) -> Boolean ---R ---E 1 + transpose: % -> % + transpose(x:%) == + ans := new(ncols x,nrows x,0) + for i in minr(ans)..maxr(ans) repeat + for j in minc(ans)..maxc(ans) repeat + qsetelt_!(ans,i,j,qelt(x,j,i)) + ans -)spool -)lisp (bye) -\end{chunk} -\begin{chunk}{OrderedAbelianSemiGroup.help} -==================================================================== -OrderedAbelianSemiGroup examples -==================================================================== + squareTop: % -> % + squareTop x == + nrows x < (cols := ncols x) => + error "squareTop: number of columns exceeds number of rows" + ans := new(cols,cols,0) + for i in minr(x)..(minr(x) + cols - 1) repeat + for j in minc(x)..maxc(x) repeat + qsetelt_!(ans,i,j,qelt(x,i,j)) + ans -Ordered sets which are also abelian semigroups, such that the addition -preserves the ordering. + horizConcat: (%,%) -> % + horizConcat(x,y) == + (rows := nrows x) ^= nrows y => + error "HConcat: matrices must have same number of rows" + ans := new(rows,(cols := ncols x) + ncols y,0) + for i in minr(x)..maxr(x) repeat + for j in minc(x)..maxc(x) repeat + qsetelt_!(ans,i,j,qelt(x,i,j)) + for i in minr(y)..maxr(y) repeat + for j in minc(y)..maxc(y) repeat + qsetelt_!(ans,i,j + cols,qelt(y,i,j)) + ans -Axiom: - x < y => x+z < y+z + vertConcat: (%,%) -> % + vertConcat(x,y) == + (cols := ncols x) ^= ncols y => + error "HConcat: matrices must have same number of columns" + ans := new((rows := nrows x) + nrows y,cols,0) + for i in minr(x)..maxr(x) repeat + for j in minc(x)..maxc(x) repeat + qsetelt_!(ans,i,j,qelt(x,i,j)) + for i in minr(y)..maxr(y) repeat + for j in minc(y)..maxc(y) repeat + qsetelt_!(ans,i + rows,j,qelt(y,i,j)) + ans -See Also: -o )show OrderedAbelianSemiGroup +--% Part extraction/assignment -\end{chunk} -{\bf See:} + listOfLists: % -> List List R + listOfLists x == + ll : List List R := nil() + for i in maxr(x)..minr(x) by -1 repeat + l : List R := nil() + for j in maxc(x)..minc(x) by -1 repeat + l := cons(qelt(x,i,j),l) + ll := cons(l,ll) + ll -\pageto{OrderedAbelianMonoid}{OAMON} -\pagefrom{AbelianMonoid}{ABELMON} -\pagefrom{OrderedSet}{ORDSET} + swapRows_!: (%,Integer,Integer) -> % + swapRows_!(x,i1,i2) == + (i1 < minr(x)) or (i1 > maxr(x)) or (i2 < minr(x)) or _ + (i2 > maxr(x)) => error "swapRows!: index out of range" + i1 = i2 => x + for j in minc(x)..maxc(x) repeat + r := qelt(x,i1,j) + qsetelt_!(x,i1,j,qelt(x,i2,j)) + qsetelt_!(x,i2,j,r) + x -{\bf Exports:}\\ + swapColumns_!: (%,Integer,Integer) -> % + swapColumns_!(x,j1,j2) == + (j1 < minc(x)) or (j1 > maxc(x)) or (j2 < minc(x)) or _ + (j2 > maxc(x)) => error "swapColumns!: index out of range" + j1 = j2 => x + for i in minr(x)..maxr(x) repeat + r := qelt(x,i,j1) + qsetelt_!(x,i,j1,qelt(x,i,j2)) + qsetelt_!(x,i,j2,r) + x -\begin{tabular}{lllll} -\cross{OASGP}{0} & -\cross{OASGP}{coerce} & -\cross{OASGP}{hash} & -\cross{OASGP}{latex} & -\cross{OASGP}{max} \\ -\cross{OASGP}{min} & -\cross{OASGP}{sample} & -\cross{OASGP}{zero?} & -\cross{OASGP}{?\~{}=?} & -\cross{OASGP}{?*?} \\ -\cross{OASGP}{?+?} & -\cross{OASGP}{?$<$?} & -\cross{OASGP}{?$<=$?} & -\cross{OASGP}{?=?} & -\cross{OASGP}{?$>$?} \\ -\cross{OASGP}{?$>=$?} &&&& -\end{tabular} + elt : (%,List(Integer),List(Integer)) -> % + elt(x:%,rowList:List Integer,colList:List Integer) == + for ei in rowList repeat + (ei < minr(x)) or (ei > maxr(x)) => + error "elt: index out of range" + for ej in colList repeat + (ej < minc(x)) or (ej > maxc(x)) => + error "elt: index out of range" + y := new(# rowList,# colList,0) + for ei in rowList for i in minr(y)..maxr(y) repeat + for ej in colList for j in minc(y)..maxc(y) repeat + qsetelt_!(y,i,j,qelt(x,ei,ej)) + y -These exports come from \refto{OrderedSet}(): -\begin{verbatim} - coerce : % -> OutputForm - hash : % -> SingleInteger - latex : % -> String - max : (%,%) -> % - min : (%,%) -> % - ? Boolean - ?>? : (%,%) -> Boolean - ?<=? : (%,%) -> Boolean - ?>=? : (%,%) -> Boolean - ?=? : (%,%) -> Boolean - ?~=? : (%,%) -> Boolean -\end{verbatim} + setelt : (%,List(Integer),List(Integer),%) -> % + setelt(x:%,rowList:List Integer,colList:List Integer,y:%) == + for ei in rowList repeat + (ei < minr(x)) or (ei > maxr(x)) => + error "setelt: index out of range" + for ej in colList repeat + (ej < minc(x)) or (ej > maxc(x)) => + error "setelt: index out of range" + ((# rowList) ^= (nrows y)) or ((# colList) ^= (ncols y)) => + error "setelt: matrix has bad dimensions" + for ei in rowList for i in minr(y)..maxr(y) repeat + for ej in colList for j in minc(y)..maxc(y) repeat + qsetelt_!(x,ei,ej,qelt(y,i,j)) + y -These exports come from \refto{AbelianMonoid}(): -\begin{verbatim} - 0 : () -> % - sample : () -> % + subMatrix: (%,Integer,Integer,Integer,Integer) -> % + subMatrix(x,i1,i2,j1,j2) == + (i2 < i1) => error "subMatrix: bad row indices" + (j2 < j1) => error "subMatrix: bad column indices" + (i1 < minr(x)) or (i2 > maxr(x)) => + error "subMatrix: index out of range" + (j1 < minc(x)) or (j2 > maxc(x)) => + error "subMatrix: index out of range" + rows := (i2 - i1 + 1) pretend NonNegativeInteger + cols := (j2 - j1 + 1) pretend NonNegativeInteger + y := new(rows,cols,0) + for i in minr(y)..maxr(y) for k in i1..i2 repeat + for j in minc(y)..maxc(y) for l in j1..j2 repeat + qsetelt_!(y,i,j,qelt(x,k,l)) + y + + setsubMatrix_!: (%,Integer,Integer,%) -> % + setsubMatrix_!(x,i1,j1,y) == + i2 := i1 + nrows(y) -1 + j2 := j1 + ncols(y) -1 + (i1 < minr(x)) or (i2 > maxr(x)) => + error _ + "setsubMatrix!: inserted matrix too big, use subMatrix to restrict it" + (j1 < minc(x)) or (j2 > maxc(x)) => + error _ + "setsubMatrix!: inserted matrix too big, use subMatrix to restrict it" + for i in minr(y)..maxr(y) for k in i1..i2 repeat + for j in minc(y)..maxc(y) for l in j1..j2 repeat + qsetelt_!(x,k,l,qelt(y,i,j)) + x + +--% Arithmetic + + "+": (%,%) -> % + x + y == + ((r := nrows x) ^= nrows y) or ((c := ncols x) ^= ncols y) => + error "can't add matrices of different dimensions" + ans := new(r,c,0) + for i in minr(x)..maxr(x) repeat + for j in minc(x)..maxc(x) repeat + qsetelt_!(ans,i,j,qelt(x,i,j) + qelt(y,i,j)) + ans + + "-": (%,%) -> % + x - y == + ((r := nrows x) ^= nrows y) or ((c := ncols x) ^= ncols y) => + error "can't subtract matrices of different dimensions" + ans := new(r,c,0) + for i in minr(x)..maxr(x) repeat + for j in minc(x)..maxc(x) repeat + qsetelt_!(ans,i,j,qelt(x,i,j) - qelt(y,i,j)) + ans + + "-": % -> % + - x == map((r1:R):R +-> - r1,x) + + "*": (%,R) -> % + a:R * x:% == map((r1:R):R +-> a * r1,x) + + "*": (R,%) -> % + x:% * a:R == map((r1:R):R +-> r1 * a,x) + + "*": (Integer,%) -> % + m:Integer * x:% == map((r1:R):R +-> m * r1,x) + + ?*? : (%,%) -> % + x:% * y:% == + (ncols x ^= nrows y) => + error "can't multiply matrices of incompatible dimensions" + ans := new(nrows x,ncols y,0) + for i in minr(x)..maxr(x) repeat + for j in minc(y)..maxc(y) repeat + entry := + sum : R := 0 + for k in minr(y)..maxr(y) for l in minc(x)..maxc(x) repeat + sum := sum + qelt(x,i,l) * qelt(y,k,j) + sum + qsetelt_!(ans,i,j,entry) + ans + + positivePower:(%,Integer) -> % + positivePower(x,n) == + (n = 1) => x + odd? n => x * positivePower(x,n - 1) + y := positivePower(x,n quo 2) + y * y + + ?**? : (%,NonNegativeInteger) -> % + x:% ** n:NonNegativeInteger == + not((nn:= nrows x) = ncols x) => error "**: matrix must be square" + zero? n => scalarMatrix(nn,1) + positivePower(x,n) + + --if R has ConvertibleTo InputForm then + --convert(x:%):InputForm == + --convert [convert("matrix"::Symbol)@InputForm, + --convert listOfLists x]$List(InputForm) + + if Col has shallowlyMutable then + + "*": (%,Col) -> Col + x:% * v:Col == + ncols(x) ^= #v => + error "can't multiply matrix A and vector v if #cols A ^= #v" + w : Col := new(nrows x,0) + for i in minr(x)..maxr(x) for k in mini(w)..maxi(w) repeat + w.k := + sum : R := 0 + for j in minc(x)..maxc(x) for l in mini(v)..maxi(v) repeat + sum := sum + qelt(x,i,j) * v(l) + sum + w + + if Row has shallowlyMutable then + + "*": (Row,%) -> Row + v:Row * x:% == + nrows(x) ^= #v => + error "can't multiply vector v and matrix A if #rows A ^= #v" + w : Row := new(ncols x,0) + for j in minc(x)..maxc(x) for k in mini(w)..maxi(w) repeat + w.k := + sum : R := 0 + for i in minr(x)..maxr(x) for l in mini(v)..maxi(v) repeat + sum := sum + qelt(x,i,j) * v(l) + sum + w + + if R has EuclideanDomain then + + columnSpace: % -> List Col + columnSpace M == + M2 := rowEchelon M + basis: List Col := [] + n: Integer := ncols M + m: Integer := nrows M + indRow: Integer := 1 + for k in 1..n while indRow <= m repeat + if not zero?(M2.(indRow,k)) then + basis := cons(column(M,k),basis) + indRow := indRow + 1 + reverse! basis + + if R has CommutativeRing then + + skewSymmetricUnitMatrix(n:PositiveInteger):% == + matrix [[(if i=j+1 and odd? j + then -1 + else if i=j-1 and odd? i + then 1 + else 0) for j in 1..n] for i in 1..n] + + SUPR ==> SparseUnivariatePolynomial R + + PfChar(A:%):SUPR == + n := nrows A + (n = 2) => monomial(1$R,2)$SUPR + qelt(A,1,2)::SUPR + M:=subMatrix(A,3,n,3,n) + r:=subMatrix(A,1,1,3,n) + s:=subMatrix(A,3,n,2,2) + p:=PfChar(M) + d:=degree(p)$SUPR + B:=skewSymmetricUnitMatrix((n-2)::PositiveInteger) + C:=r*B + g:List R := [qelt(C*s,1,1), qelt(A,1,2), 1] + if d >= 4 then + B:=M*B + for i in 4..d by 2 repeat + C:=C*B + g:=cons(qelt(C*s,1,1),g) + g:=reverse! g + res:SUPR := 0 + for i in 0..d by 2 for j in 2..d+2 repeat + c:=coefficient(p,i) + for e in first(g,j) for k in 2..-d by -2 repeat + res:=res+monomial(c*e,(k+i)::NonNegativeInteger)$SUPR + res + + pfaffian: % -> R + pfaffian a == + if antisymmetric? a + then if odd? nrows a + then 0 + else PfChar(a).0 + else + error "pfaffian: only defined for antisymmetric square matrices" + + if R has IntegralDomain then + + "exquo": (%,R) -> Union(%,"failed") + x exquo a == + ans := new(nrows x,ncols x,0) + for i in minr(x)..maxr(x) repeat + for j in minc(x)..maxc(x) repeat + entry := + (r := (qelt(x,i,j) exquo a)) case "failed" => + return "failed" + r :: R + qsetelt_!(ans,i,j,entry) + ans + + if R has Field then + + "/": (%,R) -> % + x / r == map((r1:R):R +-> r1 / r,x) + + "**": (%,Integer) -> % + x:% ** n:Integer == + not((nn:= nrows x) = ncols x) => error "**: matrix must be square" + zero? n => scalarMatrix(nn,1) + positive? n => positivePower(x,n) + (xInv := inverse x) case "failed" => + error "**: matrix must be invertible" + positivePower(xInv :: %,-n) + +*) + +\end{chunk} + +\begin{chunk}{MATCAT.dotabb} +"MATCAT" + [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"]; +"MATCAT" -> "ARR2CAT" + +\end{chunk} + +\begin{chunk}{MATCAT.dotfull} +"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" + [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"]; +"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" + -> +"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" + +\end{chunk} + +\begin{chunk}{MATCAT.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; + +"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" + [color=lightblue]; +"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" + -> +"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" + +"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" + [color=lightblue]; +"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" + -> "HomogeneousAggregate(a:Type)" + +"HomogeneousAggregate(a:Type)" [color=lightblue]; +"HomogeneousAggregate(a:Type)" -> "Aggregate()" +"HomogeneousAggregate(a:Type)" -> "Evalable(a:Type)" +"HomogeneousAggregate(a:Type)" -> "SetCategory()" + +"Evalable(a:Type)" [color="#00EE00"]; + +"SetCategory()" [color=lightblue]; +"SetCategory()" -> "BasicType()" +"SetCategory()" -> "CoercibleTo(OutputForm)" + +"BasicType()" [color=lightblue]; +"BasicType()" -> "Category" + +"CoercibleTo(OutputForm)" [color=seagreen]; +"CoercibleTo(OutputForm)" -> "CoercibleTo(a:Type)" + +"CoercibleTo(a:Type)" [color=lightblue]; +"CoercibleTo(a:Type)" -> "Category" + +"Aggregate()" [color=lightblue]; +"Aggregate()" -> "Type()" + +"Type()" [color=lightblue]; +"Type()" -> "Category" + +"Category" [color=lightblue]; + +} + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\pagehead{OrderedAbelianSemiGroup}{OASGP} +\pagepic{ps/v102orderedabeliansemigroup.ps}{OASGP}{0.75} + +\begin{chunk}{OrderedAbelianSemiGroup.input} +)set break resume +)sys rm -f OrderedAbelianSemiGroup.output +)spool OrderedAbelianSemiGroup.output +)set message test on +)set message auto off +)clear all + +--S 1 of 1 +)show OrderedAbelianSemiGroup +--R +--R OrderedAbelianSemiGroup is a category constructor +--R Abbreviation for OrderedAbelianSemiGroup is OASGP +--R This constructor is exposed in this frame. +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for OASGP +--R +--R------------------------------- Operations -------------------------------- +--R ?*? : (PositiveInteger,%) -> % ?+? : (%,%) -> % +--R ? Boolean ?<=? : (%,%) -> Boolean +--R ?=? : (%,%) -> Boolean ?>? : (%,%) -> Boolean +--R ?>=? : (%,%) -> Boolean coerce : % -> OutputForm +--R hash : % -> SingleInteger latex : % -> String +--R max : (%,%) -> % min : (%,%) -> % +--R ?~=? : (%,%) -> Boolean +--R +--E 1 + +)spool +)lisp (bye) +\end{chunk} + +\begin{chunk}{OrderedAbelianSemiGroup.help} +==================================================================== +OrderedAbelianSemiGroup examples +==================================================================== + +Ordered sets which are also abelian semigroups, such that the addition +preserves the ordering. + +Axiom: + x < y => x+z < y+z + +See Also: +o )show OrderedAbelianSemiGroup + +\end{chunk} +{\bf See:} + +\pageto{OrderedAbelianMonoid}{OAMON} +\pagefrom{AbelianMonoid}{ABELMON} +\pagefrom{OrderedSet}{ORDSET} + +{\bf Exports:}\\ + +\begin{tabular}{lllll} +\cross{OASGP}{0} & +\cross{OASGP}{coerce} & +\cross{OASGP}{hash} & +\cross{OASGP}{latex} & +\cross{OASGP}{max} \\ +\cross{OASGP}{min} & +\cross{OASGP}{sample} & +\cross{OASGP}{zero?} & +\cross{OASGP}{?\~{}=?} & +\cross{OASGP}{?*?} \\ +\cross{OASGP}{?+?} & +\cross{OASGP}{?$<$?} & +\cross{OASGP}{?$<=$?} & +\cross{OASGP}{?=?} & +\cross{OASGP}{?$>$?} \\ +\cross{OASGP}{?$>=$?} &&&& +\end{tabular} + +These exports come from \refto{OrderedSet}(): +\begin{verbatim} + coerce : % -> OutputForm + hash : % -> SingleInteger + latex : % -> String + max : (%,%) -> % + min : (%,%) -> % + ? Boolean + ?>? : (%,%) -> Boolean + ?<=? : (%,%) -> Boolean + ?>=? : (%,%) -> Boolean + ?=? : (%,%) -> Boolean + ?~=? : (%,%) -> Boolean +\end{verbatim} + +These exports come from \refto{AbelianMonoid}(): +\begin{verbatim} + 0 : () -> % + sample : () -> % zero? : % -> Boolean ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % @@ -21437,6 +23920,15 @@ These exports come from \refto{AbelianMonoid}(): OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup) \end{chunk} + +\begin{chunk}{COQ OASGP} +(* category OASGP *) +(* +Axiom + x < y => x+z < y+z +*) +\end{chunk} + \begin{chunk}{OASGP.dotabb} "OASGP" [color=lightblue,href="bookvol10.2.pdf#nameddest=OASGP"]; @@ -21444,6 +23936,7 @@ OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup) "OASGP" -> "ABELMON" \end{chunk} + \begin{chunk}{OASGP.dotfull} "OrderedAbelianSemiGroup()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OASGP"]; @@ -21451,6 +23944,7 @@ OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup) "OrderedAbelianSemiGroup()" -> "AbelianMonoid()" \end{chunk} + \begin{chunk}{OASGP.dotpic} digraph pic { fontsize=10; @@ -21497,6 +23991,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedMonoid}{ORDMON} \pagepic{ps/v102orderedmonoid.ps}{ORDMON}{0.75} @@ -21534,6 +24029,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedMonoid.help} ==================================================================== OrderedMonoid examples @@ -21619,6 +24115,17 @@ These exports come from \refto{OrderedSet}(): OrderedMonoid(): Category == Join(OrderedSet, Monoid) \end{chunk} + +\begin{chunk}{COQ ORDMON} +(* category ORDMON *) +(* +Axioms: + x < y => x*z < y*z + x < y => z*x < z*y +*) + +\end{chunk} + \begin{chunk}{ORDMON.dotabb} "ORDMON" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDMON"]; @@ -21626,6 +24133,7 @@ OrderedMonoid(): Category == Join(OrderedSet, Monoid) "ORDMON" -> "MONOID" \end{chunk} + \begin{chunk}{ORDMON.dotfull} "OrderedMonoid()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDMON"]; @@ -21633,6 +24141,7 @@ OrderedMonoid(): Category == Join(OrderedSet, Monoid) "OrderedMonoid()" -> "Monoid()" \end{chunk} + \begin{chunk}{ORDMON.dotpic} digraph pic { fontsize=10; @@ -21681,6 +24190,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PolynomialSetCategory}{PSETCAT} \pagepic{ps/v102polynomialsetcategory.ps}{PSETCAT}{0.30} @@ -21756,6 +24266,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PolynomialSetCategory.help} ==================================================================== PolynomialSetCategory examples @@ -22218,7 +24729,6 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_ makeIrreducible! (frac:Record(num:P,den:R)):Record(num:P,den:R) == g := gcd(frac.den,frac.num)$P --- one? g => frac (g = 1) => frac frac.num := exactQuotient!(frac.num,g) frac.den := exactQuo(frac.den,g) @@ -22285,6 +24795,283 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_ removeDuplicates rs \end{chunk} + +\begin{chunk}{COQ PSETCAT} +(* category PSETCAT *) +(* + + NNI ==> NonNegativeInteger + B ==> Boolean + + elements: $ -> List(P) + elements(ps:$):List(P) == + lp : List(P) := members(ps)$$ + + variables1: (List(P)) -> (List VarSet) + variables1(lp:List(P)):(List VarSet) == + lvars : List(List(VarSet)) := [variables(p)$P for p in lp] + sort((z1:VarSet,z2:VarSet):Boolean +-> z1 > z2, + removeDuplicates(concat(lvars)$List(VarSet))) + + variables2: (List(P)) -> (List VarSet) + variables2(lp:List(P)):(List VarSet) == + lvars : List(VarSet) := [mvar(p)$P for p in lp] + sort((z1:VarSet,z2:VarSet):Boolean +-> z1 > z2, + removeDuplicates(lvars)$List(VarSet)) + + variables : $ -> List VarSet + variables (ps:$) == + variables1(elements(ps)) + + mainVariables : $ -> List VarSet + mainVariables (ps:$) == + variables2(remove(ground?,elements(ps))) + + mainVariable? : (VarSet,$) -> Boolean + mainVariable? (v,ps) == + lp : List(P) := remove(ground?,elements(ps)) + while (not empty? lp) and (not (mvar(first(lp)) = v)) repeat + lp := rest lp + (not empty? lp) + + collectUnder : ($,VarSet) -> $ + collectUnder (ps,v) == + lp : List P := elements(ps) + lq : List P := [] + while (not empty? lp) repeat + p := first lp + lp := rest lp + if (ground?(p)) or (mvar(p) < v) + then + lq := cons(p,lq) + construct(lq)$$ + + collectUpper : ($,VarSet) -> $ + collectUpper (ps,v) == + lp : List P := elements(ps) + lq : List P := [] + while (not empty? lp) repeat + p := first lp + lp := rest lp + if (not ground?(p)) and (mvar(p) > v) + then + lq := cons(p,lq) + construct(lq)$$ + + collect : ($,VarSet) -> $ + collect (ps,v) == + lp : List P := elements(ps) + lq : List P := [] + while (not empty? lp) repeat + p := first lp + lp := rest lp + if (not ground?(p)) and (mvar(p) = v) + then + lq := cons(p,lq) + construct(lq)$$ + + sort : ($,VarSet) -> Record(under:$,floor:$,upper:$) + sort (ps,v) == + lp : List P := elements(ps) + us : List P := [] + vs : List P := [] + ws : List P := [] + while (not empty? lp) repeat + p := first lp + lp := rest lp + if (ground?(p)) or (mvar(p) < v) + then + us := cons(p,us) + else + if (mvar(p) = v) + then + vs := cons(p,vs) + else + ws := cons(p,ws) + [construct(us)$$,_ + construct(vs)$$,_ + construct(ws)$$]$Record(under:$,floor:$,upper:$) + + ?=? : (%,%) -> Boolean + ps1 = ps2 == + {p for p in elements(ps1)} =$(Set P) {p for p in elements(ps2)} + + localInf? (p:P,q:P):B == + degree(p) <$E degree(q) + + localTriangular? (lp:List(P)):B == + lp := remove(zero?, lp) + empty? lp => true + any? (ground?, lp) => false + lp := sort((z1:P,z2:P):Boolean +-> mvar(z1)$P > mvar(z2)$P, lp) + p,q : P + p := first lp + lp := rest lp + while (not empty? lp) and (mvar(p) > mvar((q := first(lp)))) repeat + p := q + lp := rest lp + empty? lp + + triangular? : $ -> Boolean + triangular? ps == + localTriangular? elements ps + + trivialIdeal?: $ -> Boolean + trivialIdeal? ps == + empty?(remove(zero?,elements(ps))$(List(P)))$(List(P)) + + if R has IntegralDomain + then + + roughUnitIdeal? : $ -> Boolean + roughUnitIdeal? ps == + any?(ground?,remove(zero?,elements(ps))$(List(P)))$(List P) + + relativelyPrimeLeadingMonomials? (p:P,q:P):B == + dp : E := degree(p) + dq : E := degree(q) + (sup(dp,dq)$E =$E dp +$E dq)@B + + roughBase? : $ -> Boolean + roughBase? ps == + lp := remove(zero?,elements(ps))$(List(P)) + empty? lp => true + rB? : B := true + while (not empty? lp) and rB? repeat + p := first lp + lp := rest lp + copylp := lp + while (not empty? copylp) and rB? repeat + rB? := relativelyPrimeLeadingMonomials?(p,first(copylp)) + copylp := rest copylp + rB? + + roughSubIdeal? : ($,$) -> Boolean + roughSubIdeal?(ps1,ps2) == + lp: List(P) := rewriteIdealWithRemainder(elements(ps1),ps2) + empty? (remove(zero?,lp)) + + roughEqualIdeals? : ($,$) -> Boolean + roughEqualIdeals? (ps1,ps2) == + ps1 =$$ ps2 => true + roughSubIdeal?(ps1,ps2) and roughSubIdeal?(ps2,ps1) + + if (R has GcdDomain) and (VarSet has ConvertibleTo (Symbol)) + then + + LPR ==> List Polynomial R + LS ==> List Symbol + + if R has EuclideanDomain + then + + exactQuo : (R,R) -> R + exactQuo(r:R,s:R):R == + r quo$R s + + else + + exactQuo : (R,R) -> R + exactQuo(r:R,s:R):R == + (r exquo$R s)::R + + headRemainder : (P,$) -> Record(num:P,den:R) + headRemainder (a,ps) == + lp1 : List(P) := remove(zero?, elements(ps))$(List(P)) + empty? lp1 => [a,1$R] + any?(ground?,lp1) => [reductum(a),1$R] + r : R := 1$R + lp1 := sort(localInf?, reverse elements(ps)) + lp2 := lp1 + e : Union(E, "failed") + while (not zero? a) and (not empty? lp2) repeat + p := first lp2 + if ((e:= subtractIfCan(degree(a),degree(p))) case E) + then + g := gcd((lca := leadingCoefficient(a)),_ + (lcp := leadingCoefficient(p)))$R + (lca,lcp) := (exactQuo(lca,g),exactQuo(lcp,g)) + a := lcp * reductum(a) - monomial(lca, e::E)$P * reductum(p) + r := r * lcp + lp2 := lp1 + else + lp2 := rest lp2 + [a,r] + + makeIrreducible! (frac:Record(num:P,den:R)):Record(num:P,den:R) == + g := gcd(frac.den,frac.num)$P + (g = 1) => frac + frac.num := exactQuotient!(frac.num,g) + frac.den := exactQuo(frac.den,g) + frac + + remainder : (P,$) -> Record(rnum:R,polnum:P,den:R) + remainder (a,ps) == + hRa := makeIrreducible! headRemainder (a,ps) + a := hRa.num + r : R := hRa.den + zero? a => [1$R,a,r] + b : P := monomial(1$R,degree(a))$P + c : R := leadingCoefficient(a) + while not zero?(a := reductum a) repeat + hRa := makeIrreducible! headRemainder (a,ps) + a := hRa.num + r := r * hRa.den + g := gcd(c,(lca := leadingCoefficient(a)))$R + b := ((hRa.den) * exactQuo(c,g)) * b + _ + monomial(exactQuo(lca,g),degree(a))$P + c := g + [c,b,r] + + rewriteIdealWithHeadRemainder : (List(P),%) -> List(P) if R has INTDOM + rewriteIdealWithHeadRemainder(ps,cs) == + trivialIdeal? cs => ps + roughUnitIdeal? cs => [0$P] + ps := remove(zero?,ps) + empty? ps => ps + any?(ground?,ps) => [1$P] + rs : List P := [] + while not empty? ps repeat + p := first ps + ps := rest ps + p := (headRemainder(p,cs)).num + if not zero? p + then + if ground? p + then + ps := [] + rs := [1$P] + else + primitivePart! p + rs := cons(p,rs) + removeDuplicates rs + + rewriteIdealWithRemainder : (List(P),%) -> List(P) if R has INTDOM + rewriteIdealWithRemainder(ps,cs) == + trivialIdeal? cs => ps + roughUnitIdeal? cs => [0$P] + ps := remove(zero?,ps) + empty? ps => ps + any?(ground?,ps) => [1$P] + rs : List P := [] + while not empty? ps repeat + p := first ps + ps := rest ps + p := (remainder(p,cs)).polnum + if not zero? p + then + if ground? p + then + ps := [] + rs := [1$P] + else + rs := cons(unitCanonical(p),rs) + removeDuplicates rs + +*) + +\end{chunk} + \begin{chunk}{PSETCAT.dotabb} "PSETCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PSETCAT"]; @@ -22293,6 +25080,7 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_ "PSETCAT" -> "SETCAT" \end{chunk} + \begin{chunk}{PSETCAT.dotfull} "PolynomialSetCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" [color=lightblue,href="bookvol10.2.pdf#nameddest=PSETCAT"]; @@ -22309,6 +25097,7 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_ -> "PolynomialSetCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" \end{chunk} + \begin{chunk}{PSETCAT.dotpic} digraph pic { fontsize=10; @@ -22369,6 +25158,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PriorityQueueAggregate}{PRQAGG} \pagepic{ps/v102priorityqueueaggregate.ps}{PRQAGG}{1.00} @@ -22423,6 +25213,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PriorityQueueAggregate.help} ==================================================================== PriorityQueueAggregate examples @@ -22556,12 +25347,14 @@ PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with ++ values from priority queue q1. \end{chunk} + \begin{chunk}{PRQAGG.dotabb} "PRQAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=PRQAGG"]; "PRQAGG" -> "BGAGG" \end{chunk} + \begin{chunk}{PRQAGG.dotfull} "PriorityQueueAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PRQAGG"]; @@ -22577,6 +25370,7 @@ PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with "PriorityQueueAggregate(a:SetCategory)" \end{chunk} + \begin{chunk}{PRQAGG.dotpic} digraph pic { fontsize=10; @@ -22602,6 +25396,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{QueueAggregate}{QUAGG} \pagepic{ps/v102queueaggregate.ps}{QUAGG}{1.00} @@ -22658,6 +25453,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{QueueAggregate.help} ==================================================================== QueueAggregate examples @@ -22809,11 +25605,13 @@ QueueAggregate(S:Type): Category == BagAggregate S with ++ Error: if q is empty. \end{chunk} + \begin{chunk}{QUAGG.dotabb} "QUAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=QUAGG"]; "QUAGG" -> "BGAGG" \end{chunk} + \begin{chunk}{QUAGG.dotfull} "QueueAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=QUAGG"]; @@ -22824,6 +25622,7 @@ QueueAggregate(S:Type): Category == BagAggregate S with "QueueAggregate(a:SetCategory)" -> "QueueAggregate(a:Type)" \end{chunk} + \begin{chunk}{QUAGG.dotpic} digraph pic { fontsize=10; @@ -22914,6 +25713,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SetAggregate.help} ==================================================================== SetAggregate examples @@ -23152,6 +25952,27 @@ SetAggregate(S:SetCategory): difference(s:%, x:S) == difference(s, {x}) \end{chunk} + +\begin{chunk}{COQ SETAGG} +(* category SETAGG *) +(* + + symmetricDifference : (%, %) -> % + symmetricDifference(x, y) == union(difference(x, y), difference(y, x)) + + union : (%, S) -> % + union(s:%, x:S) == union(s, {x}) + + union : (S, %) -> % + union(x:S, s:%) == union(s, {x}) + + difference : (%, S) -> % + difference(s:%, x:S) == difference(s, {x}) + +*) + +\end{chunk} + \begin{chunk}{SETAGG.dotabb} "SETAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=SETAGG"]; @@ -23159,6 +25980,7 @@ SetAggregate(S:SetCategory): "SETAGG" -> "CLAGG" \end{chunk} + \begin{chunk}{SETAGG.dotfull} "SetAggregate(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=SETAGG"]; @@ -23166,6 +25988,7 @@ SetAggregate(S:SetCategory): "SetAggregate(a:SetCategory)" -> "Collection(a:SetCategory)" \end{chunk} + \begin{chunk}{SETAGG.dotpic} digraph pic { fontsize=10; @@ -23209,6 +26032,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{StackAggregate}{SKAGG} \pagepic{ps/v102stackaggregate.ps}{SKAGG}{1.00} @@ -23264,6 +26088,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{StackAggregate.help} ==================================================================== StackAggregate examples @@ -23421,11 +26246,13 @@ StackAggregate(S:Type): Category == BagAggregate S with ++X a:Stack INT:= stack [1,2,3,4,5] ++X depth a \end{chunk} + \begin{chunk}{SKAGG.dotabb} "SKAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=SKAGG"]; "SKAGG" -> "BGAGG" \end{chunk} + \begin{chunk}{SKAGG.dotfull} "StackAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=SKAGG"]; @@ -23436,6 +26263,7 @@ StackAggregate(S:Type): Category == BagAggregate S with "StackAggregate(a:SetCategory)" -> "StackAggregate(a:Type)" \end{chunk} + \begin{chunk}{SKAGG.dotpic} digraph pic { fontsize=10; @@ -23461,6 +26289,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnaryRecursiveAggregate}{URAGG} \pagepic{ps/v102unaryrecursiveaggregate.ps}{URAGG}{1.00} @@ -23540,6 +26369,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnaryRecursiveAggregate.help} ==================================================================== UnaryRecursiveAggregate examples @@ -23985,17 +26815,222 @@ UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with y \end{chunk} + +\begin{chunk}{COQ URAGG} +(* category URAGG *) +(* + cycleMax ==> 1000 + + elt: (%,"first") -> S + elt(x, "first") == first x + + elt: (%,"last") -> S + elt(x, "last") == last x + + elt: (%,"rest") -> % + elt(x, "rest") == rest x + + second: % -> S + second x == first rest x + + third: % -> S + third x == first rest rest x + + cyclic? : % -> Boolean + cyclic? x == not empty? x and not empty? findCycle x + + last: % -> S + last x == first tail x + + nodes : % -> List(%) + nodes x == + l := empty()$List(%) + while not empty? x repeat + l := concat(x, l) + x := rest x + reverse_! l + + children : % -> List(%) + children x == + l := empty()$List(%) + empty? x => l + concat(rest x,l) + + leaf? : % -> Boolean + leaf? x == empty? x + + value : % -> S + value x == + empty? x => error "value of empty object" + first x + + less? : (%,NonNegativeInteger) -> Boolean + less?(l, n) == + i := n::Integer + while i > 0 and not empty? l repeat (l := rest l; i := i - 1) + i > 0 + + more? : (%,NonNegativeInteger) -> Boolean + more?(l, n) == + i := n::Integer + while i > 0 and not empty? l repeat (l := rest l; i := i - 1) + zero?(i) and not empty? l + + size? : (%,NonNegativeInteger) -> Boolean + size?(l, n) == + i := n::Integer + while not empty? l and i > 0 repeat (l := rest l; i := i - 1) + empty? l and zero? i + + #? : % -> NonNegativeInteger + #x == + for k in 0.. while not empty? x repeat + k = cycleMax and cyclic? x => error "cyclic list" + x := rest x + k + + tail: % -> % + tail x == + empty? x => error "empty list" + y := rest x + for k in 0.. while not empty? y repeat + k = cycleMax and cyclic? x => error "cyclic list" + y := rest(x := y) + x + + findCycle: % -> % + findCycle x == + y := rest x + while not empty? y repeat + if eq?(x, y) then return x + x := rest x + y := rest y + if empty? y then return y + if eq?(x, y) then return y + y := rest y + y + + cycleTail: % -> % + cycleTail x == + empty?(y := x := cycleEntry x) => x + z := rest x + while not eq?(x,z) repeat (y := z; z := rest z) + y + + cycleEntry: % -> % + cycleEntry x == + empty? x => x + empty?(y := findCycle x) => y + z := rest y + for l in 1.. while not eq?(y,z) repeat z := rest z + y := x + for k in 1..l repeat y := rest y + while not eq?(x,y) repeat (x := rest x; y := rest y) + x + + cycleLength: % -> NonNegativeInteger + cycleLength x == + empty? x => 0 + empty?(x := findCycle x) => 0 + y := rest x + for k in 1.. while not eq?(x,y) repeat y := rest y + k + + rest: (%,NonNegativeInteger) -> % + rest(x, n) == + for i in 1..n repeat + empty? x => error "Index out of range" + x := rest x + x + + if % has finiteAggregate then + + last: (%,NonNegativeInteger) -> % + last(x, n) == + n > (m := #x) => error "index out of range" + copy rest(x, (m - n)::NonNegativeInteger) + + if S has SetCategory then + + ?=? : (%,%) -> Boolean + x = y == + eq?(x, y) => true + for k in 0.. while not empty? x and not empty? y repeat + k = cycleMax and cyclic? x => error "cyclic list" + first x ^= first y => return false + x := rest x + y := rest y + empty? x and empty? y + + node? : (%,%) -> Boolean + node?(u, v) == + for k in 0.. while not empty? v repeat + u = v => return true + k = cycleMax and cyclic? v => error "cyclic list" + v := rest v + u=v + + if % has shallowlyMutable then + + setelt: (%,"first",S) -> S + setelt(x, "first", a) == setfirst_!(x, a) + + setelt: (%,"last",S) -> S + setelt(x, "last", a) == setlast_!(x, a) + + setelt: (%,"rest",%) -> % + setelt(x, "rest", a) == setrest_!(x, a) + + concat : (%,%) -> % + concat(x:%, y:%) == concat_!(copy x, y) + + setlast_!: (%,S) -> S + setlast_!(x, s) == + empty? x => error "setlast: empty list" + setfirst_!(tail x, s) + s + + setchildren! : (%,List(%)) -> % + setchildren_!(u,lv) == + #lv=1 => setrest_!(u, first lv) + error "wrong number of children specified" + + setvalue! : (%,S) -> S + setvalue_!(u,s) == setfirst_!(u,s) + + split_!: (%,Integer) -> % + split_!(p, n) == + n < 1 => error "index out of range" + p := rest(p, (n - 1)::NonNegativeInteger) + q := rest p + setrest_!(p, empty()) + q + + cycleSplit_!: % -> % + cycleSplit_! x == + empty?(y := cycleEntry x) or eq?(x, y) => y + z := rest x + while not eq?(z, y) repeat (x := z; z := rest z) + setrest_!(x, empty()) + y + +*) + +\end{chunk} + \begin{chunk}{URAGG.dotabb} "URAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=URAGG"]; "URAGG" -> "RCAGG" \end{chunk} + \begin{chunk}{URAGG.dotfull} "UnaryRecursiveAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=URAGG"]; "UnaryRecursiveAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" \end{chunk} + \begin{chunk}{URAGG.dotpic} digraph pic { fontsize=10; @@ -24021,6 +27056,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 6} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AbelianGroup}{ABELGRP} @@ -24057,6 +27093,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AbelianGroup.help} ==================================================================== AbelianGroup examples @@ -24161,12 +27198,43 @@ AbelianGroup(): Category == CancellationAbelianMonoid with double((-n) pretend PositiveInteger,-x) \end{chunk} + +\begin{chunk}{COQ ABELGRP} +(* category ABELGRP *) +(* +Axioms + -(-x) = x + x+(-x) = 0 + + "-": (%,%) -> % + (x:% - y:%):% == x+(-y) + + subtractIfCan : (%,%) -> Union(%,"failed") + subtractIfCan(x:%, y:%):Union(%, "failed") == (x-y)::Union(%,"failed") + + ?*? : (NonNegativeInteger,%) -> % + n:NonNegativeInteger * x:% == (n::Integer) * x + + import RepeatedDoubling(%) + + if not (% has Ring) then + + "*": (Integer,%) -> % + n:Integer * x:% == + zero? n => 0 + n>0 => double(n pretend PositiveInteger,x) + double((-n) pretend PositiveInteger,-x) +*) + +\end{chunk} + \begin{chunk}{ABELGRP.dotabb} "ABELGRP" [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELGRP"]; "ABELGRP" -> "CABMON" \end{chunk} + \begin{chunk}{ABELGRP.dotfull} "AbelianGroup()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELGRP"]; @@ -24174,6 +27242,7 @@ AbelianGroup(): Category == CancellationAbelianMonoid with "AbelianGroup()" -> "RepeatedDoubling(AbelianGroup)" \end{chunk} + \begin{chunk}{ABELGRP.dotpic} digraph pic { fontsize=10; @@ -24209,6 +27278,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BinaryTreeCategory}{BTCAT} \pagepic{ps/v102binarytreecategory.ps}{BTCAT}{1.00} @@ -24275,6 +27345,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{BinaryTreeCategory.help} ==================================================================== BinaryTreeCategory examples @@ -24457,12 +27528,49 @@ BinaryTreeCategory(S: SetCategory): Category == _ treeCount(right t,k) \end{chunk} + +\begin{chunk}{COQ BTCAT} +(* category BTCAT *) +(* + cycleTreeMax ==> 5 + + copy : % -> % + copy t == + empty? t => empty() + node(copy left t, value t, copy right t) + + if % has shallowlyMutable then + + map! : ((S -> S),%) -> % + map_!(f,t) == + empty? t => t + t.value := f(t.value) + map_!(f,left t) + map_!(f,right t) + t + + #? : % -> NonNegativeInteger + #t == treeCount(t,0) + + treeCount : (%, NonNegativeInteger) -> NonNegativeInteger + treeCount(t,k) == + empty? t => k + k := k + 1 + k = cycleTreeMax and cyclic? t => error "cyclic binary tree" + k := treeCount(left t,k) + treeCount(right t,k) + +*) + +\end{chunk} + \begin{chunk}{BTCAT.dotabb} "BTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=BTCAT"]; "BTCAT" -> "BRAGG" \end{chunk} + \begin{chunk}{BTCAT.dotfull} "BinaryTreeCategory(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=BTCAT"]; @@ -24470,6 +27578,7 @@ BinaryTreeCategory(S: SetCategory): Category == _ "BinaryRecursiveAggregate(a:SetCategory)" \end{chunk} + \begin{chunk}{BTCAT.dotpic} digraph pic { fontsize=10; @@ -24504,6 +27613,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Dictionary}{DIAGG} \pagepic{ps/v102dictionary.ps}{DIAGG}{1.00} @@ -24570,6 +27680,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Dictionary.help} ==================================================================== Dictionary examples @@ -24752,11 +27863,52 @@ Dictionary(S:SetCategory): Category == t \end{chunk} + +\begin{chunk}{COQ DIAGG} +(* category DIAGG *) +(* + + dictionary : List(S) -> % + dictionary l == + d := dictionary() + for x in l repeat insert_!(x, d) + d + + if % has finiteAggregate then + + -- remove(f:S->Boolean,t:%) == remove_!(f, copy t) + + -- select(f, t) == select_!(f, copy t) + + select! : ((S -> Boolean),%) -> % + select_!(f, t) == remove_!((x:S):Boolean +-> not f(x), t) + + --extract_! d == + -- empty? d => error "empty dictionary" + -- remove_!(x := first parts d, d, 1) + -- x + + ?=? : (%,%) -> Boolean + s = t == + eq?(s,t) => true + #s ^= #t => false + _and/[member?(x, t) for x in parts s] + + remove! : ((S -> Boolean),%) -> % + remove_!(f:S->Boolean, t:%) == + for m in parts t repeat if f m then remove_!(m, t) + t + +*) + +\end{chunk} + \begin{chunk}{DIAGG.dotabb} "DIAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIAGG"]; "DIAGG" -> "DIOPS" \end{chunk} + \begin{chunk}{DIAGG.dotfull} "Dictionary(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIAGG"]; @@ -24768,6 +27920,7 @@ Dictionary(S:SetCategory): Category == "Dictionary(a:SetCategory)" \end{chunk} + \begin{chunk}{DIAGG.dotpic} digraph pic { fontsize=10; @@ -24806,6 +27959,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DequeueAggregate}{DQAGG} \pagepic{ps/v102dequeueaggregate.ps}{DQAGG}{1.00} @@ -24869,6 +28023,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DequeueAggregate.help} ==================================================================== DequeueAggregate examples @@ -25065,12 +28220,14 @@ DequeueAggregate(S:Type): ++ the top (front) element is now the bottom (back) element, and so on. \end{chunk} + \begin{chunk}{DQAGG.dotabb} "DQAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=DQAGG"]; "DQAGG" -> "SKAGG" "DQAGG" -> "QUAGG" \end{chunk} + \begin{chunk}{DQAGG.dotfull} "DequeueAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DQAGG"]; @@ -25082,6 +28239,7 @@ DequeueAggregate(S:Type): "DequeueAggregate(a:SetCategory)" -> "DequeueAggregate(a:Type)" \end{chunk} + \begin{chunk}{DQAGG.dotpic} digraph pic { fontsize=10; @@ -25108,6 +28266,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ExtensibleLinearAggregate}{ELAGG} \pagepic{ps/v102extensiblelinearaggregate.ps}{ELAGG}{0.90} @@ -25195,6 +28354,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ExtensibleLinearAggregate.help} ==================================================================== ExtensibleLinearAggregate examples @@ -25459,17 +28619,71 @@ ExtensibleLinearAggregate(S:Type):Category == LinearAggregate S with merge_!(x, y) == merge_!(_<$S, x, y) \end{chunk} + +\begin{chunk}{COQ ELAGG} +(* category ELAGG *) +(* + + delete : (%,Integer) -> % + delete(x:%, i:Integer) == delete_!(copy x, i) + + delete : (%,UniversalSegment(Integer)) -> % + delete(x:%, i:UniversalSegment(Integer)) == delete_!(copy x, i) + + remove : ((S -> Boolean),%) -> % + remove(f:S -> Boolean, x:%) == remove_!(f, copy x) + + insert : (S,%,Integer) -> % + insert(s:S, x:%, i:Integer) == insert_!(s, copy x, i) + + insert : (%,%,Integer) -> % + insert(w:%, x:%, i:Integer) == insert_!(copy w, copy x, i) + + select : ((S -> Boolean),%) -> % + select(f, x) == select_!(f, copy x) + + concat : (%,%) -> % + concat(x:%, y:%) == concat_!(copy x, y) + + concat : (%,S) -> % + concat(x:%, y:S) == concat_!(copy x, new(1, y)) + + concat_!: (%,S) -> % + concat_!(x:%, y:S) == concat_!(x, new(1, y)) + + if S has SetCategory then + + remove : (S,%) -> % + remove(s:S, x:%) == remove_!(s, copy x) + + remove_!: (S->Boolean,%) -> % + remove_!(s:S, x:%) == remove_!(y +-> y = s, x) + + removeDuplicates : % -> % + removeDuplicates(x:%) == removeDuplicates_!(copy x) + + if S has OrderedSet then + + merge! : (%,%) -> % + merge_!(x, y) == merge_!(_<$S, x, y) + +*) + +\end{chunk} + \begin{chunk}{ELAGG.dotabb} "ELAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELAGG"]; "ELAGG" -> "LNAGG" \end{chunk} + \begin{chunk}{ELAGG.dotfull} "ExtensibleLinearAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELAGG"]; "ExtensibleLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)" \end{chunk} + \begin{chunk}{ELAGG.dotpic} digraph pic { fontsize=10; @@ -25500,6 +28714,7 @@ digraph pic { "..." [color=lightblue]; } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteLinearAggregate}{FLAGG} \pagepic{ps/v102finitelinearaggregate.ps}{FLAGG}{0.90} @@ -25596,6 +28811,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FiniteLinearAggregate.help} ==================================================================== FiniteLinearAggregate examples @@ -25903,17 +29119,56 @@ FiniteLinearAggregate(S:Type): Category == LinearAggregate S with sort_! l == sort_!(_<$S, l) \end{chunk} + +\begin{chunk}{COQ FLAGG} +(* category FLAGG *) +(* + if S has SetCategory then + + position: (S, %) -> Integer + position(x:S, t:%) == position(x, t, minIndex t) + + if S has OrderedSet then + + sorted?: % -> Boolean + sorted? l == sorted?((x,y) +-> x < y or x = y, l) + + merge: (%,%) -> % + merge(x, y) == merge(_<$S, x, y) + + sort: % -> % + sort l == sort(_<$S, l) + + if % has shallowlyMutable then + + reverse: % -> % + reverse x == reverse_! copy x + + sort: ((S,S)->Boolean,%) -> % + sort(f, l) == sort_!(f, copy l) + + if S has OrderedSet then + + sort_!: % -> % + sort_! l == sort_!(_<$S, l) + +*) + +\end{chunk} + \begin{chunk}{FLAGG.dotabb} "FLAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLAGG"]; "FLAGG" -> "LNAGG" \end{chunk} + \begin{chunk}{FLAGG.dotfull} "FiniteLinearAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLAGG"]; "FiniteLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)" \end{chunk} + \begin{chunk}{FLAGG.dotpic} digraph pic { fontsize=10; @@ -25948,6 +29203,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FreeAbelianMonoidCategory}{FAMONC} \pagepic{ps/v102freeabelianmonoidcategory.ps}{FAMONC}{0.50} @@ -25990,6 +29246,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FreeAbelianMonoidCategory.help} ==================================================================== FreeAbelianMonoidCategory examples @@ -26115,6 +29372,7 @@ FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): _ ++ of \spad{{a1,...,an}} and \spad{{b1,...,bm}}. \end{chunk} + \begin{chunk}{FAMONC.dotabb} "FAMONC" [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMONC"]; @@ -26122,6 +29380,7 @@ FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): _ "FAMONC" -> "RETRACT" \end{chunk} + \begin{chunk}{FAMONC.dotfull} "FreeAbelianMonoidCategory(a:SetCategory,b:CancellationAbelianMonoid)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMONC"]; @@ -26131,6 +29390,7 @@ FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): _ "RetractableTo(SetCategory)" \end{chunk} + \begin{chunk}{FAMONC.dotpic} digraph pic { fontsize=10; @@ -26186,6 +29446,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MultiDictionary}{MDAGG} \pagepic{ps/v102multidictionary.ps}{MDAGG}{0.90} @@ -26255,6 +29516,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{MultiDictionary.help} ==================================================================== MultiDictionary examples @@ -26422,17 +29684,20 @@ MultiDictionary(S:SetCategory): Category == DictionaryOperations S with -- to become duplicates: % -> Iterator(D,D) \end{chunk} + \begin{chunk}{MDAGG.dotabb} "MDAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=MDAGG"]; "MDAGG" -> "DIOPS" \end{chunk} + \begin{chunk}{MDAGG.dotfull} "MultiDictionary(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=MDAGG"]; "MultiDictionary(a:SetCategory)" -> "DictionaryOperations(a:SetCategory)" \end{chunk} + \begin{chunk}{MDAGG.dotpic} digraph pic { fontsize=10; @@ -26465,6 +29730,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedAbelianMonoid}{OAMON} \pagepic{ps/v102orderedabelianmonoid.ps}{OAMON}{1.00} @@ -26501,6 +29767,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedAbelianMonoid.help} ==================================================================== OrderedAbelianMonoid examples @@ -26575,12 +29842,14 @@ OrderedAbelianMonoid(): Category == Join(OrderedAbelianSemiGroup, AbelianMonoid) \end{chunk} + \begin{chunk}{OAMON.dotabb} "OAMON" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMON"]; "OAMON" -> "OASGP" "OAMON" -> "ABELMON" \end{chunk} + \begin{chunk}{OAMON.dotfull} "OrderedAbelianMonoid()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMON"]; @@ -26588,6 +29857,7 @@ OrderedAbelianMonoid(): Category == "OrderedAbelianMonoid()" -> "AbelianMonoid()" \end{chunk} + \begin{chunk}{OAMON.dotpic} digraph pic { fontsize=10; @@ -26613,6 +29883,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PermutationCategory}{PERMCAT} \pagepic{ps/v102permutationcategory.ps}{PERMCAT}{0.65} @@ -26658,6 +29929,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PermutationCategory.help} ==================================================================== PermutationCategory examples @@ -26805,18 +30077,21 @@ PermutationCategory(S:SetCategory): Category == Group with if S has Finite then OrderedSet \end{chunk} + \begin{chunk}{PERMCAT.dotabb} "PERMCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PERMCAT"]; "PERMCAT" -> "GROUP" \end{chunk} + \begin{chunk}{PERMCAT.dotfull} "PermutationCategory(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PERMCAT"]; "PermutationCategory(a:SetCategory)" -> "Group()" \end{chunk} + \begin{chunk}{PERMCAT.dotpic} digraph pic { fontsize=10; @@ -26866,6 +30141,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{StreamAggregate}{STAGG} \pagepic{ps/v102streamaggregate.ps}{STAGG}{0.60} @@ -26972,6 +30248,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{StreamAggregate.help} ==================================================================== StreamAggregate examples @@ -27324,12 +30601,96 @@ StreamAggregate(S:Type): Category == x \end{chunk} + +\begin{chunk}{COQ STAGG} +(* category STAGG *) +(* + + explicitlyFinite?: % -> Boolean + explicitlyFinite? x == not cyclic? x + + possiblyInfinite?: % -> Boolean + possiblyInfinite? x == cyclic? x + + first : (%,NonNegativeInteger) -> % + first(x, n) == construct [c2(x, x := rest x) for i in 1..n] + + c2: (%, %) -> S + c2(x, r) == + empty? x => error "Index out of range" + first x + + elt : (%,Integer,S) -> S + elt(x:%, i:Integer) == + i := i - minIndex x + (i < 0) or empty?(x := rest(x, i::NonNegativeInteger)) => _ + error "index out of range" + first x + + elt(x:%, i:UniversalSegment(Integer)) == + l := lo(i) - minIndex x + l < 0 => error "index out of range" + not hasHi i => copy(rest(x, l::NonNegativeInteger)) + (h := hi(i) - minIndex x) < l => empty() + first(rest(x, l::NonNegativeInteger), (h - l + 1)::NonNegativeInteger) + + if % has shallowlyMutable then + + concat : (%,%) -> % + concat(x:%, y:%) == concat_!(copy x, y) + + concat : List % -> % + concat l == + empty? l => empty() + concat_!(copy first l, concat rest l) + + map! : ((S -> S),%) -> % + map_!(f, l) == + y := l + while not empty? l repeat + setfirst_!(l, f first l) + l := rest l + y + + fill! : (%,S) -> % + fill_!(x, s) == + y := x + while not empty? y repeat (setfirst_!(y, s); y := rest y) + x + + setelt : (%,Integer,S) -> S + setelt(x:%, i:Integer, s:S) == + i := i - minIndex x + (i < 0) or empty?(x := rest(x,i::NonNegativeInteger)) => _ + error "index out of range" + setfirst_!(x, s) + + setelt : (%,UniversalSegment Integer,S) -> S + setelt(x:%, i:UniversalSegment(Integer), s:S) == + (l := lo(i) - minIndex x) < 0 => error "index out of range" + h := if hasHi i then hi(i) - minIndex x else maxIndex x + h < l => s + y := rest(x, l::NonNegativeInteger) + z := rest(y, (h - l + 1)::NonNegativeInteger) + while not eq?(y, z) repeat (setfirst_!(y, s); y := rest y) + s + + concat! : (%,%) -> % + concat_!(x:%, y:%) == + empty? x => y + setrest_!(tail x, y) + x +*) + +\end{chunk} + \begin{chunk}{STAGG.dotabb} "STAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=STAGG"]; "STAGG" -> "RCAGG" "STAGG" -> "LNAGG" \end{chunk} + \begin{chunk}{STAGG.dotfull} "StreamAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=STAGG"]; @@ -27337,6 +30698,7 @@ StreamAggregate(S:Type): Category == "StreamAggregate(a:Type)" -> "LinearAggregate(a:Type)" \end{chunk} + \begin{chunk}{STAGG.dotpic} digraph pic { fontsize=10; @@ -27376,6 +30738,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{TriangularSetCategory}{TSETCAT} \pagepic{ps/v102triangularsetcategory.ps}{TSETCAT}{0.35} @@ -27473,6 +30836,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{TriangularSetCategory.help} ==================================================================== TriangularSetCategory examples @@ -27624,7 +30988,7 @@ These are implemented by this category: coerce : % -> List P coHeight : % -> NonNegativeInteger if V has FINITE collectQuasiMonic : % -> % - collectUnder : (%,V) -> % + collectUnder : (%,V) -> %x collectUpper : (%,V) -> % construct : List P -> % convert : % -> InputForm if P has KONVERT INFORM @@ -28219,6 +31583,344 @@ TriangularSetCategory(R:IntegralDomain,E:OrderedAbelianMonoidSup,_ subtractIfCan(n,m)$NonNegativeInteger::NonNegativeInteger \end{chunk} + +\begin{chunk}{COQ TSETCAT} +(* category TSETCAT *) +(* + + GPS ==> GeneralPolynomialSet(R,E,V,P) + B ==> Boolean + RBT ==> Record(bas:$,top:List P) + + ?=? : (%,%) -> Boolean + ts:$ = us:$ == + empty?(ts)$$ => empty?(us)$$ + empty?(us)$$ => false + first(ts)::P =$P first(us)::P => rest(ts)::$ =$$ rest(us)::$ + false + + infRittWu? : ($,$) -> Boolean + infRittWu?(ts,us) == + empty?(us)$$ => not empty?(ts)$$ + empty?(ts)$$ => false + p : P := (last(ts))::P + q : P := (last(us))::P + infRittWu?(p,q)$P => true + supRittWu?(p,q)$P => false + v : V := mvar(p) + infRittWu?(collectUpper(ts,v),collectUpper(us,v))$$ + + reduced? : (P,$,((P,P) -> Boolean)) -> Boolean + reduced?(p,ts,redOp?) == + lp : List P := members(ts) + while (not empty? lp) and (redOp?(p,first(lp))) repeat + lp := rest lp + empty? lp + + basicSet : (List P,((P,P)->Boolean)) -> _ + basicSet(ps,redOp?) == + ps := remove(zero?,ps) + any?(ground?,ps) => "failed"::Union(RBT,"failed") + ps := sort(infRittWu?,ps) + p,b : P + bs := empty()$$ + ts : List P := [] + while not empty? ps repeat + b := first(ps) + bs := extend(bs,b)$$ + ps := rest ps + while (not empty? ps) and _ + (not reduced?((p := first(ps)),bs,redOp?)) repeat + ts := cons(p,ts) + ps := rest ps + ([bs,ts]$RBT)::Union(RBT,"failed") + + basicSet : (List P,(P->Boolean),((P,P)->Boolean)) -> _ + Union(Record(bas:$,top:List P),"failed") + basicSet(ps,pred?,redOp?) == + ps := remove(zero?,ps) + any?(ground?,ps) => "failed"::Union(RBT,"failed") + gps : List P := [] + bps : List P := [] + while not empty? ps repeat + p := first ps + ps := rest ps + if pred?(p) + then + gps := cons(p,gps) + else + bps := cons(p,bps) + gps := sort(infRittWu?,gps) + p,b : P + bs := empty()$$ + ts : List P := [] + while not empty? gps repeat + b := first(gps) + bs := extend(bs,b)$$ + gps := rest gps + while (not empty? gps) and _ + (not reduced?((p := first(gps)),bs,redOp?)) repeat + ts := cons(p,ts) + gps := rest gps + ts := sort(infRittWu?,concat(ts,bps)) + ([bs,ts]$RBT)::Union(RBT,"failed") + + initials : $ -> List P + initials ts == + lip : List P := [] + empty? ts => lip + lp := members(ts) + while not empty? lp repeat + p := first(lp) + if not ground?((ip := init(p))) + then + lip := cons(primPartElseUnitCanonical(ip),lip) + lp := rest lp + removeDuplicates lip + + degree : $ -> NonNegativeInteger + degree ts == + empty? ts => 0$NonNegativeInteger + lp := members ts + d : NonNegativeInteger := mdeg(first lp) + while not empty? (lp := rest lp) repeat + d := d * mdeg(first lp) + d + + quasiComponent : $ -> Record(close:List P,open:List P) + quasiComponent ts == + [members(ts),initials(ts)] + + normalized? : (P,$) -> Boolean + normalized?(p,ts) == + normalized?(p,members(ts))$P + + stronglyReduced? : (P,$) -> Boolean + stronglyReduced? (p,ts) == + reduced?(p,members(ts))$P + + headReduced? : (P,$) -> Boolean + headReduced? (p,ts) == + stronglyReduced?(head(p),ts) + + initiallyReduced? : (P,$) -> Boolean + initiallyReduced? (p,ts) == + lp : List (P) := members(ts) + red : Boolean := true + while (not empty? lp) and (not ground?(p)$P) and red repeat + while (not empty? lp) and (mvar(first(lp)) > mvar(p)) repeat + lp := rest lp + if (not empty? lp) + then + if (mvar(first(lp)) = mvar(p)) + then + if reduced?(p,first(lp)) + then + lp := rest lp + p := init(p) + else + red := false + else + p := init(p) + red + + reduce : (P,$,((P,P) -> P),((P,P) -> Boolean) ) -> P + reduce(p,ts,redOp,redOp?) == + (empty? ts) or (ground? p) => p + ts0 := ts + while (not empty? ts) and (not ground? p) repeat + reductor := (first ts)::P + ts := (rest ts)::$ + if not redOp?(p,reductor) + then + p := redOp(p,reductor) + ts := ts0 + p + + rewriteSetWithReduction : (List P,$,((P,P) -> P),((P,P) -> Boolean) ) ->_ + List P + rewriteSetWithReduction(lp,ts,redOp,redOp?) == + trivialIdeal? ts => lp + lp := remove(zero?,lp) + empty? lp => lp + any?(ground?,lp) => [1$P] + rs : List P := [] + while not empty? lp repeat + p := first lp + lp := rest lp + p := primPartElseUnitCanonical reduce(p,ts,redOp,redOp?) + if not zero? p + then + if ground? p + then + lp := [] + rs := [1$P] + else + rs := cons(p,rs) + removeDuplicates rs + + stronglyReduce : (P,$) -> P + stronglyReduce(p,ts) == + reduce (p,ts,lazyPrem,reduced?) + + headReduce : (P,$) -> P + headReduce(p,ts) == + reduce (p,ts,headReduce,headReduced?) + + initiallyReduce : (P,$) -> P + initiallyReduce(p,ts) == + reduce (p,ts,initiallyReduce,initiallyReduced?) + + removeZero: (P, $) -> P + removeZero(p,ts) == + (ground? p) or (empty? ts) => p + v := mvar(p) + ts_v_- := collectUnder(ts,v) + if algebraic?(v,ts) + then + q := lazyPrem(p,select(ts,v)::P) + zero? q => return q + zero? removeZero(q,ts_v_-) => return 0 + empty? ts_v_- => p + q: P := 0 + while positive? degree(p,v) repeat + q := removeZero(init(p),ts_v_-) * mainMonomial(p) + q + p := tail(p) + q + removeZero(p,ts_v_-) + + reduceByQuasiMonic: (P, $) -> P + reduceByQuasiMonic(p, ts) == + (ground? p) or (empty? ts) => p + remainder(p,collectQuasiMonic(ts)).polnum + + autoReduced? : ($,((P,List(P)) -> Boolean)) -> Boolean + autoReduced?(ts : $,redOp? : ((P,List(P)) -> Boolean)) == + empty? ts => true + lp : List (P) := members(ts) + p : P := first(lp) + lp := rest lp + while (not empty? lp) and redOp?(p,lp) repeat + p := first lp + lp := rest lp + empty? lp + + stronglyReduced? : $ -> Boolean + stronglyReduced? ts == + autoReduced? (ts, reduced?) + + normalized? : $ -> Boolean + normalized? ts == + autoReduced? (ts,normalized?) + + headReduced? : $ -> Boolean + headReduced? ts == + autoReduced? (ts,headReduced?) + + initiallyReduced? : $ -> Boolean + initiallyReduced? ts == + autoReduced? (ts,initiallyReduced?) + + mvar : % -> V + mvar ts == + empty? ts => error"Error from TSETCAT in mvar : #1 is empty" + mvar((first(ts))::P)$P + + first : $ -> Union(P,"failed") + first ts == + empty? ts => "failed"::Union(P,"failed") + lp : List(P) := sort(supRittWu?,members(ts))$(List P) + first(lp)::Union(P,"failed") + + last : $ -> Union(P,"failed") + last ts == + empty? ts => "failed"::Union(P,"failed") + lp : List(P) := sort(infRittWu?,members(ts))$(List P) + first(lp)::Union(P,"failed") + + rest : $ -> Union($,"failed") + rest ts == + empty? ts => "failed"::Union($,"failed") + lp : List(P) := sort(supRittWu?,members(ts))$(List P) + construct(rest(lp))::Union($,"failed") + + coerce : % -> List(P) + coerce (ts:$) : List(P) == + sort(supRittWu?,members(ts))$(List P) + + algebraicVariables : $ -> List(V) + algebraicVariables ts == + [mvar(p) for p in members(ts)] + + algebraic? : (V,$) -> Boolean + algebraic? (v,ts) == + member?(v,algebraicVariables(ts)) + + select : (%,V) -> Union(P,"failed") + select (ts,v) == + lp : List (P) := sort(supRittWu?,members(ts))$(List P) + while (not empty? lp) and (not (v = mvar(first lp))) repeat + lp := rest lp + empty? lp => "failed"::Union(P,"failed") + (first lp)::Union(P,"failed") + + collectQuasiMonic : % -> % + collectQuasiMonic ts == + lp: List(P) := members(ts) + newlp: List(P) := [] + while (not empty? lp) repeat + if ground? init(first(lp)) then newlp := cons(first(lp),newlp) + lp := rest lp + construct(newlp) + + collectUnder : (%,V) -> % + collectUnder (ts,v) == + lp : List (P) := sort(supRittWu?,members(ts))$(List P) + while (not empty? lp) and (not (v > mvar(first lp))) repeat + lp := rest lp + construct(lp) + + collectUpper : (%,V) -> % + collectUpper (ts,v) == + lp1 : List(P) := sort(supRittWu?,members(ts))$(List P) + lp2 : List(P) := [] + while (not empty? lp1) and (mvar(first lp1) > v) repeat + lp2 := cons(first(lp1),lp2) + lp1 := rest lp1 + construct(reverse lp2) + + construct : List P -> % + construct(lp:List(P)) == + rif := retractIfCan(lp)@Union($,"failed") + not (rif case $) => error"in construct : LP -> $ from TSETCAT : bad arg" + rif::$ + + retractIfCan : List P -> Union(%,"failed") + retractIfCan(lp:List(P)) == + empty? lp => (empty()$$)::Union($,"failed") + lp := sort(supRittWu?,lp) + rif := retractIfCan(rest(lp))@Union($,"failed") + not (rif case $) => _ + error "in retractIfCan : LP -> ... from TSETCAT : bad arg" + extendIfCan(rif::$,first(lp))@Union($,"failed") + + extend : (%,P) -> % + extend(ts:$,p:P):$ == + eif := extendIfCan(ts,p)@Union($,"failed") + not (eif case $) => error"in extend : ($,P) -> $ from TSETCAT : bad ars" + eif::$ + + if V has Finite + then + + coHeight : % -> NonNegativeInteger + coHeight ts == + n := size()$V + m := #(members ts) + subtractIfCan(n,m)$NonNegativeInteger::NonNegativeInteger +*) + +\end{chunk} + \begin{chunk}{TSETCAT.dotabb} "TSETCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=TSETCAT"]; @@ -28308,6 +32010,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 7} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteDivisorCategory}{FDIVCAT} @@ -28351,6 +32054,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FiniteDivisorCategory.help} ==================================================================== FiniteDivisorCategory examples @@ -28484,6 +32188,17 @@ FiniteDivisorCategory(F, UP, UPUP, R): Category == Result where principal? d == generator(d) case R \end{chunk} + +\begin{chunk}{COQ FDIVCAT} +(* category FDIVCAT *) +(* + principal? : % -> Boolean + principal? d == generator(d) case R + +*) + +\end{chunk} + \begin{chunk}{FDIVCAT.dotabb} "FDIVCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FDIVCAT"]; @@ -28534,6 +32249,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteSetAggregate}{FSAGG} \pagepic{ps/v102finitesetaggregate.ps}{FSAGG}{0.75} @@ -28901,12 +32617,113 @@ FiniteSetAggregate(S:SetCategory): Category == reduce("min", l) \end{chunk} + +\begin{chunk}{COQ FSAGG} +(* category FSAGG *) +(* + + ? Boolean + s < t == #s < #t and s = intersect(s,t) + + ?=? : (%,%) -> Boolean + s = t == #s = #t and empty? difference(s,t) + + brace : List(S) -> % + brace l == construct l + + set : List(S) -> % + set l == construct l + + cardinality : % -> NonNegativeInteger + cardinality s == #s + + construct : List(S) -> % + construct l == (s := set(); for x in l repeat insert_!(x,s); s) + + count : (S,%) -> NonNegativeInteger + count(x:S, s:%) == (member?(x, s) => 1; 0) + + subset? : (%,%) -> Boolean + subset?(s, t) == #s <= #t and _and/[member?(x, t) for x in parts s] + + coerce : % -> OutputForm + coerce(s:%):OutputForm == + brace [x::OutputForm for x in parts s]$List(OutputForm) + + intersect : (%,%) -> % + intersect(s, t) == + i := {} + for x in parts s | member?(x, t) repeat insert_!(x, i) + i + + difference : (%,%) -> % + difference(s:%, t:%) == + m := copy s + for x in parts t repeat remove_!(x, m) + m + + symmetricDifference : (%,%) -> % + symmetricDifference(s, t) == + d := copy s + for x in parts t repeat + if member?(x, s) then remove_!(x, d) else insert_!(x, d) + d + + union : (%,%) -> % + union(s:%, t:%) == + u := copy s + for x in parts t repeat insert_!(x, u) + u + + if S has Finite then + + universe : () -> % + universe() == {index(i::PositiveInteger) for i in 1..size()$S} + + complement : % -> % + complement s == difference(universe(), s ) + + size : () -> NonNegativeInteger + size() == 2 ** size()$S + + index : PositiveInteger -> % + index i == + {index(j::PositiveInteger)$S for j in 1..size()$S | bit?(i-1,j-1)} + + random : () -> % + random() == + index((random()$Integer rem (size()$% + 1))::PositiveInteger) + + lookup : % -> PositiveInteger + lookup s == + n:PositiveInteger := 1 + for x in parts s repeat _ + n := n + 2 ** ((lookup(x) - 1)::NonNegativeInteger) + n + + if S has OrderedSet then + + max : % -> S + max s == + empty?(l := parts s) => error "Empty set" + reduce("max", l) + + min : % -> S + min s == + empty?(l := parts s) => error "Empty set" + reduce("min", l) + +*) + +\end{chunk} + \begin{chunk}{FSAGG.dotabb} "FSAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FSAGG"]; "FSAGG" -> "DIAGG" "FSAGG" -> "SETAGG" \end{chunk} + \begin{chunk}{FSAGG.dotfull} "FiniteSetAggregate(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FSAGG"]; @@ -28914,6 +32731,7 @@ FiniteSetAggregate(S:SetCategory): Category == "FiniteSetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)" \end{chunk} + \begin{chunk}{FSAGG.dotpic} digraph pic { fontsize=10; @@ -28946,6 +32764,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{KeyedDictionary}{KDAGG} \pagepic{ps/v102keyeddictionary.ps}{KDAGG}{1.00} @@ -29019,6 +32838,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{KeyedDictionary.help} ==================================================================== KeyedDictionary examples @@ -29216,11 +33036,34 @@ KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category == keys t == [x.key for x in parts t] \end{chunk} + +\begin{chunk}{COQ KDAGG} +(* category KDAGG *) +(* + + key? : (Key,%) -> Boolean + key?(k, t) == search(k, t) case Entry + + member? : (Record(key: Key,entry: Entry),%) -> Boolean + member?(p, t) == + r := search(p.key, t) + r case Entry and r::Entry = p.entry + + if % has finiteAggregate then + + keys : % -> List(Key) + keys t == [x.key for x in parts t] + +*) + +\end{chunk} + \begin{chunk}{KDAGG.dotabb} "KDAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=KDAGG"]; "KDAGG" -> "DIAGG" \end{chunk} + \begin{chunk}{KDAGG.dotfull} "KeyedDictionary(a:SetCategory,b:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=KDAGG"]; @@ -29228,6 +33071,7 @@ KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category == "Dictionary(Record(a:SetCategory,b:SetCategory))" \end{chunk} + \begin{chunk}{KDAGG.dotpic} digraph pic { fontsize=10; @@ -29375,6 +33219,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LazyStreamAggregate.help} ==================================================================== LazyStreamAggregate examples @@ -30158,18 +34003,432 @@ LazyStreamAggregate(S:Type): Category == StreamAggregate(S) with x \end{chunk} + +\begin{chunk}{COQ LZSTAGG} +(* category LZSTAGG *) +(* + + MIN ==> 1 -- minimal stream index + + I ==> Integer + NNI ==> NonNegativeInteger + L ==> List + U ==> UniversalSegment Integer + +--% SETCAT functions + + if S has SetCategory then + + ?=? : (%,%) -> Boolean + x = y == + eq?(x,y) => true + explicitlyFinite? x and explicitlyFinite? y => + entries x = entries y + explicitEntries? x and explicitEntries? y => + frst x = frst y and EQ(rst x, rst y)$Lisp + -- treat cyclic streams + false + +--% HOAGG functions + + less? : (%,NonNegativeInteger) -> Boolean + less?(x,n) == + n = 0 => false + empty? x => true + less?(rst x,(n-1) :: NNI) + + more? : (%,NonNegativeInteger) -> Boolean + more?(x,n) == + empty? x => false + n = 0 => true + more?(rst x,(n-1) :: NNI) + + size? : (%,NonNegativeInteger) -> Boolean + size?(x,n) == + empty? x => n = 0 + size?(rst x,(n-1) :: NNI) + + #? : % -> NonNegativeInteger + # x == + -- error if stream is not finite + y := x + for i in 0.. repeat + explicitlyEmpty? y => return i + lazy? y => error "#: infinite stream" + y := rst y + if odd? i then x := rst x + eq?(x,y) => error "#: infinite stream" + +--% CLAGG functions + + any? : ((S -> Boolean),%) -> Boolean + any?(f,x) == + -- error message only when x is a stream with lazy + -- evaluation and f(s) = false for all stream elements + -- 's' which have been computed when the function is + -- called + y := x + for i in 0.. repeat + explicitlyEmpty? y => return false + lazy? y => error "any?: infinite stream" + f frst y => return true + y := rst y + if odd? i then x := rst x + eq?(x,y) => return false + + every? : ((S -> Boolean),%) -> Boolean + every?(f,x) == + -- error message only when x is a stream with lazy + -- evaluation and f(s) = true for all stream elements + -- 's' which have been computed when the function is + -- called + y := x + for i in 0.. repeat + explicitlyEmpty? y => return true + lazy? y => error "every?: infinite stream" + not f frst y => return false + y := rst y + if odd? i then x := rst x + eq?(x,y) => return true + + entries : % -> List(S) + entries x == + -- returns a list of elements which have been computed + -- error if infinite + y := x + l : L S := empty() + for i in 0.. repeat + explicitlyEmpty? y => return reverse_! l + lazy? y => error "infinite stream" + l := concat(frst y,l) + y := rst y + if odd? i then x := rst x + eq?(x,y) => error "infinite stream" + +--% CNAGG functions + + construct : List(S) -> % + construct l == + empty? l => empty() + concat(first l, construct rest l) + +--% ELTAGG functions + + elt(x:%,n:I) == + n < MIN or empty? x => error "elt: no such element" + n = MIN => frst x + elt(rst x,n - 1) + + elt : (%,Integer,S) -> S + elt(x:%,n:I,s:S) == + n < MIN or empty? x => s + n = MIN => frst x + elt(rst x,n - 1) + +--% IXAGG functions + + indexx? : (Integer,%) -> Boolean + indexx?(n,x) == + empty? x => false + n = MIN => true + indexx?(n-1,rst x) + + index? : (Integer,%) -> Boolean + index?(n,x) == + -- returns 'true' iff 'n' is the index of an entry which + -- may or may not have been computed when the function is + -- called + -- additional entries are computed if necessary + n < MIN => false + indexx?(n,x) + + indices : % -> List(Integer) + indices x == + -- error if stream is not finite + y := x + l : L I := empty() + for i in MIN.. repeat + explicitlyEmpty? y => return reverse_! l + lazy? y => error "indices: infinite stream" + l := concat(i,l) + y := rst y + if odd? i then x := rst x + eq?(x,y) => error "indices: infinite stream" + + maxIndex : % -> Integer + maxIndex x == + -- error if stream is not finite + empty? x => + error "maxIndex: no maximal index for empty stream" + y := rst x + for i in MIN.. repeat + explicitlyEmpty? y => return i + lazy? y => error "maxIndex: infinite stream" + y := rst y + if odd? i then x := rst x + eq?(x,y) => error "maxIndex: infinite stream" + + minIndex : % -> Integer + minIndex x == + empty? x => error "minIndex: no minimal index for empty stream" + MIN + +--% LNAGG functions + + delete : (%,Integer) -> % + delete(x:%,n:I) == + -- non-destructive + not index?(n,x) => error "delete: index out of range" + concat(first(x,(n - MIN) :: NNI), rest(x,(n - MIN + 1) :: NNI)) + + delete : (%,UniversalSegment(Integer)) -> % + delete(x:%,seg:U) == + low := lo seg + hasHi seg => + high := hi seg + high < low => copy x + (not index?(low,x)) or (not index?(high,x)) => + error "delete: index out of range" + concat(first(x,(low - MIN) :: NNI),rest(x,(high - MIN + 1) :: NNI)) + not index?(low,x) => error "delete: index out of range" + first(x,(low - MIN) :: NNI) + + elt(x:%,seg:U) == + low := lo seg + hasHi seg => + high := hi seg + high < low => empty() + (not index?(low,x)) or (not index?(high,x)) => + error "elt: index out of range" + first(rest(x,(low - MIN) :: NNI),(high - low + 1) :: NNI) + not index?(low,x) => error "elt: index out of range" + rest(x,(low - MIN) :: NNI) + + insert : (S,%,Integer) -> % + insert(s:S,x:%,n:I) == + not index?(n,x) => error "insert: index out of range" + nn := (n - MIN) :: NNI + concat([first(x,nn), concat(s, empty()), rest(x,nn)]) + + insert : (%,%,Integer) -> % + insert(y:%,x:%,n:I) == + not index?(n,x) => error "insert: index out of range" + nn := (n - MIN) :: NNI + concat([first(x,nn), y, rest(x,nn)]) + +--% RCAGG functions + + cycleElt : % -> Union(%,"failed") + cycleElt x == cycleElt(x)$CyclicStreamTools(S,%) + + cyclic? : % -> Boolean + cyclic? x == + cycleElt(x) case "failed" => false + true + + if S has SetCategory then + + child? : (%,%) -> Boolean + child?(x,y) == + empty? y => error "child: no children" + x = rst y + + children : % -> List(%) + children x == + empty? x => error "children: no children" + [rst x] + + distance : (%,%) -> Integer + distance(x,z) == + y := x + for i in 0.. repeat + eq?(y,z) => return i + (explicitlyEmpty? y) or (lazy? y) => + error "distance: 2nd arg not a descendent of the 1st" + y := rst y + if odd? i then x := rst x + eq?(x,y) => + error "distance: 2nd arg not a descendent of the 1st" + + if S has SetCategory then + + node? : (%,%) -> Boolean + node?(z,x) == + -- error message only when x is a stream with lazy + -- evaluation and 'y' is not a node of 'x' + -- which has been computed when the function is called + y := x + for i in 0.. repeat + z = y => return true + explicitlyEmpty? y => return false + lazy? y => error "node?: infinite stream" + y := rst y + if odd? i then x := rst x + eq?(x,y) => return false + + nodes : % -> List(%) + nodes x == + y := x + l : L % := [] + for i in 0.. repeat + explicitlyEmpty? y => return reverse_! l + lazy? y => error "nodes: infinite stream" + l := concat(y,l) + y := rst y + if odd? i then x := rst x + eq?(x,y) => error "nodes: infinite stream" + l -- @#$%^& compiler + + leaf? : % -> Boolean + leaf? x == empty? rest x + + value : % -> S + value x == first x + +--% URAGG functions + + computeCycleLength : % -> NNI + computeCycleLength cycElt == + computeCycleLength(cycElt)$CyclicStreamTools(S,%) + + computeCycleEntry : (%,%) -> % + computeCycleEntry(x,cycElt) == + computeCycleEntry(x,cycElt)$CyclicStreamTools(S,%) + + cycleEntry : % -> % + cycleEntry x == + cycElt := cycleElt x + cycElt case "failed" => + error "cycleEntry: non-cyclic stream" + computeCycleEntry(x,cycElt::%) + + cycleLength : % -> NonNegativeInteger + cycleLength x == + cycElt := cycleElt x + cycElt case "failed" => + error "cycleLength: non-cyclic stream" + computeCycleLength(cycElt::%) + + cycleTail : % -> % + cycleTail x == + cycElt := cycleElt x + cycElt case "failed" => + error "cycleTail: non-cyclic stream" + y := x := computeCycleEntry(x,cycElt::%) + z := rst x + repeat + eq?(x,z) => return y + y := z ; z := rst z + + ?.first : (%,first) -> S + elt(x,"first") == first x + + first : (%,NonNegativeInteger) -> % + first(x,n) == + -- former name: take + n = 0 or empty? x => empty() + concat(frst x, first(rst x,(n-1) :: NNI)) + + rest : % -> % + rest x == + empty? x => error "Can't take the rest of an empty stream." + rst x + + ?.rest : (%,rest) -> % + elt(x,"rest") == rest x + + rest : (%,NonNegativeInteger) -> % + rest(x,n) == + -- former name: drop + n = 0 or empty? x => x + rest(rst x,(n-1) :: NNI) + + last : % -> S + last x == + -- error if stream is not finite + empty? x => error "last: empty stream" + y1 := x + y2 := rst x + for i in 0.. repeat + explicitlyEmpty? y2 => return frst y1 + lazy? y2 => error "last: infinite stream" + y1 := y2 + y2 := rst y2 + if odd? i then x := rst x + eq?(x,y2) => error "last: infinite stream" + + if % has finiteAggregate then -- # is only defined for finiteAggregates + + last : (%,NonNegativeInteger) -> % + last(x,n) == + possiblyInfinite? x => error "last: infinite stream" + m := # x + m < n => error "last: index out of range" + copy rest(x,(m-n)::NNI) + + ?.last : (%,last) -> S + elt(x,"last") == last x + + tail : % -> % + tail x == + -- error if stream is not finite + empty? x => error "tail: empty stream" + y1 := x + y2 := rst x + for i in 0.. repeat + explicitlyEmpty? y2 => return y1 + lazy? y2 => error "tail: infinite stream" + y1 := y2 + y2 := rst y2 + if odd? i then x := rst x + eq?(x,y2) => error "tail: infinite stream" + +--% STAGG functions + + possiblyInfinite? : % -> Boolean + possiblyInfinite? x == + y := x + for i in 0.. repeat + explicitlyEmpty? y => return false + lazy? y => return true + if odd? i then x := rst x + y := rst y + eq?(x,y) => return true + + explicitlyFinite? : % -> Boolean + explicitlyFinite? x == not possiblyInfinite? x + +--% LZSTAGG functions + + extend : (%,Integer) -> % + extend(x,n) == + y := x + for i in 1..n while not empty? y repeat y := rst y + x + + complete : % -> % + complete x == + y := x + while not empty? y repeat y := rst y + x +*) + +\end{chunk} + \begin{chunk}{LZSTAGG.dotabb} "LZSTAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=LZSTAGG"]; "LZSTAGG" -> "STAGG" \end{chunk} + \begin{chunk}{LZSTAGG.dotfull} "LazyStreamAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LZSTAGG"]; "LazyStreamAggregate(a:Type)" -> "StreamAggregate(a:Type)" \end{chunk} + \begin{chunk}{LZSTAGG.dotpic} digraph pic { fontsize=10; @@ -30244,6 +34503,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LeftModule.help} ==================================================================== LeftModule examples @@ -30368,6 +34628,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ListAggregate}{LSAGG} \pagepic{ps/v102listaggregate.ps}{LSAGG}{0.60} @@ -30499,6 +34760,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ListAggregate.help} ==================================================================== ListAggregate examples @@ -31026,12 +35288,235 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S, false \end{chunk} + +\begin{chunk}{COQ LSAGG} +(* category LSAGG *) +(* + cycleMax ==> 1000 + + sort! : (((S,S) -> Boolean),%) -> % + sort_!(f, l) == mergeSort(f, l, #l) + + list : S -> % + list x == concat(x, empty()) + + reduce : (((S,S) -> S),%) -> S + reduce(f, x) == + empty? x => _ + error "reducing over an empty list needs the 3 argument form" + reduce(f, rest x, first x) + + merge : (((S,S) -> Boolean),%,%) -> % + merge(f, p, q) == merge_!(f, copy p, copy q) + + select! : ((S -> Boolean),%) -> % + select_!(f, x) == + while not empty? x and not f first x repeat x := rest x + empty? x => x + y := x + z := rest y + while not empty? z repeat + if f first z then (y := z; z := rest z) + else (z := rest z; setrest_!(y, z)) + x + + merge! : (((S,S) -> Boolean),%,%) -> % + merge_!(f, p, q) == + empty? p => q + empty? q => p + eq?(p, q) => error "cannot merge a list into itself" + if f(first p, first q) + then (r := t := p; p := rest p) + else (r := t := q; q := rest q) + while not empty? p and not empty? q repeat + if f(first p, first q) + then (setrest_!(t, p); t := p; p := rest p) + else (setrest_!(t, q); t := q; q := rest q) + setrest_!(t, if empty? p then q else p) + r + + insert! : (S,%,Integer) -> % + insert_!(s:S, x:%, i:Integer) == + i < (m := minIndex x) => error "index out of range" + i = m => concat(s, x) + y := rest(x, (i - 1 - m)::NonNegativeInteger) + z := rest y + setrest_!(y, concat(s, z)) + x + + insert! : (%,%,Integer) -> % + insert_!(w:%, x:%, i:Integer) == + i < (m := minIndex x) => error "index out of range" + i = m => concat_!(w, x) + y := rest(x, (i - 1 - m)::NonNegativeInteger) + z := rest y + setrest_!(y, w) + concat_!(y, z) + x + + remove! : ((S -> Boolean),%) -> % + remove_!(f:S -> Boolean, x:%) == + while not empty? x and f first x repeat x := rest x + empty? x => x + p := x + q := rest x + while not empty? q repeat + if f first q then q := setrest_!(p, rest q) + else (p := q; q := rest q) + x + + delete! : (%,Integer) -> % + delete_!(x:%, i:Integer) == + i < (m := minIndex x) => error "index out of range" + i = m => rest x + y := rest(x, (i - 1 - m)::NonNegativeInteger) + setrest_!(y, rest(y, 2)) + x + + delete! : (%,UniversalSegment(Integer)) -> % + delete_!(x:%, i:UniversalSegment(Integer)) == + (l := lo i) < (m := minIndex x) => error "index out of range" + h := if hasHi i then hi i else maxIndex x + h < l => x + l = m => rest(x, (h + 1 - m)::NonNegativeInteger) + t := rest(x, (l - 1 - m)::NonNegativeInteger) + setrest_!(t, rest(t, (h - l + 2)::NonNegativeInteger)) + x + + find : ((S -> Boolean),%) -> Union(S,"failed") + find(f, x) == + while not empty? x and not f first x repeat x := rest x + empty? x => "failed" + first x + + position : ((S -> Boolean),%) -> Integer + position(f:S -> Boolean, x:%) == + for k in minIndex(x).. while not empty? x and not f first x repeat + x := rest x + empty? x => minIndex(x) - 1 + k + + mergeSort: ((S, S) -> Boolean, %, Integer) -> % + mergeSort(f, p, n) == + if n = 2 and f(first rest p, first p) then p := reverse_! p + n < 3 => p + l := (n quo 2)::NonNegativeInteger + q := split_!(p, l) + p := mergeSort(f, p, l) + q := mergeSort(f, q, n - l) + merge_!(f, p, q) + + sorted? : (((S,S) -> Boolean),%) -> Boolean + sorted?(f, l) == + empty? l => true + p := rest l + while not empty? p repeat + not f(first l, first p) => return false + p := rest(l := p) + true + + reduce : (((S,S) -> S),%,S) -> S + reduce(f, x, i) == + r := i + while not empty? x repeat (r := f(r, first x); x := rest x) + r + + if S has SetCategory then + + reduce : (((S,S) -> S),%,S,S) -> S + reduce(f, x, i,a) == + r := i + while not empty? x and r ^= a repeat + r := f(r, first x) + x := rest x + r + + new : (NonNegativeInteger,S) -> % + new(n, s) == + l := empty() + for k in 1..n repeat l := concat(s, l) + l + + map : (((S,S) -> S),%,%) -> % + map(f, x, y) == + z := empty() + while not empty? x and not empty? y repeat + z := concat(f(first x, first y), z) + x := rest x + y := rest y + reverse_! z + + reverse! : % -> % + reverse_! x == + empty? x => x + empty?(y := rest x) => x + setrest_!(x, empty()) + while not empty? y repeat + z := rest y + setrest_!(y, x) + x := y + y := z + x + + copy : % -> % + copy x == + y := empty() + for k in 0.. while not empty? x repeat + k = cycleMax and cyclic? x => error "cyclic list" + y := concat(first x, y) + x := rest x + reverse_! y + + copyInto! : (%,%,Integer) -> % + copyInto_!(y, x, s) == + s < (m := minIndex y) => error "index out of range" + z := rest(y, (s - m)::NonNegativeInteger) + while not empty? z and not empty? x repeat + setfirst_!(z, first x) + x := rest x + z := rest z + y + + if S has SetCategory then + + position : (S,%,Integer) -> Integer + position(w, x, s) == + s < (m := minIndex x) => error "index out of range" + x := rest(x, (s - m)::NonNegativeInteger) + for k in s.. while not empty? x and w ^= first x repeat + x := rest x + empty? x => minIndex x - 1 + k + + removeDuplicates! : % -> % + removeDuplicates_! l == + p := l + while not empty? p repeat + p := setrest_!(p, remove_!((x:S):Boolean +-> x = first p, rest p)) + l + + if S has OrderedSet then + + ? Boolean + x < y == + while not empty? x and not empty? y repeat + first x ^= first y => return(first x < first y) + x := rest x + y := rest y + empty? x => not empty? y + false + +*) + +\end{chunk} + \begin{chunk}{LSAGG.dotabb} "LSAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=LSAGG"]; "LSAGG" -> "FLAGG" "LSAGG" -> "ELAGG" \end{chunk} + \begin{chunk}{LSAGG.dotfull} "ListAggregate(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LSAGG"]; @@ -31045,6 +35530,7 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S, "ListAggregate(a:Type)" \end{chunk} + \begin{chunk}{LSAGG.dotpic} digraph pic { fontsize=10; @@ -31329,6 +35815,7 @@ MultisetAggregate(S:SetCategory): Category == Join(MultiDictionary S, SetAggregate S) \end{chunk} + \begin{chunk}{MSETAGG.dotabb} "MSETAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=MSETAGG"]; @@ -31336,6 +35823,7 @@ MultisetAggregate(S:SetCategory): "MSETAGG" -> "SETAGG" \end{chunk} + \begin{chunk}{MSETAGG.dotfull} "MultisetAggregate(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=MSETAGG"]; @@ -31343,6 +35831,7 @@ MultisetAggregate(S:SetCategory): "MultisetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)" \end{chunk} + \begin{chunk}{MSETAGG.dotpic} digraph pic { fontsize=10; @@ -31370,6 +35859,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NonAssociativeRng}{NARNG} \pagepic{ps/v102nonassociativerng.ps}{NARNG}{1.00} @@ -31410,6 +35900,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{NonAssociativeRng.help} ==================================================================== NonAssociativeRng examples @@ -31525,6 +36016,18 @@ NonAssociativeRng(): Category == Join(AbelianGroup,Monad) with antiCommutator(x,y) == x*y + y*x \end{chunk} + +\begin{chunk}{COQ NARNG} +(* category NARNG *) +(* +++ \tab{5}noZeroDivisors\tab{5} ab = 0 => a=0 or b=0 + associator(x,y,z) == (x*y)*z - x*(y*z) + commutator(x,y) == x*y - y*x + antiCommutator(x,y) == x*y + y*x +*) + +\end{chunk} + \begin{chunk}{NARNG.dotabb} "NARNG" [color=lightblue,href="bookvol10.2.pdf#nameddest=NARNG"]; @@ -31669,6 +36172,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OneDimensionalArrayAggregate.help} ==================================================================== OneDimensionalArrayAggregate examples @@ -32062,7 +36566,6 @@ OneDimensionalArrayAggregate(S:Type): Category == y construct l == --- a := new(#l) empty? l => empty() a := new(#l, first l) for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x) @@ -32141,6 +36644,256 @@ OneDimensionalArrayAggregate(S:Type): Category == \end{chunk} + +\begin{chunk}{COQ A1AGG} +(* category A1AGG *) +(* + parts : % -> List(S) + parts x == [qelt(x, i) for i in minIndex x .. maxIndex x] + + sort! : (((S,S) -> Boolean),%) -> % + sort_!(f, a) == quickSort(f, a)$FiniteLinearAggregateSort(S, %) + + any? : ((S -> Boolean),%) -> Boolean + any?(f, a) == + for i in minIndex a .. maxIndex a repeat + f qelt(a, i) => return true + false + + every? : ((S -> Boolean),%) -> Boolean + every?(f, a) == + for i in minIndex a .. maxIndex a repeat + not(f qelt(a, i)) => return false + true + + position : ((S -> Boolean),%) -> Integer + position(f:S -> Boolean, a:%) == + for i in minIndex a .. maxIndex a repeat + f qelt(a, i) => return i + minIndex(a) - 1 + + find : ((S -> Boolean),%) -> Union(S,"failed") + find(f, a) == + for i in minIndex a .. maxIndex a repeat + f qelt(a, i) => return qelt(a, i) + "failed" + + count : ((S -> Boolean),%) -> NonNegativeInteger + count(f:S->Boolean, a:%) == + n:NonNegativeInteger := 0 + for i in minIndex a .. maxIndex a repeat + if f(qelt(a, i)) then n := n+1 + n + + map! : ((S -> S),%) -> % + map_!(f, a) == + for i in minIndex a .. maxIndex a repeat + qsetelt_!(a, i, f qelt(a, i)) + a + + setelt : (%,UniversalSegment(Integer),S) -> S + setelt(a:%, s:UniversalSegment(Integer), x:S) == + l := lo s; h := if hasHi s then hi s else maxIndex a + l < minIndex a or h > maxIndex a => error "index out of range" + for k in l..h repeat qsetelt_!(a, k, x) + x + + reduce : (((S,S) -> S),%) -> S + reduce(f, a) == + empty? a => error "cannot reduce an empty aggregate" + r := qelt(a, m := minIndex a) + for k in m+1 .. maxIndex a repeat r := f(r, qelt(a, k)) + r + + reduce : (((S,S) -> S),%,S) -> S + reduce(f, a, identity) == + for k in minIndex a .. maxIndex a repeat + identity := f(identity, qelt(a, k)) + identity + + if S has SetCategory then + + reduce : (((S,S) -> S),%,S,S) -> S + reduce(f, a, identity,absorber) == + for k in minIndex a .. maxIndex a while identity ^= absorber + repeat identity := f(identity, qelt(a, k)) + identity + +-- this is necessary since new has disappeared. +-- a and b are not both empty if n > 0 + + stupidnew: (NonNegativeInteger, %, %) -> % + stupidnew(n, a, b) == + zero? n => empty() + new(n, (empty? a => qelt(b, minIndex b); qelt(a, minIndex a))) + +-- at least one element of l must be non-empty + + stupidget: List % -> S + stupidget l == + for a in l repeat + not empty? a => return first a + error "Should not happen" + + map : (((S,S) -> S),%,%) -> % + map(f, a, b) == + m := max(minIndex a, minIndex b) + n := min(maxIndex a, maxIndex b) + l := max(0, n - m + 1)::NonNegativeInteger + c := stupidnew(l, a, b) + for i in minIndex(c).. for j in m..n repeat + qsetelt_!(c, i, f(qelt(a, j), qelt(b, j))) + c + + merge : (((S,S) -> Boolean),%,%) -> % + merge(f, a, b) == + r := stupidnew(#a + #b, a, b) + i := minIndex a + m := maxIndex a + j := minIndex b + n := maxIndex b + for k in minIndex(r).. while i <= m and j <= n repeat + if f(qelt(a, i), qelt(b, j)) then + qsetelt_!(r, k, qelt(a, i)) + i := i+1 + else + qsetelt_!(r, k, qelt(b, j)) + j := j+1 + for k in k.. for i in i..m repeat qsetelt_!(r, k, elt(a, i)) + for k in k.. for j in j..n repeat qsetelt_!(r, k, elt(b, j)) + r + + ?.? : (%,UniversalSegment(Integer)) -> % + elt(a:%, s:UniversalSegment(Integer)) == + l := lo s + h := if hasHi s then hi s else maxIndex a + l < minIndex a or h > maxIndex a => error "index out of range" + r := stupidnew(max(0, h - l + 1)::NonNegativeInteger, a, a) + for k in minIndex r.. for i in l..h repeat + qsetelt_!(r, k, qelt(a, i)) + r + + insert : (%,%,Integer) -> % + insert(a:%, b:%, i:Integer) == + m := minIndex b + n := maxIndex b + i < m or i > n => error "index out of range" + y := stupidnew(#a + #b, a, b) + for k in minIndex y.. for j in m..i-1 repeat + qsetelt_!(y, k, qelt(b, j)) + for k in k.. for j in minIndex a .. maxIndex a repeat + qsetelt_!(y, k, qelt(a, j)) + for k in k.. for j in i..n repeat qsetelt_!(y, k, qelt(b, j)) + y + + copy : % -> % + copy x == + y := stupidnew(#x, x, x) + for i in minIndex x .. maxIndex x for j in minIndex y .. repeat + qsetelt_!(y, j, qelt(x, i)) + y + + copyInto! : (%,%,Integer) -> % + copyInto_!(y, x, s) == + s < minIndex y or s + #x > maxIndex y + 1 => + error "index out of range" + for i in minIndex x .. maxIndex x for j in s.. repeat + qsetelt_!(y, j, qelt(x, i)) + y + + construct : List(S) -> % + construct l == + empty? l => empty() + a := new(#l, first l) + for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x) + a + + delete : (%,UniversalSegment(Integer)) -> % + delete(a:%, s:UniversalSegment(Integer)) == + l := lo s; h := if hasHi s then hi s else maxIndex a + l < minIndex a or h > maxIndex a => error "index out of range" + h < l => copy a + r := stupidnew((#a - h + l - 1)::NonNegativeInteger, a, a) + for k in minIndex(r).. for i in minIndex a..l-1 repeat + qsetelt_!(r, k, qelt(a, i)) + for k in k.. for i in h+1 .. maxIndex a repeat + qsetelt_!(r, k, qelt(a, i)) + r + + delete : (%,Integer) -> % + delete(x:%, i:Integer) == + i < minIndex x or i > maxIndex x => error "index out of range" + y := stupidnew((#x - 1)::NonNegativeInteger, x, x) + for i in minIndex(y).. for j in minIndex x..i-1 repeat + qsetelt_!(y, i, qelt(x, j)) + for i in i .. for j in i+1 .. maxIndex x repeat + qsetelt_!(y, i, qelt(x, j)) + y + + reverse! : % -> % + reverse_! x == + m := minIndex x + n := maxIndex x + for i in 0..((n-m) quo 2) repeat swap_!(x, m+i, n-i) + x + + concat : List(%) -> % + concat l == + empty? l => empty() + n := _+/[#a for a in l] + i := minIndex(r := new(n, stupidget l)) + for a in l repeat + copyInto_!(r, a, i) + i := i + #a + r + + sorted? : (((S,S) -> Boolean),%) -> Boolean + sorted?(f, a) == + for i in minIndex(a)..maxIndex(a)-1 repeat + not f(qelt(a, i), qelt(a, i + 1)) => return false + true + + concat : (%,%) -> % + concat(x:%, y:%) == + z := stupidnew(#x + #y, x, y) + copyInto_!(z, x, i := minIndex z) + copyInto_!(z, y, i + #x) + z + + if S has SetCategory then + + ?=? : (%,%) -> Boolean + x = y == + #x ^= #y => false + for i in minIndex x .. maxIndex x repeat + not(qelt(x, i) = qelt(y, i)) => return false + true + + coerce : % -> OutputForm + coerce(r:%):OutputForm == + bracket commaSeparate + [qelt(r, k)::OutputForm for k in minIndex r .. maxIndex r] + + position : (S,%,Integer) -> Integer + position(x:S, t:%, s:Integer) == + n := maxIndex t + s < minIndex t or s > n => error "index out of range" + for k in s..n repeat + qelt(t, k) = x => return k + minIndex(t) - 1 + + if S has OrderedSet then + + ? Boolean + a < b == + for i in minIndex a .. maxIndex a + for j in minIndex b .. maxIndex b repeat + qelt(a, i) ^= qelt(b, j) => return a.i < b.j + #a < #b +*) + +\end{chunk} + \begin{chunk}{A1AGG.dotabb} "A1AGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=A1AGG"]; "A1AGG" -> "FLAGG" @@ -32302,6 +37055,7 @@ OrderedCancellationAbelianMonoid(): Category == Join(OrderedAbelianMonoid, CancellationAbelianMonoid) \end{chunk} + \begin{chunk}{OCAMON.dotabb} "OCAMON" [color=lightblue,href="bookvol10.2.pdf#nameddest=OCAMON"]; @@ -32309,6 +37063,7 @@ OrderedCancellationAbelianMonoid(): Category == "OCAMON" -> "CABMON" \end{chunk} + \begin{chunk}{OCAMON.dotfull} "OrderedCancellationAbelianMonoid()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OCAMON"]; @@ -32316,6 +37071,7 @@ OrderedCancellationAbelianMonoid(): Category == "OrderedCancellationAbelianMonoid()" -> "CancellationAbelianMonoid()" \end{chunk} + \begin{chunk}{OCAMON.dotpic} digraph pic { fontsize=10; @@ -32473,7 +37229,8 @@ RegularTriangularSetCategory examples The category of regular triangular sets was introduced under the name regular chains in M. KALKBRENER "Three contributions to elimination theory". -In P. AUBRY, D. LAZARD and M. MORENO MAZA "On the Theories of Triangular Sets" it is proved that regular triangular sets and towers of simple +In P. AUBRY, D. LAZARD and M. MORENO MAZA "On the Theories of Triangular Sets" +it is proved that regular triangular sets and towers of simple extensions of a field are equivalent notions. In the following definitions, all polynomials and ideals are taken from @@ -33110,6 +37867,177 @@ RegularTriangularSetCategory(R:GcdDomain, E:OrderedAbelianMonoidSup,_ intersect([p],lts) \end{chunk} + +\begin{chunk}{COQ RSETCAT} +(* category RSETCAT *) +(* + + NNI ==> NonNegativeInteger + INT ==> Integer + LP ==> List P + PWT ==> Record(val : P, tower : $) + LpWT ==> Record(val : (List P), tower : $) + Split ==> List $ + pack ==> PolynomialSetUtilitiesPackage(R,E,V,P) + + purelyAlgebraic? : (P,%) -> Boolean + purelyAlgebraic?(p: P, ts: $): Boolean == + ground? p => true + not algebraic?(mvar(p),ts) => false + algebraicCoefficients?(p,ts) + + purelyTranscendental? : (P,%) -> Boolean + purelyTranscendental?(p:P,ts:$): Boolean == + empty? ts => true + lv : List V := variables(p)$P + while (not empty? lv) and (not algebraic?(first(lv),ts)) repeat _ + lv := rest lv + empty? lv + + purelyAlgebraicLeadingMonomial? : (P,%) -> Boolean + purelyAlgebraicLeadingMonomial?(p: P, ts: $): Boolean == + ground? p => true + algebraic?(mvar(p),ts) and purelyAlgebraicLeadingMonomial?(init(p), ts) + + algebraicCoefficients? : (P,%) -> Boolean + algebraicCoefficients?(p:P,ts:$): Boolean == + ground? p => true + (not ground? init(p)) and not (algebraic?(mvar(init(p)),ts)) => false + algebraicCoefficients?(init(p),ts) => + ground? tail(p) => true + mvar(tail(p)) = mvar(p) => + algebraicCoefficients?(tail(p),ts) + algebraic?(mvar(tail(p)),ts) => + algebraicCoefficients?(tail(p),ts) + false + false + + if V has Finite + then + + purelyAlgebraic? : % -> Boolean + purelyAlgebraic?(ts: $): Boolean == + empty? ts => true + size()$V = #ts => true + lp: LP := sort(infRittWu?,members(ts)) + i: NonNegativeInteger := size()$V + for p in lp repeat + v: V := mvar(p) + (i = (lookup(v)$V)::NNI) => + i := subtractIfCan(i,1)::NNI + univariate?(p)$pack => + i := subtractIfCan(i,1)::NNI + not algebraicCoefficients?(p,collectUnder(ts,v)) => + return false + i := subtractIfCan(i,1)::NNI + true + + else + + purelyAlgebraic? : % -> Boolean + purelyAlgebraic?(ts: $): Boolean == + empty? ts => true + v: V := mvar(ts) + p: P := select(ts,v)::P + ts := collectUnder(ts,v) + empty? ts => univariate?(p)$pack + not purelyAlgebraic?(ts) => false + algebraicCoefficients?(p,ts) + + augment : (P,List(%)) -> List(%) + augment(p:P,lts:List $) == + toSave: Split := [] + while not empty? lts repeat + ts := first lts + lts := rest lts + toSave := concat(augment(p,ts),toSave) + toSave + + augment : (P,%) -> List(%) + augment(lp:LP,ts:$) == + toSave: Split := [ts] + empty? lp => toSave + lp := sort(infRittWu?,lp) + while not empty? lp repeat + p := first lp + lp := rest lp + toSave := augment(p,toSave) + toSave + + augment : (List(P),List(%)) -> List(%) + augment(lp:LP,lts:List $) == + empty? lp => lts + toSave: Split := [] + while not empty? lts repeat + ts := first lts + lts := rest lts + toSave := concat(augment(lp,ts),toSave) + toSave + + extend : (P,List(%)) -> List(%) + extend(p:P,lts:List $) == + toSave : Split := [] + while not empty? lts repeat + ts := first lts + lts := rest lts + toSave := concat(extend(p,ts),toSave) + toSave + + extend : (List(P),List(%)) -> List(%) + extend(lp:LP,ts:$) == + toSave: Split := [ts] + empty? lp => toSave + lp := sort(infRittWu?,lp) + while not empty? lp repeat + p := first lp + lp := rest lp + toSave := extend(p,toSave) + toSave + + extend : (List(P),%) -> List(%) + extend(lp:LP,lts:List $) == + empty? lp => lts + toSave: Split := [] + while not empty? lts repeat + ts := first lts + lts := rest lts + toSave := concat(extend(lp,ts),toSave) + toSave + + intersect : (List(P),List(%)) -> List(%) + intersect(lp:LP,lts:List $): List $ == + -- A VERY GENERAL default algorithm + (empty? lp) or (empty? lts) => lts + lp := [primitivePart(p) for p in lp] + lp := removeDuplicates lp + lp := remove(zero?,lp) + any?(ground?,lp) => [] + toSee: List LpWT := [[lp,ts]$LpWT for ts in lts] + toSave: List $ := [] + lp: LP + p: P + ts: $ + lus: List $ + while (not empty? toSee) repeat + lpwt := first toSee; toSee := rest toSee + lp := lpwt.val; ts := lpwt.tower + empty? lp => toSave := cons(ts, toSave) + p := first lp; lp := rest lp + lus := intersect(p,ts) + toSee := concat([[lp,us]$LpWT for us in lus], toSee) + toSave + + intersect : (List(P),%) -> List(%) + intersect(lp: LP,ts: $): List $ == + intersect(lp,[ts]) + + intersect : (P,%) -> List(%) + intersect(p: P,lts: List $): List $ == + intersect([p],lts) +*) + +\end{chunk} + \begin{chunk}{RSETCAT.dotabb} "RSETCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=RSETCAT"]; @@ -33285,6 +38213,18 @@ RightModule(R:Rng):Category == AbelianGroup with ++ by the ring element r. \end{chunk} + +\begin{chunk}{COQ RMODULE} +(* category RMODULE *) +(* +Axioms + x*(a*b) = (x*a)*b + x*(a+b) = (x*a)+(x*b) + (x+y)*x = (x*a)+(y*a) +*) + +\end{chunk} + \begin{chunk}{RMODULE.dotabb} "RMODULE" [color=lightblue,href="bookvol10.2.pdf#nameddest=RMODULE"]; @@ -33451,18 +38391,34 @@ These exports come from \refto{SemiGroup}(): Rng(): Category == Join(AbelianGroup,SemiGroup) \end{chunk} + +\begin{chunk}{COQ RNG} +(* category RNG *) +(* +Axioms + x*(y+z) = x*y + x*z + (x+y)*z = x*z + y*z + +Conditional attributes + noZeroDivisors ab = 0 => a=0 or b=0 +*) + +\end{chunk} + \begin{chunk}{RNG.dotabb} "RNG" [color=lightblue,href="bookvol10.2.pdf#nameddest=RNG"]; "RNG" -> "ABELGRP" "RNG" -> "SGROUP" \end{chunk} + \begin{chunk}{RNG.dotfull} "Rng()" [color=lightblue,href="bookvol10.2.pdf#nameddest=RNG"]; "Rng()" -> "AbelianGroup()" "Rng()" -> "SemiGroup()" \end{chunk} + \begin{chunk}{RNG.dotpic} digraph pic { fontsize=10; @@ -33497,6 +38453,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 8} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BiModule}{BMODULE} @@ -33633,6 +38590,18 @@ BiModule(R:Ring,S:Ring):Category == ++ \spad{x * 1 = x} \end{chunk} + +\begin{chunk}{COQ BMODULE} +(* category BMODULE *) +(* +Axiom + r*(x*s) = (r*x)*s +leftUnitary 1 * x = x +rightUnitary x * 1 = x +*) + +\end{chunk} + \begin{chunk}{BMODULE.dotabb} "BMODULE" [color=lightblue,href="bookvol10.2.pdf#nameddest=BMODULE"]; @@ -33640,6 +38609,7 @@ BiModule(R:Ring,S:Ring):Category == "BMODULE" -> "RMODULE" \end{chunk} + \begin{chunk}{BMODULE.dotfull} "BiModule(a:Ring,b:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=BMODULE"]; @@ -33655,6 +38625,7 @@ BiModule(R:Ring,S:Ring):Category == "BiModule(a:Ring,b:OrderedAbelianMonoid)" -> "BiModule(a:Ring,b:Ring)" \end{chunk} + \begin{chunk}{BMODULE.dotpic} digraph pic { fontsize=10; @@ -33689,6 +38660,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{BitAggregate}{BTAGG} \pagepic{ps/v102bitaggregate.ps}{BTAGG}{0.65} @@ -33789,6 +38761,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{BitAggregate.help} ==================================================================== BitAggregate examples @@ -34079,6 +39052,35 @@ BitAggregate(): Category == nor(v, u) == map(nor, v, u) \end{chunk} + +\begin{chunk}{COQ BTAGG} +(* category BTAGG *) +(* + ~? : % -> % + not v == map(_not, v) + + ^? : % -> % + _^ v == map(_not, v) + + ~? : % -> % + _~(v) == map(_~, v) + + ?/\? : (%,%) -> % + _/_\(v, u) == map(_/_\, v, u) + + ?\/? : (%,%) -> % + _\_/(v, u) == map(_\_/, v, u) + + nand : (%,%) -> % + nand(v, u) == map(nand, v, u) + + nor : (%,%) -> % + nor(v, u) == map(nor, v, u) + +*) + +\end{chunk} + \begin{chunk}{BTAGG.dotabb} "BTAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=BTAGG"]; "BTAGG" -> "ORDSET" @@ -34086,6 +39088,7 @@ BitAggregate(): Category == "BTAGG" -> "A1AGG" \end{chunk} + \begin{chunk}{BTAGG.dotfull} "BitAggregate()" [color=lightblue,href="bookvol10.2.pdf#nameddest=BTAGG"]; @@ -34094,6 +39097,7 @@ BitAggregate(): Category == "BitAggregate()" -> "OneDimensionalArrayAggregate(Boolean)" \end{chunk} + \begin{chunk}{BTAGG.dotpic} digraph pic { fontsize=10; @@ -34312,6 +39316,16 @@ NonAssociativeRing(): Category == Join(NonAssociativeRng,MonadWithUnit) with coerce(n) == n * 1$% \end{chunk} + +\begin{chunk}{COQ NASRING} +(* category NASRING *) +(* + n:Integer + coerce(n) == n * 1$% +*) + +\end{chunk} + \begin{chunk}{NASRING.dotabb} "NASRING" [color=lightblue,href="bookvol10.2.pdf#nameddest=NASRING"]; @@ -34319,6 +39333,7 @@ NonAssociativeRing(): Category == Join(NonAssociativeRng,MonadWithUnit) with "NASRING" -> "NARNG" \end{chunk} + \begin{chunk}{NASRING.dotfull} "NonAssociativeRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=NASRING"]; @@ -34326,6 +39341,7 @@ NonAssociativeRing(): Category == Join(NonAssociativeRng,MonadWithUnit) with "NonAssociativeRing()" -> "MonadWithUnit()" \end{chunk} + \begin{chunk}{NASRING.dotpic} digraph pic { fontsize=10; @@ -34368,6 +39384,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NormalizedTriangularSetCategory}{NTSCAT} \pagepic{ps/v102normalizedtriangularsetcategory.ps}{NTSCAT}{0.45} @@ -34485,6 +39502,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{NormalizedTriangularSetCategory.help} ==================================================================== NormalizedTriangularSetCategory examples @@ -34784,12 +39802,14 @@ NormalizedTriangularSetCategory(R:GcdDomain,E:OrderedAbelianMonoidSup,_ Category == RegularTriangularSetCategory(R,E,V,P) \end{chunk} + \begin{chunk}{NTSCAT.dotabb} "NTSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=NTSCAT"]; "NTSCAT" -> "RSETCAT" \end{chunk} + \begin{chunk}{NTSCAT.dotfull} "NormalizedRegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" [color=lightblue,href="bookvol10.2.pdf#nameddest=NTSCAT"]; @@ -34846,6 +39866,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedAbelianGroup}{OAGROUP} \pagepic{ps/v102orderedabeliangroup.ps}{OAGROUP}{1.00} @@ -34884,6 +39905,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedAbelianGroup.help} ==================================================================== OrderedAbelianGroup examples @@ -34965,6 +39987,7 @@ OrderedAbelianGroup(): Category == Join(OrderedCancellationAbelianMonoid, AbelianGroup) \end{chunk} + \begin{chunk}{OAGROUP.dotabb} "OAGROUP" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAGROUP"]; @@ -34972,6 +39995,7 @@ OrderedAbelianGroup(): Category == "OAGROUP" -> "ABELGRP" \end{chunk} + \begin{chunk}{OAGROUP.dotfull} "OrderedAbelianGroup()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAGROUP"]; @@ -34979,6 +40003,7 @@ OrderedAbelianGroup(): Category == "OrderedAbelianGroup()" -> "AbelianGroup()" \end{chunk} + \begin{chunk}{OAGROUP.dotpic} digraph pic { fontsize=10; @@ -35003,6 +40028,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedAbelianMonoidSup}{OAMONS} \pagepic{ps/v102orderedabelianmonoidsup.ps}{OAMONS}{0.80} @@ -35040,6 +40066,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedAbelianMonoidSup.help} ==================================================================== OrderedAbelianMonoidSup examples @@ -35135,18 +40162,32 @@ OrderedAbelianMonoidSup(): Category == OrderedCancellationAbelianMonoid with ++ x and y can be subtracted. \end{chunk} + +\begin{chunk}{COQ OAMONS} +(* category OAMONS *) +(* +Axioms + sup(a,b)-a \~~= "failed" + sup(a,b)-b \~~= "failed" + x-a \~~= "failed" and x-b \~~= "failed" => x >= sup(a,b) +*) + +\end{chunk} + \begin{chunk}{OAMONS.dotabb} "OAMONS" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMONS"]; "OAMONS" -> "OCAMON" \end{chunk} + \begin{chunk}{OAMONS.dotfull} "OrderedAbelianMonoidSup()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMONS"]; "OrderedAbelianMonoidSup()" -> "OrderedCancellationAbelianMonoid()" \end{chunk} + \begin{chunk}{OAMONS.dotpic} digraph pic { fontsize=10; @@ -35182,6 +40223,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedMultisetAggregate}{OMSAGG} \pagepic{ps/v102orderedmultisetaggregate.ps}{OMSAGG}{0.50} @@ -35257,6 +40299,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedMultisetAggregate.help} ==================================================================== OrderedMultisetAggregate examples @@ -35460,6 +40503,7 @@ OrderedMultisetAggregate(S:OrderedSet): Category == ++ min(u) returns the smallest entry in the multiset aggregate u. \end{chunk} + \begin{chunk}{OMSAGG.dotabb} "OMSAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=OMSAGG"]; @@ -35467,6 +40511,7 @@ OrderedMultisetAggregate(S:OrderedSet): Category == "OMSAGG" -> "PRQAGG" \end{chunk} + \begin{chunk}{OMSAGG.dotfull} "OrderedMultisetAggregate(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=OMSAGG"]; @@ -35476,6 +40521,7 @@ OrderedMultisetAggregate(S:OrderedSet): Category == "PriorityQueueAggregate(a:SetCategory)" \end{chunk} + \begin{chunk}{OMSAGG.dotpic} digraph pic { fontsize=10; @@ -35515,6 +40561,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Ring}{RING} \pagepic{ps/v102ring.ps}{RING}{1.00} @@ -35556,6 +40603,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Ring.help} ==================================================================== Ring examples @@ -35725,6 +40773,16 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with coerce(n) == n * 1$% \end{chunk} + +\begin{chunk}{COQ RING} +(* category RING *) +(* + n:Integer + coerce(n) == n * 1$% +*) + +\end{chunk} + \begin{chunk}{RING.dotabb} "RING" [color=lightblue,href="bookvol10.2.pdf#nameddest=RING"]; @@ -35733,6 +40791,7 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with "RING" -> "LMODULE" \end{chunk} + \begin{chunk}{RING.dotfull} "Ring()" [color=lightblue,href="bookvol10.2.pdf#nameddest=RING"]; @@ -35741,6 +40800,7 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with "Ring()" -> "LeftModule(a:Ring)" \end{chunk} + \begin{chunk}{RING.dotpic} digraph pic { fontsize=10; @@ -35780,6 +40840,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SquareFreeRegularTriangularSetCategory}{SFRTCAT} \pagepic{ps/v102squarefreeregulartriangularsetcategory.ps}{SFRTCAT}{0.50} @@ -35897,6 +40958,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SquareFreeRegularTriangularSetCategory.help} ==================================================================== SquareFreeRegularTriangularSetCategory examples @@ -36188,12 +41250,14 @@ SquareFreeRegularTriangularSetCategory(R:GcdDomain,E:OrderedAbelianMonoidSup,_ RegularTriangularSetCategory(R,E,V,P) \end{chunk} + \begin{chunk}{SFRTCAT.dotabb} "SFRTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SFRTCAT"]; "SFRTCAT" -> "RSETCAT" \end{chunk} + \begin{chunk}{SFRTCAT.dotfull} "SquareFreeRegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" [color=lightblue,href="bookvol10.2.pdf#nameddest=SFRTCAT"]; @@ -36202,6 +41266,7 @@ SquareFreeRegularTriangularSetCategory(R:GcdDomain,E:OrderedAbelianMonoidSup,_ "RegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" \end{chunk} + \begin{chunk}{SFRTCAT.dotpic} digraph pic { fontsize=10; @@ -36250,6 +41315,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{StringAggregate}{SRAGG} \pagepic{ps/v102stringaggregate.ps}{SRAGG}{1.00} @@ -36366,6 +41432,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{StringAggregate.help} ==================================================================== StringAggregate examples @@ -36730,26 +41797,58 @@ StringAggregate: Category == OneDimensionalArrayAggregate Character with ++ allow juxtaposition of strings to work as concatenation. ++ For example, \axiom{"smoo" "shed"} returns \axiom{"smooshed"}. add - trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) + trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) + trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc) + lowerCase s == lowerCase_! copy s + upperCase s == upperCase_! copy s + prefix?(s, t) == substring?(s, t, minIndex t) + coerce(c:Character):% == new(1, c) + elt(s:%, t:%): % == concat(s,t)$% + +\end{chunk} + +\begin{chunk}{COQ SRAGG} +(* category SRAGG *) +(* + + trim : (%,Character) -> % + trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) + + trim : (%,CharacterClass) -> % trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc) - lowerCase s == lowerCase_! copy s - upperCase s == upperCase_! copy s - prefix?(s, t) == substring?(s, t, minIndex t) + + lowerCase! : % -> % + lowerCase s == lowerCase_! copy s + + upperCase : % -> % + upperCase s == upperCase_! copy s + + prefix? : (%,%) -> Boolean + prefix?(s, t) == substring?(s, t, minIndex t) + + coerce : % -> OutputForm coerce(c:Character):% == new(1, c) - elt(s:%, t:%): % == concat(s,t)$% + + ?.? : (%,%) -> % + elt(s:%, t:%): % == concat(s,t)$% + +*) \end{chunk} + \begin{chunk}{SRAGG.dotabb} "SRAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=SRAGG"]; "SRAGG" -> "A1AGG" \end{chunk} + \begin{chunk}{SRAGG.dotfull} "StringAggregate()" [color=lightblue,href="bookvol10.2.pdf#nameddest=SRAGG"]; "StringAggregate()" -> "OneDimensionalArrayAggregate(Character)" \end{chunk} + \begin{chunk}{SRAGG.dotpic} digraph pic { fontsize=10; @@ -36782,6 +41881,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{TableAggregate}{TBAGG} \pagepic{ps/v102tableaggregate.ps}{TBAGG}{0.60} @@ -36881,6 +41981,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{TableAggregate.help} ==================================================================== TableAggregate examples @@ -37176,7 +42277,6 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category == add table() == empty() table l == dictionary l --- empty() == dictionary() insert_!(p, t) == (t(p.key) := p.entry; t) indices t == keys t @@ -37202,18 +42302,125 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category == for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k) z --- map(f, s, t, x) == --- z := table() --- for k in keys s repeat z.k := f(s.k, t(k, x)) --- for k in keys t | not key?(k, s) repeat z.k := f(t.k, x) --- z + if % has finiteAggregate then + parts(t:%):List Record(key:Key,entry:Entry) == + [[k, t.k] for k in keys t] + parts(t:%):List Entry == [t.k for k in keys t] + entries(t:%):List Entry == parts(t) + + s:% = t:% == + eq?(s,t) => true + #s ^= #t => false + for k in keys s repeat + (e := search(k, t)) _ + case "failed" or (e::Entry) ^= s.k => return false + true + + map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%== + z := table() + for k in keys t repeat + ke: Record(key:Key,entry:Entry) := f [k, t.k] + z ke.key := ke.entry + z + map_!(f:Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%_ + == + lke: List Record(key:Key,entry:Entry) := nil() + for k in keys t repeat + lke := cons(f [k, remove_!(k,t)::Entry], lke) + for ke in lke repeat + t ke.key := ke.entry + t + + inspect(t: %): Record(key:Key,entry:Entry) == + ks := keys t + empty? ks => error "Cannot extract from an empty aggregate" + [first ks, t first ks] + + find(f: Record(key:Key,entry:Entry)->Boolean, t:%):_ + Union(Record(key:Key,entry:Entry), "failed") == + for ke in parts(t)@List(Record(key:Key,entry:Entry)) _ + repeat if f ke then return ke + "failed" + + index?(k: Key, t: %): Boolean == + search(k,t) case Entry + + remove_!(x:Record(key:Key,entry:Entry), t:%) == + if member?(x, t) then remove_!(x.key, t) + t + extract_!(t: %): Record(key:Key,entry:Entry) == + k: Record(key:Key,entry:Entry) := inspect t + remove_!(k.key, t) + k + + any?(f: Entry->Boolean, t: %): Boolean == + for k in keys t | f t k repeat return true + false + every?(f: Entry->Boolean, t: %): Boolean == + for k in keys t | not f t k repeat return false + true + count(f: Entry->Boolean, t: %): NonNegativeInteger == + tally: NonNegativeInteger := 0 + for k in keys t | f t k repeat tally := tally + 1 + tally + +\end{chunk} + +\begin{chunk}{COQ TBAGG} +(* category TBAGG *) +(* + + table : () -> % + table() == empty() + + table : List(Record(key: Key,entry: Entry)) -> % + table l == dictionary l + + insert! : (Record(key: Key,entry: Entry),%) -> % + insert_!(p, t) == (t(p.key) := p.entry; t) + + indices : % -> List(Key) + indices t == keys t + + coerce : % -> OutputForm + coerce(t:%):OutputForm == + prefix("table"::OutputForm, + [k::OutputForm = (t.k)::OutputForm for k in keys t]) + + ?.? : (%,Key) -> Entry + elt(t, k) == + (r := search(k, t)) case Entry => r::Entry + error "key not in table" + + elt : (%,Key,Entry) -> Entry + elt(t, k, e) == + (r := search(k, t)) case Entry => r::Entry + e + + map! : ((Entry -> Entry),%) -> % + map_!(f, t) == + for k in keys t repeat t.k := f t.k + t + + map : (((Entry,Entry) -> Entry),%,%) -> % + map(f:(Entry, Entry) -> Entry, s:%, t:%) == + z := table() + for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k) + z if % has finiteAggregate then + + parts : % -> List(Record(key: Key,entry: Entry)) parts(t:%):List Record(key:Key,entry:Entry) == [[k, t.k] for k in keys t] + + parts : % -> List(Entry) parts(t:%):List Entry == [t.k for k in keys t] + + entries : % -> List(Entry) entries(t:%):List Entry == parts(t) + ?=? : (%,%) -> Boolean s:% = t:% == eq?(s,t) => true #s ^= #t => false @@ -37222,12 +42429,17 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category == case "failed" or (e::Entry) ^= s.k => return false true + map : ((Record(key: Key,entry: Entry) -> + Record(key: Key,entry: Entry)),%) -> % map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%== z := table() for k in keys t repeat ke: Record(key:Key,entry:Entry) := f [k, t.k] z ke.key := ke.entry z + + map! : ((Record(key: Key,entry: Entry) -> + Record(key: Key,entry: Entry)),%) -> % map_!(f:Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%_ == lke: List Record(key:Key,entry:Entry) := nil() @@ -37237,46 +42449,62 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category == t ke.key := ke.entry t + inspect : % -> Record(key: Key,entry: Entry) inspect(t: %): Record(key:Key,entry:Entry) == ks := keys t empty? ks => error "Cannot extract from an empty aggregate" [first ks, t first ks] + find : ((Record(key: Key,entry: Entry) -> Boolean),%) -> + Union(Record(key: Key,entry: Entry),"failed") find(f: Record(key:Key,entry:Entry)->Boolean, t:%):_ Union(Record(key:Key,entry:Entry), "failed") == for ke in parts(t)@List(Record(key:Key,entry:Entry)) _ repeat if f ke then return ke "failed" + index? : (Key,%) -> Boolean index?(k: Key, t: %): Boolean == search(k,t) case Entry + remove! : (Record(key: Key,entry: Entry),%) -> % remove_!(x:Record(key:Key,entry:Entry), t:%) == if member?(x, t) then remove_!(x.key, t) t + + extract! : % -> Record(key: Key,entry: Entry) extract_!(t: %): Record(key:Key,entry:Entry) == k: Record(key:Key,entry:Entry) := inspect t remove_!(k.key, t) k + any? : ((Entry -> Boolean),%) -> Boolean any?(f: Entry->Boolean, t: %): Boolean == for k in keys t | f t k repeat return true false + + every? : ((Entry -> Boolean),%) -> Boolean every?(f: Entry->Boolean, t: %): Boolean == for k in keys t | not f t k repeat return false true + + count : ((Entry -> Boolean),%) -> NonNegativeInteger count(f: Entry->Boolean, t: %): NonNegativeInteger == tally: NonNegativeInteger := 0 for k in keys t | f t k repeat tally := tally + 1 tally +*) + \end{chunk} + \begin{chunk}{TBAGG.dotabb} "TBAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=TBAGG"]; "TBAGG" -> "KDAGG" "TBAGG" -> "IXAGG" \end{chunk} + \begin{chunk}{TBAGG.dotfull} "TableAggregate(a:SetCategory,b:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=TBAGG"]; @@ -37286,6 +42514,7 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category == "IndexedAggregate(a:SetCategory,b:SetCategory)" \end{chunk} + \begin{chunk}{TBAGG.dotpic} digraph pic { fontsize=10; @@ -37337,6 +42566,7 @@ digraph pic { "HOAGG..." [color=lightblue]; } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{VectorCategory}{VECTCAT} \pagepic{ps/v102vectorcategory.ps}{VECTCAT}{1.00} @@ -37768,12 +42998,82 @@ VectorCategory(R:Type): Category == OneDimensionalArrayAggregate R with sqrt(dot(p,p)) \end{chunk} + +\begin{chunk}{COQ VECTCAT} +(* category VECTCAT *) +(* + + if R has AbelianSemiGroup then + + ?+? : (%,%) -> % + u + v == + (n := #u) ^= #v => error "Vectors must be of the same length" + map(_+ , u, v) + + if R has AbelianMonoid then + + zero : NonNegativeInteger -> % + zero n == new(n, 0) + + if R has AbelianGroup then + + -? : % -> % + - u == map(x +-> -x, u) + + ?*? : (Integer,%) -> % + n:Integer * u:% == map(x +-> n * x, u) + + ?-? : (%,%) -> % + u - v == u + (-v) + + if R has Monoid then + + ?*? : (%,R) -> % + u:% * r:R == map(x +-> x * r, u) + + ?*? : (R,%) -> % + r:R * u:% == map(x +-> r * x, u) + + if R has Ring then + + dot : (%,%) -> R + dot(u, v) == + #u ^= #v => error "Vectors must be of the same length" + _+/[qelt(u, i) * qelt(v, i) for i in minIndex u .. maxIndex u] + + outerProduct : (%,%) -> Matrix(R) + outerProduct(u, v) == + matrix [[qelt(u, i) * qelt(v,j) for i in minIndex u .. maxIndex u] _ + for j in minIndex v .. maxIndex v] + + cross : (%,%) -> % + cross(u, v) == + #u ^= 3 or #v ^= 3 => error "Vectors must be of length 3" + construct [qelt(u, 2)*qelt(v, 3) - qelt(u, 3)*qelt(v, 2) , _ + qelt(u, 3)*qelt(v, 1) - qelt(u, 1)*qelt(v, 3) , _ + qelt(u, 1)*qelt(v, 2) - qelt(u, 2)*qelt(v, 1) ] + + if R has RadicalCategory and R has Ring then + + length : % -> R + length p == + sqrt(dot(p,p)) + + magnitude : % -> R + magnitude p == + sqrt(dot(p,p)) + +*) + +\end{chunk} + \begin{chunk}{VECTCAT.dotabb} "VECTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=VECTCAT"]; "VECTCAT" -> "A1AGG" \end{chunk} + \begin{chunk}{VECTCAT.dotfull} "VectorCategory(a:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=VECTCAT"]; @@ -37784,6 +43084,7 @@ VectorCategory(R:Type): Category == OneDimensionalArrayAggregate R with "VectorCategory(a:Ring)" -> "VectorCategory(a:Type)" \end{chunk} + \begin{chunk}{VECTCAT.dotpic} digraph pic { fontsize=10; @@ -37812,6 +43113,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 9} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AssociationListAggregate}{ALAGG} @@ -38018,6 +43320,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AssociationListAggregate.help} ==================================================================== AssociationListAggregate examples @@ -38482,12 +43785,14 @@ AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category == ++ with key k, or "failed" if u has no key k. \end{chunk} + \begin{chunk}{ALAGG.dotabb} "ALAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ALAGG"]; "ALAGG" -> "TBAGG" "ALAGG" -> "LSAGG" \end{chunk} + \begin{chunk}{ALAGG.dotfull} "AssociationListAggregate(a:SetCategory,b:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=ALAGG"]; @@ -38497,6 +43802,7 @@ AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category == "ListAggregate(Record(a:SetCategory,b:SetCategory))" \end{chunk} + \begin{chunk}{ALAGG.dotpic} digraph pic { fontsize=10; @@ -38537,6 +43843,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CharacteristicNonZero}{CHARNZ} \pagepic{ps/v102characteristicnonzero.ps}{CHARNZ}{0.90} @@ -38579,6 +43886,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CharacteristicNonZero.help} ==================================================================== CharacteristicNonZero examples @@ -38676,18 +43984,21 @@ CharacteristicNonZero():Category == Ring with ++ where p is the characteristic of the ring. \end{chunk} + \begin{chunk}{CHARNZ.dotabb} "CHARNZ" [color=lightblue,href="bookvol10.2.pdf#nameddest=CHARNZ"]; "CHARNZ" -> "RING" \end{chunk} + \begin{chunk}{CHARNZ.dotfull} "CharacteristicNonZero()" [color=lightblue,href="bookvol10.2.pdf#nameddest=CHARNZ"]; "CharacteristicNonZero()" -> "Ring()" \end{chunk} + \begin{chunk}{CHARNZ.dotpic} digraph pic { fontsize=10; @@ -38730,6 +44041,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CharacteristicZero}{CHARZ} \pagepic{ps/v102characteristiczero.ps}{CHARZ}{0.90} @@ -38771,6 +44083,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CharacteristicZero.help} ==================================================================== CharacteristicZero examples @@ -38916,6 +44229,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{CommutativeRing}{COMRING} \pagepic{ps/v102commutativering.ps}{COMRING}{0.65} @@ -38957,6 +44271,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{CommutativeRing.help} ==================================================================== CommutativeRing examples @@ -39063,6 +44378,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with commutative("*") ++ multiplication is commutative. \end{chunk} + \begin{chunk}{COMRING.dotabb} "COMRING" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMRING"]; @@ -39070,6 +44386,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with "COMRING" -> "BMODULE" \end{chunk} + \begin{chunk}{COMRING.dotfull} "CommutativeRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMRING"]; @@ -39077,6 +44394,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with "CommutativeRing()" -> "BiModule(a:Ring,b:Ring)" \end{chunk} + \begin{chunk}{COMRING.dotpic} digraph pic { fontsize=10; @@ -39130,6 +44448,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DifferentialRing}{DIFRING} \pagepic{ps/v102differentialring.ps}{DIFRING}{0.90} @@ -39173,6 +44492,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DifferentialRing.help} ==================================================================== DifferentialRing examples @@ -39302,18 +44622,40 @@ DifferentialRing(): Category == Ring with D(r,n) == differentiate(r,n) \end{chunk} + +\begin{chunk}{COQ DIFRING} +(* category DIFRING *) +(* + + D : % -> % + D r == differentiate r + + differentiate : (%,NonNegativeInteger) -> % + differentiate(r, n) == + for i in 1..n repeat r := differentiate r + r + + D : (%,NonNegativeInteger) -> % + D(r,n) == differentiate(r,n) + +*) + +\end{chunk} + \begin{chunk}{DIFRING.dotabb} "DIFRING" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFRING"]; "DIFRING" -> "RING" \end{chunk} + \begin{chunk}{DIFRING.dotfull} "DifferentialRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFRING"]; "DifferentialRing()" -> "Ring()" \end{chunk} + \begin{chunk}{DIFRING.dotpic} digraph pic { fontsize=10; @@ -39356,6 +44698,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{EntireRing}{ENTIRER} \pagepic{ps/v102EntireRing.ps}{ENTIRER}{0.65} @@ -39397,6 +44740,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{EntireRing.help} ==================================================================== EntireRing examples @@ -39503,6 +44847,21 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with ++ must be zero. \end{chunk} + +\begin{chunk}{COQ ENTIRER} +(* category ENTIRER *) +(* +Entire Rings (non-commutative Integral Domains), i.e. a ring +not necessarily commutative which has no zero divisors. + +Axioms +noZeroDivisors ab=0 => a=0 or b=0 + not(1=0) + +*) + +\end{chunk} + \begin{chunk}{ENTIRER.dotabb} "ENTIRER" [color=lightblue,href="bookvol10.2.pdf#nameddest=ENTIRER"]; @@ -39510,6 +44869,7 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with "ENTIRER" -> "BMODULE" \end{chunk} + \begin{chunk}{ENTIRER.dotfull} "EntireRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ENTIRER"]; @@ -39517,6 +44877,7 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with "EntireRing()" -> "BiModule(a:Ring,b:Ring)" \end{chunk} + \begin{chunk}{ENTIRER.dotpic} digraph pic { fontsize=10; @@ -39565,6 +44926,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FreeModuleCat}{FMCAT} \pagepic{ps/v102freemodulecat.ps}{FMCAT}{0.75} @@ -39611,6 +44973,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FreeModuleCat.help} ==================================================================== FreeModuleCat examples @@ -39784,6 +45147,7 @@ FreeModuleCat(R, Basis):Category == Exports where if R has CommutativeRing then Module(R) \end{chunk} + \begin{chunk}{FMCAT.dotabb} "FMCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMCAT"]; @@ -39791,6 +45155,7 @@ FreeModuleCat(R, Basis):Category == Exports where "FMCAT" -> "RETRACT" \end{chunk} + \begin{chunk}{FMCAT.dotfull} "FreeModuleCat(a:Ring,b:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMCAT"]; @@ -39798,6 +45163,7 @@ FreeModuleCat(R, Basis):Category == Exports where "FreeModuleCat(a:Ring,b:SetCategory)" -> "RetractableTo(SetCategory)" \end{chunk} + \begin{chunk}{FMCAT.dotpic} digraph pic { fontsize=10; @@ -39836,6 +45202,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LeftAlgebra}{LALG} \pagepic{ps/v102leftalgebra.ps}{LALG}{1.00} @@ -39878,6 +45245,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LeftAlgebra.help} ==================================================================== LeftAlgebra examples @@ -39980,6 +45348,17 @@ LeftAlgebra(R:Ring): Category == Join(Ring, LeftModule R) with coerce(x:R):% == x * 1$% \end{chunk} + +\begin{chunk}{COQ LALG} +(* category LALG *) +(* + coerce : R -> % + coerce(x:R):% == x * 1$% + +*) + +\end{chunk} + \begin{chunk}{LALG.dotabb} "LALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=LALG"]; @@ -39987,6 +45366,7 @@ LeftAlgebra(R:Ring): Category == Join(Ring, LeftModule R) with "LALG" -> "RING" \end{chunk} + \begin{chunk}{LALG.dotfull} "LeftAlgebra(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LALG"]; @@ -39994,6 +45374,7 @@ LeftAlgebra(R:Ring): Category == Join(Ring, LeftModule R) with "LeftAlgebra(a:Ring)" -> "Ring()" \end{chunk} + \begin{chunk}{LALG.dotpic} digraph pic { fontsize=10; @@ -40027,6 +45408,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LinearlyExplicitRingOver}{LINEXP} \pagepic{ps/v102linearlyexplicitringover.ps}{LINEXP}{0.90} @@ -40070,6 +45452,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LinearlyExplicitRingOver.help} ==================================================================== LinearlyExplicitRingOver examples @@ -40170,12 +45553,14 @@ LinearlyExplicitRingOver(R:Ring): Category == Ring with ++ \spad{A x = v} and \spad{B x = w} have the same solutions in R. \end{chunk} + \begin{chunk}{LINEXP.dotabb} "LINEXP" [color=lightblue,href="bookvol10.2.pdf#nameddest=LINEXP"]; "LINEXP" -> "RING" \end{chunk} + \begin{chunk}{LINEXP.dotfull} "LinearlyExplicitRingOver(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LINEXP"]; @@ -40191,6 +45576,7 @@ LinearlyExplicitRingOver(R:Ring): Category == Ring with "LinearlyExplicitRingOver(a:Ring)" \end{chunk} + \begin{chunk}{LINEXP.dotpic} digraph pic { fontsize=10; @@ -40233,6 +45619,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Module}{MODULE} \pagepic{ps/v102module.ps}{MODULE}{1.00} @@ -40269,6 +45656,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Module.help} ==================================================================== Module examples @@ -40362,12 +45750,29 @@ Module(R:CommutativeRing): Category == BiModule(R,R) if not(R is %) then x:%*r:R == r*x \end{chunk} + +\begin{chunk}{COQ MODULE} +(* category MODULE *) +(* +The category of modules over a commutative ring. + +Axioms + 1*x = x + (a*b)*x = a*(b*x) + (a+b)*x = (a*x)+(b*x) + a*(x+y) = (a*x)+(a*y) + +*) + +\end{chunk} + \begin{chunk}{MODULE.dotabb} "MODULE" [color=lightblue,href="bookvol10.2.pdf#nameddest=MODULE"]; "MODULE" -> "BMODULE" \end{chunk} + \begin{chunk}{MODULE.dotfull} "Module(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=MODULE"]; @@ -40379,6 +45784,7 @@ Module(R:CommutativeRing): Category == BiModule(R,R) "Module(Field)" -> "Module(a:CommutativeRing)" \end{chunk} + \begin{chunk}{MODULE.dotpic} digraph pic { fontsize=10; @@ -40412,6 +45818,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedRing}{ORDRING} \pagepic{ps/v102orderedring.ps}{ORDRING}{0.75} @@ -40458,6 +45865,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedRing.help} ==================================================================== OrderedRing examples @@ -40606,6 +46014,37 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with error "x satisfies neither positive?, negative? or zero?" \end{chunk} + +\begin{chunk}{COQ ORDRING} +(* category ORDRING *) +(* +Axiom + 0 ab< ac + + positive? : % -> Boolean + positive? x == x>0 + + negative? : % -> Boolean + negative? x == x<0 + + sign : % -> Integer + sign x == + positive? x => 1 + negative? x => -1 + zero? x => 0 + error "x satisfies neither positive?, negative? or zero?" + + abs : % -> % + abs x == + positive? x => x + negative? x => -x + zero? x => 0 + error "x satisfies neither positive?, negative? or zero?" + +*) + +\end{chunk} + \begin{chunk}{ORDRING.dotabb} "ORDRING" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDRING"]; @@ -40614,6 +46053,7 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with "ORDRING" -> "MONOID" \end{chunk} + \begin{chunk}{ORDRING.dotfull} "OrderedRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDRING"]; @@ -40622,6 +46062,7 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with "OrderedRing()" -> "Monoid()" \end{chunk} + \begin{chunk}{ORDRING.dotpic} digraph pic { fontsize=10; @@ -40666,6 +46107,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PartialDifferentialRing}{PDRING} \pagepic{ps/v102partialdifferentialring.ps}{PDRING}{1.00} @@ -40712,6 +46154,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PartialDifferentialRing.help} ==================================================================== PartialDifferentialRing examples @@ -40879,12 +46322,52 @@ PartialDifferentialRing(S:SetCategory): Category == Ring with D(r:%, lv:List S, ln:List NonNegativeInteger) == differentiate(r, lv, ln) \end{chunk} + +\begin{chunk}{COQ PDRING} +(* category PDRING *) +(* +Axioms + differentiate(x+y,e)=differentiate(x,e)+differentiate(y,e) + differentiate(x*y,e)=x*differentiate(y,e)+differentiate(x,e)*y + + differentiate : (%,List(S)) -> % + differentiate(r:%, l:List S) == + for s in l repeat r := differentiate(r, s) + r + + differentiate : (%,S,NonNegativeInteger) -> % + differentiate(r:%, s:S, n:NonNegativeInteger) == + for i in 1..n repeat r := differentiate(r, s) + r + + differentiate : (%,List(S),List(NonNegativeInteger)) -> % + differentiate(r:%, ls:List S, ln:List NonNegativeInteger) == + for s in ls for n in ln repeat r := differentiate(r, s, n) + r + + D : (%,S) -> % + D(r:%, v:S) == differentiate(r,v) + + D : (%,List(S)) -> % + D(r:%, lv:List S) == differentiate(r,lv) + + D : (%,S,NonNegativeInteger) -> % + D(r:%, v:S, n:NonNegativeInteger) == differentiate(r,v,n) + + D : (%,List(S),List(NonNegativeInteger)) -> % + D(r:%, lv:List S, ln:List NonNegativeInteger) == differentiate(r, lv, ln) + +*) + +\end{chunk} + \begin{chunk}{PDRING.dotabb} "PDRING" [color=lightblue,href="bookvol10.2.pdf#nameddest=PDRING"]; "PDRING" -> "RING" \end{chunk} + \begin{chunk}{PDRING.dotfull} "PartialDifferentialRing(a:SetCategory)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PDRING"]; @@ -40901,6 +46384,7 @@ PartialDifferentialRing(S:SetCategory): Category == Ring with "PartialDifferentialRing(a:SetCategory)" \end{chunk} + \begin{chunk}{PDRING.dotpic} digraph pic { fontsize=10; @@ -40943,6 +46427,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PointCategory}{PTCAT} \pagepic{ps/v102pointcategory.ps}{PTCAT}{1.00} @@ -41050,6 +46535,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PointCategory.help} ==================================================================== PointCategory examples @@ -41288,18 +46774,21 @@ PointCategory(R:Ring) : Category == VectorCategory(R) with ++ extend(x,l,r) \undocumented \end{chunk} + \begin{chunk}{PTCAT.dotabb} "PTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PTCAT"]; "PTCAT" -> "VECTCAT" \end{chunk} + \begin{chunk}{PTCAT.dotfull} "PointCategory(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PTCAT"]; "PointCategory(a:Ring)" -> "VectorCategory(a:Ring)" \end{chunk} + \begin{chunk}{PTCAT.dotpic} digraph pic { fontsize=10; @@ -41334,6 +46823,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{RectangularMatrixCategory}{RMATCAT} \pagepic{ps/v102rectangularmatrixcategory.ps}{RMATCAT}{0.45} @@ -41418,6 +46908,7 @@ The RectangularMatrix domain is matrices of fixed dimension. )spool )lisp (bye) \end{chunk} + \begin{chunk}{RectangularMatrixCategory.help} ==================================================================== RectangularMatrixCategory examples @@ -41765,6 +47256,51 @@ RectangularMatrixCategory(m,n,R,Row,Col): Category == Definition where true \end{chunk} + +\begin{chunk}{COQ RMATCAT} +(* category RMATCAT *) +(* + nrows : % -> NonNegativeInteger + nrows x == m + + ncols : % -> NonNegativeInteger + ncols x == n + + square? : % -> Boolean + square? x == m = n + + diagonal? : % -> Boolean + diagonal? x == + not square? x => false + for i in minRowIndex x .. maxRowIndex x repeat + for j in minColIndex x .. maxColIndex x + | (j - minColIndex x) ^= (i - minRowIndex x) repeat + not zero? qelt(x, i, j) => return false + true + + symmetric? : % -> Boolean + symmetric? x == + m ^= n => false + mr := minRowIndex x; mc := minColIndex x + for i in 0..(n - 1) repeat + for j in (i + 1)..(n - 1) repeat + qelt(x,mr + i,mc + j) ^= qelt(x,mr + j,mc + i) => return false + true + + antisymmetric? : % -> Boolean + antisymmetric? x == + m ^= n => false + mr := minRowIndex x; mc := minColIndex x + for i in 0..(n - 1) repeat + for j in i..(n - 1) repeat + qelt(x,mr + i,mc + j) ^= -qelt(x,mr + j,mc + i) => + return false + true + +*) + +\end{chunk} + \begin{chunk}{RMATCAT.dotabb} "RMATCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=RMATCAT"]; @@ -41772,6 +47308,7 @@ RectangularMatrixCategory(m,n,R,Row,Col): Category == Definition where "RMATCAT" -> "HOAGG" \end{chunk} + \begin{chunk}{RMATCAT.dotfull} "RectangularMatrixCategory(a:NonNegativeInteger,b:NonNegativeInteger,c:Ring,d:DirectProductCategory(b,c),e:DirectProductCategory(a,c))" [color=lightblue,href="bookvol10.2.pdf#nameddest=RMATCAT"]; @@ -41781,6 +47318,7 @@ RectangularMatrixCategory(m,n,R,Row,Col): Category == Definition where -> "HomogeneousAggregate(Ring)" \end{chunk} + \begin{chunk}{RMATCAT.dotpic} digraph pic { fontsize=10; @@ -41816,6 +47354,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SquareFreeNormalizedTriangularSetCategory}{SNTSCAT} \pagepic{ps/v102squarefreenormalizedtriangularsetcategory.ps}{SNTSCAT}{0.45} @@ -41933,6 +47472,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{SquareFreeNormalizedTriangularSetCategory.help} ==================================================================== SquareFreeNormalizedTriangularSetCategory examples @@ -42219,6 +47759,7 @@ SquareFreeNormalizedTriangularSetCategory(R:GcdDomain,_ NormalizedTriangularSetCategory(R,E,V,P)) \end{chunk} + \begin{chunk}{SNTSCAT.dotabb} "SNTSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SNTSCAT"]; @@ -42226,6 +47767,7 @@ SquareFreeNormalizedTriangularSetCategory(R:GcdDomain,_ "SNTSCAT" -> "SFRTCAT" \end{chunk} + \begin{chunk}{SNTSCAT.dotfull} "SquareFreeNormalizedTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" [color=lightblue,href="bookvol10.2.pdf#nameddest=SNTSCAT"]; @@ -42238,6 +47780,7 @@ SquareFreeNormalizedTriangularSetCategory(R:GcdDomain,_ "NormalizedRegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))" \end{chunk} + \begin{chunk}{SNTSCAT.dotpic} digraph pic { fontsize=10; @@ -42258,6 +47801,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{StringCategory}{STRICAT} \pagepic{ps/v102stringcategory.ps}{STRICAT}{0.75} @@ -42375,6 +47919,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{StringCategory.help} ==================================================================== StringCategory examples @@ -42670,6 +48215,7 @@ StringCategory():Category == _ ++ string(i) returns the decimal representation of i in a string \end{chunk} + \begin{chunk}{STRICAT.dotabb} "STRICAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=STRICAT"]; @@ -42678,6 +48224,7 @@ StringCategory():Category == _ "STRICAT" -> "SRAGG" \end{chunk} + \begin{chunk}{STRICAT.dotfull} "StringCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=STRICAT"]; @@ -42686,6 +48233,7 @@ StringCategory():Category == _ "StringCategory()" -> "StringAggregate()" \end{chunk} + \begin{chunk}{STRICAT.dotpic} digraph pic { fontsize=10; @@ -42723,6 +48271,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnivariateSkewPolynomialCategory}{OREPCAT} \pagepic{ps/v102univariateskewpolynomialcategory.ps}{OREPCAT}{0.55} @@ -42796,6 +48345,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariateSkewPolynomialCategory.help} ==================================================================== UnivariateSkewPolynomialCategory examples @@ -43216,6 +48766,157 @@ UnivariateSkewPolynomialCategory(R:Ring): [a, u0, v0, u * a0] \end{chunk} + +\begin{chunk}{COQ OREPCAT} +(* category OREPCAT *) +(* +This is the category of univariate skew polynomials over an Ore +coefficient ring. + +The multiplication is given by x a = \sigma(a) x + \delta a + + coerce : R -> % + coerce(x:R):% == monomial(x, 0) + + coefficients : % -> List(R) + coefficients l == + ans:List(R) := empty() + while l ^= 0 repeat + ans := concat(leadingCoefficient l, ans) + l := reductum l + ans + + ?*? : (R,%) -> % + a:R * y:% == + z:% := 0 + while y ^= 0 repeat + z := z + monomial(a * leadingCoefficient y, degree y) + y := reductum y + z + + retractIfCan : % -> Union(R,"failed") + retractIfCan(x:%):Union(R, "failed") == + zero? x or zero? degree x => leadingCoefficient x + "failed" + + if R has IntegralDomain then + + exquo : (%,R) -> Union(%,"failed") + l exquo a == + ans:% := 0 + while l ^= 0 repeat + (u := (leadingCoefficient(l) exquo a)) case "failed" => + return "failed" + ans := ans + monomial(u::R, degree l) + l := reductum l + ans + + if R has GcdDomain then + + content : % -> R + content l == gcd coefficients l + + primitivePart : % -> % + primitivePart l == (l exquo content l)::% + + if R has Field then + + leftQuotient : (%,%) -> % + leftQuotient(a, b) == leftDivide(a,b).quotient + + leftRemainder : (%,%) -> % + leftRemainder(a, b) == leftDivide(a,b).remainder + + leftExtendedGcd : (%,%) -> Record(coef1: %,coef2: %,generator: %) + leftExtendedGcd(a, b) == extended(a, b, leftEEA) + + rightLcm : (%,%) -> % + rightLcm(a, b) == nclcm(a, b, leftEEA) + + rightQuotient : (%,%) -> % + rightQuotient(a, b) == rightDivide(a,b).quotient + + rightRemainder : (%,%) -> % + rightRemainder(a, b) == rightDivide(a,b).remainder + + rightExtendedGcd : (%,%) -> Record(coef1: %,coef2: %,generator: %) + rightExtendedGcd(a, b) == extended(a, b, rightEEA) + + leftLcm : (%,%) -> % + leftLcm(a, b) == nclcm(a, b, rightEEA) + + leftExactQuotient : (%,%) -> Union(%,"failed") + leftExactQuotient(a, b) == exactQuotient leftDivide(a, b) + + rightExactQuotient : (%,%) -> Union(%,"failed") + rightExactQuotient(a, b) == exactQuotient rightDivide(a, b) + + rightGcd : (%,%) -> % + rightGcd(a, b) == ncgcd(a, b, rightRemainder) + + leftGcd : (%,%) -> % + leftGcd(a, b) == ncgcd(a, b, leftRemainder) + + exactQuotient: Record(quotient:%, remainder:%) -> Union(%, "failed") + exactQuotient qr == (zero?(qr.remainder) => qr.quotient; "failed") + + -- returns [g = leftGcd(a, b), c, d, l = rightLcm(a, b)] + -- such that g := a c + b d + leftEEA: (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%) + leftEEA(a, b) == + a0 := a + u0:% := v:% := 1 + v0:% := u:% := 0 + while b ^= 0 repeat + qr := leftDivide(a, b) + (a, b) := (b, qr.remainder) + (u0, u):= (u, u0 - u * qr.quotient) + (v0, v):= (v, v0 - v * qr.quotient) + [a, u0, v0, a0 * u] + + ncgcd: (%, %, (%, %) -> %) -> % + ncgcd(a, b, ncrem) == + zero? a => b + zero? b => a + degree a < degree b => ncgcd(b, a, ncrem) + while b ^= 0 repeat (a, b) := (b, ncrem(a, b)) + a + + extended: (%, %, (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%)) -> + Record(coef1:%, coef2:%, generator:%) + extended(a, b, eea) == + zero? a => [0, 1, b] + zero? b => [1, 0, a] + degree a < degree b => + rec := eea(b, a) + [rec.coef2, rec.coef1, rec.gcd] + rec := eea(a, b) + [rec.coef1, rec.coef2, rec.gcd] + + nclcm: (%, %, (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%)) -> % + nclcm(a, b, eea) == + zero? a or zero? b => 0 + degree a < degree b => nclcm(b, a, eea) + rec := eea(a, b) + rec.lcm + + -- returns [g = rightGcd(a, b), c, d, l = leftLcm(a, b)] + -- such that g := a c + b d + rightEEA: (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%) + rightEEA(a, b) == + a0 := a + u0:% := v:% := 1 + v0:% := u:% := 0 + while b ^= 0 repeat + qr := rightDivide(a, b) + (a, b) := (b, qr.remainder) + (u0, u):= (u, u0 - qr.quotient * u) + (v0, v):= (v, v0 - qr.quotient * v) + [a, u0, v0, u * a0] +*) + +\end{chunk} + \begin{chunk}{OREPCAT.dotabb} "OREPCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=OREPCAT"]; @@ -43224,6 +48925,7 @@ UnivariateSkewPolynomialCategory(R:Ring): "OREPCAT" -> "RING" \end{chunk} + \begin{chunk}{OREPCAT.dotfull} "UnivariateSkewPolynomialCategory(R:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=OREPCAT"]; @@ -43235,6 +48937,7 @@ UnivariateSkewPolynomialCategory(R:Ring): -> "Ring()" \end{chunk} + \begin{chunk}{OREPCAT.dotpic} digraph pic { fontsize=10; @@ -43303,6 +49006,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{XAlgebra}{XALG} \pagepic{ps/v102xalgebra.ps}{XALG}{0.70} @@ -43345,6 +49049,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{XAlgebra.help} ==================================================================== XAlgebra examples @@ -43389,7 +49094,6 @@ o )show XAlgebra \end{tabular} - {\bf Attributes Exported:} \begin{itemize} \item {\bf \cross{XALG}{unitsKnown}} @@ -43460,6 +49164,7 @@ XAlgebra(R: Ring): Category == if R has CommutativeRing then Algebra(R) \end{chunk} + \begin{chunk}{XALG.dotabb} "XALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=XALG"]; @@ -43467,6 +49172,7 @@ XAlgebra(R: Ring): Category == "XALG" -> "RING" \end{chunk} + \begin{chunk}{XALG.dotfull} "XAlgebra(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=XALG"]; @@ -43474,6 +49180,7 @@ XAlgebra(R: Ring): Category == "XAlgebra(a:Ring)" -> "BiModule(a:Ring,b:Ring)" \end{chunk} + \begin{chunk}{XALG.dotpic} digraph pic { fontsize=10; @@ -43523,6 +49230,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 10} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Algebra}{ALGEBRA} @@ -43566,6 +49274,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Algebra.help} ==================================================================== Algebra examples @@ -43694,6 +49403,24 @@ Algebra(R:CommutativeRing): Category == coerce(x:R):% == x * 1$% \end{chunk} + +\begin{chunk}{COQ ALGEBRA} +(* category ALGEBRA *) +(* +Axioms + (b+c)::% = (b::%) + (c::%) + (b*c)::% = (b::%) * (c::%) + (1::R)::% = 1::% + b*x = (b::%)*x + r*(a*b) = (r*a)*b = a*(r*b) + + coerce : R -> % + coerce(x:R):% == x * 1$% + +*) + +\end{chunk} + \begin{chunk}{ALGEBRA.dotabb} "ALGEBRA" [color=lightblue,href="bookvol10.2.pdf#nameddest=ALGEBRA"]; @@ -43701,6 +49428,7 @@ Algebra(R:CommutativeRing): Category == "ALGEBRA" -> "MODULE" \end{chunk} + \begin{chunk}{ALGEBRA.dotfull} "Algebra(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=ALGEBRA"]; @@ -43783,6 +49511,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DifferentialExtension}{DIFEXT} \pagepic{ps/v102differentialextension.ps}{DIFEXT}{0.65} @@ -43838,6 +49567,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DifferentialExtension.help} ==================================================================== DifferentialExtension examples @@ -44001,6 +49731,37 @@ DifferentialExtension(R:Ring): Category == Ring with differentiate(x, s +-> differentiate(s, v)$R) \end{chunk} + +\begin{chunk}{COQ DIFEXT} +(* category DIFEXT *) +(* + + differentiate : (%,(R -> R),NonNegativeInteger) -> % + differentiate(x:%, derivation: R -> R, n:NonNegativeInteger):% == + for i in 1..n repeat x := differentiate(x, derivation) + x + + D : (%,(R -> R)) -> % + D(x:%, derivation: R -> R) == differentiate(x, derivation) + + D : (%,(R -> R),NonNegativeInteger) -> % + D(x:%, derivation: R -> R, n:NonNegativeInteger) == + differentiate(x, derivation, n) + + if R has DifferentialRing then + + differentiate : % -> % + differentiate x == differentiate(x, differentiate$R) + + if R has PartialDifferentialRing Symbol then + + differentiate : (%,Symbol) -> % + differentiate(x:%, v:Symbol):% == + differentiate(x, s +-> differentiate(s, v)$R) +*) + +\end{chunk} + \begin{chunk}{DIFEXT.dotabb} "DIFEXT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFEXT"]; @@ -44009,6 +49770,7 @@ DifferentialExtension(R:Ring): Category == Ring with "DIFEXT" -> "PDRING" \end{chunk} + \begin{chunk}{DIFEXT.dotfull} "DifferentialExtension(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFEXT"]; @@ -44027,6 +49789,7 @@ DifferentialExtension(R:Ring): Category == Ring with "DifferentialExtension(a:Ring)" \end{chunk} + \begin{chunk}{DIFEXT.dotpic} digraph pic { fontsize=10; @@ -44070,6 +49833,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FullyLinearlyExplicitRingOver}{FLINEXP} \pagepic{ps/v102fullylinearlyexplicitringover.ps}{FLINEXP}{1.00} @@ -44115,6 +49879,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FullyLinearlyExplicitRingOver.help} ==================================================================== FullyLinearlyExplicitRingOver examples @@ -44237,12 +50002,14 @@ FullyLinearlyExplicitRingOver(R:Ring):Category == reducedSystem(rec.mat, rec.vec) \end{chunk} + \begin{chunk}{FLINEXP.dotabb} "FLINEXP" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLINEXP"]; "FLINEXP" -> "LINEXP" \end{chunk} + \begin{chunk}{FLINEXP.dotfull} "FullyLinearlyExplicitRingOver(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLINEXP"]; @@ -44260,6 +50027,7 @@ FullyLinearlyExplicitRingOver(R:Ring):Category == "FullyLinearlyExplicitRingOver(a:Ring)" \end{chunk} + \begin{chunk}{FLINEXP.dotpic} digraph pic { fontsize=10; @@ -44306,6 +50074,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LieAlgebra}{LIECAT} \pagepic{ps/v102liealgebra.ps}{LIECAT}{1.00} @@ -44343,6 +50112,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LieAlgebra.help} ==================================================================== LieAlgebra examples @@ -44450,18 +50220,29 @@ LieAlgebra(R: CommutativeRing): Category == Module(R) with if R has Field then x / r == inv(r)$R * x \end{chunk} + +\begin{chunk}{COQ LIECAT} +(* category LIECAT *) +(* + if R has Field then x / r == inv(r)$R * x +*) + +\end{chunk} + \begin{chunk}{LIECAT.dotabb} "LIECAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=LIECAT"]; "LIECAT" -> "MODULE" \end{chunk} + \begin{chunk}{LIECAT.dotfull} "LieAlgebra(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LIECAT"]; "LieAlgebra(a:CommutativeRing)" -> "Module(a:CommutativeRing)" \end{chunk} + \begin{chunk}{LIECAT.dotpic} digraph pic { fontsize=10; @@ -44498,6 +50279,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{LinearOrdinaryDifferentialOperatorCategory}{LODOCAT} \pagepic{ps/v102linearordinarydifferentialoperatorcategory.ps}{LODOCAT}{0.50} @@ -44576,6 +50358,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LinearOrdinaryDifferentialOperatorCategory.help} ==================================================================== LinearOrdinaryDifferentialOperatorCategory examples @@ -44820,6 +50603,37 @@ LinearOrdinaryDifferentialOperatorCategory(A:Ring): Category == if A has Field then symmetricSquare l == symmetricPower(l, 2) \end{chunk} + +\begin{chunk}{COQ LODOCAT} +(* category LODOCAT *) +(* +Multiplication of operators corresponds to functional composition: +(L1 * L2).(f) = L1 L2 f + + D : () -> % + D() == monomial(1, 1) + + m1monom: NonNegativeInteger -> % + m1monom n == + a:A := (odd? n => -1; 1) + monomial(a, n) + + adjoint : % -> % + adjoint a == + ans:% := 0 + while a ^= 0 repeat + ans := ans + m1monom(degree a) * leadingCoefficient(a)::% + a := reductum a + ans + + if A has Field then + + symmetricSquare : % -> % + symmetricSquare l == symmetricPower(l, 2) +*) + +\end{chunk} + \begin{chunk}{LODOCAT.dotabb} "LODOCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=LODOCAT"]; @@ -44827,6 +50641,7 @@ LinearOrdinaryDifferentialOperatorCategory(A:Ring): Category == "LODOCAT" -> "OREPCAT" \end{chunk} + \begin{chunk}{LODOCAT.dotfull} "LinearOrdinaryDifferentialOperatorCategory(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LODOCAT"]; @@ -44836,6 +50651,7 @@ LinearOrdinaryDifferentialOperatorCategory(A:Ring): Category == -> "UnivariateSkewPolynomialCategory(R:Ring)" \end{chunk} + \begin{chunk}{LODOCAT.dotpic} digraph pic { fontsize=10; @@ -44918,6 +50734,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{NonAssociativeAlgebra}{NAALG} \pagepic{ps/v102nonassociativealgebra.ps}{NAALG}{0.75} @@ -44960,6 +50777,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{NonAssociativeAlgebra.help} ==================================================================== NonAssociativeAlgebra examples @@ -45074,12 +50892,27 @@ NonAssociativeAlgebra(R:CommutativeRing): Category == _ ++ and \spad{a} for \spad{n=1}. add plenaryPower(a,n) == --- one? n => a ( n = 1 ) => a n1 : PositiveInteger := (n-1)::NonNegativeInteger::PositiveInteger plenaryPower(a,n1) * plenaryPower(a,n1) \end{chunk} + +\begin{chunk}{COQ NAALG} +(* category NAALG *) +(* +Axioms + r*(a*b) = (r*a)*b = a*(r*b) + + plenaryPower : (%,PositiveInteger) -> % + plenaryPower(a,n) == + ( n = 1 ) => a + n1 : PositiveInteger := (n-1)::NonNegativeInteger::PositiveInteger + plenaryPower(a,n1) * plenaryPower(a,n1) +*) + +\end{chunk} + \begin{chunk}{NAALG.dotabb} "NAALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=NAALG"]; @@ -45087,6 +50920,7 @@ NonAssociativeAlgebra(R:CommutativeRing): Category == _ "NAALG" -> "MODULE" \end{chunk} + \begin{chunk}{NAALG.dotfull} "NonAssociativeAlgebra(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=NAALG"]; @@ -45094,6 +50928,7 @@ NonAssociativeAlgebra(R:CommutativeRing): Category == _ "NonAssociativeAlgebra(a:CommutativeRing)" -> "Module(a:CommutativeRing)" \end{chunk} + \begin{chunk}{NAALG.dotpic} digraph pic { fontsize=10; @@ -45141,6 +50976,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{VectorSpace}{VSPACE} \pagepic{ps/v102vectorspace.ps}{VSPACE}{1.00} @@ -45178,6 +51014,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{VectorSpace.help} ==================================================================== VectorSpace examples @@ -45267,18 +51104,31 @@ VectorSpace(S:Field): Category == Module(S) with (v:% / s:S):% == inv(s) * v \end{chunk} + +\begin{chunk}{COQ VSPACE} +(* category VSPACE *) +(* + ?/? : (%,S) -> % + (v:% / s:S):% == inv(s) * v + +*) + +\end{chunk} + \begin{chunk}{VSPACE.dotabb} "VSPACE" [color=lightblue,href="bookvol10.2.pdf#nameddest=VSPACE"]; "VSPACE" -> "MODULE" \end{chunk} + \begin{chunk}{VSPACE.dotfull} "VectorSpace(a:Field)" [color=lightblue,href="bookvol10.2.pdf#nameddest=VSPACE"]; "VectorSpace(a:Field)" -> "Module(Field)" \end{chunk} + \begin{chunk}{VSPACE.dotpic} digraph pic { fontsize=10; @@ -45318,6 +51168,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{XFreeAlgebra}{XFALG} \pagepic{ps/v102xfreealgebra.ps}{XFALG}{0.50} @@ -45377,6 +51228,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{XFreeAlgebra.help} ==================================================================== XFreeAlgebra examples @@ -45617,6 +51469,7 @@ XFreeAlgebra(vl:OrderedSet,R:Ring):Category == Catdef where if R has noZeroDivisors then noZeroDivisors \end{chunk} + \begin{chunk}{XFALG.dotabb} "XFALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=XFALG"]; @@ -45625,6 +51478,7 @@ XFreeAlgebra(vl:OrderedSet,R:Ring):Category == Catdef where "XFALG" -> "XALG" \end{chunk} + \begin{chunk}{XFALG.dotfull} "XFreeAlgebra(a:OrderedSet,b:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=XFALG"]; @@ -45634,6 +51488,7 @@ XFreeAlgebra(vl:OrderedSet,R:Ring):Category == Catdef where "RetractableTo(OrderedFreeMonoid(OrderedSet))" \end{chunk} + \begin{chunk}{XFALG.dotpic} digraph pic { fontsize=10; @@ -45699,6 +51554,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 11} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DirectProductCategory}{DIRPCAT} @@ -45824,6 +51680,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DirectProductCategory.help} ==================================================================== DirectProductCategory examples @@ -46259,6 +52116,61 @@ DirectProductCategory(dim:NonNegativeInteger, R:Type): Category == dimension() == dim::CardinalNumber \end{chunk} + +\begin{chunk}{COQ DIRPCAT} +(* category DIRPCAT *) +(* + if R has Ring then + + coerce : Integer -> % + coerce(n:Integer):% == n::R::% + + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$R + + differentiate : (%,(R -> R)) -> % + differentiate(z:%, d:R -> R) == map(d, z) + + equation2R: Vector % -> Matrix R + equation2R v == + ans:Matrix(R) := new(dim, #v, 0) + for i in minRowIndex ans .. maxRowIndex ans repeat + for j in minColIndex ans .. maxColIndex ans repeat + qsetelt_!(ans, i, j, qelt(qelt(v, j), i)) + ans + + reducedSystem : Matrix(%) -> Matrix(R) + reducedSystem(m:Matrix %):Matrix(R) == + empty? m => new(0, 0, 0) + reduce(vertConcat, [equation2R row(m, i) + for i in minRowIndex m .. maxRowIndex m])$List(Matrix R) + + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(R),vec: Vector(R)) + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix R, vec:Vector R) == + vh:Vector(R) := + empty? v => empty() + rh := reducedSystem(v::Matrix %)@Matrix(R) + column(rh, minColIndex rh) + [reducedSystem(m)@Matrix(R), vh] + + if R has Finite then + + size : () -> NonNegativeInteger + size == size$R ** dim + + if R has Field then + + ?/? : (%,R) -> % + x / b == x * inv b + + dimension : () -> CardinalNumber + dimension() == dim::CardinalNumber +*) + +\end{chunk} + \begin{chunk}{DIRPCAT.dotabb} "DIRPCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIRPCAT"]; @@ -46273,6 +52185,7 @@ DirectProductCategory(dim:NonNegativeInteger, R:Type): Category == "DIRPCAT" -> "OAMONS" \end{chunk} + \begin{chunk}{DIRPCAT.dotfull} "DirectProductCategory(a:NonNegativeInteger,b:Type)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIRPCAT"]; @@ -46296,6 +52209,7 @@ DirectProductCategory(dim:NonNegativeInteger, R:Type): Category == -> "OrderedAbelianMonoidSup()" \end{chunk} + \begin{chunk}{DIRPCAT.dotpic} digraph pic { fontsize=10; @@ -46326,6 +52240,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DivisionRing}{DIVRING} \pagepic{ps/v102divisionring.ps}{DIVRING}{0.65} @@ -46370,6 +52285,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DivisionRing.help} ==================================================================== DivisionRing examples @@ -46511,6 +52427,35 @@ DivisionRing(): Category == q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x \end{chunk} + +\begin{chunk}{COQ DIVRING} +(* category DIVRING *) +(* + n: Integer + x: % + + ?^? : (%,Integer) -> % + _^(x:%, n:Integer):% == x ** n + + import RepeatedSquaring(%) + + ?**? : (%,Integer) -> % + x ** n: Integer == + zero? n => 1 + zero? x => + n<0 => error "division by zero" + x + n<0 => + expt(inv x,(-n) pretend PositiveInteger) + expt(x,n pretend PositiveInteger) + + ?*? : (Fraction(Integer),%) -> % + q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x + +*) + +\end{chunk} + \begin{chunk}{DIVRING.dotabb} "DIVRING" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVRING"]; @@ -46518,6 +52463,7 @@ DivisionRing(): Category == "DIVRING" -> "ALGEBRA" \end{chunk} + \begin{chunk}{DIVRING.dotfull} "DivisionRing()" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVRING"]; @@ -46526,6 +52472,7 @@ DivisionRing(): Category == "DivisionRing()" -> "RepeatedSquaring(DivisionRing)" \end{chunk} + \begin{chunk}{DIVRING.dotpic} digraph pic { fontsize=10; @@ -46568,6 +52515,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteRankNonAssociativeAlgebra}{FINAALG} \pagepic{ps/v102finiteranknonassociativealgebra.ps}{FINAALG}{0.80} @@ -47531,12 +53479,454 @@ FiniteRankNonAssociativeAlgebra(R:CommutativeRing): [parts coordinates(b(i+m)*x,b) for i in 1..rank()]$List(List R) \end{chunk} + +\begin{chunk}{COQ FINAALG} +(* category FINAALG *) +(* + V ==> Vector + M ==> Matrix + REC ==> Record(particular: Union(V R,"failed"),basis: List V R) + LSMP ==> LinearSystemMatrixPackage(R,V R,V R, M R) + SUP ==> SparseUnivariatePolynomial + NNI ==> NonNegativeInteger + + -- next 2 functions: use a general characteristicPolynomial + leftCharacteristicPolynomial : % -> SparseUnivariatePolynomial(R) + leftCharacteristicPolynomial a == + n := rank()$% + ma : Matrix R := leftRegularRepresentation(a,someBasis()$%) + mb : Matrix SUP R := zero(n,n) + for i in 1..n repeat + for j in 1..n repeat + mb(i,j):= + i=j => monomial(ma(i,j),0)$SUP(R) - monomial(1,1)$SUP(R) + monomial(ma(i,j),1)$SUP(R) + determinant mb + + rightCharacteristicPolynomial : % -> SparseUnivariatePolynomial(R) + rightCharacteristicPolynomial a == + n := rank()$% + ma : Matrix R := rightRegularRepresentation(a,someBasis()$%) + mb : Matrix SUP R := zero(n,n) + for i in 1..n repeat + for j in 1..n repeat + mb(i,j):= + i=j => monomial(ma(i,j),0)$SUP(R) - monomial(1,1)$SUP(R) + monomial(ma(i,j),1)$SUP(R) + determinant mb + + leftTrace : % -> R + leftTrace a == + t : R := 0 + ma : Matrix R := leftRegularRepresentation(a,someBasis()$%) + for i in 1..rank()$% repeat + t := t + elt(ma,i,i) + t + + rightTrace : % -> R + rightTrace a == + t : R := 0 + ma : Matrix R := rightRegularRepresentation(a,someBasis()$%) + for i in 1..rank()$% repeat + t := t + elt(ma,i,i) + t + + leftNorm : % -> R + leftNorm a == determinant leftRegularRepresentation(a,someBasis()$%) + + rightNorm : % -> R + rightNorm a == determinant rightRegularRepresentation(a,someBasis()$%) + + antiAssociative? : () -> Boolean + antiAssociative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? ( (b.i*b.j)*b.k + b.i*(b.j*b.k) ) => + messagePrint("algebra is not anti-associative")$OutputForm + return false + messagePrint("algebra is anti-associative")$OutputForm + true + + jordanAdmissible? : () -> Boolean + jordanAdmissible?() == + b := someBasis() + n := rank() + recip(2 * 1$R) case "failed" => + messagePrint("this algebra is not Jordan admissible, " _ + "as 2 is not invertible in the ground ring")$OutputForm + false + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for l in 1..n repeat + not zero? ( _ + antiCommutator(antiCommutator(b.i,b.j),_ + antiCommutator(b.l,b.k)) + _ + antiCommutator(antiCommutator(b.l,b.j),_ + antiCommutator(b.k,b.i)) + _ + antiCommutator(antiCommutator(b.k,b.j),_ + antiCommutator(b.i,b.l)) _ + ) => + messagePrint(_ + "this algebra is not Jordan admissible")$OutputForm + return false + messagePrint("this algebra is Jordan admissible")$OutputForm + true + + lieAdmissible? : () -> Boolean + lieAdmissible?() == + n := rank() + b := someBasis() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? (commutator(commutator(b.i,b.j),b.k) _ + + commutator(commutator(b.j,b.k),b.i) _ + + commutator(commutator(b.k,b.i),b.j)) => + messagePrint("this algebra is not Lie admissible")$OutputForm + return false + messagePrint("this algebra is Lie admissible")$OutputForm + true + + structuralConstants : Vector(%) -> Vector(Matrix(R)) + structuralConstants b == + --n := rank() + -- be careful with the possibility that b is not a basis + m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger + sC : Vector Matrix R := [new(m,m,0$R) for k in 1..m] + for i in 1..m repeat + for j in 1..m repeat + covec : Vector R := coordinates(b.i * b.j, b) + for k in 1..m repeat + setelt( sC.k, i, j, covec.k ) + sC + + if R has IntegralDomain then + + leftRecip : % -> Union(%,"failed") + leftRecip x == + zero? x => "failed" + lu := leftUnit() + lu case "failed" => "failed" + b := someBasis() + xx : % := (lu :: %) + k : PositiveInteger := 1 + cond : Matrix R := coordinates(xx,b) :: Matrix(R) + listOfPowers : List % := [xx] + while rank(cond) = k repeat + k := k+1 + xx := xx*x + listOfPowers := cons(xx,listOfPowers) + cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) ) + vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first + invC := recip vectorOfCoef.1 + invC case "failed" => "failed" + invCR : R := - (invC :: R) + reduce(_+,[(invCR*vectorOfCoef.i)*power for i in _ + 2..maxIndex vectorOfCoef for power in reverse listOfPowers]) + + rightRecip : % -> Union(%,"failed") + rightRecip x == + zero? x => "failed" + ru := rightUnit() + ru case "failed" => "failed" + b := someBasis() + xx : % := (ru :: %) + k : PositiveInteger := 1 + cond : Matrix R := coordinates(xx,b) :: Matrix(R) + listOfPowers : List % := [xx] + while rank(cond) = k repeat + k := k+1 + xx := x*xx + listOfPowers := cons(xx,listOfPowers) + cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) ) + vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first + invC := recip vectorOfCoef.1 + invC case "failed" => "failed" + invCR : R := - (invC :: R) + reduce(_+,[(invCR*vectorOfCoef.i)*power for i in _ + 2..maxIndex vectorOfCoef for power in reverse listOfPowers]) + + recip : % -> Union(%,"failed") + recip x == + lrx := leftRecip x + lrx case "failed" => "failed" + rrx := rightRecip x + rrx case "failed" => "failed" + (lrx :: %) ^= (rrx :: %) => "failed" + lrx :: % + + leftMinimalPolynomial : % -> SparseUnivariatePolynomial(R) + leftMinimalPolynomial x == + zero? x => monomial(1$R,1)$(SparseUnivariatePolynomial R) + b := someBasis() + xx : % := x + k : PositiveInteger := 1 + cond : Matrix R := coordinates(xx,b) :: Matrix(R) + while rank(cond) = k repeat + k := k+1 + xx := x*xx + cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) ) + vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first + res : SparseUnivariatePolynomial R := 0 + for i in 1..k repeat + res:=res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial R) + res + + rightMinimalPolynomial : % -> SparseUnivariatePolynomial(R) + rightMinimalPolynomial x == + zero? x => monomial(1$R,1)$(SparseUnivariatePolynomial R) + b := someBasis() + xx : % := x + k : PositiveInteger := 1 + cond : Matrix R := coordinates(xx,b) :: Matrix(R) + while rank(cond) = k repeat + k := k+1 + xx := xx*x + cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) ) + vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first + res : SparseUnivariatePolynomial R := 0 + for i in 1..k repeat + res:=res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial R) + res + + associatorDependence : () -> List(Vector(R)) + associatorDependence() == + n := rank() + b := someBasis() + cond : Matrix(R) := new(n**4,6,0$R)$Matrix(R) + z : Integer := 0 + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + a123 : Vector R := coordinates(associator(b.i,b.j,b.k),b) + a231 : Vector R := coordinates(associator(b.j,b.k,b.i),b) + a312 : Vector R := coordinates(associator(b.k,b.i,b.j),b) + a132 : Vector R := coordinates(associator(b.i,b.k,b.j),b) + a321 : Vector R := coordinates(associator(b.k,b.j,b.i),b) + a213 : Vector R := coordinates(associator(b.j,b.i,b.k),b) + for r in 1..n repeat + z:= z+1 + setelt(cond,z,1,elt(a123,r)) + setelt(cond,z,2,elt(a231,r)) + setelt(cond,z,3,elt(a312,r)) + setelt(cond,z,4,elt(a132,r)) + setelt(cond,z,5,elt(a321,r)) + setelt(cond,z,6,elt(a213,r)) + nullSpace(cond) + + jacobiIdentity? : () -> Boolean + jacobiIdentity?() == + n := rank() + b := someBasis() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? ((b.i*b.j)*b.k + (b.j*b.k)*b.i + (b.k*b.i)*b.j) => + messagePrint("Jacobi identity does not hold")$OutputForm + return false + messagePrint("Jacobi identity holds")$OutputForm + true + + lieAlgebra? : () -> Boolean + lieAlgebra?() == + not antiCommutative?() => + messagePrint("this is not a Lie algebra")$OutputForm + false + not jacobiIdentity?() => + messagePrint("this is not a Lie algebra")$OutputForm + false + messagePrint("this is a Lie algebra")$OutputForm + true + + jordanAdmissible? : () -> Boolean + jordanAlgebra?() == + b := someBasis() + n := rank() + recip(2 * 1$R) case "failed" => + messagePrint("this is not a Jordan algebra, as 2 is not " _ + "invertible in the ground ring")$OutputForm + false + not commutative?() => + messagePrint("this is not a Jordan algebra")$OutputForm + false + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for l in 1..n repeat + not zero? (associator(b.i,b.j,b.l*b.k)+_ + associator(b.l,b.j,b.k*b.i)+associator(b.k,b.j,b.i*b.l)) => + messagePrint("not a Jordan algebra")$OutputForm + return false + messagePrint("this is a Jordan algebra")$OutputForm + true + + noncommutativeJordanAlgebra? : () -> Boolean + noncommutativeJordanAlgebra?() == + b := someBasis() + n := rank() + recip(2 * 1$R) case "failed" => + messagePrint("this is not a noncommutative Jordan algebra,_ + as 2 is not invertible in the ground ring")$OutputForm + false + not flexible?()$% => + messagePrint("this is not a noncommutative Jordan algebra,_ + as it is not flexible")$OutputForm + false + not jordanAdmissible?()$% => + messagePrint("this is not a noncommutative Jordan algebra,_ + as it is not Jordan admissible")$OutputForm + false + messagePrint("this is a noncommutative Jordan algebra")$OutputForm + true + + antiCommutative? : () -> Boolean + antiCommutative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in i..n repeat + not zero? (i=j => b.i*b.i; b.i*b.j + b.j*b.i) => + messagePrint("algebra is not anti-commutative")$OutputForm + return false + messagePrint("algebra is anti-commutative")$OutputForm + true + + commutative? : () -> Boolean + commutative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in i+1..n repeat + not zero? commutator(b.i,b.j) => + messagePrint("algebra is not commutative")$OutputForm + return false + messagePrint("algebra is commutative")$OutputForm + true + + associative? : () -> Boolean + associative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? associator(b.i,b.j,b.k) => + messagePrint("algebra is not associative")$OutputForm + return false + messagePrint("algebra is associative")$OutputForm + true + + leftAlternative? : () -> Boolean + leftAlternative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? (associator(b.i,b.j,b.k) + associator(b.j,b.i,b.k)) => + messagePrint("algebra is not left alternative")$OutputForm + return false + messagePrint("algebra satisfies 2*associator(a,a,b) = 0")$OutputForm + true + + rightAlternative? : () -> Boolean + rightAlternative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? (associator(b.i,b.j,b.k) + associator(b.i,b.k,b.j)) => + messagePrint("algebra is not right alternative")$OutputForm + return false + messagePrint("algebra satisfies 2*associator(a,b,b) = 0")$OutputForm + true + + flexible? : () -> Boolean + flexible?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? (associator(b.i,b.j,b.k) + associator(b.k,b.j,b.i)) => + messagePrint("algebra is not flexible")$OutputForm + return false + messagePrint("algebra satisfies 2*associator(a,b,a) = 0")$OutputForm + true + + alternative? : () -> Boolean + alternative?() == + b := someBasis() + n := rank() + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + not zero? (associator(b.i,b.j,b.k) + associator(b.j,b.i,b.k)) => + messagePrint("algebra is not alternative")$OutputForm + return false + not zero? (associator(b.i,b.j,b.k) + associator(b.i,b.k,b.j)) => + messagePrint("algebra is not alternative")$OutputForm + return false + messagePrint("algebra satisfies 2*associator(a,b,b) = 0 " _ + "= 2*associator(a,a,b) = 0")$OutputForm + true + + leftDiscriminant : Vector(%) -> R + leftDiscriminant v == determinant leftTraceMatrix v + + rightDiscriminant : Vector(%) -> R + rightDiscriminant v == determinant rightTraceMatrix v + + coordinates : (Vector(%),Vector(%)) -> Matrix(R) + coordinates(v:Vector %, b:Vector %) == + m := new(#v, #b, 0)$Matrix(R) + for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat + setRow_!(m, j, coordinates(qelt(v, i), b)) + m + + represents : (Vector(R),Vector(%)) -> % + represents(v, b) == + m := minIndex v - 1 + reduce(_+,[v(i+m) * b(i+m) for i in 1..maxIndex b]) + + leftTraceMatrix : Vector(%) -> Matrix(R) + leftTraceMatrix v == + matrix [[leftTrace(v.i*v.j) for j in minIndex v..maxIndex v]$List(R) + for i in minIndex v .. maxIndex v]$List(List R) + + rightTraceMatrix : Vector(%) -> Matrix(R) + rightTraceMatrix v == + matrix [[rightTrace(v.i*v.j) for j in minIndex v..maxIndex v]$List(R) + for i in minIndex v .. maxIndex v]$List(List R) + + leftRegularRepresentation : (%,Vector(%)) -> Matrix(R) + leftRegularRepresentation(x, b) == + m := minIndex b - 1 + matrix + [parts coordinates(x*b(i+m),b) for i in 1..rank()]$List(List R) + + rightRegularRepresentation : (%,Vector(%)) -> Matrix(R) + rightRegularRepresentation(x, b) == + m := minIndex b - 1 + matrix + [parts coordinates(b(i+m)*x,b) for i in 1..rank()]$List(List R) + +*) + +\end{chunk} + \begin{chunk}{FINAALG.dotabb} "FINAALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FINAALG"]; "FINAALG" -> "NAALG" \end{chunk} + \begin{chunk}{FINAALG.dotfull} "FiniteRankNonAssociativeAlgebra(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FINAALG"]; @@ -47544,6 +53934,7 @@ FiniteRankNonAssociativeAlgebra(R:CommutativeRing): "NonAssociativeAlgebra(a:CommutativeRing)" \end{chunk} + \begin{chunk}{FINAALG.dotpic} digraph pic { fontsize=10; @@ -47595,6 +53986,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FreeLieAlgebra}{FLALG} \pagepic{ps/v102freeliealgebra.ps}{FLALG}{1.00} @@ -47642,6 +54034,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FreeLieAlgebra.help} ==================================================================== FreeLieAlgebra examples @@ -47801,12 +54194,14 @@ FreeLieAlgebra(VarSet:OrderedSet, R:CommutativeRing) :Category == _ ++ by \axiom{vi} in \axiom{p}. \end{chunk} + \begin{chunk}{FLALG.dotabb} "FLALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLALG"]; "FLALG" -> "LIECAT" \end{chunk} + \begin{chunk}{FLALG.dotfull} "FreeLieAlgebra(a:OrderedSet,b:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLALG"]; @@ -47814,6 +54209,7 @@ FreeLieAlgebra(VarSet:OrderedSet, R:CommutativeRing) :Category == _ "LieAlgebra(a:CommutativeRing)" \end{chunk} + \begin{chunk}{FLALG.dotpic} digraph pic { fontsize=10; @@ -47854,6 +54250,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{IntegralDomain}{INTDOM} \pagepic{ps/v102integraldomain.ps}{INTDOM}{0.65} @@ -47899,6 +54296,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{IntegralDomain.help} ==================================================================== IntegralDomain examples @@ -47917,8 +54315,6 @@ have zero divisors since | 0 0 | | 0 0 | | 0 0 | +- -+ +- -+ +- -+ - - Conditional attributes: canonicalUnitNormal - the canonical field is the same for all associates canonicalsClosed - the product of two canonicals is itself canonical @@ -48106,6 +54502,60 @@ IntegralDomain(): Category == true \end{chunk} + +\begin{chunk}{COQ INTDOM} +(* category INTDOM *) +(* +Conditional attributes: + canonicalUnitNormal - the canonical field is the same for all associates + canonicalsClosed - the product of two canonicals is itself canonical + + Ring -> CommutativeRing -> IntegralDomain + + 1) (associative addition) a + (b + c) = (a + b) + c + 2) (commutative addition) a + b = b + a + 3) (associative multiplication) a(bc) = (ab)c + 4) (distributive mulitplication) a(b + c) = ab + ac; (b + c)a = ba + ca + 5) (equation solution) a + x = b has a solution in R + + x,y: % + + UCA ==> Record(unit:%,canonical:%,associate:%) + + if not (% has Field) then + + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + unitNormal(x) == [1$%,x,1$%]$UCA -- the non-canonical definition + + unitCanonical : % -> % + unitCanonical(x) == unitNormal(x).canonical -- always true + + recip : % -> Union(%,"failed") + recip(x) == if zero? x then "failed" else _exquo(1$%,x) + + unit? : % -> Boolean + unit?(x) == (recip x case "failed" => false; true) + + if % has canonicalUnitNormal then + + associates? : (%,%) -> Boolean + associates?(x,y) == + (unitNormal x).canonical = (unitNormal y).canonical + + else + + associates? : (%,%) -> Boolean + associates?(x,y) == + zero? x => zero? y + zero? y => false + x exquo y case "failed" => false + y exquo x case "failed" => false + true + +*) + +\end{chunk} + \begin{chunk}{INTDOM.dotabb} "INTDOM" [color=lightblue,href="bookvol10.2.pdf#nameddest=INTDOM"]; @@ -48114,6 +54564,7 @@ IntegralDomain(): Category == "INTDOM" -> "ENTIRER" \end{chunk} + \begin{chunk}{INTDOM.dotfull} "IntegralDomain()" [color=lightblue,href="bookvol10.2.pdf#nameddest=INTDOM"]; @@ -48122,6 +54573,7 @@ IntegralDomain(): Category == "IntegralDomain()" -> "EntireRing()" \end{chunk} + \begin{chunk}{INTDOM.dotpic} digraph pic { fontsize=10; @@ -48157,6 +54609,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MonogenicLinearOperator}{MLO} \pagepic{ps/v102monogeniclinearoperator.ps}{MLO}{0.60} @@ -48204,6 +54657,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{MonogenicLinearOperator.help} ==================================================================== MonogenicLinearOperator examples @@ -48368,6 +54822,7 @@ MonogenicLinearOperator(R): Category == Defn where ++ the generating operator, \spad{monomial(1,1)}. \end{chunk} + \begin{chunk}{MLO.dotabb} "MLO" [color=lightblue,href="bookvol10.2.pdf#nameddest=MLO"]; @@ -48376,6 +54831,7 @@ MonogenicLinearOperator(R): Category == Defn where "MLO" -> "ALGEBRA" \end{chunk} + \begin{chunk}{MLO.dotfull} "MonogenicLinearOperator(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=MLO"]; @@ -48384,6 +54840,7 @@ MonogenicLinearOperator(R): Category == Defn where "MonogenicLinearOperator(a:Ring)" -> "Algebra(a:CommutativeRing)" \end{chunk} + \begin{chunk}{MLO.dotpic} digraph pic { fontsize=10; @@ -48449,6 +54906,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OctonionCategory}{OC} \pagepic{ps/v102octonioncategory.ps}{OC}{1.00} @@ -48526,6 +54984,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OctonionCategory.help} ==================================================================== OctonionCategory examples @@ -48869,7 +55328,6 @@ OctonionCategory(R: CommutativeRing): Category == imagI(x),imagJ(x),imagK(x)) z := part := "i"::Symbol::OutputForm --- one? imagi(x) => part (imagi(x) = 1) => part (imagi(x) :: OutputForm) * part zero? y => z @@ -48880,7 +55338,6 @@ OctonionCategory(R: CommutativeRing): Category == imagI(x),imagJ(x),imagK(x)) z := part := "j"::Symbol::OutputForm --- one? imagj(x) => part (imagj(x) = 1) => part (imagj(x) :: OutputForm) * part zero? y => z @@ -48891,7 +55348,6 @@ OctonionCategory(R: CommutativeRing): Category == imagI(x),imagJ(x),imagK(x)) z := part := "k"::Symbol::OutputForm --- one? imagk(x) => part (imagk(x) = 1) => part (imagk(x) :: OutputForm) * part zero? y => z @@ -48902,7 +55358,6 @@ OctonionCategory(R: CommutativeRing): Category == imagI(x),imagJ(x),imagK(x)) z := part := "E"::Symbol::OutputForm --- one? imagE(x) => part (imagE(x) = 1) => part (imagE(x) :: OutputForm) * part zero? y => z @@ -48912,7 +55367,6 @@ OctonionCategory(R: CommutativeRing): Category == y := octon(0$R,0$R,0$R,0$R,0$R,0$R,imagJ(x),imagK(x)) z := part := "I"::Symbol::OutputForm --- one? imagI(x) => part (imagI(x) = 1) => part (imagI(x) :: OutputForm) * part zero? y => z @@ -48922,14 +55376,12 @@ OctonionCategory(R: CommutativeRing): Category == y := octon(0$R,0$R,0$R,0$R,0$R,0$R,0$R,imagK(x)) z := part := "J"::Symbol::OutputForm --- one? imagJ(x) => part (imagJ(x) = 1) => part (imagJ(x) :: OutputForm) * part zero? y => z z + (y :: OutputForm) -- we know that the real part,i,j,k,E,I,J parts are 0 part := "K"::Symbol::OutputForm --- one? imagK(x) => part (imagK(x) = 1) => part (imagK(x) :: OutputForm) * part @@ -48983,6 +55435,227 @@ OctonionCategory(R: CommutativeRing): Category == "failed" \end{chunk} + +\begin{chunk}{COQ OC} +(* category OC *) +(* + + characteristic : () -> NonNegativeInteger + characteristic() == + characteristic()$R + + conjugate : % -> % + conjugate x == + octon(real x, - imagi x, - imagj x, - imagk x, - imagE x,_ + - imagI x, - imagJ x, - imagK x) + + map : ((R -> R),%) -> % + map(fn, x) == + octon(fn real x,fn imagi x,fn imagj x,fn imagk x, fn imagE x,_ + fn imagI x, fn imagJ x,fn imagK x) + + norm : % -> R + norm x == + real x * real x + imagi x * imagi x + _ + imagj x * imagj x + imagk x * imagk x + _ + imagE x * imagE x + imagI x * imagI x + _ + imagJ x * imagJ x + imagK x * imagK x + + ?=? : (%,%) -> Boolean + x = y == + (real x = real y) and (imagi x = imagi y) and _ + (imagj x = imagj y) and (imagk x = imagk y) and _ + (imagE x = imagE y) and (imagI x = imagI y) and _ + (imagJ x = imagJ y) and (imagK x = imagK y) + + ?+? : (%,%) -> % + x + y == + octon(real x + real y, imagi x + imagi y,_ + imagj x + imagj y, imagk x + imagk y,_ + imagE x + imagE y, imagI x + imagI y,_ + imagJ x + imagJ y, imagK x + imagK y) + + -? : % -> % + - x == + octon(- real x, - imagi x, - imagj x, - imagk x,_ + - imagE x, - imagI x, - imagJ x, - imagK x) + + ?*? : (R,%) -> % + r:R * x:% == + octon(r * real x, r * imagi x, r * imagj x, r * imagk x,_ + r * imagE x, r * imagI x, r * imagJ x, r * imagK x) + + ?*? : (Integer,%) -> % + n:Integer * x:% == + octon(n * real x, n * imagi x, n * imagj x, n * imagk x,_ + n * imagE x, n * imagI x, n * imagJ x, n * imagK x) + + coerce : R -> % + coerce(r:R) == + octon(r,0$R,0$R,0$R,0$R,0$R,0$R,0$R) + + coerce : Integer -> % + coerce(n:Integer) == + octon(n :: R,0$R,0$R,0$R,0$R,0$R,0$R,0$R) + + zero? : % -> Boolean + zero? x == + zero? real x and zero? imagi x and _ + zero? imagj x and zero? imagk x and _ + zero? imagE x and zero? imagI x and _ + zero? imagJ x and zero? imagK x + + retract : % -> R + retract(x):R == + not (zero? imagi x and zero? imagj x and zero? imagk x and _ + zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=> + error "Cannot retract octonion." + real x + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + retractIfCan(x):Union(R,"failed") == + not (zero? imagi x and zero? imagj x and zero? imagk x and _ + zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=> + "failed" + real x + + coerce : % -> OutputForm + coerce(x:%):OutputForm == + part,z : OutputForm + y : % + zero? x => (0$R) :: OutputForm + not zero?(real x) => + y := octon(0$R,imagi(x),imagj(x),imagk(x),imagE(x), + imagI(x),imagJ(x),imagK(x)) + zero? y => real(x) :: OutputForm + (real(x) :: OutputForm) + (y :: OutputForm) + -- we know that the real part is 0 + not zero?(imagi(x)) => + y := octon(0$R,0$R,imagj(x),imagk(x),imagE(x), + imagI(x),imagJ(x),imagK(x)) + z := + part := "i"::Symbol::OutputForm + (imagi(x) = 1) => part + (imagi(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part and i part are 0 + not zero?(imagj(x)) => + y := octon(0$R,0$R,0$R,imagk(x),imagE(x), + imagI(x),imagJ(x),imagK(x)) + z := + part := "j"::Symbol::OutputForm + (imagj(x) = 1) => part + (imagj(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part and i and j parts are 0 + not zero?(imagk(x)) => + y := octon(0$R,0$R,0$R,0$R,imagE(x), + imagI(x),imagJ(x),imagK(x)) + z := + part := "k"::Symbol::OutputForm + (imagk(x) = 1) => part + (imagk(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part,i,j,k parts are 0 + not zero?(imagE(x)) => + y := octon(0$R,0$R,0$R,0$R,0$R, + imagI(x),imagJ(x),imagK(x)) + z := + part := "E"::Symbol::OutputForm + (imagE(x) = 1) => part + (imagE(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part,i,j,k,E parts are 0 + not zero?(imagI(x)) => + y := octon(0$R,0$R,0$R,0$R,0$R,0$R,imagJ(x),imagK(x)) + z := + part := "I"::Symbol::OutputForm + (imagI(x) = 1) => part + (imagI(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part,i,j,k,E,I parts are 0 + not zero?(imagJ(x)) => + y := octon(0$R,0$R,0$R,0$R,0$R,0$R,0$R,imagK(x)) + z := + part := "J"::Symbol::OutputForm + (imagJ(x) = 1) => part + (imagJ(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part,i,j,k,E,I,J parts are 0 + part := "K"::Symbol::OutputForm + (imagK(x) = 1) => part + (imagK(x) :: OutputForm) * part + + if R has Field then + + inv : % -> % + inv x == + (norm x) = 0 => error "This octonion is not invertible." + (inv norm x) * conjugate x + + if R has ConvertibleTo InputForm then + + convert : % -> InputForm + convert(x:%):InputForm == + l : List InputForm := [convert("octon" :: Symbol), + convert(real x)$R, convert(imagi x)$R, convert(imagj x)$R,_ + convert(imagk x)$R, convert(imagE x)$R,_ + convert(imagI x)$R, convert(imagJ x)$R,_ + convert(imagK x)$R] + convert(l)$InputForm + + if R has OrderedSet then + + ? Boolean + x < y == + real x = real y => + imagi x = imagi y => + imagj x = imagj y => + imagk x = imagk y => + imagE x = imagE y => + imagI x = imagI y => + imagJ x = imagJ y => + imagK x < imagK y + imagJ x < imagJ y + imagI x < imagI y + imagE x < imagE y + imagk x < imagk y + imagj x < imagj y + imagi x < imagi y + real x < real y + + if R has RealNumberSystem then + + abs : % -> R + abs x == sqrt norm x + + if R has IntegerNumberSystem then + + rational? : % -> Boolean + rational? x == + (zero? imagi x) and (zero? imagj x) and (zero? imagk x) and _ + (zero? imagE x) and (zero? imagI x) and (zero? imagJ x) and _ + (zero? imagK x) + + rational : % -> Fraction(Integer) + rational x == + rational? x => rational real x + error "Not a rational number" + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + rationalIfCan x == + rational? x => rational real x + "failed" +*) + +\end{chunk} + \begin{chunk}{OC.dotabb} "OC" [color=lightblue,href="bookvol10.2.pdf#nameddest=OC"]; @@ -48991,6 +55664,7 @@ OctonionCategory(R: CommutativeRing): Category == "OC" -> "FRETRCT" \end{chunk} + \begin{chunk}{OC.dotfull} "OctonionCategory(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=OC"]; @@ -49000,6 +55674,7 @@ OctonionCategory(R: CommutativeRing): Category == "FullyRetractableTo(a:CommutativeRing)" \end{chunk} + \begin{chunk}{OC.dotpic} digraph pic { fontsize=10; @@ -49017,6 +55692,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{QuaternionCategory}{QUATCAT} \pagepic{ps/v102quaternioncategory.ps}{QUATCAT}{0.70} @@ -49110,6 +55786,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{QuaternionCategory.help} ==================================================================== QuaternionCategory examples @@ -49432,7 +56109,6 @@ QuaternionCategory(R: CommutativeRing): Category == quatern(n :: R,0$R,0$R,0$R) one? x == --- one? real x and zero? imagI x and (real x) = 1 and zero? imagI x and zero? imagJ x and zero? imagK x @@ -49463,7 +56139,6 @@ QuaternionCategory(R: CommutativeRing): Category == y := quatern(0$R,0$R,imagJ(x),imagK(x)) z := part := "i"::Symbol::OutputForm --- one? imagI(x) => part (imagI(x) = 1) => part (imagI(x) :: OutputForm) * part zero? y => z @@ -49473,14 +56148,12 @@ QuaternionCategory(R: CommutativeRing): Category == y := quatern(0$R,0$R,0$R,imagK(x)) z := part := "j"::Symbol::OutputForm --- one? imagJ(x) => part (imagJ(x) = 1) => part (imagJ(x) :: OutputForm) * part zero? y => z z + (y :: OutputForm) -- we know that the real part and i and j parts are 0 part := "k"::Symbol::OutputForm --- one? imagK(x) => part (imagK(x) = 1) => part (imagK(x) :: OutputForm) * part @@ -49522,6 +56195,173 @@ QuaternionCategory(R: CommutativeRing): Category == "failed" \end{chunk} + +\begin{chunk}{COQ QUATCAT} +(* category QUATCAT *) +(* + + characteristic : () -> NonNegativeInteger + characteristic() == + characteristic()$R + + conjugate : % -> % + conjugate x == + quatern(real x, - imagI x, - imagJ x, - imagK x) + + map : ((R -> R),%) -> % + map(fn, x) == + quatern(fn real x, fn imagI x, fn imagJ x, fn imagK x) + + norm : % -> R + norm x == + real x * real x + imagI x * imagI x + + imagJ x * imagJ x + imagK x * imagK x + + ?=? : (%,%) -> Boolean + x = y == + (real x = real y) and (imagI x = imagI y) and + (imagJ x = imagJ y) and (imagK x = imagK y) + + ?+? : (%,%) -> % + x + y == + quatern(real x + real y, imagI x + imagI y, + imagJ x + imagJ y, imagK x + imagK y) + + ?-? : (%,%) -> % + x - y == + quatern(real x - real y, imagI x - imagI y, + imagJ x - imagJ y, imagK x - imagK y) + + -? : % -> % + - x == + quatern(- real x, - imagI x, - imagJ x, - imagK x) + + ?*? : (R,%) -> % + r:R * x:$ == + quatern(r * real x, r * imagI x, r * imagJ x, r * imagK x) + + ?*? : (Integer,%) -> % + n:Integer * x:$ == + quatern(n * real x, n * imagI x, n * imagJ x, n * imagK x) + + differentiate : (%,(R -> R)) -> % + differentiate(x:$, d:R -> R) == + quatern(d real x, d imagI x, d imagJ x, d imagK x) + + coerce : R -> % + coerce(r:R) == + quatern(r,0$R,0$R,0$R) + + coerce : Integer -> % + coerce(n:Integer) == + quatern(n :: R,0$R,0$R,0$R) + + one? : % -> Boolean + one? x == + (real x) = 1 and zero? imagI x and + zero? imagJ x and zero? imagK x + + zero? : % -> Boolean + zero? x == + zero? real x and zero? imagI x and + zero? imagJ x and zero? imagK x + + retract : % -> R + retract(x):R == + not (zero? imagI x and zero? imagJ x and zero? imagK x) => + error "Cannot retract quaternion." + real x + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + retractIfCan(x):Union(R,"failed") == + not (zero? imagI x and zero? imagJ x and zero? imagK x) => + "failed" + real x + + coerce : % -> OutputForm + coerce(x:$):OutputForm == + part,z : OutputForm + y : $ + zero? x => (0$R) :: OutputForm + not zero?(real x) => + y := quatern(0$R,imagI(x),imagJ(x),imagK(x)) + zero? y => real(x) :: OutputForm + (real(x) :: OutputForm) + (y :: OutputForm) + -- we know that the real part is 0 + not zero?(imagI(x)) => + y := quatern(0$R,0$R,imagJ(x),imagK(x)) + z := + part := "i"::Symbol::OutputForm + (imagI(x) = 1) => part + (imagI(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part and i part are 0 + not zero?(imagJ(x)) => + y := quatern(0$R,0$R,0$R,imagK(x)) + z := + part := "j"::Symbol::OutputForm + (imagJ(x) = 1) => part + (imagJ(x) :: OutputForm) * part + zero? y => z + z + (y :: OutputForm) + -- we know that the real part and i and j parts are 0 + part := "k"::Symbol::OutputForm + (imagK(x) = 1) => part + (imagK(x) :: OutputForm) * part + + if R has Field then + + inv : % -> % + inv x == + norm x = 0 => error "This quaternion is not invertible." + (inv norm x) * conjugate x + + if R has ConvertibleTo InputForm then + + convert : % -> InputForm + convert(x:$):InputForm == + l : List InputForm := [convert("quatern" :: Symbol), + convert(real x)$R, convert(imagI x)$R, convert(imagJ x)$R, + convert(imagK x)$R] + convert(l)$InputForm + + if R has OrderedSet then + + ? Boolean + x < y == + real x = real y => + imagI x = imagI y => + imagJ x = imagJ y => + imagK x < imagK y + imagJ x < imagJ y + imagI x < imagI y + real x < real y + + if R has RealNumberSystem then + + abs : % -> R + abs x == sqrt norm x + + if R has IntegerNumberSystem then + + rational? : % -> Boolean + rational? x == + (zero? imagI x) and (zero? imagJ x) and (zero? imagK x) + + rational : % -> Fraction(Integer) + rational x == + rational? x => rational real x + error "Not a rational number" + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + rationalIfCan x == + rational? x => rational real x + "failed" +*) + +\end{chunk} + \begin{chunk}{QUATCAT.dotabb} "QUATCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=QUATCAT"]; @@ -49532,6 +56372,7 @@ QuaternionCategory(R: CommutativeRing): Category == "QUATCAT" -> "FRETRCT" \end{chunk} + \begin{chunk}{QUATCAT.dotfull} "QuaternionCategory(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=QUATCAT"]; @@ -49547,6 +56388,7 @@ QuaternionCategory(R: CommutativeRing): Category == "FullyRetractableTo(a:CommutativeRing)" \end{chunk} + \begin{chunk}{QUATCAT.dotpic} digraph pic { fontsize=10; @@ -49568,6 +56410,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{SquareMatrixCategory}{SMATCAT} \pagepic{ps/v102squarematrixcategory.ps}{SMATCAT}{0.25} @@ -49687,6 +56530,7 @@ The SquareMatrix domain is for square matrices of fixed dimension. )spool )lisp (bye) \end{chunk} + \begin{chunk}{SquareMatrixCategory.help} ==================================================================== SquareMatrixCategory examples @@ -50020,7 +56864,6 @@ SquareMatrixCategory(ndim,R,Row,Col): Category == Definition where positivePower:(%,Integer) -> % positivePower(x,n) == --- one? n => x (n = 1) => x odd? n => x * positivePower(x,n - 1) y := positivePower(x,n quo 2) @@ -50094,6 +56937,105 @@ SquareMatrixCategory(ndim,R,Row,Col): Category == Definition where positivePower(xInv :: %,-n) \end{chunk} + +\begin{chunk}{COQ SMATCAT} +(* category SMATCAT *) +(* + minr ==> minRowIndex + maxr ==> maxRowIndex + minc ==> minColIndex + maxc ==> maxColIndex + mini ==> minIndex + maxi ==> maxIndex + + positivePower:(%,Integer) -> % + positivePower(x,n) == + (n = 1) => x + odd? n => x * positivePower(x,n - 1) + y := positivePower(x,n quo 2) + y * y + + ?**? : (%,NonNegativeInteger) -> % + x:% ** n:NonNegativeInteger == + zero? n => scalarMatrix 1 + positivePower(x,n) + + coerce : R -> % + coerce(r:R) == scalarMatrix r + + differentiate : (%,(R -> R)) -> % + differentiate(x:%,d:R -> R) == map(d,x) + + diagonal : % -> Row + diagonal x == + v:Vector(R) := new(ndim,0) + for i in minr x .. maxr x + for j in minc x .. maxc x + for k in minIndex v .. maxIndex v repeat + qsetelt_!(v, k, qelt(x, i, j)) + directProduct v + + retract : % -> R + retract(x:%):R == + diagonal? x => retract diagonal x + error "Not retractable" + + retractIfCan : % -> Union(R,"failed") + retractIfCan(x:%):Union(R, "failed") == + diagonal? x => retractIfCan diagonal x + "failed" + + equation2R: Vector % -> Matrix R + equation2R v == + ans:Matrix(Col) := new(ndim,#v,0) + for i in minr ans .. maxr ans repeat + for j in minc ans .. maxc ans repeat + qsetelt_!(ans, i, j, column(qelt(v, j), i)) + reducedSystem ans + + reducedSystem : Matrix(%) -> Matrix(Integer) + reducedSystem(x:Matrix %):Matrix(R) == + empty? x => new(0,0,0) + reduce(vertConcat, [equation2R row(x, i) + for i in minr x .. maxr x])$List(Matrix R) + + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(R),vec: Vector(R)) + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix R, vec:Vector R) == + vh:Vector(R) := + empty? v => new(0,0) + rh := reducedSystem(v::Matrix %)@Matrix(R) + column(rh, minColIndex rh) + [reducedSystem(m)@Matrix(R), vh] + + trace : % -> R + trace x == + tr : R := 0 + for i in minr(x)..maxr(x) for j in minc(x)..maxc(x) repeat + tr := tr + x(i,j) + tr + + diagonalProduct : % -> R + diagonalProduct x == + pr : R := 1 + for i in minr(x)..maxr(x) for j in minc(x)..maxc(x) repeat + pr := pr * x(i,j) + pr + + if R has Field then + + ?**? : (%,Integer) -> % + x:% ** n:Integer == + zero? n => scalarMatrix 1 + positive? n => positivePower(x,n) + (xInv := inverse x) case "failed" => + error "**: matrix must be invertible" + positivePower(xInv :: %,-n) +*) + +\end{chunk} + \begin{chunk}{SMATCAT.dotabb} "SMATCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=SMATCAT"]; @@ -50119,6 +57061,7 @@ SquareMatrixCategory(ndim,R,Row,Col): Category == Definition where -> "RectangularMatrixCategory(a:NonNegativeInteger,b:NonNegativeInteger,c:Ring,d:DirectProductCategory(b,c),e:DirectProductCategory(a,c))" \end{chunk} + \begin{chunk}{SMATCAT.dotpic} digraph pic { fontsize=10; @@ -50202,6 +57145,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{XPolynomialsCat}{XPOLYC} \pagepic{ps/v102xpolynomialscat.ps}{XPOLYC}{0.50} @@ -50263,6 +57207,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{XPolynomialsCat.help} ==================================================================== XPolynomialsCat examples @@ -50438,12 +57383,14 @@ XPolynomialsCat(vl:OrderedSet,R:Ring):Category == Export where ++ at order \spad{n}. \end{chunk} + \begin{chunk}{XPOLYC.dotabb} "XPOLYC" [color=lightblue,href="bookvol10.2.pdf#nameddest=XPOLYC"]; "XPOLYC" -> "XFALG" \end{chunk} + \begin{chunk}{XPOLYC.dotfull} "XPolynomialsCat(a:OrderedRing,b:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=XPOLYC"]; @@ -50451,6 +57398,7 @@ XPolynomialsCat(vl:OrderedSet,R:Ring):Category == Export where "XFreeAlgebra(a:OrderedSet,b:Ring)" \end{chunk} + \begin{chunk}{XPOLYC.dotpic} digraph pic { fontsize=10; @@ -50521,6 +57469,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 12} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AbelianMonoidRing}{AMR} @@ -50578,6 +57527,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AbelianMonoidRing.help} ==================================================================== AbelianMonoidRing examples @@ -50801,6 +57751,31 @@ AbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == q:Fraction(Integer) * p:% == map(x1 +-> q * x1, p) \end{chunk} + +\begin{chunk}{COQ AMR} +(* category AMR *) +(* + + monomial? : % -> Boolean + monomial? x == zero? reductum x + + map : ((R -> R),%) -> % + map(fn:R -> R, x: %) == + -- this default definition assumes that reductum is cheap + zero? x => 0 + r:=fn leadingCoefficient x + zero? r => map(fn,reductum x) + monomial(r, degree x) + map(fn,reductum x) + + if R has Algebra Fraction Integer then + + ?*? : (Integer,%) -> % + q:Fraction(Integer) * p:% == map(x1 +-> q * x1, p) + +*) + +\end{chunk} + \begin{chunk}{AMR.dotabb} "AMR" [color=lightblue,href="bookvol10.2.pdf#nameddest=AMR"]; @@ -50812,6 +57787,7 @@ AbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == "AMR" -> "ALGEBRA" \end{chunk} + \begin{chunk}{AMR.dotfull} "AbelianMonoidRing(a:Ring,b:OrderedAbelianMonoid)" [color=lightblue,href="bookvol10.2.pdf#nameddest=AMR"]; @@ -50828,6 +57804,7 @@ AbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == "Algebra(Fraction(Integer))" \end{chunk} + \begin{chunk}{AMR.dotpic} digraph pic { fontsize=10; @@ -50879,6 +57856,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FortranMachineTypeCategory}{FMTC} \pagepic{ps/v102fortranmachinetypecategory.ps}{FMTC}{0.40} @@ -50929,6 +57907,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FortranMachineTypeCategory.help} ==================================================================== FortranMachineTypeCategory examples @@ -51073,6 +58052,7 @@ FortranMachineTypeCategory():Category == Join(IntegralDomain,OrderedSet, "FMTC" -> "RETRACT" \end{chunk} + \begin{chunk}{FMTC.dotfull} "FortranMachineTypeCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FMTC"]; @@ -51081,6 +58061,7 @@ FortranMachineTypeCategory():Category == Join(IntegralDomain,OrderedSet, "FortranMachineTypeCategory()" -> "RetractableTo(Integer)" \end{chunk} + \begin{chunk}{FMTC.dotpic} digraph pic { fontsize=10; @@ -51149,6 +58130,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FramedNonAssociativeAlgebra}{FRNAALG} \pagepic{ps/v102framednonassociativealgebra.ps}{FRNAALG}{0.75} @@ -51237,6 +58219,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FramedNonAssociativeAlgebra.help} ==================================================================== FramedNonAssociativeAlgebra examples @@ -51768,12 +58751,257 @@ FramedNonAssociativeAlgebra(R:CommutativeRing): m \end{chunk} + +\begin{chunk}{COQ FRNAALG} +(* category FRNAALG *) +(* + + V ==> Vector + M ==> Matrix + P ==> Polynomial + F ==> Fraction + REC ==> Record(particular: Union(V R,"failed"),basis: List V R) + LSMP ==> LinearSystemMatrixPackage(R,V R,V R, M R) + CVMP ==> CoerceVectorMatrixPackage(R) + + --GA ==> GenericNonAssociativeAlgebra(R,rank()$%,_ + -- [random()$Character :: String :: Symbol for i in 1..rank()$%], _ + -- structuralConstants()$%) + --y : GA := generic() + if R has Field then + + leftRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(R)) + leftRankPolynomial() == + n := rank() + b := basis() + gamma : Vector Matrix R := structuralConstants b + listOfNumbers : List String:= [PRINC_-TO_-STRING(q)$Lisp for q in 1..n] + symbolsForCoef : Vector Symbol := + [concat("%", concat("x", i))::Symbol for i in listOfNumbers] + xx : M P R + mo : P R + x : M P R := new(1,n,0) + for i in 1..n repeat + mo := monomial(1, [symbolsForCoef.i], [1])$(P R) + qsetelt_!(x,1,i,mo) + y : M P R := copy x + k : PositiveInteger := 1 + cond : M P R := copy x + -- multiplication in the generic algebra means using + -- the structural matrices as bilinear forms. + -- left multiplication by x, we prepare for that: + genGamma : V M P R := coerceP$CVMP gamma + x := reduce(horizConcat,[x*genGamma(i) for i in 1..#genGamma]) + while rank(cond) = k repeat + k := k+1 + for i in 1..n repeat + setelt(xx,[1],[i],x*transpose y) + y := copy xx + cond := horizConcat(cond, xx) + vectorOfCoef : Vector P R := (nullSpace(cond)$Matrix(P R)).first + res : SparseUnivariatePolynomial P R := 0 + for i in 1..k repeat + res:=res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial P R) + res + + rightRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(R)) + rightRankPolynomial() == + n := rank() + b := basis() + gamma : Vector Matrix R := structuralConstants b + listOfNumbers : List String :=[PRINC_-TO_-STRING(q)$Lisp for q in 1..n] + symbolsForCoef : Vector Symbol := + [concat("%", concat("x", i))::Symbol for i in listOfNumbers] + xx : M P R + mo : P R + x : M P R := new(1,n,0) + for i in 1..n repeat + mo := monomial(1, [symbolsForCoef.i], [1])$(P R) + qsetelt_!(x,1,i,mo) + y : M P R := copy x + k : PositiveInteger := 1 + cond : M P R := copy x + -- multiplication in the generic algebra means using + -- the structural matrices as bilinear forms. + -- left multiplication by x, we prepare for that: + genGamma : V M P R := coerceP$CVMP gamma + x := _ + reduce(horizConcat,[genGamma(i)*transpose x for i in 1..#genGamma]) + while rank(cond) = k repeat + k := k+1 + for i in 1..n repeat + setelt(xx,[1],[i],y * transpose x) + y := copy xx + cond := horizConcat(cond, xx) + vectorOfCoef : Vector P R := (nullSpace(cond)$Matrix(P R)).first + res : SparseUnivariatePolynomial P R := 0 + for i in 1..k repeat + res := _ + res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial P R) + res + + leftUnitsInternal : () -> REC + leftUnitsInternal() == + n := rank() + b := basis() + gamma : Vector Matrix R := structuralConstants b + cond : Matrix(R) := new(n**2,n,0$R)$Matrix(R) + rhs : Vector(R) := new(n**2,0$R)$Vector(R) + z : Integer := 0 + addOn : R := 0 + for k in 1..n repeat + for i in 1..n repeat + z := z+1 -- index for the rows + addOn := + k=i => 1 + 0 + setelt(rhs,z,addOn)$Vector(R) + for j in 1..n repeat -- index for the columns + setelt(cond,z,j,elt(gamma.k,j,i))$Matrix(R) + solve(cond,rhs)$LSMP + + + leftUnit : () -> Union(%,"failed") + leftUnit() == + res : REC := leftUnitsInternal() + res.particular case "failed" => + messagePrint("this algebra has no left unit")$OutputForm + "failed" + represents (res.particular :: V R) + + leftUnits : () -> Union(Record(particular: %,basis: List(%)),"failed") + leftUnits() == + res : REC := leftUnitsInternal() + res.particular case "failed" => + messagePrint("this algebra has no left unit")$OutputForm + "failed" + [represents(res.particular :: V R)$%, _ + map(represents, res.basis)$ListFunctions2(Vector R, %) ] + + rightUnitsInternal : () -> REC + rightUnitsInternal() == + n := rank() + b := basis() + gamma : Vector Matrix R := structuralConstants b + condo : Matrix(R) := new(n**2,n,0$R)$Matrix(R) + rhs : Vector(R) := new(n**2,0$R)$Vector(R) + z : Integer := 0 + addOn : R := 0 + for k in 1..n repeat + for i in 1..n repeat + z := z+1 -- index for the rows + addOn := + k=i => 1 + 0 + setelt(rhs,z,addOn)$Vector(R) + for j in 1..n repeat -- index for the columns + setelt(condo,z,j,elt(gamma.k,i,j))$Matrix(R) + solve(condo,rhs)$LSMP + + rightUnit : () -> Union(%,"failed") + rightUnit() == + res : REC := rightUnitsInternal() + res.particular case "failed" => + messagePrint("this algebra has no right unit")$OutputForm + "failed" + represents (res.particular :: V R) + + rightUnits : () -> Union(Record(particular: %,basis: List(%)),"failed") + rightUnits() == + res : REC := rightUnitsInternal() + res.particular case "failed" => + messagePrint("this algebra has no right unit")$OutputForm + "failed" + [represents(res.particular :: V R)$%, _ + map(represents, res.basis)$ListFunctions2(Vector R, %) ] + + unit : () -> Union(%,"failed") + unit() == + n := rank() + b := basis() + gamma : Vector Matrix R := structuralConstants b + cond : Matrix(R) := new(2*n**2,n,0$R)$Matrix(R) + rhs : Vector(R) := new(2*n**2,0$R)$Vector(R) + z : Integer := 0 + u : Integer := n*n + addOn : R := 0 + for k in 1..n repeat + for i in 1..n repeat + z := z+1 -- index for the rows + addOn := + k=i => 1 + 0 + setelt(rhs,z,addOn)$Vector(R) + setelt(rhs,u,addOn)$Vector(R) + for j in 1..n repeat -- index for the columns + setelt(cond,z,j,elt(gamma.k,j,i))$Matrix(R) + setelt(cond,u,j,elt(gamma.k,i,j))$Matrix(R) + res : REC := solve(cond,rhs)$LSMP + res.particular case "failed" => + messagePrint("this algebra has no unit")$OutputForm + "failed" + represents (res.particular :: V R) + + apply : (Matrix(R),%) -> % + apply(m:Matrix(R),a:%) == + v : Vector R := coordinates(a) + v := m *$Matrix(R) v + convert v + + structuralConstants : () -> Vector(Matrix(R)) + structuralConstants() == structuralConstants basis() + + conditionsForIdempotents : () -> List(Polynomial(R)) + conditionsForIdempotents() == conditionsForIdempotents basis() + + convert : % -> Vector(R) + convert(x:%):Vector(R) == coordinates(x, basis()) + + convert : Vector(R) -> % + convert(v:Vector R):% == represents(v, basis()) + + leftTraceMatrix : () -> Matrix(R) + leftTraceMatrix() == leftTraceMatrix basis() + + rightTraceMatrix : () -> Matrix(R) + rightTraceMatrix() == rightTraceMatrix basis() + + leftDiscriminant : () -> R + leftDiscriminant() == leftDiscriminant basis() + + rightDiscriminant : Vector(%) -> R + rightDiscriminant() == rightDiscriminant basis() + + leftRegularRepresentation : % -> Matrix(R) + leftRegularRepresentation x == leftRegularRepresentation(x, basis()) + + rightRegularRepresentation : % -> Matrix(R) + rightRegularRepresentation x == rightRegularRepresentation(x, basis()) + + coordinates : % -> Vector(R) + coordinates x == coordinates(x, basis()) + + represents : Vector(R) -> % + represents(v:Vector R):%== represents(v, basis()) + + coordinates : Vector(%) -> Matrix(R) + coordinates(v:Vector %) == + m := new(#v, rank(), 0)$Matrix(R) + for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat + setRow_!(m, j, coordinates qelt(v, i)) + m + +*) + +\end{chunk} + \begin{chunk}{FRNAALG.dotabb} "FRNAALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FRNAALG"]; "FRNAALG" -> "FINAALG" \end{chunk} + \begin{chunk}{FRNAALG.dotfull} "FramedNonAssociativeAlgebra(a:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FRNAALG"]; @@ -51781,6 +59009,7 @@ FramedNonAssociativeAlgebra(R:CommutativeRing): "FiniteRankNonAssociativeAlgebra(a:CommutativeRing)" \end{chunk} + \begin{chunk}{FRNAALG.dotpic} digraph pic { fontsize=10; @@ -51885,6 +59114,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{GcdDomain.help} ==================================================================== GcdDomain examples @@ -52077,18 +59307,75 @@ GcdDomain(): Category == Join(IntegralDomain, LeftOreRing) with [cc1*c1, cc1, cc2] \end{chunk} + +\begin{chunk}{COQ GCDDOM} +(* category GCDDOM *) +(* + + lcm : (%,%) -> % + lcm(x: %,y: %) == + y = 0 => 0 + x = 0 => 0 + LCM : Union(%,"failed") := y exquo gcd(x,y) + LCM case % => x * LCM + error "bad gcd in lcm computation" + + lcm : List(%) -> % + lcm(l:List %) == reduce(lcm,l,1,0) + + gcd : List(%) -> % + gcd(l:List %) == reduce(gcd,l,0,1) + + SUP ==> SparseUnivariatePolynomial + + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) + gcdPolynomial(p1,p2) == + zero? p1 => unitCanonical p2 + zero? p2 => unitCanonical p1 + c1:= content(p1); c2:= content(p2) + p1:= (p1 exquo c1)::SUP % + p2:= (p2 exquo c2)::SUP % + if (e1:=minimumDegree p1) > 0 then p1:=(p1 exquo monomial(1,e1))::SUP % + if (e2:=minimumDegree p2) > 0 then p2:=(p2 exquo monomial(1,e2))::SUP % + e1:=min(e1,e2); c1:=gcd(c1,c2) + p1:= + degree p1 = 0 or degree p2 = 0 => monomial(c1,0) + p:= subResultantGcd(p1,p2) + degree p = 0 => monomial(c1,0) + c2:= gcd(leadingCoefficient p1,leadingCoefficient p2) + unitCanonical(_ + c1 * primitivePart(((c2*p) exquo leadingCoefficient p)::SUP %)) + zero? e1 => p1 + monomial(1,e1)*p1 + + -- See [Delenclos 06], [Bronstein 96a] + lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) + lcmCoef(c1, c2) == + g := gcd(c1, c2) + cc1 := (c2 exquo g)::% + cc2 := (c1 exquo g)::% + [cc1*c1, cc1, cc2] + +*) + +\end{chunk} + \begin{chunk}{GCDDOM.dotabb} "GCDDOM" [color=lightblue,href="bookvol10.2.pdf#nameddest=GCDDOM"]; "GCDDOM" -> "INTDOM" \end{chunk} + \begin{chunk}{GCDDOM.dotfull} "GcdDomain()" [color=lightblue,href="bookvol10.2.pdf#nameddest=GCDDOM"]; "GcdDomain()" -> "IntegralDomain()" \end{chunk} + \begin{chunk}{GCDDOM.dotpic} digraph pic { fontsize=10; @@ -52127,6 +59414,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{OrderedIntegralDomain}{OINTDOM} \pagepic{ps/v102orderedintegraldomain.ps}{OINTDOM}{0.45} @@ -52177,6 +59465,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{OrderedIntegralDomain.help} ==================================================================== OrderedIntegralDomain examples @@ -52313,6 +59602,7 @@ OrderedIntegralDomain(): Category == Join(IntegralDomain, OrderedRing) \end{chunk} + \begin{chunk}{OINTDOM.dotabb} "OINTDOM" [color=lightblue,href="bookvol10.2.pdf#nameddest=OINTDOM"]; @@ -52320,6 +59610,7 @@ OrderedIntegralDomain(): Category == "OINTDOM" -> "ORDRING" \end{chunk} + \begin{chunk}{OINTDOM.dotfull} "OrderedIntegralDomain()" [color=lightblue,href="bookvol10.2.pdf#nameddest=OINTDOM"]; @@ -52327,6 +59618,7 @@ OrderedIntegralDomain(): Category == "OrderedIntegralDomain()" -> "OrderedRing()" \end{chunk} + \begin{chunk}{OINTDOM.dotpic} digraph pic { fontsize=10; @@ -52374,6 +59666,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 13} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteAbelianMonoidRing}{FAMR} @@ -52444,6 +59737,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FiniteAbelianMonoidRing.help} ==================================================================== FiniteAbelianMonoidRing examples @@ -52722,7 +60016,6 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == zero? x => 0 r:=leadingCoefficient x x:=reductum x --- while not zero? x and not one? r repeat while not zero? x and not (r = 1) repeat r:=gcd(r,leadingCoefficient x) x:=reductum x @@ -52734,6 +60027,91 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == unitCanonical((x exquo c)::%) \end{chunk} + +\begin{chunk}{COQ FAMR} +(* category FAMR *) +(* + + pomopo! : (%,R,E,%) -> % + pomopo!(p1,r,e,p2) == p1 + r * mapExponents(x1+->x1+e,p2) + + if R has CommutativeRing then + + binomThmExpt : (%,%,NonNegativeInteger) -> % + binomThmExpt(x,y,nn) == + nn = 0 => 1$% + ans,xn,yn: % + bincoef: Integer + powl: List(%):= [x] + for i in 2..nn repeat powl:=[x * powl.first, :powl] + yn:=y; ans:=powl.first; i:=1; bincoef:=nn + for xn in powl.rest repeat + ans:= bincoef * xn * yn + ans + bincoef:= (nn-i) * bincoef quo (i+1); i:= i+1 + -- last I and BINCOEF unused + yn:= y * yn + ans + yn + + ground? : % -> Boolean + ground? x == + retractIfCan(x)@Union(R,"failed") case "failed" => false + true + + ground : % -> R + ground x == retract(x)@R + + mapExponents : ((E -> E),%) -> % + mapExponents (fn:E -> E, x: %) == + -- this default definition assumes that reductum is cheap + zero? x => 0 + monomial(leadingCoefficient x,fn degree x)+mapExponents(fn,reductum x) + + coefficients : % -> List(R) + coefficients x == + zero? x => empty() + concat(leadingCoefficient x, coefficients reductum x) + + if R has Field then + + ?/? : (%,R) -> % + x/r == map(x1+->x1/r,x) + + if R has IntegralDomain then + + exquo : (%,R) -> Union(%,"failed") + x exquo r == + -- probably not a very good definition in most special cases + zero? x => 0 + ans:% :=0 + t:=leadingCoefficient x exquo r + while not (t case "failed") and not zero? x repeat + ans:=ans+monomial(t::R,degree x) + x:=reductum x + if not zero? x then t:=leadingCoefficient x exquo r + t case "failed" => "failed" + ans + + if R has GcdDomain then + + content : % -> R + content x == -- this assumes reductum is cheap + zero? x => 0 + r:=leadingCoefficient x + x:=reductum x + while not zero? x and not (r = 1) repeat + r:=gcd(r,leadingCoefficient x) + x:=reductum x + r + + primitivePart : % -> % + primitivePart x == + zero? x => x + c := content x + unitCanonical((x exquo c)::%) +*) + +\end{chunk} + \begin{chunk}{FAMR.dotabb} "FAMR" [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMR"]; @@ -52741,6 +60119,7 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == "FAMR" -> "FRETRCT" \end{chunk} + \begin{chunk}{FAMR.dotfull} "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoid)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMR"]; @@ -52755,6 +60134,7 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoid)" \end{chunk} + \begin{chunk}{FAMR.dotpic} digraph pic { fontsize=10; @@ -52821,6 +60201,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{IntervalCategory}{INTCAT} \pagepic{ps/v102intervalcategory.ps}{INTCAT}{0.60} @@ -52895,6 +60276,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{IntervalCategory.help} ==================================================================== IntervalCategory examples @@ -53167,6 +60549,7 @@ IntervalCategory(R: Join(FloatingPointSystem,TranscendentalFunctionCategory)): ++ interval \axiom{i}, false otherwise. \end{chunk} + \begin{chunk}{INTCAT.dotabb} "INTCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=INTCAT"]; @@ -53177,6 +60560,7 @@ IntervalCategory(R: Join(FloatingPointSystem,TranscendentalFunctionCategory)): "INTCAT" -> "TRANFUN" \end{chunk} + \begin{chunk}{INTCAT.dotfull} "IntervalCategory(a:Join(FloatingPointSystem,TranscendentalFunctionCategory))" [color=lightblue,href="bookvol10.2.pdf#nameddest=INTCAT"]; @@ -53192,6 +60576,7 @@ IntervalCategory(R: Join(FloatingPointSystem,TranscendentalFunctionCategory)): -> "RetractableTo(Integer)" \end{chunk} + \begin{chunk}{INTCAT.dotpic} digraph pic { fontsize=10; @@ -53247,6 +60632,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PowerSeriesCategory}{PSCAT} \pagepic{ps/v102powerseriescategory.ps}{PSCAT}{0.60} @@ -53307,6 +60693,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PowerSeriesCategory.help} ==================================================================== PowerSeriesCategory examples @@ -53509,12 +60896,47 @@ PowerSeriesCategory(Coef,Expon,Var): Category == Definition where ps:% / r:Coef == map((r1:Coef):Coef +-> r1 / r,ps) \end{chunk} + +\begin{chunk}{COQ PSCAT} +(* category PSCAT *) +(* + + ?*? : (Integer,%) -> % + n:I * ps:% == (zero? n => 0; map((r1:Coef):Coef +-> n * r1,ps)) + + ?*? : (Coef,%) -> % + r:Coef * ps:% == (zero? r => 0; map((r1:Coef):Coef +-> r * r1,ps)) + + ?*? : (%,Coef) -> % + ps:% * r:Coef == (zero? r => 0; map((r1:Coef):Coef +-> r1 * r,ps)) + + -? : % -> % + - ps == map((r1:Coef):Coef +-> -r1,ps) + + if Coef has Algebra Fraction Integer then + + ?*? : (Fraction(Integer),%) -> % + r:RN * ps:% == (zero? r => 0; map((r1:Coef):Coef +-> r * r1,ps)) + + ?*? : (%,Fraction(Integer)) -> % + ps:% * r:RN == (zero? r => 0; map((r1:Coef):Coef +-> r1 * r,ps)) + + if Coef has Field then + + ?/? : (%,Coef) -> % + ps:% / r:Coef == map((r1:Coef):Coef +-> r1 / r,ps) + +*) + +\end{chunk} + \begin{chunk}{PSCAT.dotabb} "PSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCAT"]; "PSCAT" -> "AMR" \end{chunk} + \begin{chunk}{PSCAT.dotfull} "PowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid,c:OrderedSet)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCAT"]; @@ -53532,6 +60954,7 @@ PowerSeriesCategory(Coef,Expon,Var): Category == Definition where -> "PowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid,c:OrderedSet)" \end{chunk} + \begin{chunk}{PSCAT.dotpic} digraph pic { fontsize=10; @@ -53588,6 +61011,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PrincipalIdealDomain}{PID} \pagepic{ps/v102principalidealdomain.ps}{PID}{0.65} @@ -53639,6 +61063,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PrincipalIdealDomain.help} ==================================================================== PrincipalIdealDomain examples @@ -53785,18 +61210,21 @@ PrincipalIdealDomain(): Category == GcdDomain with ++ is not in the ideal generated by the fi. \end{chunk} + \begin{chunk}{PID.dotabb} "PID" [color=lightblue,href="bookvol10.2.pdf#nameddest=PID"]; "PID" -> "GCDDOM" \end{chunk} + \begin{chunk}{PID.dotfull} "PrincipalIdealDomain()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PID"]; "PrincipalIdealDomain()" -> "GcdDomain()" \end{chunk} + \begin{chunk}{PID.dotpic} digraph pic { fontsize=10; @@ -53838,6 +61266,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UniqueFactorizationDomain}{UFD} \pagepic{ps/v102uniquefactorizationdomain.ps}{UFD}{0.65} @@ -53889,6 +61318,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UniqueFactorizationDomain.help} ==================================================================== UniqueFactorizationDomain examples @@ -54049,18 +61479,36 @@ UniqueFactorizationDomain(): Category == GcdDomain with prime? x == # factorList factor x = 1 \end{chunk} + +\begin{chunk}{COQ UFD} +(* category UFD *) +(* + + squareFreePart : % -> % + squareFreePart x == + unit(s := squareFree x) * _*/[f.factor for f in factors s] + + prime? : % -> Boolean + prime? x == # factorList factor x = 1 + +*) + +\end{chunk} + \begin{chunk}{UFD.dotabb} "UFD" [color=lightblue,href="bookvol10.2.pdf#nameddest=UFD"]; "UFD" -> "GCDDOM" \end{chunk} + \begin{chunk}{UFD.dotfull} "UniqueFactorizationDomain()" [color=lightblue,href="bookvol10.2.pdf#nameddest=UFD"]; "UniqueFactorizationDomain()" -> "GcdDomain()" \end{chunk} + \begin{chunk}{UFD.dotpic} digraph pic { fontsize=10; @@ -54102,6 +61550,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 14} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DivisorCategory}{DIVCAT} @@ -54154,6 +61603,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DivisorCategory.help} ==================================================================== DivisorCategory examples @@ -54324,6 +61774,7 @@ DivisorCategory(S:SetCategory):Category == Exports where incr: % -> % \end{chunk} + \begin{chunk}{DIVCAT.dotabb} "DIVCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVCAT"]; "OAGROUP" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAGROUP"]; @@ -54332,11 +61783,13 @@ DivisorCategory(S:SetCategory):Category == Exports where "DIVCAT" -> "PID" \end{chunk} + \begin{chunk}{DIVCAT.dotfull} "DivisorCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVCAT"]; "DivisorCategory()" -> "PrincipalIdealDomain()" \end{chunk} + \begin{chunk}{DIVCAT.dotpic} digraph pic { fontsize=10; @@ -54361,6 +61814,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{EuclideanDomain}{EUCDOM} \pagepic{ps/v102euclideandomain.ps}{EUCDOM}{0.65} @@ -54418,6 +61872,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{EuclideanDomain.help} ==================================================================== EuclideanDomain examples @@ -54718,18 +62173,139 @@ EuclideanDomain(): Category == PrincipalIdealDomain with concat(v1,v2) \end{chunk} + +\begin{chunk}{COQ EUCDOM} +(* category EUCDOM *) +(* + x,y,z: % + l: List % + + sizeLess? : (%,%) -> Boolean + sizeLess?(x,y) == + zero? y => false + zero? x => true + euclideanSize(x) % + x quo y == divide(x,y).quotient --divide must be user-supplied + + ?rem? : (%,%) -> % + x rem y == divide(x,y).remainder + + exquo : (%,%) -> Union(%,"failed") + x exquo y == + zero? x => 0 + zero? y => "failed" + qr:=divide(x,y) + zero?(qr.remainder) => qr.quotient + "failed" + + gcd : (%,%) -> % + gcd(x,y) == --Euclidean Algorithm + x:=unitCanonical x + y:=unitCanonical y + while not zero? y repeat + (x,y):= (y,x rem y) + y:=unitCanonical y -- this doesn't affect the + -- correctness of Euclid's algorithm, + -- but + -- a) may improve performance + -- b) ensures gcd(x,y)=gcd(y,x) + -- if canonicalUnitNormal + x + + IdealElt ==> Record(coef1:%,coef2:%,generator:%) + + unitNormalizeIdealElt: IdealElt -> IdealElt + unitNormalizeIdealElt(s:IdealElt):IdealElt == + (u,c,a):=unitNormal(s.generator) + (a = 1) => s + [a*s.coef1,a*s.coef2,c]$IdealElt + + extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) + extendedEuclidean(x,y) == --Extended Euclidean Algorithm + s1:=unitNormalizeIdealElt([1$%,0$%,x]$IdealElt) + s2:=unitNormalizeIdealElt([0$%,1$%,y]$IdealElt) + zero? y => s1 + zero? x => s2 + while not zero?(s2.generator) repeat + qr:= divide(s1.generator, s2.generator) + s3:=[s1.coef1 - qr.quotient * s2.coef1, + s1.coef2 - qr.quotient * s2.coef2, qr.remainder]$IdealElt + s1:=s2 + s2:=unitNormalizeIdealElt s3 + if not(zero?(s1.coef1)) and not sizeLess?(s1.coef1,y) + then + qr:= divide(s1.coef1,y) + s1.coef1:= qr.remainder + s1.coef2:= s1.coef2 + qr.quotient * x + s1 := unitNormalizeIdealElt s1 + s1 + + TwoCoefs ==> Record(coef1:%,coef2:%) + + extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") + extendedEuclidean(x,y,z) == + zero? z => [0,0]$TwoCoefs + s:= extendedEuclidean(x,y) + (w:= z exquo s.generator) case "failed" => "failed" + zero? y => [s.coef1 * w, s.coef2 * w]$TwoCoefs + qr:= divide((s.coef1 * w), y) + [qr.remainder, s.coef2 * w + qr.quotient * x]$TwoCoefs + + principalIdeal : List(%) -> Record(coef: List(%),generator: %) + principalIdeal l == + l = [] => error "empty list passed to principalIdeal" + rest l = [] => + uca:=unitNormal(first l) + [[uca.unit],uca.canonical] + rest rest l = [] => + u:= extendedEuclidean(first l,second l) + [[u.coef1, u.coef2], u.generator] + v:=principalIdeal rest l + u:= extendedEuclidean(first l,v.generator) + [[u.coef1,:[u.coef2*vv for vv in v.coef]],u.generator] + + expressIdealMember : (List(%),%) -> Union(List(%),"failed") + expressIdealMember(l,z) == + z = 0 => [0 for v in l] + pid := principalIdeal l + (q := z exquo (pid.generator)) case "failed" => "failed" + [q*v for v in pid.coef] + + multiEuclidean : (List(%),%) -> Union(List(%),"failed") + multiEuclidean(l,z) == + n := #l + zero? n => error "empty list passed to multiEuclidean" + n = 1 => [z] + l1 := copy l + l2 := split!(l1, n quo 2) + u:= extendedEuclidean(*/l1, */l2, z) + u case "failed" => "failed" + v1 := multiEuclidean(l1,u.coef2) + v1 case "failed" => "failed" + v2 := multiEuclidean(l2,u.coef1) + v2 case "failed" => "failed" + concat(v1,v2) + +*) + +\end{chunk} + \begin{chunk}{EUCDOM.dotabb} "EUCDOM" [color=lightblue,href="bookvol10.2.pdf#nameddest=EUCDOM"]; "EUCDOM" -> "PID" \end{chunk} + \begin{chunk}{EUCDOM.dotfull} "EuclideanDomain()" [color=lightblue,href="bookvol10.2.pdf#nameddest=EUCDOM"]; "EuclideanDomain()" -> "PrincipalIdealDomain()" \end{chunk} + \begin{chunk}{EUCDOM.dotpic} digraph pic { fontsize=10; @@ -54770,6 +62346,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MultivariateTaylorSeriesCategory}{MTSCAT} \pagepic{ps/v102multivariatetaylorseriescategory.ps}{MTSCAT}{1.00} @@ -54882,6 +62459,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{MultivariateTaylorSeriesCategory.help} ==================================================================== MultivariateTaylorSeriesCategory examples @@ -55191,6 +62769,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where --++ coefficients by integers. \end{chunk} + \begin{chunk}{MTSCAT.dotabb} "MTSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=MTSCAT"]; @@ -55200,6 +62779,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where "MTSCAT" -> "EVALAB" \end{chunk} + \begin{chunk}{MTSCAT.dotfull} "MultivariateTaylorSeriesCategory(a:Ring,b:OrderedSet)" [color=lightblue,href="bookvol10.2.pdf#nameddest=MTSCAT"]; @@ -55213,6 +62793,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where "Evalable(MultivariateTaylorSeriesCategory(a:Ring,b:OrderedSet))" \end{chunk} + \begin{chunk}{MTSCAT.dotpic} digraph pic { fontsize=10; @@ -55237,6 +62818,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PolynomialFactorizationExplicit}{PFECAT} \pagepic{ps/v102polynomialfactorizationexplicit.ps}{PFECAT}{0.80} @@ -55294,6 +62876,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PolynomialFactorizationExplicit.help} ==================================================================== PolynomialFactorizationExplicit examples @@ -55520,6 +63103,60 @@ PolynomialFactorizationExplicit(): Category == Definition where solveLinearPolynomialEquationByFractions(lf,g)$LPE \end{chunk} + +\begin{chunk}{COQ PFECAT} +(* category PFECAT *) +(* + + gcdPolynomial : + (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) + gcdPolynomial(f,g) == + zero? f => g + zero? g => f + cf:=content f + if not one? cf then f:=(f exquo cf)::P + cg:=content g + if not one? cg then g:=(g exquo cg)::P + ans:=subResultantGcd(f,g)$P + gcd(cf,cg)*(ans exquo content ans)::P + + if % has CharacteristicNonZero then + + charthRoot : % -> Union(%,"failed") if $ has CHARNZ + charthRoot f == + -- to take p'th root of f, solve the system X-fY=0, + -- so solution is [x,y] + -- with x^p=X and y^p=Y, then (x/y)^p = f + zero? f => 0 + m:Matrix % := matrix [[1,-f]] + ans:= conditionP m + ans case "failed" => "failed" + (ans.1) exquo (ans.2) + + if % has Field then + + solveLinearPolynomialEquation : + (List(SparseUnivariatePolynomial(%)), + SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") + solveLinearPolynomialEquation(lf,g) == + multiEuclidean(lf,g)$P + + else + + solveLinearPolynomialEquation : + (List(SparseUnivariatePolynomial(%)), + SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") + solveLinearPolynomialEquation(lf,g) == + LPE ==> LinearPolynomialEquationByFractions % + solveLinearPolynomialEquationByFractions(lf,g)$LPE + +*) + +\end{chunk} + \begin{chunk}{PFECAT.dotabb} "PFECAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PFECAT"]; @@ -55654,6 +63291,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariatePowerSeriesCategory.help} ==================================================================== UnivariatePowerSeriesCategory examples @@ -55972,12 +63610,51 @@ UnivariatePowerSeriesCategory(Coef,Expon): Category == Definition where variables f == list create() \end{chunk} + +\begin{chunk}{COQ UPSCAT} +(* category UPSCAT *) +(* + + degree : % -> Expon + degree f == order f + + leadingCoefficient : % -> Coef + leadingCoefficient f == coefficient(f,order f) + + leadingMonomial : % -> % + leadingMonomial f == + ord := order f + monomial(coefficient(f,ord),ord) + + monomial : (%,List(SingletonAsOrderedSet),List(Expon)) -> % + monomial(f:%,listVar:List SingletonAsOrderedSet,listExpon:List Expon) == + empty? listVar or not empty? rest listVar => + error "monomial: variable list must have exactly one entry" + empty? listExpon or not empty? rest listExpon => + error "monomial: exponent list must have exactly one entry" + f * monomial(1,first listExpon) + + monomial : (%,SingletonAsOrderedSet,Expon) -> % + monomial(f:%,v:SingletonAsOrderedSet,n:Expon) == + f * monomial(1,n) + + reductum : % -> % + reductum f == f - leadingMonomial f + + variables : % -> List(SingletonAsOrderedSet) + variables f == list create() + +*) + +\end{chunk} + \begin{chunk}{UPSCAT.dotabb} "UPSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPSCAT"]; "UPSCAT" -> "PSCAT" \end{chunk} + \begin{chunk}{UPSCAT.dotfull} "UnivariatePowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid)" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPSCAT"]; @@ -56000,6 +63677,7 @@ UnivariatePowerSeriesCategory(Coef,Expon): Category == Definition where "UnivariatePowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid)" \end{chunk} + \begin{chunk}{UPSCAT.dotpic} digraph pic { fontsize=10; @@ -56066,6 +63744,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 15} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{Field}{FIELD} @@ -56130,6 +63809,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{Field.help} ==================================================================== Field examples @@ -56364,6 +64044,61 @@ Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain, divide(x,y) == [x / y,0] \end{chunk} + +\begin{chunk}{COQ FIELD} +(* category FIELD *) +(* +Axioms + a*(b/a) = b + inv(a) = 1/a + + + x,y: % + n: Integer + + UCA ==> Record(unit:%,canonical:%,associate:%) + + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + unitNormal(x) == + if zero? x then [1$%,0$%,1$%]$UCA else [x,1$%,inv(x)]$UCA + + unitCanonical : % -> % + unitCanonical(x) == if zero? x then x else 1 + + associates? : (%,%) -> Boolean + associates?(x,y) == if zero? x then zero? y else not(zero? y) + + inv : % -> % + inv x ==((u:=recip x) case "failed" => error "not invertible"; u) + + exquo : (%,%) -> Union(%,"failed") + x exquo y == (y=0 => "failed"; x / y) + + gcd : (%,%) -> % + gcd(x,y) == 1 + + euclideanSize : % -> NonNegativeInteger + euclideanSize(x) == 0 + + prime? : % -> Boolean + prime? x == false + + squareFree : % -> Factored(%) + squareFree x == x::Factored(%) + + factor : % -> Factored(%) + factor x == x::Factored(%) + + ?/? : (%,%) -> % + x / y == (zero? y => error "catdef: division by zero"; x * inv(y)) + + divide : (%,%) -> Record(quotient: %,remainder: %) + divide(x,y) == [x / y,0] + +*) + +\end{chunk} + \begin{chunk}{FIELD.dotabb} "FIELD" [color=lightblue,href="bookvol10.2.pdf#nameddest=FIELD"]; @@ -56372,6 +64107,7 @@ Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain, "FIELD" -> "DIVRING" \end{chunk} + \begin{chunk}{FIELD.dotfull} "Field()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FIELD"]; @@ -56380,6 +64116,7 @@ Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain, "Field()" -> "DivisionRing()" \end{chunk} + \begin{chunk}{FIELD.dotpic} digraph pic { fontsize=10; @@ -56405,6 +64142,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{IntegerNumberSystem}{INS} \pagepic{ps/v102integernumbersystem.ps}{INS}{0.30} @@ -56494,6 +64232,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{IntegerNumberSystem.help} ==================================================================== IntegerNumberSystem examples @@ -56927,7 +64666,6 @@ IntegerNumberSystem(): Category == r1 := c1-q*d1 c := d; c1 := d1 d := r; d1 := r1 --- not one? c => error "inverse does not exist" not (c = 1) => error "inverse does not exist" negative? c1 => c1 + b c1 @@ -56944,6 +64682,140 @@ IntegerNumberSystem(): Category == z := mulmod(z, z, p) \end{chunk} + +\begin{chunk}{COQ INS} +(* category INS *) +(* + + characteristic : () -> NonNegativeInteger + characteristic() == 0 + + differentiate : % -> % + differentiate x == 0 + + even? : % -> Boolean + even? x == not odd? x + + positive? : % -> Boolean + positive? x == x > 0 + + copy : % -> % + copy x == x + + bit? : (%,%) -> Boolean + bit?(x, i) == odd? shift(x, -i) + + mask : % -> % + mask n == dec shift(1, n) + + rational? : % -> Boolean + rational? x == true + + euclideanSize : % -> NonNegativeInteger + euclideanSize(x) == + x=0 => error "euclideanSize called on zero" + x<0 => (-convert(x)@Integer)::NonNegativeInteger + convert(x)@Integer::NonNegativeInteger + + convert : % -> Float + convert(x:%):Float == (convert(x)@Integer)::Float + + convert : % -> DoubleFloat + convert(x:%):DoubleFloat == (convert(x)@Integer)::DoubleFloat + + convert : % -> InputForm + convert(x:%):InputForm == convert(convert(x)@Integer) + + retract(x:%):Integer == convert(x)@Integer + + convert : % -> Pattern(Integer) + convert(x:%):Pattern(Integer)== convert(x)@Integer ::Pattern(Integer) + + factor : % -> Factored(%) + factor x == factor(x)$IntegerFactorizationPackage(%) + + squareFree : % -> Factored(%) + squareFree x == squareFree(x)$IntegerFactorizationPackage(%) + + prime? : % -> Boolean + prime? x == prime?(x)$IntegerPrimesPackage(%) + + factorial : % -> % + factorial x == factorial(x)$IntegerCombinatoricFunctions(%) + + binomial : (%,%) -> % + binomial(n, m) == binomial(n, m)$IntegerCombinatoricFunctions(%) + + permutation : (%,%) -> % + permutation(n, m) == permutation(n,m)$IntegerCombinatoricFunctions(%) + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + retractIfCan(x:%):Union(Integer, "failed") == convert(x)@Integer + + init : () -> % + init() == 0 + + -- iterates in order 0,1,-1,2,-2,3,-3,... + nextItem : % -> Union(%,"failed") + nextItem(n) == + zero? n => 1 + n>0 => -n + 1-n + + patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) + patternMatch(x, p, l) == + patternMatch(x, p, l)$PatternMatchIntegerNumberSystem(%) + + rational : % -> Fraction(Integer) + rational(x:%):Fraction(Integer) == + (convert(x)@Integer)::Fraction(Integer) + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + rationalIfCan(x:%):Union(Fraction Integer, "failed") == + (convert(x)@Integer)::Fraction(Integer) + + symmetricRemainder : (%,%) -> % + symmetricRemainder(x, n) == + r := x rem n + r = 0 => r + if n < 0 then n:=-n + r > 0 => + 2 * r > n => r - n + r + 2*r + n <= 0 => r + n + r + + invmod : (%,%) -> % + invmod(a, b) == + if negative? a then a := positiveRemainder(a, b) + c := a; c1:% := 1 + d := b; d1:% := 0 + while not zero? d repeat + q := c quo d + r := c-q*d + r1 := c1-q*d1 + c := d; c1 := d1 + d := r; d1 := r1 + not (c = 1) => error "inverse does not exist" + negative? c1 => c1 + b + c1 + + powmod : (%,%,%) -> % + powmod(x, n, p) == + if negative? x then x := positiveRemainder(x, p) + zero? x => 0 + zero? n => 1 + y:% := 1 + z := x + repeat + if odd? n then y := mulmod(y, z, p) + zero?(n := shift(n, -1)) => return y + z := mulmod(z, z, p) +*) + +\end{chunk} + \begin{chunk}{INS.dotabb} "INS" [color=lightblue,href="bookvol10.2.pdf#nameddest=INS"]; @@ -57123,6 +64995,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{LocalPowerSeriesCategory.help} ==================================================================== LocalPowerSeriesCategory examples @@ -57454,12 +65327,14 @@ LocalPowerSeriesCategory(K:Field):Category == Implementation where ++ returns the value of the \spad{printInfo} flag. \end{chunk} + \begin{chunk}{LOCPOWC.dotabb} "LOCPOWC" [color=lightblue,href="bookvol10.2.pdf#nameddest=LOCPOWC"]; "LOCPOWC" -> "UPSCAT" \end{chunk} + \begin{chunk}{LOCPOWC.dotfull} "LocalPowerSeriesCategory(f:Field)" [color=lightblue,href="bookvol10.2.pdf#nameddest=LOCPOWC"]; @@ -57467,6 +65342,7 @@ LocalPowerSeriesCategory(K:Field):Category == Implementation where "UnivariatePowerSeriesCategory(c:Ring,e:OrderedAbelianMonoid)" \end{chunk} + \begin{chunk}{LOCPOWC.dotpic} digraph pic { fontsize=10; @@ -57742,6 +65618,7 @@ PAdicIntegerCategory(p): Category == Definition where ++ Argument \spad{a} must be a root of \spad{f} \spad{(mod p)}. \end{chunk} + \begin{chunk}{PADICCT.dotabb} "PADICCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=PADICCT"]; @@ -57749,6 +65626,7 @@ PAdicIntegerCategory(p): Category == Definition where "PADICCT" -> "EUCDOM" \end{chunk} + \begin{chunk}{PADICCT.dotfull} "PAdicIntegerCategory(a:Integer)" [color=lightblue,href="bookvol10.2.pdf#nameddest=PADICCT"]; @@ -57756,6 +65634,7 @@ PAdicIntegerCategory(p): Category == Definition where "PAdicIntegerCategory(a:Integer)" -> "EuclideanDomain()" \end{chunk} + \begin{chunk}{PADICCT.dotpic} digraph pic { fontsize=10; @@ -57803,6 +65682,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PolynomialCategory}{POLYCAT} \pagepic{ps/v102polynomialcategory.ps}{POLYCAT}{0.40} @@ -57937,6 +65817,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PolynomialCategory.help} ==================================================================== PolynomialCategory examples @@ -58485,9 +66366,6 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet): eval(p, lvar,[rhs e for e in l]$List(%)) monomials p == --- zero? p => empty() --- concat(leadingMonomial p, monomials reductum p) --- replaced by sequential version for efficiency, by WMSIT, 7/30/90 ml:= empty$List(%) while p ^= 0 repeat ml:=concat(leadingMonomial p, ml) @@ -58501,7 +66379,6 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet): isTimes p == empty?(lv := variables p) or not monomial? p => "failed" l := [monomial(1, v, degree(p, v)) for v in lv] --- one?(r := leadingCoefficient p) => ((r := leadingCoefficient p) = 1) => empty? rest lv => "failed" l @@ -58771,254 +66648,628 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet): p)$PolynomialCategoryLifting(E,VarSet,R,%,InputForm) \end{chunk} -\begin{chunk}{POLYCAT.dotabb} -"POLYCAT" - [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"]; -"POLYCAT" -> "PDRING" -"POLYCAT" -> "FAMR" -"POLYCAT" -> "EVALAB" -"POLYCAT" -> "IEVALAB" -"POLYCAT" -> "RETRACT" -"POLYCAT" -> "FLINEXP" -"POLYCAT" -> "ORDSET" -"POLYCAT" -> "GCDDOM" -"POLYCAT" -> "PFECAT" -\end{chunk} -\begin{chunk}{POLYCAT.dotfull} -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"]; -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "PartialDifferentialRing(a:OrderedSet)" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoidSup)" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "Evalable(PolynomialCategory(...))" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "InnerEvalable(a:OrderedSet,b:Ring)" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "InnerEvalable(a:OrderedSet,b:PolynomialCategory(...))" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "RetractableTo(a:OrderedSet)" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "FullyLinearlyExplicitRingOver(a:Ring)" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "OrderedSet()" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "GcdDomain()" -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "PolynomialFactorizationExplicit()" +\begin{chunk}{COQ POLYCAT} +(* category POLYCAT *) +(* + p:% + v:VarSet + ln:List NonNegativeInteger + lv:List VarSet + n:NonNegativeInteger + pp,qq:SparseUnivariatePolynomial % -"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)" - [color=seagreen,href="bookvol10.2.pdf#nameddest=POLYCAT"]; -"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)" - -> "PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" -\end{chunk} -\begin{chunk}{POLYCAT.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; + eval : (%,List(Equation(%))) -> % + eval(p:%, l:List Equation %) == + empty? l => p + for e in l repeat + retractIfCan(lhs e)@Union(VarSet,"failed") case "failed" => + error "cannot find a variable to evaluate" + lvar:=[retract(lhs e)@VarSet for e in l] + eval(p, lvar,[rhs e for e in l]$List(%)) -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"]; -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "PDRING..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "FAMR..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "EVALAB..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "IEVALAB..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "RETRACT..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "FLINEXP..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "ORDSET..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "GCDDOM..." -"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" - -> "PFECAT..." + monomials : % -> List(%) + monomials p == + ml:= empty$List(%) + while p ^= 0 repeat + ml:=concat(leadingMonomial p, ml) + p:= reductum p + reverse ml -"PDRING..." [color=lightblue]; -"FAMR..." [color=lightblue]; -"EVALAB..." [color=lightblue]; -"IEVALAB..." [color=lightblue]; -"RETRACT..." [color=lightblue]; -"FLINEXP..." [color=lightblue]; -"ORDSET..." [color=lightblue]; -"GCDDOM..." [color=lightblue]; -"PFECAT..." [color=lightblue]; + isPlus : % -> Union(List(%),"failed") + isPlus p == + empty? rest(l := monomials p) => "failed" + l -} + isTimes : % -> Union(List(%),"failed") + isTimes p == + empty?(lv := variables p) or not monomial? p => "failed" + l := [monomial(1, v, degree(p, v)) for v in lv] + ((r := leadingCoefficient p) = 1) => + empty? rest lv => "failed" + l + concat(r::%, l) -\end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{UnivariateTaylorSeriesCategory}{UTSCAT} -\pagepic{ps/v102univariatetaylorseriescategory.ps}{UTSCAT}{0.60} + isExpt : % -> + Union(Record(var: VarSet,exponent: NonNegativeInteger),"failed") + isExpt p == + (u := mainVariable p) case "failed" => "failed" + p = monomial(1, u::VarSet, d := degree(p, u::VarSet)) => + [u::VarSet, d] + "failed" -\begin{chunk}{UnivariateTaylorSeriesCategory.input} -)set break resume -)sys rm -f UnivariateTaylorSeriesCategory.output -)spool UnivariateTaylorSeriesCategory.output -)set message test on -)set message auto off -)clear all + coefficient : (%,VarSet,NonNegativeInteger) -> % + coefficient(p,v,n) == coefficient(univariate(p,v),n) ---S 1 of 1 -)show UnivariateTaylorSeriesCategory ---R ---R UnivariateTaylorSeriesCategory(Coef: Ring) is a category constructor ---R Abbreviation for UnivariateTaylorSeriesCategory is UTSCAT ---R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for UTSCAT ---R ---R------------------------------- Operations -------------------------------- ---R ?*? : (Coef,%) -> % ?*? : (%,Coef) -> % ---R ?*? : (%,%) -> % ?*? : (Integer,%) -> % ---R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % ---R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % ---R ?+? : (%,%) -> % ?-? : (%,%) -> % ---R -? : % -> % ?=? : (%,%) -> Boolean ---R 1 : () -> % 0 : () -> % ---R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % ---R center : % -> Coef coefficients : % -> Stream(Coef) ---R coerce : % -> % if Coef has INTDOM coerce : Integer -> % ---R coerce : % -> OutputForm complete : % -> % ---R degree : % -> NonNegativeInteger hash : % -> SingleInteger ---R latex : % -> String leadingCoefficient : % -> Coef ---R leadingMonomial : % -> % map : ((Coef -> Coef),%) -> % ---R monomial? : % -> Boolean one? : % -> Boolean ---R order : % -> NonNegativeInteger pole? : % -> Boolean ---R quoByVar : % -> % recip : % -> Union(%,"failed") ---R reductum : % -> % sample : () -> % ---R series : Stream(Coef) -> % variable : % -> Symbol ---R zero? : % -> Boolean ?~=? : (%,%) -> Boolean ---R ?*? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT)) ---R ?*? : (Fraction(Integer),%) -> % if Coef has ALGEBRA(FRAC(INT)) ---R ?**? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT)) ---R ?**? : (%,%) -> % if Coef has ALGEBRA(FRAC(INT)) ---R ?**? : (%,Coef) -> % if Coef has FIELD ---R ?/? : (%,Coef) -> % if Coef has FIELD ---R D : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef ---R D : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef ---R D : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R D : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R D : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R acos : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R acosh : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R acot : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R acoth : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R acsc : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R acsch : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R approximate : (%,NonNegativeInteger) -> Coef if Coef has **: (Coef,NonNegativeInteger) -> Coef and Coef has coerce: Symbol -> Coef ---R asec : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R asech : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R asin : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R asinh : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R associates? : (%,%) -> Boolean if Coef has INTDOM ---R atan : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R atanh : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R characteristic : () -> NonNegativeInteger ---R charthRoot : % -> Union(%,"failed") if Coef has CHARNZ ---R coefficient : (%,NonNegativeInteger) -> Coef ---R coerce : Coef -> % if Coef has COMRING ---R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT)) ---R cos : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R cosh : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R cot : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R coth : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R csc : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R csch : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R differentiate : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef ---R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef ---R differentiate : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R differentiate : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef ---R ?.? : (%,%) -> % if NonNegativeInteger has SGROUP ---R ?.? : (%,NonNegativeInteger) -> Coef ---R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,NonNegativeInteger) -> Coef ---R exp : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM ---R extend : (%,NonNegativeInteger) -> % ---R integrate : (%,Symbol) -> % if Coef has ACFS(INT) and Coef has PRIMCAT and Coef has TRANFUN and Coef has ALGEBRA(FRAC(INT)) or Coef has variables: Coef -> List(Symbol) and Coef has integrate: (Coef,Symbol) -> Coef and Coef has ALGEBRA(FRAC(INT)) ---R integrate : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R log : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R monomial : (%,List(SingletonAsOrderedSet),List(NonNegativeInteger)) -> % ---R monomial : (%,SingletonAsOrderedSet,NonNegativeInteger) -> % ---R monomial : (Coef,NonNegativeInteger) -> % ---R multiplyCoefficients : ((Integer -> Coef),%) -> % ---R multiplyExponents : (%,PositiveInteger) -> % ---R nthRoot : (%,Integer) -> % if Coef has ALGEBRA(FRAC(INT)) ---R order : (%,NonNegativeInteger) -> NonNegativeInteger ---R pi : () -> % if Coef has ALGEBRA(FRAC(INT)) ---R polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef) ---R polynomial : (%,NonNegativeInteger) -> Polynomial(Coef) ---R sec : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R sech : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> % ---R sin : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R sinh : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R sqrt : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R subtractIfCan : (%,%) -> Union(%,"failed") ---R tan : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R tanh : % -> % if Coef has ALGEBRA(FRAC(INT)) ---R terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef)) ---R truncate : (%,NonNegativeInteger,NonNegativeInteger) -> % ---R truncate : (%,NonNegativeInteger) -> % ---R unit? : % -> Boolean if Coef has INTDOM ---R unitCanonical : % -> % if Coef has INTDOM ---R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if Coef has INTDOM ---R variables : % -> List(SingletonAsOrderedSet) ---R ---E 1 + coefficient : (%,List(VarSet),List(NonNegativeInteger)) -> % + coefficient(p,lv,ln) == + empty? lv => + empty? ln => p + error "mismatched lists in coefficient" + empty? ln => error "mismatched lists in coefficient" + coefficient(coefficient(univariate(p,first lv),first ln), + rest lv,rest ln) -)spool -)lisp (bye) -\end{chunk} -\begin{chunk}{UnivariateTaylorSeriesCategory.help} -==================================================================== -UnivariateTaylorSeriesCategory examples -==================================================================== + monomial : (%,List(VarSet),List(NonNegativeInteger)) -> % + monomial(p,lv,ln) == + empty? lv => + empty? ln => p + error "mismatched lists in monomial" + empty? ln => error "mismatched lists in monomial" + monomial(monomial(p,first lv, first ln),rest lv, rest ln) -UnivariateTaylorSeriesCategory is the category of Taylor series -in one variable. + retract : % -> VarSet + retract(p:%):VarSet == + q := mainVariable(p)::VarSet + q::% = p => q + error "Polynomial is not a single variable" -See Also: -o )show UnivariateTaylorSeriesCategory + retractIfCan : % -> Union(VarSet,"failed") + retractIfCan(p:%):Union(VarSet, "failed") == + ((q := mainVariable p) case VarSet) and (q::VarSet::% = p) => q + "failed" -\end{chunk} -{\bf See:} + mkPrim: % -> % + mkPrim(p:%):% == monomial(1,degree p) -\pagefrom{RadicalCategory}{RADCAT} -\pagefrom{TranscendentalFunctionCategory}{TRANFUN} -\pagefrom{UnivariatePowerSeriesCategory}{UPSCAT} + primitiveMonomials : % -> List(%) + primitiveMonomials p == [mkPrim q for q in monomials p] -{\bf Exports:}\\ + totalDegree : % -> NonNegativeInteger + totalDegree p == + ground? p => 0 + u := univariate(p, mainVariable(p)::VarSet) + d: NonNegativeInteger := 0 + while u ^= 0 repeat + d := max(d, degree u + totalDegree leadingCoefficient u) + u := reductum u + d -\begin{tabular}{llll} -\cross{UTSCAT}{0} & -\cross{UTSCAT}{1} & -\cross{UTSCAT}{acos} & -\cross{UTSCAT}{acosh} \\ -\cross{UTSCAT}{acot} & -\cross{UTSCAT}{acoth} & -\cross{UTSCAT}{acsc} & -\cross{UTSCAT}{acsch} \\ -\cross{UTSCAT}{approximate} & -\cross{UTSCAT}{asec} & -\cross{UTSCAT}{asech} & -\cross{UTSCAT}{asin} \\ -\cross{UTSCAT}{asinh} & -\cross{UTSCAT}{associates?} & -\cross{UTSCAT}{atan} & -\cross{UTSCAT}{atanh} \\ -\cross{UTSCAT}{center} & -\cross{UTSCAT}{characteristic} & -\cross{UTSCAT}{charthRoot} & + totalDegree : (%,List(VarSet)) -> NonNegativeInteger + totalDegree(p,lv) == + ground? p => 0 + u := univariate(p, v:=(mainVariable(p)::VarSet)) + d: NonNegativeInteger := 0 + w: NonNegativeInteger := 0 + if member?(v, lv) then w:=1 + while u ^= 0 repeat + d := max(d, w*(degree u) + totalDegree(leadingCoefficient u,lv)) + u := reductum u + d + + if R has CommutativeRing then + + resultant : (%,%,VarSet) -> % if R has COMRING + resultant(p1,p2,mvar) == + resultant(univariate(p1,mvar),univariate(p2,mvar)) + + differentiate : (%,VarSet) -> % + discriminant(p,var) == + discriminant(univariate(p,var)) + + if R has IntegralDomain then + + allMonoms: List(%) -> List(%) + allMonoms(l:List %):List(%) == + removeDuplicates_! concat [primitiveMonomials p for p in l] + + P2R: (%, List(E), NonNegativeInteger) -> Vector(R) + P2R(p:%, b:List E, n:NonNegativeInteger):Vector(R) == + w := new(n, 0)$Vector(R) + for i in minIndex w .. maxIndex w for bj in b repeat + qsetelt_!(w, i, coefficient(p, bj)) + w + + eq2R: (List(%), List(E)) -> Matrix(R) + eq2R(l:List %, b:List E):Matrix(R) == + matrix [[coefficient(p, bj) for p in l] for bj in b] + + reducedSystem : Matrix(%) -> Matrix(R) + reducedSystem(m:Matrix %):Matrix(R) == + l := listOfLists m + b := removeDuplicates_! + concat [allMonoms r for r in l]$List(List(%)) + d := [degree bj for bj in b] + mm := eq2R(first l, d) + l := rest l + while not empty? l repeat + mm := vertConcat(mm, eq2R(first l, d)) + l := rest l + mm + + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(R),vec: Vector(R)) + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix R, vec:Vector R) == + l := listOfLists m + r := entries v + b : List % := removeDuplicates_! concat(allMonoms r, + concat [allMonoms s for s in l]$List(List(%))) + d := [degree bj for bj in b] + n := #d + mm := eq2R(first l, d) + w := P2R(first r, d, n) + l := rest l + r := rest r + while not empty? l repeat + mm := vertConcat(mm, eq2R(first l, d)) + w := concat(w, P2R(first r, d, n)) + l := rest l + r := rest r + [mm, w] + + if R has PolynomialFactorizationExplicit then + -- we might be in trouble if its actually only + -- a univariate polynomial category - have to remember to + -- over-ride these in UnivariatePolynomialCategory + + PFBR ==>PolynomialFactorizationByRecursion(R,E,VarSet,%) + + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) + gcdPolynomial(pp,qq) == + gcdPolynomial(pp,qq)$GeneralPolynomialGcdPackage(E,VarSet,R,%) + + solveLinearPolynomialEquation : + (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT + solveLinearPolynomialEquation(lpp,pp) == + solveLinearPolynomialEquationByRecursion(lpp,pp)$PFBR + + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + factorPolynomial(pp) == + factorByRecursion(pp)$PFBR + + factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + factorSquareFreePolynomial(pp) == + factorSquareFreeByRecursion(pp)$PFBR + + factor : % -> Factored(%) + factor p == + v:Union(VarSet,"failed"):=mainVariable p + v case "failed" => + ansR:=factor leadingCoefficient p + makeFR(unit(ansR)::%, + [[w.flg,w.fctr::%,w.xpnt] for w in factorList ansR]) + up:SparseUnivariatePolynomial %:=univariate(p,v) + ansSUP:=factorByRecursion(up)$PFBR + makeFR(multivariate(unit(ansSUP),v), + [[ww.flg,multivariate(ww.fctr,v),ww.xpnt] + for ww in factorList ansSUP]) + + if R has CharacteristicNonZero then + + mat: Matrix % + + conditionP : Matrix(%) -> Union(Vector(%),"failed") + conditionP mat == + ll:=listOfLists transpose mat --hence each list corresponds to a + --column, i.e. to one variable + llR:List List R := [ empty() for z in first ll] + monslist:List List % := empty() + ch:=characteristic()$% + for l in ll repeat + mons:= "setUnion"/[primitiveMonomials u for u in l] + redmons:List % :=[] + for m in mons repeat + vars:=variables m + degs:=degree(m,vars) + deg1:List NonNegativeInteger + deg1:=[ ((nd:=d:Integer exquo ch:Integer) + case "failed" => return "failed" ; + nd::Integer::NonNegativeInteger) + for d in degs ] + redmons:=[monomial(1,vars,deg1),:redmons] + llR:=[[ground coefficient(u,vars,degs),:v]_ + for u in l for v in llR] + monslist:=[redmons,:monslist] + ans:=conditionP transpose matrix llR + ans case "failed" => "failed" + i:NonNegativeInteger:=0 + [ +/[m*(ans.(i:=i+1))::% for m in mons ] + for mons in monslist] + + if R has CharacteristicNonZero then + + charthRoot : % -> Union(%,"failed") + charthRoot p == + vars:= variables p + empty? vars => + ans := charthRoot ground p + ans case "failed" => "failed" + ans::R::% + ch:=characteristic()$% + charthRootlv(p,vars,ch) + + charthRootlv:(%,List VarSet,NonNegativeInteger) -> Union(%,"failed") + charthRootlv(p,vars,ch) == + empty? vars => + ans := charthRoot ground p + ans case "failed" => "failed" + ans::R::% + v:=first vars + vars:=rest vars + d:=degree(p,v) + ans:% := 0 + while (d>0) repeat + (dd:=(d::Integer exquo ch::Integer)) case "failed" => + return "failed" + cp:=coefficient(p,v,d) + p:=p-monomial(cp,v,d) + ansx:=charthRootlv(cp,vars,ch) + ansx case "failed" => return "failed" + d:=degree(p,v) + ans:=ans+monomial(ansx,v,dd::Integer::NonNegativeInteger) + ansx:=charthRootlv(p,vars,ch) + ansx case "failed" => return "failed" + return ans+ansx + + monicDivide : (%,%,VarSet) -> Record(quotient: %,remainder: %) + monicDivide(p1,p2,mvar) == + result:=monicDivide(univariate(p1,mvar),univariate(p2,mvar)) + [multivariate(result.quotient,mvar), + multivariate(result.remainder,mvar)] + + if R has GcdDomain then + + if R has EuclideanDomain and R has CharacteristicZero then + + squareFree : % -> Factored(%) + squareFree p == squareFree(p)$MultivariateSquareFree(E,VarSet,R,%) + + else + + squareFree : % -> Factored(%) + squareFree p == squareFree(p)$PolynomialSquareFree(VarSet,E,R,%) + + squareFreePart : % -> % + squareFreePart p == + unit(s := squareFree p) * */[f.factor for f in factors s] + + content : (%,VarSet) -> % + content(p,v) == content univariate(p,v) + + primitivePart : % -> % + primitivePart p == + zero? p => p + unitNormal((p exquo content p) ::%).canonical + + primitivePart : (%,VarSet) -> % + primitivePart(p,v) == + zero? p => p + unitNormal((p exquo content(p,v)) ::%).canonical + + if R has OrderedSet then + + ? Boolean + p:% < q:% == + (dp:= degree p) < (dq := degree q) => (leadingCoefficient q) > 0 + dq < dp => (leadingCoefficient p) < 0 + leadingCoefficient(p - q) < 0 + + if (R has PatternMatchable Integer) and + (VarSet has PatternMatchable Integer) then + + patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) + patternMatch(p:%, pat:Pattern Integer, + l:PatternMatchResult(Integer, %)) == + patternMatch(p, pat, + l)$PatternMatchPolynomialCategory(Integer,E,VarSet,R,%) + + if (R has PatternMatchable Float) and + (VarSet has PatternMatchable Float) then + + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + patternMatch(p:%, pat:Pattern Float, + l:PatternMatchResult(Float, %)) == + patternMatch(p, pat, + l)$PatternMatchPolynomialCategory(Float,E,VarSet,R,%) + + if (R has ConvertibleTo Pattern Integer) and + (VarSet has ConvertibleTo Pattern Integer) then + + convert : % -> Pattern(Integer) + convert(x:%):Pattern(Integer) == + map(convert, convert, + x)$PolynomialCategoryLifting(E,VarSet,R,%,Pattern Integer) + + if (R has ConvertibleTo Pattern Float) and + (VarSet has ConvertibleTo Pattern Float) then + + convert : % -> Pattern(Float) + convert(x:%):Pattern(Float) == + map(convert, convert, + x)$PolynomialCategoryLifting(E, VarSet, R, %, Pattern Float) + + if (R has ConvertibleTo InputForm) and + (VarSet has ConvertibleTo InputForm) then + + convert : % -> InputForm + convert(p:%):InputForm == + map(convert, convert, + p)$PolynomialCategoryLifting(E,VarSet,R,%,InputForm) + +*) + +\end{chunk} + +\begin{chunk}{POLYCAT.dotabb} +"POLYCAT" + [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"]; +"POLYCAT" -> "PDRING" +"POLYCAT" -> "FAMR" +"POLYCAT" -> "EVALAB" +"POLYCAT" -> "IEVALAB" +"POLYCAT" -> "RETRACT" +"POLYCAT" -> "FLINEXP" +"POLYCAT" -> "ORDSET" +"POLYCAT" -> "GCDDOM" +"POLYCAT" -> "PFECAT" + +\end{chunk} + +\begin{chunk}{POLYCAT.dotfull} +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"]; +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "PartialDifferentialRing(a:OrderedSet)" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoidSup)" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "Evalable(PolynomialCategory(...))" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "InnerEvalable(a:OrderedSet,b:Ring)" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "InnerEvalable(a:OrderedSet,b:PolynomialCategory(...))" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "RetractableTo(a:OrderedSet)" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "FullyLinearlyExplicitRingOver(a:Ring)" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "OrderedSet()" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "GcdDomain()" +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "PolynomialFactorizationExplicit()" + +"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)" + [color=seagreen,href="bookvol10.2.pdf#nameddest=POLYCAT"]; +"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)" + -> "PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" +\end{chunk} + +\begin{chunk}{POLYCAT.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; + +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"]; +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "PDRING..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "FAMR..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "EVALAB..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "IEVALAB..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "RETRACT..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "FLINEXP..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "ORDSET..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "GCDDOM..." +"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" + -> "PFECAT..." + +"PDRING..." [color=lightblue]; +"FAMR..." [color=lightblue]; +"EVALAB..." [color=lightblue]; +"IEVALAB..." [color=lightblue]; +"RETRACT..." [color=lightblue]; +"FLINEXP..." [color=lightblue]; +"ORDSET..." [color=lightblue]; +"GCDDOM..." [color=lightblue]; +"PFECAT..." [color=lightblue]; + +} + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\pagehead{UnivariateTaylorSeriesCategory}{UTSCAT} +\pagepic{ps/v102univariatetaylorseriescategory.ps}{UTSCAT}{0.60} + +\begin{chunk}{UnivariateTaylorSeriesCategory.input} +)set break resume +)sys rm -f UnivariateTaylorSeriesCategory.output +)spool UnivariateTaylorSeriesCategory.output +)set message test on +)set message auto off +)clear all + +--S 1 of 1 +)show UnivariateTaylorSeriesCategory +--R +--R UnivariateTaylorSeriesCategory(Coef: Ring) is a category constructor +--R Abbreviation for UnivariateTaylorSeriesCategory is UTSCAT +--R This constructor is exposed in this frame. +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for UTSCAT +--R +--R------------------------------- Operations -------------------------------- +--R ?*? : (Coef,%) -> % ?*? : (%,Coef) -> % +--R ?*? : (%,%) -> % ?*? : (Integer,%) -> % +--R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % +--R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % +--R ?+? : (%,%) -> % ?-? : (%,%) -> % +--R -? : % -> % ?=? : (%,%) -> Boolean +--R 1 : () -> % 0 : () -> % +--R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % +--R center : % -> Coef coefficients : % -> Stream(Coef) +--R coerce : % -> % if Coef has INTDOM coerce : Integer -> % +--R coerce : % -> OutputForm complete : % -> % +--R degree : % -> NonNegativeInteger hash : % -> SingleInteger +--R latex : % -> String leadingCoefficient : % -> Coef +--R leadingMonomial : % -> % map : ((Coef -> Coef),%) -> % +--R monomial? : % -> Boolean one? : % -> Boolean +--R order : % -> NonNegativeInteger pole? : % -> Boolean +--R quoByVar : % -> % recip : % -> Union(%,"failed") +--R reductum : % -> % sample : () -> % +--R series : Stream(Coef) -> % variable : % -> Symbol +--R zero? : % -> Boolean ?~=? : (%,%) -> Boolean +--R ?*? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT)) +--R ?*? : (Fraction(Integer),%) -> % if Coef has ALGEBRA(FRAC(INT)) +--R ?**? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT)) +--R ?**? : (%,%) -> % if Coef has ALGEBRA(FRAC(INT)) +--R ?**? : (%,Coef) -> % if Coef has FIELD +--R ?/? : (%,Coef) -> % if Coef has FIELD +--R D : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef +--R D : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef +--R D : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R D : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R D : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R acos : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R acosh : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R acot : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R acoth : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R acsc : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R acsch : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R approximate : (%,NonNegativeInteger) -> Coef if Coef has **: (Coef,NonNegativeInteger) -> Coef and Coef has coerce: Symbol -> Coef +--R asec : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R asech : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R asin : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R asinh : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R associates? : (%,%) -> Boolean if Coef has INTDOM +--R atan : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R atanh : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R characteristic : () -> NonNegativeInteger +--R charthRoot : % -> Union(%,"failed") if Coef has CHARNZ +--R coefficient : (%,NonNegativeInteger) -> Coef +--R coerce : Coef -> % if Coef has COMRING +--R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT)) +--R cos : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R cosh : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R cot : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R coth : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R csc : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R csch : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R differentiate : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef +--R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef +--R differentiate : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R differentiate : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef +--R ?.? : (%,%) -> % if NonNegativeInteger has SGROUP +--R ?.? : (%,NonNegativeInteger) -> Coef +--R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,NonNegativeInteger) -> Coef +--R exp : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM +--R extend : (%,NonNegativeInteger) -> % +--R integrate : (%,Symbol) -> % if Coef has ACFS(INT) and Coef has PRIMCAT and Coef has TRANFUN and Coef has ALGEBRA(FRAC(INT)) or Coef has variables: Coef -> List(Symbol) and Coef has integrate: (Coef,Symbol) -> Coef and Coef has ALGEBRA(FRAC(INT)) +--R integrate : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R log : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R monomial : (%,List(SingletonAsOrderedSet),List(NonNegativeInteger)) -> % +--R monomial : (%,SingletonAsOrderedSet,NonNegativeInteger) -> % +--R monomial : (Coef,NonNegativeInteger) -> % +--R multiplyCoefficients : ((Integer -> Coef),%) -> % +--R multiplyExponents : (%,PositiveInteger) -> % +--R nthRoot : (%,Integer) -> % if Coef has ALGEBRA(FRAC(INT)) +--R order : (%,NonNegativeInteger) -> NonNegativeInteger +--R pi : () -> % if Coef has ALGEBRA(FRAC(INT)) +--R polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef) +--R polynomial : (%,NonNegativeInteger) -> Polynomial(Coef) +--R sec : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R sech : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> % +--R sin : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R sinh : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R sqrt : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R subtractIfCan : (%,%) -> Union(%,"failed") +--R tan : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R tanh : % -> % if Coef has ALGEBRA(FRAC(INT)) +--R terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef)) +--R truncate : (%,NonNegativeInteger,NonNegativeInteger) -> % +--R truncate : (%,NonNegativeInteger) -> % +--R unit? : % -> Boolean if Coef has INTDOM +--R unitCanonical : % -> % if Coef has INTDOM +--R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if Coef has INTDOM +--R variables : % -> List(SingletonAsOrderedSet) +--R +--E 1 + +)spool +)lisp (bye) +\end{chunk} + +\begin{chunk}{UnivariateTaylorSeriesCategory.help} +==================================================================== +UnivariateTaylorSeriesCategory examples +==================================================================== + +UnivariateTaylorSeriesCategory is the category of Taylor series +in one variable. + +See Also: +o )show UnivariateTaylorSeriesCategory + +\end{chunk} +{\bf See:} + +\pagefrom{RadicalCategory}{RADCAT} +\pagefrom{TranscendentalFunctionCategory}{TRANFUN} +\pagefrom{UnivariatePowerSeriesCategory}{UPSCAT} + +{\bf Exports:}\\ + +\begin{tabular}{llll} +\cross{UTSCAT}{0} & +\cross{UTSCAT}{1} & +\cross{UTSCAT}{acos} & +\cross{UTSCAT}{acosh} \\ +\cross{UTSCAT}{acot} & +\cross{UTSCAT}{acoth} & +\cross{UTSCAT}{acsc} & +\cross{UTSCAT}{acsch} \\ +\cross{UTSCAT}{approximate} & +\cross{UTSCAT}{asec} & +\cross{UTSCAT}{asech} & +\cross{UTSCAT}{asin} \\ +\cross{UTSCAT}{asinh} & +\cross{UTSCAT}{associates?} & +\cross{UTSCAT}{atan} & +\cross{UTSCAT}{atanh} \\ +\cross{UTSCAT}{center} & +\cross{UTSCAT}{characteristic} & +\cross{UTSCAT}{charthRoot} & \cross{UTSCAT}{coefficient} \\ \cross{UTSCAT}{coefficients} & \cross{UTSCAT}{coerce} & @@ -59379,9 +67630,6 @@ UnivariateTaylorSeriesCategory(Coef): Category == Definition where -- creates a term c * vv ** k k = 0 => c :: OUT mon := (k = 1 => vv; vv ** (k :: OUT)) --- if factorials?() and k > 1 then --- c := factorial(k)$IntegerCombinatoricFunctions * c --- mon := mon / hconcat(k :: OUT,"!" :: OUT) c = 1 => mon c = -1 => -mon (c :: OUT) * mon @@ -59485,7 +67733,6 @@ UnivariateTaylorSeriesCategory(Coef): Category == Definition where positive? r => 0 zero? r => error "0**0 undefined" error "0 raised to a negative power" --- not one? frst coefs => not (frst coefs = 1) => error "**: constant coefficient should be 1" coefs := concat(0,rst coefs) @@ -59546,31 +67793,284 @@ UnivariateTaylorSeriesCategory(Coef): Category == Definition where acsch x == series acsch(coefficients x)$STNC \end{chunk} -\begin{chunk}{UTSCAT.dotabb} -"UTSCAT" - [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"]; -"UTSCAT" -> "UPSCAT" -\end{chunk} -\begin{chunk}{UTSCAT.dotfull} -"UnivariateTaylorSeriesCategory(a:Ring)" - [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"]; -"UnivariateTaylorSeriesCategory(a:Ring)" -> - "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" +\begin{chunk}{COQ UTSCAT} +(* category UTSCAT *) +(* -\end{chunk} -\begin{chunk}{UTSCAT.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; + zero? : % -> Boolean + zero? x == + empty? (coefs := coefficients x) => true + (zero? frst coefs) and (empty? rst coefs) => true + false -"UnivariateTaylorSeriesCategory(a:Ring)" [color=lightblue]; -"UnivariateTaylorSeriesCategory(a:Ring)" -> - "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" +--% OutputForms -"UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" - [color=seagreen,href="bookvol10.2.pdf#nameddest=UPSCAT"]; +-- We provide defaulr output functions on UTSCAT using the functions +-- 'coefficients', 'center', and 'variable'. + + -- check a global Lisp variable + factorials?: () -> Boolean + factorials?() == false + + termOutput: (I,Coef,OUT) -> OUT + termOutput(k,c,vv) == + -- creates a term c * vv ** k + k = 0 => c :: OUT + mon := (k = 1 => vv; vv ** (k :: OUT)) + c = 1 => mon + c = -1 => -mon + (c :: OUT) * mon + + -- check a global Lisp variable + showAll?: () -> Boolean + showAll?() == true + + coerce : % -> OutputForm + coerce(p:%):OUT == + empty? (uu := coefficients p) => (0$Coef) :: OUT + var := variable p; cen := center p + vv := + zero? cen => var :: OUT + paren(var :: OUT - cen :: OUT) + n : NNI ; count : NNI := _$streamCount$Lisp + l : L OUT := empty() + for n in 0..count while not empty? uu repeat + if frst(uu) ^= 0 then + l := concat(termOutput(n :: I,frst uu,vv),l) + uu := rst uu + if showAll?() then + for n in (count + 1).. while explicitEntries? uu and _ + not eq?(uu,rst uu) repeat + if frst(uu) ^= 0 then + l := concat(termOutput(n :: I,frst uu,vv),l) + uu := rst uu + l := + explicitlyEmpty? uu => l + eq?(uu,rst uu) and frst uu = 0 => l + concat(prefix("O" :: OUT,[vv ** (n :: OUT)]),l) + empty? l => (0$Coef) :: OUT + reduce("+",reverse_! l) + + if Coef has Field then + + ?*? : (%,Coef) -> % + (x:%) ** (r:Coef) == series power(r,coefficients x)$STTA + + if Coef has Algebra Fraction Integer then + if Coef has CommutativeRing then + + ?**? : (%,%) -> % + (x:%) ** (y:%) == series(coefficients x **$STTF coefficients y) + + ?**? : (%,Fraction(Integer)) -> % + (x:%) ** (r:RN) == series powern(r,coefficients x)$STTA + + exp : % -> % + exp x == series exp(coefficients x)$STTF + + log : % -> % + log x == series log(coefficients x)$STTF + + sin : % -> % + sin x == series sin(coefficients x)$STTF + + cos : % -> % + cos x == series cos(coefficients x)$STTF + + tan : % -> % + tan x == series tan(coefficients x)$STTF + + cot : % -> % + cot x == series cot(coefficients x)$STTF + + sec : % -> % + sec x == series sec(coefficients x)$STTF + + csc : % -> % + csc x == series csc(coefficients x)$STTF + + asin : % -> % + asin x == series asin(coefficients x)$STTF + + acos : % -> % + acos x == series acos(coefficients x)$STTF + + atan : % -> % + atan x == series atan(coefficients x)$STTF + + acot : % -> % + acot x == series acot(coefficients x)$STTF + + asec : % -> % + asec x == series asec(coefficients x)$STTF + + acsc : % -> % + acsc x == series acsc(coefficients x)$STTF + + sinh : % -> % + sinh x == series sinh(coefficients x)$STTF + + cosh : % -> % + cosh x == series cosh(coefficients x)$STTF + + tanh : % -> % + tanh x == series tanh(coefficients x)$STTF + + coth : % -> % + coth x == series coth(coefficients x)$STTF + + sech : % -> % + sech x == series sech(coefficients x)$STTF + + csch : % -> % + csch x == series csch(coefficients x)$STTF + + asinh : % -> % + asinh x == series asinh(coefficients x)$STTF + + acosh : % -> % + acosh x == series acosh(coefficients x)$STTF + + atanh : % -> % + atanh x == series atanh(coefficients x)$STTF + + acoth : % -> % + acoth x == series acoth(coefficients x)$STTF + + asech : % -> % + asech x == series asech(coefficients x)$STTF + + acsch : % -> % + acsch x == series acsch(coefficients x)$STTF + + else + + ?**? : (%,%) -> % + (x:%) ** (y:%) == series(coefficients x **$STNC coefficients y) + + ?**? : (%,Fraction(Integer)) -> % + (x:%) ** (r:RN) == + coefs := coefficients x + empty? coefs => + positive? r => 0 + zero? r => error "0**0 undefined" + error "0 raised to a negative power" + not (frst coefs = 1) => + error "**: constant coefficient should be 1" + coefs := concat(0,rst coefs) + onePlusX := monom(1,0)$STTA + $STTA monom(1,1)$STTA + ratPow := powern(r,onePlusX)$STTA + series compose(ratPow,coefs)$STTA + + exp : % -> % + exp x == series exp(coefficients x)$STNC + + log : % -> % + log x == series log(coefficients x)$STNC + + sin : % -> % + sin x == series sin(coefficients x)$STNC + + cos : % -> % + cos x == series cos(coefficients x)$STNC + + tan : % -> % + tan x == series tan(coefficients x)$STNC + + cot : % -> % + cot x == series cot(coefficients x)$STNC + + sec : % -> % + sec x == series sec(coefficients x)$STNC + + csc : % -> % + csc x == series csc(coefficients x)$STNC + + asin : % -> % + asin x == series asin(coefficients x)$STNC + + acos : % -> % + acos x == series acos(coefficients x)$STNC + + atan : % -> % + atan x == series atan(coefficients x)$STNC + + acot : % -> % + acot x == series acot(coefficients x)$STNC + + asec : % -> % + asec x == series asec(coefficients x)$STNC + + acsc : % -> % + acsc x == series acsc(coefficients x)$STNC + + sinh : % -> % + sinh x == series sinh(coefficients x)$STNC + + cosh : % -> % + cosh x == series cosh(coefficients x)$STNC + + tanh : % -> % + tanh x == series tanh(coefficients x)$STNC + + coth : % -> % + coth x == series coth(coefficients x)$STNC + + sech : % -> % + sech x == series sech(coefficients x)$STNC + + csch : % -> % + csch x == series csch(coefficients x)$STNC + + asinh : % -> % + asinh x == series asinh(coefficients x)$STNC + + acosh : % -> % + acosh x == series acosh(coefficients x)$STNC + + atanh : % -> % + atanh x == series atanh(coefficients x)$STNC + + acoth : % -> % + acoth x == series acoth(coefficients x)$STNC + + asech : % -> % + asech x == series asech(coefficients x)$STNC + + acsch : % -> % + acsch x == series acsch(coefficients x)$STNC +*) + +\end{chunk} + +\begin{chunk}{UTSCAT.dotabb} +"UTSCAT" + [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"]; +"UTSCAT" -> "UPSCAT" + +\end{chunk} + +\begin{chunk}{UTSCAT.dotfull} +"UnivariateTaylorSeriesCategory(a:Ring)" + [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"]; +"UnivariateTaylorSeriesCategory(a:Ring)" -> + "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" + +\end{chunk} + +\begin{chunk}{UTSCAT.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; + +"UnivariateTaylorSeriesCategory(a:Ring)" [color=lightblue]; +"UnivariateTaylorSeriesCategory(a:Ring)" -> + "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" + +"UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" + [color=seagreen,href="bookvol10.2.pdf#nameddest=UPSCAT"]; "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" -> "UnivariatePowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid)" @@ -59634,6 +68134,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 16} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AlgebraicallyClosedField}{ACF} @@ -59835,6 +68336,7 @@ zerosOf(sup,x) )spool )lisp (bye) \end{chunk} + \begin{chunk}{AlgebraicallyClosedField.help} ==================================================================== AlgebraicallyClosedField examples @@ -60261,9 +68763,7 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with nthRoot(- (r::$ / a), d) binomialRoots(p, y, fn) == - -- p = a * x**n + b alpha := assign(x := new(y)$Symbol, fn(p, x)) --- one?(n := degree p) => [ alpha ] ((n := degree p) = 1) => [ alpha ] cyclo := cyclotomic(n,monomial(1,1)$SUP)_ $NumberTheoreticPolynomialFunctions(SUP) @@ -60297,6 +68797,106 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with reverse_! ans \end{chunk} + +\begin{chunk}{COQ ACF} +(* category ACF *) +(* + + SUP ==> SparseUnivariatePolynomial $ + + zeroOf : Polynomial(%) -> % + zeroOf(p:SUP) == assign(x := new(), zeroOf(p, x)) + + rootOf : Polynomial(%) -> % + rootOf(p:SUP) == assign(x := new(), rootOf(p, x)) + + zerosOf : Polynomial(%) -> List(%) + zerosOf(p:SUP) == zerosOf(p, new()) + + rootsOf : SparseUnivariatePolynomial(%) -> List(%) + rootsOf(p:SUP) == rootsOf(p, new()) + + rootsOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%) + rootsOf(p:SUP, y:Symbol) == allroots(p, y, rootOf) + + zerosOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%) + zerosOf(p:SUP, y:Symbol) == allroots(p, y, zeroOf) + + assign : (Symbol, $) -> $ + assign(x, f) == (assignSymbol(x, f, $)$Lisp; f) + + zeroOf : Polynomial(%) -> % + zeroOf(p:Polynomial $) == + empty?(l := variables p) => error "zeroOf: constant polynomial" + zeroOf(univariate p, first l) + + rootOf : Polynomial(%) -> % + rootOf(p:Polynomial $) == + empty?(l := variables p) => error "rootOf: constant polynomial" + rootOf(univariate p, first l) + + zerosOf : Polynomial(%) -> List(%) + zerosOf(p:Polynomial $) == + empty?(l := variables p) => error "zerosOf: constant polynomial" + zerosOf(univariate p, first l) + + rootsOf : Polynomial(%) -> List(%) + rootsOf(p:Polynomial $) == + empty?(l := variables p) => error "rootsOf: constant polynomial" + rootsOf(univariate p, first l) + + zeroOf : (SparseUnivariatePolynomial(%),Symbol) -> % + zeroOf(p:SUP, y:Symbol) == + zero?(d := degree p) => error "zeroOf: constant polynomial" + zero? coefficient(p, 0) => 0 + a := leadingCoefficient p + d = 2 => + b := coefficient(p, 1) + (sqrt(b**2 - 4 * a * coefficient(p, 0)) - b) / (2 * a) + (r := retractIfCan(reductum p)@Union($,"failed")) case "failed" => + rootOf(p, y) + nthRoot(- (r::$ / a), d) + + binomialRoots: (SUP, Symbol, (SUP, Symbol) -> $) -> List $ + binomialRoots(p, y, fn) == + alpha := assign(x := new(y)$Symbol, fn(p, x)) + ((n := degree p) = 1) => [ alpha ] + cyclo := cyclotomic(n,monomial(1,1)$SUP)_ + $NumberTheoreticPolynomialFunctions(SUP) + beta := assign(x := new(y)$Symbol, fn(cyclo, x)) + [alpha*beta**i for i in 0..(n-1)::NonNegativeInteger] + + import PolynomialDecomposition(SUP,$) + + allroots: (SUP, Symbol, (SUP, Symbol) -> $) -> List $ + allroots(p, y, fn) == + zero? p => error "allroots: polynomial must be nonzero" + zero? coefficient(p,0) => + concat(0, allroots(p quo monomial(1,1), y, fn)) + zero?(p1:=reductum p) => empty() + zero? reductum p1 => binomialRoots(p, y, fn) + decompList := decompose(p) + # decompList > 1 => + h := last decompList + g := leftFactor(p,h) :: SUP + groots := allroots(g, y, fn) + "append"/[allroots(h-r::SUP, y, fn) for r in groots] + ans := nil()$List($) + while not ground? p repeat + alpha := assign(x := new(y)$Symbol, fn(p, x)) + q := monomial(1, 1)$SUP - alpha::SUP + if not zero?(p alpha) then + p := p quo q + ans := concat(alpha, ans) + else while zero?(p alpha) repeat + p := (p exquo q)::SUP + ans := concat(alpha, ans) + reverse_! ans + +*) + +\end{chunk} + \begin{chunk}{ACF.dotabb} "ACF" [color=lightblue,href="bookvol10.2.pdf#nameddest=ACF"]; @@ -60304,6 +68904,7 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with "ACF" -> "RADCAT" \end{chunk} + \begin{chunk}{ACF.dotfull} "AlgebraicallyClosedField()" [color=lightblue,href="bookvol10.2.pdf#nameddest=ACF"]; @@ -60311,6 +68912,7 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with "AlgebraicallyClosedField()" -> "RadicalCategory()" \end{chunk} + \begin{chunk}{ACF.dotpic} digraph pic { fontsize=10; @@ -60345,6 +68947,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{DifferentialPolynomialCategory}{DPOLCAT} \pagepic{ps/v102differentialpolynomialcategory.ps}{DPOLCAT}{0.35} @@ -60508,6 +69111,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{DifferentialPolynomialCategory.help} ==================================================================== DifferentialPolynomialCategory examples @@ -61158,6 +69762,151 @@ DifferentialPolynomialCategory(R:Ring,S:OrderedSet, [rhs e for e in l]$List($)) \end{chunk} + +\begin{chunk}{COQ DPOLCAT} +(* category DPOLCAT *) +(* + p:$ + s:S + + makeVariable : % -> (NonNegativeInteger -> %) + makeVariable s == n +-> makeVariable(s,n)::$ + + if R has IntegralDomain then + + differentiate : (%,(R -> R)) -> % + differentiate(p:$, d:R -> R) == + ans:$ := 0 + l := variables p + while (u:=retractIfCan(p)@Union(R, "failed")) case "failed" repeat + t := leadingMonomial p + lc := leadingCoefficient t + ans := ans + d(lc)::$ * (t exquo lc)::$ + + +/[differentiate(t, v) * (differentiate v)::$ for v in l] + p := reductum p + ans + d(u::R)::$ + + order : % -> NonNegativeInteger + order (p:$):NonNegativeInteger == + ground? p => 0 + "max"/[order v for v in variables p] + + order : (%,S) -> NonNegativeInteger + order (p:$,s:S):NonNegativeInteger == + ground? p => 0 + empty? (vv:= [order v for v in variables p | (variable v) = s ]) =>0 + "max"/vv + + degree : (%,S) -> NonNegativeInteger + degree (p, s) == + d:NonNegativeInteger:=0 + for lp in monomials p repeat + lv:= [v for v in variables lp | (variable v) = s ] + if not empty? lv then d:= max(d, +/degree(lp, lv)) + d + + weights : % -> List(NonNegativeInteger) + weights p == + ws:List NonNegativeInteger := nil + empty? (mp:=monomials p) => ws + for lp in mp repeat + lv:= variables lp + if not empty? lv then + dv:= degree(lp, lv) + w:=+/[(weight v) * d _ + for v in lv for d in dv]$(List NonNegativeInteger) + ws:= concat(ws, w) + ws + + weight : % -> NonNegativeInteger + weight p == + empty? (ws:=weights p) => 0 + "max"/ws + + weights : (%,S) -> List(NonNegativeInteger) + weights (p, s) == + ws:List NonNegativeInteger := nil + empty?(mp:=monomials p) => ws + for lp in mp repeat + lv:= [v for v in variables lp | (variable v) = s ] + if not empty? lv then + dv:= degree(lp, lv) + w:=+/[(weight v) * d _ + for v in lv for d in dv]$(List NonNegativeInteger) + ws:= concat(ws, w) + ws + + weight : (%,S) -> NonNegativeInteger + weight (p,s) == + empty? (ws:=weights(p,s)) => 0 + "max"/ws + + isobaric? : % -> Boolean + isobaric? p == (# removeDuplicates weights p) = 1 + + leader : % -> V + leader p == -- depends on the ranking + vl:= variables p + -- it's not enough just to look at leadingMonomial p + -- the term-ordering need not respect the ranking + empty? vl => error "leader is not defined " + "max"/vl + + initial : % -> % + initial p == leadingCoefficient univariate(p,leader p) + + separant : % -> % + separant p == differentiate(p, leader p) + + coerce : S -> % + coerce(s:S):$ == s::V::$ + + retractIfCan : % -> Union(S,"failed") + retractIfCan(p:$):Union(S, "failed") == + (v := retractIfCan(p)@Union(V,"failed")) case "failed" => "failed" + retractIfCan(v::V) + + differentialVariables : % -> List(S) + differentialVariables p == + removeDuplicates [variable v for v in variables p] + + if R has DifferentialRing then + + makeVariable : % -> (NonNegativeInteger -> %) + makeVariable p == n +-> differentiate(p, n) + + eval : (%,List(S),List(R)) -> % + eval(p:$, sl:List S, rl:List R) == + ordp:= order p + vl := concat [[makeVariable(s,j)$V for j in 0..ordp] + for s in sl]$List(List V) + rrl:=nil$List(R) + for r in rl repeat + t:= r + rrl:= concat(rrl, + concat(r, [t := differentiate t for i in 1..ordp])) + eval(p, vl, rrl) + + eval : (%,List(S),List(%)) -> % + eval(p:$, sl:List S, rl:List $) == + ordp:= order p + vl := concat [[makeVariable(s,j)$V for j in 0..ordp] + for s in sl]$List(List V) + rrl:=nil$List($) + for r in rl repeat + t:=r + rrl:=concat(rrl, + concat(r, [t:=differentiate t for i in 1..ordp])) + eval(p, vl, rrl) + + eval : (%,List(Equation(%))) -> % + eval(p:$, l:List Equation $) == + eval(p, [retract(lhs e)@S for e in l]$List(S), + [rhs e for e in l]$List($)) +*) + +\end{chunk} + \begin{chunk}{DPOLCAT.dotabb} "DPOLCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DPOLCAT"]; @@ -61166,6 +69915,7 @@ DifferentialPolynomialCategory(R:Ring,S:OrderedSet, "DPOLCAT" -> "RETRACT" \end{chunk} + \begin{chunk}{DPOLCAT.dotfull} "DifferentialPolynomialCategory(a:Ring,b:OrderedSet,c:DifferentialVariableCategory(b),d:OrderedAbelianMonoidSup)" [color=lightblue,href="bookvol10.2.pdf#nameddest=DPOLCAT"]; @@ -61177,6 +69927,7 @@ DifferentialPolynomialCategory(R:Ring,S:OrderedSet, -> "RetractableTo(OrderedSet)" \end{chunk} + \begin{chunk}{DPOLCAT.dotpic} digraph pic { fontsize=10; @@ -61241,6 +69992,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FieldOfPrimeCharacteristic}{FPC} \pagepic{ps/v102fieldofprimecharacteristic.ps}{FPC}{1.00} @@ -61308,6 +70060,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FieldOfPrimeCharacteristic.help} ==================================================================== FieldOfPrimeCharacteristic examples @@ -61515,6 +70268,17 @@ FieldOfPrimeCharacteristic:Category == _ primeFrobenius(a,s) == a ** (characteristic()**s) \end{chunk} + +\begin{chunk}{COQ FPC} +(* category FPC *) +(* + primeFrobenius(a) == a ** characteristic() + primeFrobenius(a,s) == a ** (characteristic()**s) + +*) + +\end{chunk} + \begin{chunk}{FPC.dotabb} "FPC" [color=lightblue,href="bookvol10.2.pdf#nameddest=FPC"]; @@ -61522,12 +70286,14 @@ FieldOfPrimeCharacteristic:Category == _ "FPC" -> "FIELD" \end{chunk} + \begin{chunk}{FPC.dotfull} "FieldOfPrimeCharacteristic()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FPC"]; "FieldOfPrimeCharacteristic()" -> "CharacteristicNonZero()" \end{chunk} + \begin{chunk}{FPC.dotpic} digraph pic { fontsize=10; @@ -61558,6 +70324,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteRankAlgebra}{FINRALG} \pagepic{ps/v102finiterankalgebra.ps}{FINRALG}{0.50} @@ -61610,6 +70377,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FiniteRankAlgebra.help} ==================================================================== FiniteRankAlgebra examples @@ -61810,6 +70578,41 @@ FiniteRankAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): [parts coordinates(x*b(i+m),b) for i in 1..rank()]$List(List R) \end{chunk} + +\begin{chunk}{COQ FINRALG} +(* category FINRALG *) +(* + + discriminant : Vector(%) -> R + discriminant v == determinant traceMatrix v + + coordinates : (Vector(%),Vector(%)) -> Matrix(R) + coordinates(v:Vector %, b:Vector %) == + m := new(#v, #b, 0)$Matrix(R) + for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat + setRow_!(m, j, coordinates(qelt(v, i), b)) + m + + represents : (Vector(R),Vector(%)) -> % + represents(v, b) == + m := minIndex v - 1 + _+/[v(i+m) * b(i+m) for i in 1..rank()] + + traceMatrix : Vector(%) -> Matrix(R) + traceMatrix v == + matrix [[trace(v.i*v.j) for j in minIndex v..maxIndex v]$List(R) + for i in minIndex v .. maxIndex v]$List(List R) + + regularRepresentation : (%,Vector(%)) -> Matrix(R) + regularRepresentation(x, b) == + m := minIndex b - 1 + matrix + [parts coordinates(x*b(i+m),b) for i in 1..rank()]$List(List R) + +*) + +\end{chunk} + \begin{chunk}{FINRALG.dotabb} "FINRALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FINRALG"]; @@ -61819,6 +70622,7 @@ FiniteRankAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): "FINRALG" -> "CHARZ" \end{chunk} + \begin{chunk}{FINRALG.dotfull} "FiniteRankAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" [color=lightblue,href="bookvol10.2.pdf#nameddest=FINRALG"]; @@ -61832,6 +70636,7 @@ FiniteRankAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): "CharacteristicZero()" \end{chunk} + \begin{chunk}{FINRALG.dotpic} digraph pic { fontsize=10; @@ -61872,6 +70677,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FunctionSpace}{FS} \pagepic{ps/v102functionspace.ps}{FS}{0.65} @@ -62052,6 +70858,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FunctionSpace.help} ==================================================================== FunctionSpace examples @@ -62920,7 +71727,6 @@ FunctionSpace(R:OrderedSet): Category == Definition where [kernel(op, z), g, l.n] opderiv(op, n) == --- one? n => (n = 1) => g := symsub(gendiff, n)::% [x +-> kernel(opdiff,[kernel(op, g), g, first x])] @@ -63027,7 +71833,6 @@ FunctionSpace(R:OrderedSet): Category == Definition where if R has RetractableTo Z then smpIsMult p == --- (u := mainVariable p) case K and one? degree(q:=univariate(p,u::K)) (u := mainVariable p) case K and (degree(q:=univariate(p,u::K))=1) and zero?(leadingCoefficient reductum q) and ((r:=retractIfCan(leadingCoefficient q)@Union(R,"failed")) @@ -63160,7 +71965,6 @@ FunctionSpace(R:OrderedSet): Category == Definition where retract(x:%):R == (retract(numer x)@R exquo retract(denom x)@R)::R coerce(x:%):OutputForm == --- one?(denom x) => smp2O numer x ((denom x) = 1) => smp2O numer x smp2O(numer x) / smp2O(denom x) @@ -63233,1512 +72037,1069 @@ FunctionSpace(R:OrderedSet): Category == Definition where convert(numer x) / convert(denom x) \end{chunk} -\begin{chunk}{FS.dotabb} -"FS" - [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"]; -"FS" -> "ES" -"FS" -> "FPATMAB" -"FS" -> "FRETRCT" -"FS" -> "PATAB" -"FS" -> "RETRACT" -"FS" -> "KONVERT" -"FS" -> "MONOID" -"FS" -> "GROUP" -"FS" -> "ABELMON" -"FS" -> "ABELGRP" -"FS" -> "PDRING" -"FS" -> "FLINEXP" -"FS" -> "CHARNZ" -"FS" -> "INTDOM" -"FS" -> "FIELD" -\end{chunk} -\begin{chunk}{FS.dotfull} -"FunctionSpace(a:OrderedSet)" - [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"]; -"FunctionSpace(a:OrderedSet)" -> "ExpressionSpace()" -"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Symbol)" -"FunctionSpace(a:OrderedSet)" -> "Patternable(OrderedSet)" -"FunctionSpace(a:OrderedSet)" -> "FullyPatternMatchable(OrderedSet)" -"FunctionSpace(a:OrderedSet)" -> "FullyRetractableTo(OrderedSet)" -"FunctionSpace(a:OrderedSet)" -> "ConvertibleTo(InputForm)" -"FunctionSpace(a:OrderedSet)" -> "Monoid()" -"FunctionSpace(a:OrderedSet)" -> "Group()" -"FunctionSpace(a:OrderedSet)" -> "AbelianMonoid()" -"FunctionSpace(a:OrderedSet)" -> "AbelianGroup()" -"FunctionSpace(a:OrderedSet)" -> "PartialDifferentialRing(Symbol)" -"FunctionSpace(a:OrderedSet)" -> "FullyLinearlyExplicitRingOver(OrderedSet)" -"FunctionSpace(a:OrderedSet)" -> "CharacteristicNonZero()" -"FunctionSpace(a:OrderedSet)" -> "IntegralDomain()" -"FunctionSpace(a:OrderedSet)" -> "Field()" -"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Integer)" -"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Fraction(Integer))" +\begin{chunk}{COQ FS} +(* category FS *) +(* + import BasicOperatorFunctions1(%) -\end{chunk} -\begin{chunk}{FS.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; + -- these are needed in Ring only, but need to be declared here + -- because of compiler bug: if they are declared inside the Ring + -- case, then they are not visible inside the IntegralDomain case. -"FunctionSpace(a:OrderedSet)" [color=lightblue]; -"FunctionSpace(a:OrderedSet)" -> "ES..." -"FunctionSpace(a:OrderedSet)" -> "RETRACT..." -"FunctionSpace(a:OrderedSet)" -> "PATAB..." -"FunctionSpace(a:OrderedSet)" -> "FPATMAB..." -"FunctionSpace(a:OrderedSet)" -> "FRETRCT..." -"FunctionSpace(a:OrderedSet)" -> "KONVERT..." -"FunctionSpace(a:OrderedSet)" -> "MONOID..." -"FunctionSpace(a:OrderedSet)" -> "GROUP..." -"FunctionSpace(a:OrderedSet)" -> "ABELMON..." -"FunctionSpace(a:OrderedSet)" -> "ABELGRP..." -"FunctionSpace(a:OrderedSet)" -> "PDRING..." -"FunctionSpace(a:OrderedSet)" -> "FLINEXP..." -"FunctionSpace(a:OrderedSet)" -> "CHARNZ..." -"FunctionSpace(a:OrderedSet)" -> "INTDOM..." -"FunctionSpace(a:OrderedSet)" -> "FIELD..." -"FunctionSpace(a:OrderedSet)" -> "RETRACT..." + opdiff := operator("%diff"::SY)$CommonOperators() -"ES..." [color=lightblue]; -"EVALABLE..." [color=lightblue]; -"FRETRCT..." [color=lightblue]; -"FPATMAB..." [color=lightblue]; -"IEVALAB..." [color=lightblue]; -"ORDSET..." [color=lightblue]; -"PATAB..." [color=lightblue]; -"RETRACT..." [color=lightblue]; -"KONVERT..." [color=lightblue]; -"MONOID..." [color=lightblue]; -"GROUP..." [color=lightblue]; -"ABELMON..." [color=lightblue]; -"ABELGRP..." [color=lightblue]; -"PDRING..." [color=lightblue]; -"FLINEXP..." [color=lightblue]; -"CHARNZ..." [color=lightblue]; -"INTDOM..." [color=lightblue]; -"FIELD..." [color=lightblue]; -"RETRACT..." [color=lightblue]; -} + opquote := operator("applyQuote"::SY)$CommonOperators -\end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{InfinitlyClosePointCategory}{INFCLCT} -\pagepic{ps/v102infinitlyclosepointcategory.eps}{INFCLCT}{0.50} + ground? : % -> Boolean + ground? x == retractIfCan(x)@Union(R,"failed") case R -\begin{chunk}{InfinitlyClosePointCategory.input} -)set break resume -)sys rm -f InfinitlyClosePointCategory.output -)spool InfinitlyClosePointCategory.output -)set message test on -)set message auto off -)clear all + ground : % -> R + ground x == retract x ---S 1 of 1 -)show InfinitlyClosePointCategory ---R ---I InfinitlyClosePointCategory(K: Field, ---I symb: List Symbol, ---I PolyRing: PolynomialCategory(t#1,t#4,OrderedVariableList t#2), ---I E: DirectProductCategory(# t#2,NonNegativeInteger), ---I ProjPt: ProjectiveSpaceCategory t#1, ---I PCS: LocalPowerSeriesCategory t#1, ---I Plc: PlacesCategory(t#1,t#6), ---I DIVISOR: DivisorCategory t#7, ---I BLMET: BlowUpMethodCategory) is a category constructor ---I Abbreviation for InfinitlyClosePointCategory is INFCLCT ---I This constructor is exposed in this frame. ---I Issue )edit bookvol10.2.pamphlet to see algebra source code for INFCLCT ---I ---I------------------------------- Operations -------------------------------- ---I ?=? : (%,%) -> Boolean actualExtensionV : % -> K ---I chartV : % -> BLMET coerce : % -> OutputForm ---I create : (ProjPt,PolyRing) -> % degree : % -> PositiveInteger ---I excpDivV : % -> DIVISOR hash : % -> SingleInteger ---I latex : % -> String localParamV : % -> List PCS ---I localPointV : % -> AffinePlane K multV : % -> NonNegativeInteger ---I pointV : % -> ProjPt setchart! : (%,BLMET) -> BLMET ---I setpoint! : (%,ProjPt) -> ProjPt symbNameV : % -> Symbol ---I ?~=? : (%,%) -> Boolean ---I create : (ProjPt, ---I DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K), ---I AffinePlane K, ---I NonNegativeInteger, ---I BLMET, ---I NonNegativeInteger, ---I DIVISOR, ---I K, ---I Symbol) -> % ---I curveV : % -> ---I DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) ---I setcurve! : ---I (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> ---I DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) ---I setexcpDiv! : (%,DIVISOR) -> DIVISOR ---I setlocalParam! : (%,List PCS) -> List PCS ---I setlocalPoint! : (%,AffinePlane K) -> AffinePlane K ---I setmult! : (%,NonNegativeInteger) -> NonNegativeInteger ---I setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger ---I setsymbName! : (%,Symbol) -> Symbol ---I subMultV : % -> NonNegativeInteger ---I ---E 1 + coerce : Symbol -> % + coerce(x:SY):% == kernel(x)@K :: % -)spool -)lisp (bye) -\end{chunk} -\begin{chunk}{InfinitlyClosePointCategory.help} -==================================================================== -InfinitlyClosePointCategory examples -==================================================================== + retract : % -> Symbol + retract(x:%):SY == symbolIfCan(retract(x)@K)::SY -This category is part of the PAFF package + applyQuote : (Symbol,%) -> % + applyQuote(s:SY, x:%) == applyQuote(s, [x]) -See Also: -o )show InfinitlyClosePointCategory + applyQuote : (Symbol,%,%) -> % + applyQuote(s, x, y) == applyQuote(s, [x, y]) -\end{chunk} + applyQuote : (Symbol,%,%,%) -> % + applyQuote(s, x, y, z) == applyQuote(s, [x, y, z]) -\pagefrom{SetCategoryWithDegree}{SETCATD} + applyQuote : (Symbol,%,%,%,%) -> % + applyQuote(s, x, y, z, t) == applyQuote(s, [x, y, z, t]) -{\bf Exports:}\\ -\begin{tabular}{llll} -\cross{INFCLCT}{?=?} & -\cross{INFCLCT}{?\~{}=?} & -\cross{INFCLCT}{actualExtensionV} & -\cross{INFCLCT}{chartV} \\ -\cross{INFCLCT}{coerce} & -\cross{INFCLCT}{create} & -\cross{INFCLCT}{curveV} & -\cross{INFCLCT}{degree} \\ -\cross{INFCLCT}{excpDivV} & -\cross{INFCLCT}{hash} & -\cross{INFCLCT}{latex} & -\cross{INFCLCT}{localParamV} \\ -\cross{INFCLCT}{localPointV} & -\cross{INFCLCT}{multV} & -\cross{INFCLCT}{pointV} & -\cross{INFCLCT}{setchart!} \\ -\cross{INFCLCT}{setcurve!} & -\cross{INFCLCT}{setexcpDiv!} & -\cross{INFCLCT}{setlocalParam!} & -\cross{INFCLCT}{setlocalPoint!} \\ -\cross{INFCLCT}{setmult!} & -\cross{INFCLCT}{setpoint!} & -\cross{INFCLCT}{setsubmult!} & -\cross{INFCLCT}{setsymbName!} \\ -\cross{INFCLCT}{subMultV} & -\cross{INFCLCT}{symbNameV} && -\end{tabular} + applyQuote : (Symbol,List(%)) -> % + applyQuote(s:SY, l:List %) == opquote concat(s::%, l) -These are directly exported but not implemented: -\begin{verbatim} - actualExtensionV : % -> K - chartV : % -> BLMET - create : - (ProjPt,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K), - AffinePlane K,NonNegativeInteger,BLMET,NonNegativeInteger,DIVISOR,K,Symbol) - -> % - create : (ProjPt,PolyRing) -> % - curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) - excpDivV : % -> DIVISOR - localParamV : % -> List PCS - localPointV : % -> AffinePlane K - multV : % -> NonNegativeInteger - pointV : % -> ProjPt - setchart! : (%,BLMET) -> BLMET - setcurve! : - (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> - DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) - setexcpDiv! : (%,DIVISOR) -> DIVISOR - setlocalParam! : (%,List PCS) -> List PCS - setlocalPoint! : (%,AffinePlane K) -> AffinePlane K - setmult! : (%,NonNegativeInteger) -> NonNegativeInteger - setpoint! : (%,ProjPt) -> ProjPt - setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger - setsymbName! : (%,Symbol) -> Symbol - subMultV : % -> NonNegativeInteger - symbNameV : % -> Symbol -\end{verbatim} + belong? : BasicOperator -> Boolean + belong? op == op = opdiff or op = opquote -These exports come from \refto{SetCategoryWithDegree}: -\begin{verbatim} - ?=? : (%,%) -> Boolean - ?~=? : (%,%) -> Boolean - coerce : % -> OutputForm - degree : % -> PositiveInteger - hash : % -> SingleInteger - latex : % -> String -\end{verbatim} + subs : (% -> %, K) -> % + subs(fn, k) == kernel(operator k,[fn x for x in argument k]$List(%)) -\begin{chunk}{category INFCLCT InfinitlyClosePointCategory} -)abbrev category INFCLCT InfinitlyClosePointCategory -++ Authors: Gaetan Hache -++ Date Created: may 1997 -++ Date Last Updated: April 2010, by Tim Daly -++ Description: -++ This category is part of the PAFF package -InfinitlyClosePointCategory(_ - K :Field,_ - symb :List(Symbol),_ - PolyRing :PolynomialCategory(K,E,OrderedVariableList(symb)),_ - E :DirectProductCategory(#symb,NonNegativeInteger),_ - ProjPt :ProjectiveSpaceCategory(K),_ - PCS :LocalPowerSeriesCategory(K),_ - Plc :PlacesCategory(K,PCS),_ - DIVISOR :DivisorCategory(Plc),_ - BLMET :BlowUpMethodCategory_ - ):Category == Exports where + operator : BasicOperator -> BasicOperator + operator op == + is?(op, "%diff"::SY) => opdiff + is?(op, "%quote"::SY) => opquote + error "Unknown operator" - bls ==> ['X,'Y] - BlUpRing ==> DistributedMultivariatePolynomial(bls , K) - AFP ==> AffinePlane(K) + if R has ConvertibleTo InputForm then - Exports ==> SetCategoryWithDegree with + INP==>InputForm - create: (ProjPt , BlUpRing, AFP , NonNegativeInteger,BLMET, _ - NonNegativeInteger, DIVISOR,K,Symbol) -> % - ++ create an infinitly close point + import MakeUnaryCompiledFunction(%, %, %) - create: (ProjPt,PolyRing) -> % - - setpoint_!: (%,ProjPt) -> ProjPt + differentiand: List % -> % + differentiand l == eval(first l, retract(second l)@K, third l) - setcurve_!: (%,BlUpRing) -> BlUpRing + pint : List INP-> INP + pint l == convert concat(convert("D"::SY)@INP, l) - setlocalPoint_!: (%,AFP) -> AFP - - setsubmult_! : (%, NonNegativeInteger) -> NonNegativeInteger + indiff: List % -> INP + indiff l == + r2:= convert([convert("::"::SY)@INP,_ + convert(third l)@INP,_ + convert("Symbol"::SY)@INP]@List INP)@INP + pint [convert(differentiand l)@INP, r2] - setmult_!: (%,NonNegativeInteger) -> NonNegativeInteger - - setchart_!: (%,BLMET) -> BLMET -- CHH + eval(f:%, s:SY) == eval(f, [s]) - setexcpDiv_!: (%,DIVISOR) -> DIVISOR + eval(f:%, s:OP, g:%, x:SY) == eval(f, [s], [g], x) - setlocalParam_!: (%,List PCS) -> List(PCS) + eval(f:%, ls:List OP, lg:List %, x:SY) == + eval(f, ls, [compiledFunction(g, x) for g in lg]) - setsymbName_!: (%,Symbol) -> Symbol - - subMultV: % -> NonNegativeInteger + setProperty(opdiff,SPECIALINPUT,_ + indiff@(List % -> InputForm) pretend None) - localParamV: % -> List PCS + variables : % -> List(Symbol) + variables x == + l := empty()$List(SY) + for k in tower x repeat + if ((s := symbolIfCan k) case SY) then l := concat(s::SY, l) + reverse_! l - symbNameV: % -> Symbol + retractIfCan : % -> Union(Symbol,"failed") + retractIfCan(x:%):Union(SY, "failed") == + (k := retractIfCan(x)@Union(K,"failed")) case "failed" => "failed" + symbolIfCan(k::K) - pointV: % -> ProjPt - ++ pointV returns the infinitly close point. + if R has Ring then - curveV: % -> BlUpRing - ++ curveV(p) returns the defining polynomial of the strict transform - ++ on which lies the corresponding infinitly close point. + import UserDefinedPartialOrdering(SY) - localPointV: % -> AFP - ++ localPointV returns the coordinates of the local infinitly - ++ close point +-- cannot use new()$Symbol because of possible re-instantiation + gendiff := "%%0"::SY - multV: % -> NonNegativeInteger - ++ multV returns the multiplicity of the infinitly close point. + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$R - chartV: % -> BLMET -- CHH - ++ chartV is the chart of the infinitly close point. The first integer - ++ correspond to variable defining the exceptional line, the last one - ++ the affine neighboorhood and the second one is the - ++ remaining integer. For example [1,2,3] means that - ++ Z=1, X=X and Y=XY. [2,3,1] means that X=1, Y=Y and Z=YZ. + coerce : Kernel(%) -> % + coerce(k:K):% == k::MP::% - excpDivV: % -> DIVISOR - ++ excpDivV returns the exceptional divisor of the infinitly close point. + symsub : (SY, Z) -> SY + symsub(sy, i) == concat(string sy, convert(i)@String)::SY - actualExtensionV: % -> K + numerator : % -> % + numerator x == numer(x)::% -\end{chunk} -\begin{chunk}{INFCLCT.dotabb} -"INFCLCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"]; -"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] -"INFCLCT" -> "ALIST" + eval : (%,Symbol,NonNegativeInteger,(% -> %)) -> % + eval(x:%, s:SY, n:N, f:% -> %) == + eval(x,[s],[n],[(y:List %):% +-> f(first(y))]) -\end{chunk} -\begin{chunk}{INFCLCT.dotfull} -"InfinitlyClosePointCategory" - [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"]; -"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)" + eval : (%,Symbol,NonNegativeInteger,(List(%) -> %)) -> % + eval(x:%, s:SY, n:N, f:List % -> %) == eval(x, [s], [n], [f]) -\end{chunk} -\begin{chunk}{INFCLCT.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; + eval : (%,List(Symbol),List((List(%) -> %))) -> % + eval(x:%, l:List SY, f:List(List % -> %)) == eval(x, l, new(#l, 1), f) -"InfinitlyClosePointCategory" [color=lightblue]; -"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)" + elt : (BasicOperator,List(%)) -> % + elt(op:OP, args:List %) == + unary? op and ((od? := has?(op, ODD)) or has?(op, EVEN)) and + leadingCoefficient(numer first args) < 0 => + x := op(- first args) + od? => -x + x + elt(op, args)$ExpressionSpace_&(%) -"AssocationList(SetCategory,SetCategory)" -> "AssocationList()" + eval : (%,List(Symbol),List(NonNegativeInteger),List((% -> %))) -> % + eval(x:%, s:List SY, n:List N, l:List(% -> %)) == + eval(x, s, n, [y+-> f(first(y)) for f in l]$List(List % -> %)) -"AssocationList()" [color=lightblue]; + -- op(arg)**m ==> func(arg)**(m quo n) * op(arg)**(m rem n) + smprep : (List SY, List N, List(List % -> %), MP) -> % + smprep(lop, lexp, lfunc, p) == + (v := mainVariable p) case "failed" => p::% + symbolIfCan(k := v::K) case SY => p::% + g := (op := operator k) + (arg := [eval(a,lop,lexp,lfunc) for a in argument k]$List(%)) + q := map(y+->eval(y::%, lop, lexp, lfunc), + univariate(p, k))$SparseUnivariatePolynomialFunctions2(MP, %) + (n := position(name op, lop)) < minIndex lop => q g + a:% := 0 + f := eval((lfunc.n) arg, lop, lexp, lfunc) + e := lexp.n + while q ^= 0 repeat + m := degree q + qr := divide(m, e) + t1 := f ** (qr.quotient)::N + t2 := g ** (qr.remainder)::N + a := a + leadingCoefficient(q) * t1 * t2 + q := reductum q + a -} + dispdiff : List % -> Record(name:O, sub:O, arg:List O, level:N) + dispdiff l == + s := second(l)::O + t := third(l)::O + a := argument(k := retract(first l)@K) + is?(k, opdiff) => + rec := dispdiff a + i := position(s, rec.arg) + rec.arg.i := t + [rec.name, + hconcat(rec.sub, hconcat(","::SY::O, (i+1-minIndex a)::O)), + rec.arg, (zero?(rec.level) => 0; rec.level + 1)] + i := position(second l, a) + m := [x::O for x in a]$List(O) + m.i := t + [name(operator k)::O, hconcat(","::SY::O, (i+1-minIndex a)::O), + m, (empty? rest a => 1; 0)] -\end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{PseudoAlgebraicClosureOfPerfectFieldCategory}{PACPERC} -\pagepic{ps/v102pseudoalgebraicclosureofperfectfieldcategory.ps}{PACPERC}{0.50} + ddiff : List % -> O + ddiff l == + rec := dispdiff l + opname := + zero?(rec.level) => sub(rec.name, rec.sub) + differentiate(rec.name, rec.level) + prefix(opname, rec.arg) -\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.input} -)set break resume -)sys rm -f PseudoAlgebraicClosureOfPerfectFieldCategory.output -)spool PseudoAlgebraicClosureOfPerfectFieldCategory.output -)set message test on -)set message auto off -)clear all + substArg : (OP, List %, Z, %) -> % + substArg(op, l, i, g) == + z := copy l + z.i := g + kernel(op, z) ---S 1 of 1 -)show PseudoAlgebraicClosureOfPerfectFieldCategory ---R ---R PseudoAlgebraicClosureOfPerfectFieldCategory is a category constructor ---R Abbreviation for PseudoAlgebraicClosureOfPerfectFieldCategory is PACPERC ---R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for PACPERC ---R ---R------------------------------- Operations -------------------------------- ---R ?*? : (Fraction(Integer),%) -> % ?*? : (%,Fraction(Integer)) -> % ---R ?*? : (%,%) -> % ?*? : (Integer,%) -> % ---R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % ---R ?**? : (%,Integer) -> % ?**? : (%,NonNegativeInteger) -> % ---R ?**? : (%,PositiveInteger) -> % ?+? : (%,%) -> % ---R ?-? : (%,%) -> % -? : % -> % ---R ?/? : (%,%) -> % ?=? : (%,%) -> Boolean ---R 1 : () -> % 0 : () -> % ---R ?^? : (%,Integer) -> % ?^? : (%,NonNegativeInteger) -> % ---R ?^? : (%,PositiveInteger) -> % associates? : (%,%) -> Boolean ---R coerce : Fraction(Integer) -> % coerce : % -> % ---R coerce : Integer -> % coerce : % -> OutputForm ---R conjugate : % -> % extDegree : % -> PositiveInteger ---R factor : % -> Factored(%) fullOutput : % -> OutputForm ---R gcd : List(%) -> % gcd : (%,%) -> % ---R ground? : % -> Boolean hash : % -> SingleInteger ---R inv : % -> % latex : % -> String ---R lcm : List(%) -> % lcm : (%,%) -> % ---R maxTower : List(%) -> % one? : % -> Boolean ---R previousTower : % -> % prime? : % -> Boolean ---R ?quo? : (%,%) -> % recip : % -> Union(%,"failed") ---R ?rem? : (%,%) -> % sample : () -> % ---R setTower! : % -> Void sizeLess? : (%,%) -> Boolean ---R squareFree : % -> Factored(%) squareFreePart : % -> % ---R unit? : % -> Boolean unitCanonical : % -> % ---R vectorise : (%,%) -> Vector(%) zero? : % -> Boolean ---R ?~=? : (%,%) -> Boolean ---R characteristic : () -> NonNegativeInteger ---R definingPolynomial : % -> SparseUnivariatePolynomial(%) ---R definingPolynomial : () -> SparseUnivariatePolynomial(%) ---R distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%) ---R divide : (%,%) -> Record(quotient: %,remainder: %) ---R euclideanSize : % -> NonNegativeInteger ---R expressIdealMember : (List(%),%) -> Union(List(%),"failed") ---R exquo : (%,%) -> Union(%,"failed") ---R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") ---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) ---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) ---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) ---R lift : (%,%) -> SparseUnivariatePolynomial(%) ---R lift : % -> SparseUnivariatePolynomial(%) ---R multiEuclidean : (List(%),%) -> Union(List(%),"failed") ---R newElement : (SparseUnivariatePolynomial(%),Symbol) -> % ---R newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> % ---R principalIdeal : List(%) -> Record(coef: List(%),generator: %) ---R reduce : SparseUnivariatePolynomial(%) -> % ---R subtractIfCan : (%,%) -> Union(%,"failed") ---R unitNormal : % -> Record(unit: %,canonical: %,associate: %) ---R ---E 1 + diffdiff : (List %, SY) -> % + diffdiff(l, x) == + f := kernel(opdiff, l) + diffdiff0(l, x, f, retract(f)@K, empty()) -)spool -)lisp (bye) -\end{chunk} -\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.help} -==================================================================== -PseudoAlgebraicClosureOfPerfectFieldCategory examples -==================================================================== + diffdiff0 : (List %, SY, %, K, List %) -> % + diffdiff0(l, x, expr, kd, done) == + op := operator(k := retract(first l)@K) + gg := second l + u := third l + arg := argument k + ans:% := 0 + if (not member?(u,done)) and (ans := differentiate(u,x))^=0 then + ans := ans * kernel(opdiff, + [subst(expr, [kd], [kernel(opdiff, [first l, gg, gg])]), + gg, u]) + done := concat(gg, done) + is?(k, opdiff) => ans + diffdiff0(arg, x, expr, k, done) + for i in minIndex arg .. maxIndex arg for b in arg repeat + if (not member?(b,done)) and (bp:=differentiate(b,x))^=0 then + g := symsub(gendiff, i)::% + ans := ans + bp * kernel(opdiff, [subst(expr, [kd], + [kernel(opdiff, [substArg(op, arg, i, g), gg, u])]), g, b]) + ans -This category exports the function for domains which implement dynamic -extension using the simple notion of tower extensions. A tower extension -T of the ground field K is any sequence of field extensions - (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K -and for - i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 -and defined by an irreducible polynomial p(Z) in K_{i-1}. + dfeval : (List %, K) -> % + dfeval(l, g) == + eval(differentiate(first l, symbolIfCan(g)::SY), g, third l) -Two towers - (T_1: K_01, K_11,...,K_i1,...,K_n1) -and - (T_2: K_02, K_12,...,K_i2,...,K_n2) -are said to be related if - T_1 <= T_2 (or T_1 >= T_2), -that is if - K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). + diffEval : List % -> % + diffEval l == + k:K + g := retract(second l)@K + ((u := retractIfCan(first l)@Union(K, "failed")) case "failed") + or (u case K and symbolIfCan(k := u::K) case SY) => dfeval(l, g) + op := operator k + (ud := derivative op) case "failed" => + -- possible trouble + -- make sure it is a dummy var + dumm:%:=symsub(gendiff,1)::% + ss:=subst(l.1,l.2=dumm) + -- output(nl::OutputForm)$OutputPackage + -- output("fixed"::OutputForm)$OutputPackage + nl:=[ss,dumm,l.3] + kernel(opdiff, nl) + (n := position(second l,argument k)) < minIndex l => + dfeval(l,g) + d := ud::List(List % -> %) + eval((d.n)(argument k), g, third l) -Any algebraic operations defined for several elements are only defined -if all of the concerned elements are coming from a set of related tower -extensions. + diffArg : (List %, OP, N) -> List % + diffArg(l, op, i) == + n := i - 1 + minIndex l + z := copy l + z.n := g := symsub(gendiff, n)::% + [kernel(op, z), g, l.n] -See Also: -o )show PseudoAlgebraicClosureOfPerfectFieldCategory + opderiv : (OP, N) -> List(List % -> %) + opderiv(op, n) == + (n = 1) => + g := symsub(gendiff, n)::% + [x +-> kernel(opdiff,[kernel(op, g), g, first x])] + [y +-> kernel(opdiff, diffArg(y, op, i)) for i in 1..n] -\end{chunk} + kderiv : K -> List % + kderiv k == + zero?(n := #(args := argument k)) => empty() + op := operator k + grad := + (u := derivative op) case "failed" => opderiv(op, n) + u::List(List % -> %) + if #grad ^= n then grad := opderiv(op, n) + [g args for g in grad] -\pagefrom{Field}{FIELD} + -- SPECIALDIFF contains a map (List %, Symbol) -> % + -- it is used when the usual chain rule does not apply, + -- for instance with implicit algebraics. -{\bf Exports:}\\ -\begin{tabular}{llll} -\cross{PACPERC}{0} & -\cross{PACPERC}{1} & -\cross{PACPERC}{associates?} & -\cross{PACPERC}{characteristic} \\ -\cross{PACPERC}{coerce} & -\cross{PACPERC}{conjugate} & -\cross{PACPERC}{definingPolynomial} & -\cross{PACPERC}{distinguishedRootsOf} \\ -\cross{PACPERC}{divide} & -\cross{PACPERC}{euclideanSize} & -\cross{PACPERC}{expressIdealMember} & -\cross{PACPERC}{exquo} \\ -\cross{PACPERC}{extDegree} & -\cross{PACPERC}{extendedEuclidean} & -\cross{PACPERC}{factor} & -\cross{PACPERC}{fullOutput} \\ -\cross{PACPERC}{gcd} & -\cross{PACPERC}{gcdPolynomial} & -\cross{PACPERC}{ground?} & -\cross{PACPERC}{hash} \\ -\cross{PACPERC}{inv} & -\cross{PACPERC}{latex} & -\cross{PACPERC}{lcm} & -\cross{PACPERC}{lift} \\ -\cross{PACPERC}{maxTower} & -\cross{PACPERC}{multiEuclidean} & -\cross{PACPERC}{newElement} & -\cross{PACPERC}{one?} \\ -\cross{PACPERC}{previousTower} & -\cross{PACPERC}{prime?} & -\cross{PACPERC}{principalIdeal} & -\cross{PACPERC}{?quo?} \\ -\cross{PACPERC}{recip} & -\cross{PACPERC}{reduce} & -\cross{PACPERC}{?rem?} & -\cross{PACPERC}{sample} \\ -\cross{PACPERC}{setTower!} & -\cross{PACPERC}{sizeLess?} & -\cross{PACPERC}{squareFree} & -\cross{PACPERC}{squareFreePart} \\ -\cross{PACPERC}{subtractIfCan} & -\cross{PACPERC}{unit?} & -\cross{PACPERC}{unitCanonical} & -\cross{PACPERC}{unitNormal} \\ -\cross{PACPERC}{vectorise} & -\cross{PACPERC}{zero?} & -\cross{PACPERC}{?*?} & -\cross{PACPERC}{?**?} \\ -\cross{PACPERC}{?+?} & -\cross{PACPERC}{?-?} & -\cross{PACPERC}{-?} & -\cross{PACPERC}{?/?} \\ -\cross{PACPERC}{?=?} & -\cross{PACPERC}{?\^{}?} & -\cross{PACPERC}{?\~{}=?} & -\end{tabular} + kerderiv : (K, SY) -> % + kerderiv(k, x) == + (v := symbolIfCan(k)) case SY => + v::SY = x => 1 + 0 + (fn := property(operator k, SPECIALDIFF)) case None => + ((fn::None) pretend ((List %, SY) -> %)) (argument k, x) + +/[g * differentiate(y,x) for g in kderiv k for y in argument k] -{\bf Attributes Exported:} -\begin{itemize} -\item {\bf \cross{PACPERC}{canonicalUnitNormal}} -is true if we can choose a canonical representative for each class -of associate elements, that is {\tt associates?(a,b)} returns true -if and only if {\tt unitCanonical(a) = unitCanonical(b)}. -\item {\bf \cross{PACPERC}{canonicalsClosed}} -is true if\hfill\\ -{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}. -\item {\bf \cross{PACPERC}{noZeroDivisors}} -is true if $x * y \ne 0$ implies both x and y are non-zero. -\item {\bf \cross{PACPERC}{commutative(``*'')}} -is true if it has an operation $"*": (D,D) -> D$ -which is commutative. -\item {\bf \cross{PACPERC}{unitsKnown}} -is true if a monoid (a multiplicative semigroup with a 1) has -unitsKnown means that the operation {\tt recip} can only return -``failed'' if its argument is not a unit. -\item {\bf \cross{PACPERC}{leftUnitary}} -is true if $1 * x = x$ for all x. -\item {\bf \cross{PACPERC}{rightUnitary}} -is true if $x * 1 = x$ for all x. -\end{itemize} + smpderiv : (MP, SY) -> % + smpderiv(p, x) == + map((s:R):R +-> retract differentiate(s::PR, x), p)::% + + +/[differentiate(p,k)::% * kerderiv(k, x) for k in variables p] -These are directly exported but not implemented: -\begin{verbatim} - conjugate: % -> % - definingPolynomial: () -> SUP(%) - definingPolynomial: % -> SUP % - distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List % - extDegree: % -> PI - fullOutput: % -> OutputForm - ground_? : % -> Boolean - lift: % -> SUP(%) - lift: (%,%) -> SUP(%) - maxTower: List % -> % - newElement: (SUP(%), %, Symbol) -> % - newElement: (SUP(%), Symbol) -> % - previousTower: % -> % - reduce: SUP(%) -> % - setTower_!: % -> Void - vectorise: (%,%) -> Vector(%) -\end{verbatim} + coerce : Polynomial(R) -> % + coerce(p:PR):% == + map(s +-> s::%, r +-> r::%, p)$PolynomialCategoryLifting( + IndexedExponents SY, SY, R, PR, %) -These exports come from \refto{Field}(): -\begin{verbatim} - associates? : (%,%) -> Boolean - divide : (%,%) -> Record(quotient: %,remainder: %) - euclideanSize : % -> NonNegativeInteger - exquo : (%,%) -> Union(%,"failed") - factor : % -> Factored % - gcd : (%,%) -> % - inv : % -> % - prime? : % -> Boolean - squareFree : % -> Factored % - unitCanonical : % -> % - unitNormal : % -> Record(unit: %,canonical: %,associate: %) - ?/? : (%,%) -> % -\end{verbatim} + worse? : (K, K) -> Boolean + worse?(k1, k2) == + (u := less?(name operator k1,name operator k2)) case "failed" => + k1 < k2 + u::Boolean -These exports come from \refto{EuclideanDomain}(): -\begin{verbatim} - 0 : () -> % - 1 : () -> % - characteristic : () -> NonNegativeInteger - coerce : % -> % - coerce : Integer -> % - coerce : % -> OutputForm - expressIdealMember : (List %,%) -> Union(List %,"failed") - extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") - extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) - gcd : List % -> % - gcdPolynomial : (SparseUnivariatePolynomial %, - SparseUnivariatePolynomial %) -> - SparseUnivariatePolynomial % - hash : % -> SingleInteger - latex : % -> String - lcm : List % -> % - lcm : (%,%) -> % - multiEuclidean : (List %,%) -> Union(List %,"failed") - one? : % -> Boolean - principalIdeal : List % -> Record(coef: List %,generator: %) - recip : % -> Union(%,"failed") - sample : () -> % - sizeLess? : (%,%) -> Boolean - subtractIfCan : (%,%) -> Union(%,"failed") - unit? : % -> Boolean - zero? : % -> Boolean - ?+? : (%,%) -> % - ?=? : (%,%) -> Boolean - ?~=? : (%,%) -> Boolean - ?*? : (%,%) -> % - ?*? : (Integer,%) -> % - ?*? : (PositiveInteger,%) -> % - ?*? : (NonNegativeInteger,%) -> % - ?-? : (%,%) -> % - -? : % -> % - ?**? : (%,PositiveInteger) -> % - ?**? : (%,NonNegativeInteger) -> % - ?^? : (%,PositiveInteger) -> % - ?^? : (%,NonNegativeInteger) -> % - ?quo? : (%,%) -> % - ?rem? : (%,%) -> % -\end{verbatim} + bestKernel: List K -> K + bestKernel l == + empty? rest l => first l + a := bestKernel rest l + worse?(first l, a) => a + first l -These exports come from \refto{UniqueFactorizationDomain}(): -\begin{verbatim} - squareFreePart : % -> % -\end{verbatim} + smp2O : MP -> O + smp2O p == + (r:=retractIfCan(p)@Union(R,"failed")) case R =>r::R::OutputForm + a := + userOrdered?() => bestKernel variables p + mainVariable(p)::K + outputForm(map((x:MP):% +-> x::%, univariate(p, a))_ + $SparseUnivariatePolynomialFunctions2(MP, %), a::OutputForm) + smpsubst : (MP, List K, List %) -> % + smpsubst(p, lk, lv) == + map(x +-> match(lk, lv, x, + notfound((z:K):%+->subs(s+->subst(s, lk, lv), z), lk, x))_ + $ListToMap(K,%),y+->y::%,p)_ + $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%) -These exports come from \refto{DivisionRing}(): -\begin{verbatim} - coerce : Fraction Integer -> % - ?*? : (Fraction Integer,%) -> % - ?*? : (%,Fraction Integer) -> % - ?**? : (%,Integer) -> % - ?^? : (%,Integer) -> % -\end{verbatim} + smpeval : (MP, List K, List %) -> % + smpeval(p, lk, lv) == + map(x +-> match(lk, lv, x, + notfound((z:K):%+->map(s+->eval(s,lk,lv),z),lk,x))_ + $ListToMap(K,%),y+->y::%,p)_ + $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%) -\begin{chunk}{category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory} -)abbrev category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory -++ Authors: Gaetan Hache -++ Date Created: may 1997 -++ Date Last Updated: April 2010, by Tim Daly -++ Description: -++ This category exports the function for domains -++ which implement dynamic extension using the simple notion of tower -++ extensions. ++ A tower extension T of the ground -++ field K is any sequence of field extension -++ (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K -++ and for i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 -++ and defined by an irreducible polynomial p(Z) in K_{i-1}. -++ Two towers (T_1: K_01, K_11,...,K_i1,...,K_n1) -++ and (T_2: K_02, K_12,...,K_i2,...,K_n2) -++ are said to be related if T_1 <= T_2 (or T_1 >= T_2), -++ that is if K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). -++ Any algebraic operations defined for several elements -++ are only defined if all of the concerned elements are coming from -++ a set of related tower extensions. -PseudoAlgebraicClosureOfPerfectFieldCategory() : Category == PUB where +-- this is called on k when k is not a member of lk - INT ==> Integer - K ==> Fraction Integer - NNI ==> NonNegativeInteger - SUP ==> SparseUnivariatePolynomial - BOOLEAN ==> Boolean - PI ==> PositiveInteger - FFFACTSE ==> FiniteFieldFactorizationWithSizeParseBySideEffect + notfound : (K -> %, List K, K) -> % + notfound(fn, lk, k) == + empty? setIntersection(tower(f := k::%), lk) => f + fn k - PUB ==> Field with + if R has ConvertibleTo InputForm then - definingPolynomial: () -> SUP(%) - definingPolynomial: % -> SUP % + pushunq : (List SY, List %) -> List % + pushunq(l, arg) == + empty? l => [eval a for a in arg] + [eval(a, l) for a in arg] - lift: % -> SUP(%) - lift: (%,%) -> SUP(%) - reduce: SUP(%) -> % + kunq : (K, List SY, Boolean) -> % + kunq(k, l, givenlist?) == + givenlist? and empty? l => k::% + is?(k, opquote) and + (member?(s:=retract(first argument k)@SY, l) or empty? l) => + interpret(convert(concat(convert(s)@InputForm, + [convert a for a in pushunq(l, rest argument k) + ]@List(InputForm)))@InputForm)$InputFormFunctions1(%) + (operator k) pushunq(l, argument k) - distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List % - ++ distinguishedRootsOf(p,a) returns a (distinguised) root for each - ++ irreducible factor of the polynomial p (factored over the field defined - ++ by the element a). - - ground_? : % -> Boolean - maxTower: List % -> % - ++ maxTower(l) returns the tower in the list having the maximal extension - ++ degree over the ground field. It has no meaning if the towers are - ++ not related. - extDegree: % -> PI - ++ extDegree(a) returns the extension degree of the extension tower - ++ over which the element is defined. - previousTower: % -> % - ++ previousTower(a) returns the previous tower extension over which - ++ the element a is defined. + smpunq : (MP, List SY, Boolean) -> % + smpunq(p, l, givenlist?) == + givenlist? and empty? l => p::% + map(x +-> kunq(x, l, givenlist?), y+->y::%, p)_ + $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%) - vectorise: (%,%) -> Vector(%) + smpret : MP -> Union(PR, "failed") + smpret p == + "or"/[symbolIfCan(k) case "failed" for k in variables p] => + "failed" + map(x+->symbolIfCan(x)::SY::PR, y+->y::PR,p)_ + $PolynomialCategoryLifting(IndexedExponents K, K, R, MP, PR) - conjugate: % -> % - newElement: (SUP(%), %, Symbol) -> % - newElement: (SUP(%), Symbol) -> % - setTower_!: % -> Void - fullOutput: % -> OutputForm + isExpt : (%,BasicOperator) -> + Union(Record(var: Kernel(%),exponent: Integer),"failed") + isExpt(x:%, op:OP) == + (u := isExpt x) case "failed" => "failed" + is?((u::Record(var:K, exponent:Z)).var, op) => u + "failed" + + isExpt : (%,Symbol) -> + Union(Record(var: Kernel(%),exponent: Integer),"failed") + isExpt(x:%, sy:SY) == + (u := isExpt x) case "failed" => "failed" + is?((u::Record(var:K, exponent:Z)).var, sy) => u + "failed" + + if R has RetractableTo Z then + + smpIsMult : MP -> Union(Record(coef:Z, var:K),"failed") + smpIsMult p == + (u := mainVariable p) case K and (degree(q:=univariate(p,u::K))=1) + and zero?(leadingCoefficient reductum q) + and ((r:=retractIfCan(leadingCoefficient q)@Union(R,"failed")) + case R) + and (n := retractIfCan(r::R)@Union(Z, "failed")) case Z => + [n::Z, u::K] + "failed" + + debugA: (List % ,List %,Boolean) -> Boolean + debugA(a1,a2,t) == + -- uncomment for debugging + -- output(hconcat [a1::OutputForm,_ + -- a2::OutputForm,t::OutputForm])$OutputPackage + t + + equaldiff : (K,K)->Boolean + equaldiff(k1,k2) == + a1:=argument k1 + a2:=argument k2 + -- check the operator + res:=operator k1 = operator k2 + not res => debugA(a1,a2,res) + -- check the evaluation point + res:= (a1.3 = a2.3) + not res => debugA(a1,a2,res) + -- check all the arguments + res:= (a1.1 = a2.1) and (a1.2 = a2.2) + res => debugA(a1,a2,res) + -- check the substituted arguments + (subst(a1.1,[retract(a1.2)@K],[a2.2]) = a2.1) => debugA(a1,a2,true) + debugA(a1,a2,false) + + setProperty(opdiff,SPECIALEQUAL, + equaldiff@((K,K) -> Boolean) pretend None) + + setProperty(opdiff, SPECIALDIFF, + diffdiff@((List %, SY) -> %) pretend None) + + setProperty(opdiff, SPECIALDISP, + ddiff@(List % -> OutputForm) pretend None) + + if not(R has IntegralDomain) then + + mainKernel : % -> Union(Kernel(%),"failed") + mainKernel x == mainVariable numer x + + kernels : % -> List(Kernel(%)) + kernels x == variables numer x + + retract : % -> R + retract(x:%):R == retract numer x + + retract : % -> Polynomial(R) + retract(x:%):PR == smpret(numer x)::PR + + retractIfCan : % -> Union(Fraction(Integer),"failed") + retractIfCan(x:%):Union(R, "failed") == retract numer x + + retractIfCan : % -> Union(Polynomial(R),"failed") + retractIfCan(x:%):Union(PR, "failed") == smpret numer x + + eval : (%,List(Kernel(%)),List(%)) -> % + eval(x:%, lk:List K, lv:List %) == smpeval(numer x, lk, lv) + + subst : (%,List(Kernel(%)),List(%)) -> % + subst(x:%, lk:List K, lv:List %) == smpsubst(numer x, lk, lv) + + differentiate : (%,Symbol) -> % + differentiate(x:%, s:SY) == smpderiv(numer x, s) + + coerce : % -> OutputForm + coerce(x:%):OutputForm == smp2O numer x + + if R has ConvertibleTo InputForm then + + eval(f:%, l:List SY) == smpunq(numer f, l, true) + + eval f == smpunq(numer f, empty(), false) + + eval : (%,List(Symbol),List(NonNegativeInteger),List((List(%) -> %))) + -> % + eval(x:%, s:List SY, n:List N, f:List(List % -> %)) == + smprep(s, n, f, numer x) + + isPlus : % -> Union(List(%),"failed") + isPlus x == + (u := isPlus numer x) case "failed" => "failed" + [p::% for p in u::List(MP)] + + isTimes : % -> Union(List(%),"failed") + isTimes x == + (u := isTimes numer x) case "failed" => "failed" + [p::% for p in u::List(MP)] + + isExpt : % -> Union(Record(var: Kernel(%),exponent: Integer),"failed") + isExpt x == + (u := isExpt numer x) case "failed" => "failed" + r := u::Record(var:K, exponent:NonNegativeInteger) + [r.var, r.exponent::Z] + + isPower : % -> Union(Record(val: %,exponent: Integer),"failed") + isPower x == + (u := isExpt numer x) case "failed" => "failed" + r := u::Record(var:K, exponent:NonNegativeInteger) + [r.var::%, r.exponent::Z] + + if R has ConvertibleTo Pattern Z then + + convert : % -> Pattern(Integer) + convert(x:%):Pattern(Z) == convert numer x + + if R has ConvertibleTo Pattern Float then + + convert : % -> Pattern(Float) + convert(x:%):Pattern(Float) == convert numer x + + if R has RetractableTo Z then + + isMult : % -> Union(Record(coef: Integer,var: Kernel(%)),"failed") + isMult x == smpIsMult numer x + + if R has CommutativeRing then + + ?*? : (R,%) -> % + r:R * x:% == r::MP::% * x + + if R has IntegralDomain then + + mainKernel : % -> Union(Kernel(%),"failed") + mainKernel x == mainVariable(x)$QF + + kernels : % -> List(Kernel(%)) + kernels x == variables(x)$QF + + univariate : (%,Kernel(%)) -> Fraction(SparseUnivariatePolynomial(%)) + univariate(x:%, k:K) == univariate(x, k)$QF + + isPlus : % -> Union(List(%),"failed") + isPlus x == isPlus(x)$QF + + isTimes : % -> Union(List(%),"failed") + isTimes x == isTimes(x)$QF + + isExpt : % -> Union(Record(var: Kernel(%),exponent: Integer),"failed") + isExpt x == isExpt(x)$QF + + isPower : % -> Union(Record(val: %,exponent: Integer),"failed") + isPower x == isPower(x)$QF + + denominator : % -> % + denominator x == denom(x)::% + + coerce : Fraction(R) -> % + coerce(q:Q):% == (numer q)::MP / (denom q)::MP + + coerce : Fraction(Polynomial(R)) -> % + coerce(q:Fraction PR):% == (numer q)::% / (denom q)::% + + coerce : Fraction(Polynomial(Fraction(R))) -> % + coerce(q:Fraction Polynomial Q) == (numer q)::% / (denom q)::% + + retract : % -> Polynomial(R) + retract(x:%):PR == retract(retract(x)@Fraction(PR)) + + retract : % -> Fraction(Polynomial(R)) + retract(x:%):Fraction(PR) == smpret(numer x)::PR / smpret(denom x)::PR + + retract : % -> R + retract(x:%):R == (retract(numer x)@R exquo retract(denom x)@R)::R + + coerce : % -> OutputForm + coerce(x:%):OutputForm == + ((denom x) = 1) => smp2O numer x + smp2O(numer x) / smp2O(denom x) + + retractIfCan : % -> Union(R,"failed") + retractIfCan(x:%):Union(R,"failed") == + (n := retractIfCan(numer x)@Union(R, "failed")) case "failed" or + (d := retractIfCan(denom x)@Union(R, "failed")) case "failed" + or (r := n::R exquo d::R) case "failed" => "failed" + r::R + + eval : (%,Symbol) -> % + eval(f:%, l:List SY) == + smpunq(numer f, l, true) / smpunq(denom f, l, true) + + if R has ConvertibleTo InputForm then + + eval : % -> % + eval f == + smpunq(numer f, empty(), false) / smpunq(denom f, empty(), false) + + eval : (%,List(Symbol),List(NonNegativeInteger),List((% -> %))) -> % + eval(x:%, s:List SY, n:List N, f:List(List % -> %)) == + smprep(s, n, f, numer x) / smprep(s, n, f, denom x) + + differentiate : (%,Symbol) -> % + differentiate(f:%, x:SY) == + (smpderiv(numer f, x) * denom(f)::% - + numer(f)::% * smpderiv(denom f, x)) + / (denom(f)::% ** 2) + + eval : (%,List(%),List(%)) -> % + eval(x:%, lk:List K, lv:List %) == + smpeval(numer x, lk, lv) / smpeval(denom x, lk, lv) + + subst : (%,List(Kernel(%)),List(%)) -> % + subst(x:%, lk:List K, lv:List %) == + smpsubst(numer x, lk, lv) / smpsubst(denom x, lk, lv) + + par : % -> % + par x == + (r := retractIfCan(x)@Union(R, "failed")) case R => x + paren x + + convert : Factored(%) -> % + convert(x:Factored %):% == + par(unit x) * */[par(f.factor) ** f.exponent for f in factors x] + + retractIfCan : % -> Union(Polynomial(R),"failed") + retractIfCan(x:%):Union(PR, "failed") == + (u := retractIfCan(x)@Union(Fraction PR,"failed")) case "failed" + => "failed" + retractIfCan(u::Fraction(PR)) + + retractIfCan : % -> Union(Fraction(Polynomial(R)),"failed") + retractIfCan(x:%):Union(Fraction PR, "failed") == + (n := smpret numer x) case "failed" => "failed" + (d := smpret denom x) case "failed" => "failed" + n::PR / d::PR + + coerce : Polynomial(Fraction(R)) -> + coerce(p:Polynomial Q):% == + map(x+->x::%, y+->y::%,p)_ + $PolynomialCategoryLifting(IndexedExponents SY, SY, + Q, Polynomial Q, %) + + if R has RetractableTo Z then + + coerce : Fraction(Integer) -> % + coerce(x:Fraction Z):% == numer(x)::MP / denom(x)::MP + + isMult : % -> Union(Record(coef: Integer,var: Kernel(%)),"failed") + isMult x == + (u := smpIsMult numer x) case "failed" + or (v := retractIfCan(denom x)@Union(R, "failed")) case "failed" + or (w := retractIfCan(v::R)@Union(Z, "failed")) case "failed" + => "failed" + r := u::Record(coef:Z, var:K) + (q := r.coef exquo w::Z) case "failed" => "failed" + [q::Z, r.var] + + if R has ConvertibleTo Pattern Z then + + convert : % -> Pattern(Integer) + convert(x:%):Pattern(Z) == convert(numer x) / convert(denom x) + + if R has ConvertibleTo Pattern Float then + + convert : % -> Pattern(Float) + convert(x:%):Pattern(Float) == + convert(numer x) / convert(denom x) +*) \end{chunk} -\begin{chunk}{PACPERC.dotabb} -"PACPERC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"]; -"PACPERC" -> "FIELD" + +\begin{chunk}{FS.dotabb} +"FS" + [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"]; +"FS" -> "ES" +"FS" -> "FPATMAB" +"FS" -> "FRETRCT" +"FS" -> "PATAB" +"FS" -> "RETRACT" +"FS" -> "KONVERT" +"FS" -> "MONOID" +"FS" -> "GROUP" +"FS" -> "ABELMON" +"FS" -> "ABELGRP" +"FS" -> "PDRING" +"FS" -> "FLINEXP" +"FS" -> "CHARNZ" +"FS" -> "INTDOM" +"FS" -> "FIELD" \end{chunk} -\begin{chunk}{PACPERC.dotfull} -"PseudoAlgebraicClosureOfPerfectFieldCategory" - [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"]; -"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "Field()" +\begin{chunk}{FS.dotfull} +"FunctionSpace(a:OrderedSet)" + [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"]; +"FunctionSpace(a:OrderedSet)" -> "ExpressionSpace()" +"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Symbol)" +"FunctionSpace(a:OrderedSet)" -> "Patternable(OrderedSet)" +"FunctionSpace(a:OrderedSet)" -> "FullyPatternMatchable(OrderedSet)" +"FunctionSpace(a:OrderedSet)" -> "FullyRetractableTo(OrderedSet)" +"FunctionSpace(a:OrderedSet)" -> "ConvertibleTo(InputForm)" +"FunctionSpace(a:OrderedSet)" -> "Monoid()" +"FunctionSpace(a:OrderedSet)" -> "Group()" +"FunctionSpace(a:OrderedSet)" -> "AbelianMonoid()" +"FunctionSpace(a:OrderedSet)" -> "AbelianGroup()" +"FunctionSpace(a:OrderedSet)" -> "PartialDifferentialRing(Symbol)" +"FunctionSpace(a:OrderedSet)" -> "FullyLinearlyExplicitRingOver(OrderedSet)" +"FunctionSpace(a:OrderedSet)" -> "CharacteristicNonZero()" +"FunctionSpace(a:OrderedSet)" -> "IntegralDomain()" +"FunctionSpace(a:OrderedSet)" -> "Field()" +"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Integer)" +"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Fraction(Integer))" \end{chunk} -\begin{chunk}{PACPERC.dotpic} +\begin{chunk}{FS.dotpic} digraph pic { fontsize=10; bgcolor="#ECEA81"; node [shape=box, color=white, style=filled]; -"PseudoAlgebraicClosureOfPerfectFieldCategory" [color=lightblue]; -"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "FIELD..." +"FunctionSpace(a:OrderedSet)" [color=lightblue]; +"FunctionSpace(a:OrderedSet)" -> "ES..." +"FunctionSpace(a:OrderedSet)" -> "RETRACT..." +"FunctionSpace(a:OrderedSet)" -> "PATAB..." +"FunctionSpace(a:OrderedSet)" -> "FPATMAB..." +"FunctionSpace(a:OrderedSet)" -> "FRETRCT..." +"FunctionSpace(a:OrderedSet)" -> "KONVERT..." +"FunctionSpace(a:OrderedSet)" -> "MONOID..." +"FunctionSpace(a:OrderedSet)" -> "GROUP..." +"FunctionSpace(a:OrderedSet)" -> "ABELMON..." +"FunctionSpace(a:OrderedSet)" -> "ABELGRP..." +"FunctionSpace(a:OrderedSet)" -> "PDRING..." +"FunctionSpace(a:OrderedSet)" -> "FLINEXP..." +"FunctionSpace(a:OrderedSet)" -> "CHARNZ..." +"FunctionSpace(a:OrderedSet)" -> "INTDOM..." +"FunctionSpace(a:OrderedSet)" -> "FIELD..." +"FunctionSpace(a:OrderedSet)" -> "RETRACT..." +"ES..." [color=lightblue]; +"EVALABLE..." [color=lightblue]; +"FRETRCT..." [color=lightblue]; +"FPATMAB..." [color=lightblue]; +"IEVALAB..." [color=lightblue]; +"ORDSET..." [color=lightblue]; +"PATAB..." [color=lightblue]; +"RETRACT..." [color=lightblue]; +"KONVERT..." [color=lightblue]; +"MONOID..." [color=lightblue]; +"GROUP..." [color=lightblue]; +"ABELMON..." [color=lightblue]; +"ABELGRP..." [color=lightblue]; +"PDRING..." [color=lightblue]; +"FLINEXP..." [color=lightblue]; +"CHARNZ..." [color=lightblue]; +"INTDOM..." [color=lightblue]; "FIELD..." [color=lightblue]; - +"RETRACT..." [color=lightblue]; } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{QuotientFieldCategory}{QFCAT} -\pagepic{ps/v102quotientfieldcategory.ps}{QFCAT}{0.50} +\pagehead{InfinitlyClosePointCategory}{INFCLCT} +\pagepic{ps/v102infinitlyclosepointcategory.eps}{INFCLCT}{0.50} -\begin{chunk}{QuotientFieldCategory.input} +\begin{chunk}{InfinitlyClosePointCategory.input} )set break resume -)sys rm -f QuotientFieldCategory.output -)spool QuotientFieldCategory.output +)sys rm -f InfinitlyClosePointCategory.output +)spool InfinitlyClosePointCategory.output )set message test on )set message auto off )clear all --S 1 of 1 -)show QuotientFieldCategory +)show InfinitlyClosePointCategory --R ---R QuotientFieldCategory(S: IntegralDomain) is a category constructor ---R Abbreviation for QuotientFieldCategory is QFCAT ---R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for QFCAT ---R ---R------------------------------- Operations -------------------------------- ---R ?*? : (%,S) -> % ?*? : (S,%) -> % ---R ?*? : (Fraction(Integer),%) -> % ?*? : (%,Fraction(Integer)) -> % ---R ?*? : (%,%) -> % ?*? : (Integer,%) -> % ---R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % ---R ?**? : (%,Integer) -> % ?**? : (%,NonNegativeInteger) -> % ---R ?**? : (%,PositiveInteger) -> % ?+? : (%,%) -> % ---R ?-? : (%,%) -> % -? : % -> % ---R ?/? : (S,S) -> % ?/? : (%,%) -> % ---R ?=? : (%,%) -> Boolean D : (%,(S -> S)) -> % ---R D : % -> % if S has DIFRING 1 : () -> % ---R 0 : () -> % ?^? : (%,Integer) -> % ---R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % ---R abs : % -> % if S has OINTDOM associates? : (%,%) -> Boolean ---R ceiling : % -> S if S has INS coerce : S -> % ---R coerce : Fraction(Integer) -> % coerce : % -> % ---R coerce : Integer -> % coerce : % -> OutputForm ---R convert : % -> Float if S has REAL denom : % -> S ---R denominator : % -> % differentiate : (%,(S -> S)) -> % ---R factor : % -> Factored(%) floor : % -> S if S has INS ---R gcd : List(%) -> % gcd : (%,%) -> % ---R hash : % -> SingleInteger init : () -> % if S has STEP ---R inv : % -> % latex : % -> String ---R lcm : List(%) -> % lcm : (%,%) -> % ---R map : ((S -> S),%) -> % max : (%,%) -> % if S has ORDSET ---R min : (%,%) -> % if S has ORDSET numer : % -> S ---R numerator : % -> % one? : % -> Boolean ---R prime? : % -> Boolean ?quo? : (%,%) -> % ---R random : () -> % if S has INS recip : % -> Union(%,"failed") ---R ?rem? : (%,%) -> % retract : % -> S ---R sample : () -> % sizeLess? : (%,%) -> Boolean ---R squareFree : % -> Factored(%) squareFreePart : % -> % ---R unit? : % -> Boolean unitCanonical : % -> % ---R wholePart : % -> S if S has EUCDOM zero? : % -> Boolean ---R ?~=? : (%,%) -> Boolean ---R ? Boolean if S has ORDSET ---R ?<=? : (%,%) -> Boolean if S has ORDSET ---R ?>? : (%,%) -> Boolean if S has ORDSET ---R ?>=? : (%,%) -> Boolean if S has ORDSET ---R D : (%,(S -> S),NonNegativeInteger) -> % ---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) ---R D : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) ---R D : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) ---R D : (%,Symbol) -> % if S has PDRING(SYMBOL) ---R D : (%,NonNegativeInteger) -> % if S has DIFRING ---R characteristic : () -> NonNegativeInteger ---R charthRoot : % -> Union(%,"failed") if S has CHARNZ or and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit)) ---R coerce : Symbol -> % if S has RETRACT(SYMBOL) ---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit)) ---R convert : % -> DoubleFloat if S has REAL ---R convert : % -> InputForm if S has KONVERT(INFORM) ---R convert : % -> Pattern(Float) if S has KONVERT(PATTERN(FLOAT)) ---R convert : % -> Pattern(Integer) if S has KONVERT(PATTERN(INT)) ---R differentiate : (%,(S -> S),NonNegativeInteger) -> % ---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) ---R differentiate : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) ---R differentiate : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) ---R differentiate : (%,Symbol) -> % if S has PDRING(SYMBOL) ---R differentiate : (%,NonNegativeInteger) -> % if S has DIFRING ---R differentiate : % -> % if S has DIFRING ---R divide : (%,%) -> Record(quotient: %,remainder: %) ---R ?.? : (%,S) -> % if S has ELTAB(S,S) ---R euclideanSize : % -> NonNegativeInteger ---R eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S) ---R eval : (%,List(Symbol),List(S)) -> % if S has IEVALAB(SYMBOL,S) ---R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) ---R eval : (%,Equation(S)) -> % if S has EVALAB(S) ---R eval : (%,S,S) -> % if S has EVALAB(S) ---R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) ---R expressIdealMember : (List(%),%) -> Union(List(%),"failed") ---R exquo : (%,%) -> Union(%,"failed") ---R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") ---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) ---R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT ---R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT ---R fractionPart : % -> % if S has EUCDOM ---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) ---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) ---R multiEuclidean : (List(%),%) -> Union(List(%),"failed") ---R negative? : % -> Boolean if S has OINTDOM ---R nextItem : % -> Union(%,"failed") if S has STEP ---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if S has PATMAB(FLOAT) ---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if S has PATMAB(INT) ---R positive? : % -> Boolean if S has OINTDOM ---R principalIdeal : List(%) -> Record(coef: List(%),generator: %) ---R reducedSystem : Matrix(%) -> Matrix(S) ---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(S),vec: Vector(S)) ---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if S has LINEXP(INT) ---R reducedSystem : Matrix(%) -> Matrix(Integer) if S has LINEXP(INT) ---R retract : % -> Integer if S has RETRACT(INT) ---R retract : % -> Fraction(Integer) if S has RETRACT(INT) ---R retract : % -> Symbol if S has RETRACT(SYMBOL) ---R retractIfCan : % -> Union(Integer,"failed") if S has RETRACT(INT) ---R retractIfCan : % -> Union(Fraction(Integer),"failed") if S has RETRACT(INT) ---R retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT(SYMBOL) ---R retractIfCan : % -> Union(S,"failed") ---R sign : % -> Integer if S has OINTDOM ---R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if S has PFECAT ---R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT ---R subtractIfCan : (%,%) -> Union(%,"failed") ---R unitNormal : % -> Record(unit: %,canonical: %,associate: %) ---R +--I InfinitlyClosePointCategory(K: Field, +--I symb: List Symbol, +--I PolyRing: PolynomialCategory(t#1,t#4,OrderedVariableList t#2), +--I E: DirectProductCategory(# t#2,NonNegativeInteger), +--I ProjPt: ProjectiveSpaceCategory t#1, +--I PCS: LocalPowerSeriesCategory t#1, +--I Plc: PlacesCategory(t#1,t#6), +--I DIVISOR: DivisorCategory t#7, +--I BLMET: BlowUpMethodCategory) is a category constructor +--I Abbreviation for InfinitlyClosePointCategory is INFCLCT +--I This constructor is exposed in this frame. +--I Issue )edit bookvol10.2.pamphlet to see algebra source code for INFCLCT +--I +--I------------------------------- Operations -------------------------------- +--I ?=? : (%,%) -> Boolean actualExtensionV : % -> K +--I chartV : % -> BLMET coerce : % -> OutputForm +--I create : (ProjPt,PolyRing) -> % degree : % -> PositiveInteger +--I excpDivV : % -> DIVISOR hash : % -> SingleInteger +--I latex : % -> String localParamV : % -> List PCS +--I localPointV : % -> AffinePlane K multV : % -> NonNegativeInteger +--I pointV : % -> ProjPt setchart! : (%,BLMET) -> BLMET +--I setpoint! : (%,ProjPt) -> ProjPt symbNameV : % -> Symbol +--I ?~=? : (%,%) -> Boolean +--I create : (ProjPt, +--I DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K), +--I AffinePlane K, +--I NonNegativeInteger, +--I BLMET, +--I NonNegativeInteger, +--I DIVISOR, +--I K, +--I Symbol) -> % +--I curveV : % -> +--I DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) +--I setcurve! : +--I (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> +--I DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) +--I setexcpDiv! : (%,DIVISOR) -> DIVISOR +--I setlocalParam! : (%,List PCS) -> List PCS +--I setlocalPoint! : (%,AffinePlane K) -> AffinePlane K +--I setmult! : (%,NonNegativeInteger) -> NonNegativeInteger +--I setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger +--I setsymbName! : (%,Symbol) -> Symbol +--I subMultV : % -> NonNegativeInteger +--I --E 1 )spool )lisp (bye) \end{chunk} -\begin{chunk}{QuotientFieldCategory.help} + +\begin{chunk}{InfinitlyClosePointCategory.help} ==================================================================== -QuotientFieldCategory examples +InfinitlyClosePointCategory examples ==================================================================== -QuotientField(S) is the category of fractions of an Integral Domain S. +This category is part of the PAFF package See Also: -o )show QuotientFieldCategory +o )show InfinitlyClosePointCategory \end{chunk} -{\bf See:} -\pagefrom{Algebra}{ALGEBRA} -\pagefrom{CharacteristicNonZero}{CHARNZ} -\pagefrom{CharacteristicZero}{CHARZ} -\pagefrom{ConvertibleTo}{KONVERT} -\pagefrom{DifferentialExtension}{DIFEXT} -\pagefrom{EuclideanDomain}{EUCDOM} -\pagefrom{Field}{FIELD} -\pagefrom{FullyEvalableOver}{FEVALAB} -\pagefrom{FullyLinearlyExplicitRingOver}{FLINEXP} -\pagefrom{FullyPatternMatchable}{FPATMAB} -\pagefrom{OrderedIntegralDomain}{OINTDOM} -\pagefrom{OrderedSet}{ORDSET} -\pagefrom{Patternable}{PATAB} -\pagefrom{PolynomialFactorizationExplicit}{PFECAT} -\pagefrom{RealConstant}{REAL} -\pagefrom{RetractableTo}{RETRACT} -\pagefrom{StepThrough}{STEP} +\pagefrom{SetCategoryWithDegree}{SETCATD} {\bf Exports:}\\ - -\begin{tabular}{lllll} -\cross{QFCAT}{0} & -\cross{QFCAT}{1} & -\cross{QFCAT}{abs} \\ -\cross{QFCAT}{associates?} & -\cross{QFCAT}{ceiling} & -\cross{QFCAT}{characteristic} \\ -\cross{QFCAT}{charthRoot} & -\cross{QFCAT}{coerce} & -\cross{QFCAT}{conditionP} \\ -\cross{QFCAT}{convert} & -\cross{QFCAT}{D} & -\cross{QFCAT}{denom} \\ -\cross{QFCAT}{denominator} & -\cross{QFCAT}{differentiate} & -\cross{QFCAT}{divide} \\ -\cross{QFCAT}{euclideanSize} & -\cross{QFCAT}{eval} & -\cross{QFCAT}{expressIdealMember} \\ -\cross{QFCAT}{exquo} & -\cross{QFCAT}{extendedEuclidean} & -\cross{QFCAT}{factor} \\ -\cross{QFCAT}{factorPolynomial} & -\cross{QFCAT}{factorSquareFreePolynomial} & -\cross{QFCAT}{floor} \\ -\cross{QFCAT}{fractionPart} & -\cross{QFCAT}{gcd} & -\cross{QFCAT}{gcdPolynomial} \\ -\cross{QFCAT}{hash} & -\cross{QFCAT}{init} & -\cross{QFCAT}{inv} \\ -\cross{QFCAT}{latex} & -\cross{QFCAT}{lcm} & -\cross{QFCAT}{map} \\ -\cross{QFCAT}{max} & -\cross{QFCAT}{min} & -\cross{QFCAT}{multiEuclidean} \\ -\cross{QFCAT}{negative?} & -\cross{QFCAT}{nextItem} & -\cross{QFCAT}{numer} \\ -\cross{QFCAT}{numerator} & -\cross{QFCAT}{one?} & -\cross{QFCAT}{patternMatch} \\ -\cross{QFCAT}{positive?} & -\cross{QFCAT}{prime?} & -\cross{QFCAT}{principalIdeal} \\ -\cross{QFCAT}{random} & -\cross{QFCAT}{recip} & -\cross{QFCAT}{reducedSystem} \\ -\cross{QFCAT}{retract} & -\cross{QFCAT}{retractIfCan} & -\cross{QFCAT}{sample} \\ -\cross{QFCAT}{sign} & -\cross{QFCAT}{sizeLess?} & -\cross{QFCAT}{solveLinearPolynomialEquation} \\ -\cross{QFCAT}{squareFree} & -\cross{QFCAT}{squareFreePart} & -\cross{QFCAT}{squareFreePolynomial} \\ -\cross{QFCAT}{subtractIfCan} & -\cross{QFCAT}{unit?} & -\cross{QFCAT}{unitNormal} \\ -\cross{QFCAT}{unitCanonical} & -\cross{QFCAT}{wholePart} & -\cross{QFCAT}{zero?} \\ -\cross{QFCAT}{?.?} & -\cross{QFCAT}{?*?} & -\cross{QFCAT}{?**?} \\ -\cross{QFCAT}{?+?} & -\cross{QFCAT}{?-?} & -\cross{QFCAT}{-?} \\ -\cross{QFCAT}{?/?} & -\cross{QFCAT}{?=?} & -\cross{QFCAT}{?\^{}?} \\ -\cross{QFCAT}{?quo?} & -\cross{QFCAT}{?rem?} & -\cross{QFCAT}{?\~{}=?} \\ -\cross{QFCAT}{?$<$?} & -\cross{QFCAT}{?$<=$?} & -\cross{QFCAT}{?$>$?} \\ -\cross{QFCAT}{?$>=$?} && -\end{tabular} - -{\bf Attributes Exported:} -\begin{itemize} -\item {\bf \cross{QFCAT}{canonicalUnitNormal}} -is true if we can choose a canonical representative for each class -of associate elements, that is {\tt associates?(a,b)} returns true -if and only if {\tt unitCanonical(a) = unitCanonical(b)}. -\item {\bf \cross{QFCAT}{canonicalsClosed}} -is true if\hfill\\ -{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}. -\item {\bf \cross{QFCAT}{noZeroDivisors}} -is true if $x * y \ne 0$ implies both x and y are non-zero. -\item {\bf \cross{QFCAT}{commutative(``*'')}} -is true if it has an operation $"*": (D,D) -> D$ -which is commutative. -\item {\bf \cross{QFCAT}{unitsKnown}} -is true if a monoid (a multiplicative semigroup with a 1) has -unitsKnown means that the operation {\tt recip} can only return -``failed'' if its argument is not a unit. -\item {\bf \cross{QFCAT}{leftUnitary}} -is true if $1 * x = x$ for all x. -\item {\bf \cross{QFCAT}{rightUnitary}} -is true if $x * 1 = x$ for all x. -\item {\bf nil} -\end{itemize} +\begin{tabular}{llll} +\cross{INFCLCT}{?=?} & +\cross{INFCLCT}{?\~{}=?} & +\cross{INFCLCT}{actualExtensionV} & +\cross{INFCLCT}{chartV} \\ +\cross{INFCLCT}{coerce} & +\cross{INFCLCT}{create} & +\cross{INFCLCT}{curveV} & +\cross{INFCLCT}{degree} \\ +\cross{INFCLCT}{excpDivV} & +\cross{INFCLCT}{hash} & +\cross{INFCLCT}{latex} & +\cross{INFCLCT}{localParamV} \\ +\cross{INFCLCT}{localPointV} & +\cross{INFCLCT}{multV} & +\cross{INFCLCT}{pointV} & +\cross{INFCLCT}{setchart!} \\ +\cross{INFCLCT}{setcurve!} & +\cross{INFCLCT}{setexcpDiv!} & +\cross{INFCLCT}{setlocalParam!} & +\cross{INFCLCT}{setlocalPoint!} \\ +\cross{INFCLCT}{setmult!} & +\cross{INFCLCT}{setpoint!} & +\cross{INFCLCT}{setsubmult!} & +\cross{INFCLCT}{setsymbName!} \\ +\cross{INFCLCT}{subMultV} & +\cross{INFCLCT}{symbNameV} && +\end{tabular} These are directly exported but not implemented: \begin{verbatim} - ceiling : % -> S if S has INS - denom : % -> S - floor : % -> S if S has INS - numer : % -> S - wholePart : % -> S if S has EUCDOM - ?/? : (S,S) -> % -\end{verbatim} - -These are implemented by this category: -\begin{verbatim} - characteristic : () -> NonNegativeInteger - coerce : Symbol -> % if S has RETRACT SYMBOL - coerce : Fraction Integer -> % - convert : % -> InputForm if S has KONVERT INFORM - convert : % -> DoubleFloat if S has REAL - convert : % -> Float if S has REAL - convert : % -> Pattern Integer if S has KONVERT PATTERN INT - convert : % -> Pattern Float if S has KONVERT PATTERN FLOAT - denominator : % -> % - differentiate : (%,(S -> S)) -> % - fractionPart : % -> % if S has EUCDOM - init : () -> % if S has STEP - map : ((S -> S),%) -> % - nextItem : % -> Union(%,"failed") if S has STEP - numerator : % -> % - patternMatch : - (%,Pattern Float,PatternMatchResult(Float,%)) -> - PatternMatchResult(Float,%) - if S has PATMAB FLOAT - patternMatch : - (%,Pattern Integer,PatternMatchResult(Integer,%)) -> - PatternMatchResult(Integer,%) - if S has PATMAB INT - random : () -> % if S has INS - reducedSystem : Matrix % -> Matrix S - reducedSystem : (Matrix %,Vector %) -> Record(mat: Matrix S,vec: Vector S) - retract : % -> Symbol if S has RETRACT SYMBOL - retract : % -> Integer if S has RETRACT INT - retractIfCan : % -> Union(Integer,"failed") if S has RETRACT INT - retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT SYMBOL - ? Boolean if S has ORDSET + actualExtensionV : % -> K + chartV : % -> BLMET + create : + (ProjPt,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K), + AffinePlane K,NonNegativeInteger,BLMET,NonNegativeInteger,DIVISOR,K,Symbol) + -> % + create : (ProjPt,PolyRing) -> % + curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) + excpDivV : % -> DIVISOR + localParamV : % -> List PCS + localPointV : % -> AffinePlane K + multV : % -> NonNegativeInteger + pointV : % -> ProjPt + setchart! : (%,BLMET) -> BLMET + setcurve! : + (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> + DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) + setexcpDiv! : (%,DIVISOR) -> DIVISOR + setlocalParam! : (%,List PCS) -> List PCS + setlocalPoint! : (%,AffinePlane K) -> AffinePlane K + setmult! : (%,NonNegativeInteger) -> NonNegativeInteger + setpoint! : (%,ProjPt) -> ProjPt + setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger + setsymbName! : (%,Symbol) -> Symbol + subMultV : % -> NonNegativeInteger + symbNameV : % -> Symbol \end{verbatim} -These exports come from \refto{Field}(): +These exports come from \refto{SetCategoryWithDegree}: \begin{verbatim} - 0 : () -> % - 1 : () -> % - associates? : (%,%) -> Boolean - coerce : % -> % - coerce : Integer -> % - coerce : % -> OutputForm - divide : (%,%) -> Record(quotient: %,remainder: %) - euclideanSize : % -> NonNegativeInteger - expressIdealMember : (List %,%) -> Union(List %,"failed") - extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") - extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) - exquo : (%,%) -> Union(%,"failed") - factor : % -> Factored % - gcd : (%,%) -> % - gcd : List % -> % - gcdPolynomial : - (SparseUnivariatePolynomial %, - SparseUnivariatePolynomial %) -> - SparseUnivariatePolynomial % - hash : % -> SingleInteger - inv : % -> % - latex : % -> String - lcm : List % -> % - lcm : (%,%) -> % - multiEuclidean : (List %,%) -> Union(List %,"failed") - one? : % -> Boolean - prime? : % -> Boolean - principalIdeal : List % -> Record(coef: List %,generator: %) - recip : % -> Union(%,"failed") - sample : () -> % - sizeLess? : (%,%) -> Boolean - squareFree : % -> Factored % - squareFreePart : % -> % - subtractIfCan : (%,%) -> Union(%,"failed") - unit? : % -> Boolean - unitCanonical : % -> % - unitNormal : % -> Record(unit: %,canonical: %,associate: %) - zero? : % -> Boolean - ?*? : (Fraction Integer,%) -> % - ?*? : (%,Fraction Integer) -> % - ?**? : (%,Integer) -> % - ?^? : (%,Integer) -> % - ?+? : (%,%) -> % ?=? : (%,%) -> Boolean ?~=? : (%,%) -> Boolean - ?*? : (%,%) -> % - ?*? : (Integer,%) -> % - ?*? : (PositiveInteger,%) -> % - ?*? : (NonNegativeInteger,%) -> % - ?-? : (%,%) -> % - -? : % -> % - ?**? : (%,PositiveInteger) -> % - ?**? : (%,NonNegativeInteger) -> % - ?^? : (%,NonNegativeInteger) -> % - ?^? : (%,PositiveInteger) -> % - ?/? : (%,%) -> % - ?quo? : (%,%) -> % - ?rem? : (%,%) -> % + coerce : % -> OutputForm + degree : % -> PositiveInteger + hash : % -> SingleInteger + latex : % -> String \end{verbatim} -These exports come from \refto{Algebra}(S:IntegralDomain): -\begin{verbatim} - coerce : S -> % - ?*? : (%,S) -> % - ?*? : (S,%) -> % -\end{verbatim} +\begin{chunk}{category INFCLCT InfinitlyClosePointCategory} +)abbrev category INFCLCT InfinitlyClosePointCategory +++ Authors: Gaetan Hache +++ Date Created: may 1997 +++ Date Last Updated: April 2010, by Tim Daly +++ Description: +++ This category is part of the PAFF package +InfinitlyClosePointCategory(_ + K :Field,_ + symb :List(Symbol),_ + PolyRing :PolynomialCategory(K,E,OrderedVariableList(symb)),_ + E :DirectProductCategory(#symb,NonNegativeInteger),_ + ProjPt :ProjectiveSpaceCategory(K),_ + PCS :LocalPowerSeriesCategory(K),_ + Plc :PlacesCategory(K,PCS),_ + DIVISOR :DivisorCategory(Plc),_ + BLMET :BlowUpMethodCategory_ + ):Category == Exports where -These exports come from \refto{RetractableTo}(S:IntegralDomain): -\begin{verbatim} - retract : % -> S - retractIfCan : % -> Union(S,"failed") -\end{verbatim} + bls ==> ['X,'Y] + BlUpRing ==> DistributedMultivariatePolynomial(bls , K) + AFP ==> AffinePlane(K) -These exports come from \refto{FullyEvalableOver}(S:IntegralDomain): -\begin{verbatim} - ?.? : (%,S) -> % if S has ELTAB(S,S) - eval : (%,Equation S) -> % if S has EVALAB S - eval : (%,List Symbol,List S) -> % if S has IEVALAB(SYMBOL,S) - eval : (%,List Equation S) -> % if S has EVALAB S - eval : (%,S,S) -> % if S has EVALAB S - eval : (%,List S,List S) -> % if S has EVALAB S - eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S) -\end{verbatim} + Exports ==> SetCategoryWithDegree with -These exports come from \refto{DifferentialExtension}(S:IntegralDomain): -\begin{verbatim} - D : (%,(S -> S)) -> % - D : (%,(S -> S),NonNegativeInteger) -> % - D : % -> % if S has DIFRING - D : (%,NonNegativeInteger) -> % if S has DIFRING - D : (%,List Symbol,List NonNegativeInteger) -> % - if S has PDRING SYMBOL - D : (%,Symbol,NonNegativeInteger) -> % - if S has PDRING SYMBOL - D : (%,List Symbol) -> % if S has PDRING SYMBOL - D : (%,Symbol) -> % if S has PDRING SYMBOL - differentiate : (%,List Symbol) -> % - if S has PDRING SYMBOL - differentiate : (%,Symbol,NonNegativeInteger) -> % - if S has PDRING SYMBOL - differentiate : (%,List Symbol,List NonNegativeInteger) -> % - if S has PDRING SYMBOL - differentiate : (%,NonNegativeInteger) -> % if S has DIFRING - differentiate : % -> % if S has DIFRING - differentiate : (%,Symbol) -> % if S has PDRING SYMBOL - differentiate : (%,(S -> S),NonNegativeInteger) -> % -\end{verbatim} + create: (ProjPt , BlUpRing, AFP , NonNegativeInteger,BLMET, _ + NonNegativeInteger, DIVISOR,K,Symbol) -> % + ++ create an infinitly close point -These exports come from -\refto{FullyLinearlyExplicitRingOver}(S:IntegralDomain): -\begin{verbatim} - reducedSystem : (Matrix %,Vector %) -> - Record(mat: Matrix Integer,vec: Vector Integer) - if S has LINEXP INT - reducedSystem : Matrix % -> Matrix Integer if S has LINEXP INT -\end{verbatim} + create: (ProjPt,PolyRing) -> % + + setpoint_!: (%,ProjPt) -> ProjPt -These exports come from \refto{RetractableTo}(Fraction(Integer)): -\begin{verbatim} - retract : % -> Fraction Integer if S has RETRACT INT - retractIfCan : % -> Union(Fraction Integer,"failed") - if S has RETRACT INT -\end{verbatim} + setcurve_!: (%,BlUpRing) -> BlUpRing -These exports come from \refto{OrderedSet}(): -\begin{verbatim} - max : (%,%) -> % if S has ORDSET - min : (%,%) -> % if S has ORDSET - ?<=? : (%,%) -> Boolean if S has ORDSET - ?>? : (%,%) -> Boolean if S has ORDSET - ?>=? : (%,%) -> Boolean if S has ORDSET -\end{verbatim} + setlocalPoint_!: (%,AFP) -> AFP + + setsubmult_! : (%, NonNegativeInteger) -> NonNegativeInteger -These exports come from \refto{OrderedIntegralDomain}(): -\begin{verbatim} - abs : % -> % if S has OINTDOM - negative? : % -> Boolean if S has OINTDOM - positive? : % -> Boolean if S has OINTDOM - sign : % -> Integer if S has OINTDOM -\end{verbatim} + setmult_!: (%,NonNegativeInteger) -> NonNegativeInteger + + setchart_!: (%,BLMET) -> BLMET -- CHH -These exports come from \refto{CharacteristicNonZero}(): -\begin{verbatim} - charthRoot : % -> Union(%,"failed") - if S has CHARNZ - or and(has($,CharacteristicNonZero), - has(S,PolynomialFactorizationExplicit)) -\end{verbatim} + setexcpDiv_!: (%,DIVISOR) -> DIVISOR -These exports come from \refto{PolynomialFactorizationExplicit}(): -\begin{verbatim} - conditionP : Matrix % -> Union(Vector %,"failed") - if and(has($,CharacteristicNonZero), - has(S,PolynomialFactorizationExplicit)) - factorPolynomial : - SparseUnivariatePolynomial % -> - Factored SparseUnivariatePolynomial % - if S has PFECAT - factorSquareFreePolynomial : - SparseUnivariatePolynomial % -> - Factored SparseUnivariatePolynomial % - if S has PFECAT - solveLinearPolynomialEquation : - (List SparseUnivariatePolynomial %, - SparseUnivariatePolynomial %) -> - Union(List SparseUnivariatePolynomial %,"failed") - if S has PFECAT - squareFreePolynomial : - SparseUnivariatePolynomial % -> - Factored SparseUnivariatePolynomial % - if S has PFECAT -\end{verbatim} + setlocalParam_!: (%,List PCS) -> List(PCS) -\begin{chunk}{category QFCAT QuotientFieldCategory} -)abbrev category QFCAT QuotientFieldCategory -++ Date Last Updated: 5th March 1996 -++ Description: -++ QuotientField(S) is the category of fractions of an Integral Domain S. + setsymbName_!: (%,Symbol) -> Symbol + + subMultV: % -> NonNegativeInteger -QuotientFieldCategory(S: IntegralDomain): Category == - Join(Field, Algebra S, RetractableTo S, FullyEvalableOver S, - DifferentialExtension S, FullyLinearlyExplicitRingOver S, - Patternable S, FullyPatternMatchable S) with - _/ : (S, S) -> % - ++ d1 / d2 returns the fraction d1 divided by d2. - numer : % -> S - ++ numer(x) returns the numerator of the fraction x. - denom : % -> S - ++ denom(x) returns the denominator of the fraction x. - numerator : % -> % - ++ numerator(x) is the numerator of the fraction x converted to %. - denominator : % -> % - ++ denominator(x) is the denominator of the fraction x converted to %. - if S has StepThrough then StepThrough - if S has RetractableTo Integer then - RetractableTo Integer - RetractableTo Fraction Integer - if S has OrderedSet then OrderedSet - if S has OrderedIntegralDomain then OrderedIntegralDomain - if S has RealConstant then RealConstant - if S has ConvertibleTo InputForm then ConvertibleTo InputForm - if S has CharacteristicZero then CharacteristicZero - if S has CharacteristicNonZero then CharacteristicNonZero - if S has RetractableTo Symbol then RetractableTo Symbol - if S has EuclideanDomain then - wholePart: % -> S - ++ wholePart(x) returns the whole part of the fraction x - ++ i.e. the truncated quotient of the numerator by the denominator. - fractionPart: % -> % - ++ fractionPart(x) returns the fractional part of x. - ++ x = wholePart(x) + fractionPart(x) - if S has IntegerNumberSystem then - random: () -> % - ++ random() returns a random fraction. - ceiling : % -> S - ++ ceiling(x) returns the smallest integral element above x. - floor: % -> S - ++ floor(x) returns the largest integral element below x. - if S has PolynomialFactorizationExplicit then - PolynomialFactorizationExplicit + localParamV: % -> List PCS - add - import MatrixCommonDenominator(S, %) + symbNameV: % -> Symbol - numerator(x) == numer(x)::% + pointV: % -> ProjPt + ++ pointV returns the infinitly close point. - denominator(x) == denom(x) ::% + curveV: % -> BlUpRing + ++ curveV(p) returns the defining polynomial of the strict transform + ++ on which lies the corresponding infinitly close point. - if S has StepThrough then - init() == init()$S / 1$S + localPointV: % -> AFP + ++ localPointV returns the coordinates of the local infinitly + ++ close point - nextItem(n) == - m:= nextItem(numer(n)) - m case "failed" => - error "We seem to have a Fraction of a finite object" - m / 1 + multV: % -> NonNegativeInteger + ++ multV returns the multiplicity of the infinitly close point. - map(fn, x) == (fn numer x) / (fn denom x) + chartV: % -> BLMET -- CHH + ++ chartV is the chart of the infinitly close point. The first integer + ++ correspond to variable defining the exceptional line, the last one + ++ the affine neighboorhood and the second one is the + ++ remaining integer. For example [1,2,3] means that + ++ Z=1, X=X and Y=XY. [2,3,1] means that X=1, Y=Y and Z=YZ. - reducedSystem(m:Matrix %):Matrix S == clearDenominator m + excpDivV: % -> DIVISOR + ++ excpDivV returns the exceptional divisor of the infinitly close point. - characteristic() == characteristic()$S + actualExtensionV: % -> K - differentiate(x:%, deriv:S -> S) == - n := numer x - d := denom x - (deriv n * d - n * deriv d) / (d**2) +\end{chunk} - if S has ConvertibleTo InputForm then - convert(x:%):InputForm == (convert numer x) / (convert denom x) +\begin{chunk}{INFCLCT.dotabb} +"INFCLCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"]; +"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] +"INFCLCT" -> "ALIST" - if S has RealConstant then - convert(x:%):Float == (convert numer x) / (convert denom x) +\end{chunk} - convert(x:%):DoubleFloat == (convert numer x) / (convert denom x) +\begin{chunk}{INFCLCT.dotfull} +"InfinitlyClosePointCategory" + [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"]; +"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)" - -- Note that being a Join(OrderedSet,IntegralDomain) is not the same - -- as being an OrderedIntegralDomain. - if S has OrderedIntegralDomain then - if S has canonicalUnitNormal then - x:% < y:% == - (numer x * denom y) < (numer y * denom x) - else - x:% < y:% == - if denom(x) < 0 then (x,y):=(y,x) - if denom(y) < 0 then (x,y):=(y,x) - (numer x * denom y) < (numer y * denom x) - else if S has OrderedSet then - x:% < y:% == - (numer x * denom y) < (numer y * denom x) +\end{chunk} - if (S has EuclideanDomain) then - fractionPart x == x - (wholePart(x)::%) +\begin{chunk}{INFCLCT.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; - if S has RetractableTo Symbol then - coerce(s:Symbol):% == s::S::% +"InfinitlyClosePointCategory" [color=lightblue]; +"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)" - retract(x:%):Symbol == retract(retract(x)@S) +"AssocationList(SetCategory,SetCategory)" -> "AssocationList()" - retractIfCan(x:%):Union(Symbol, "failed") == - (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed" - retractIfCan(r::S) +"AssocationList()" [color=lightblue]; - if (S has ConvertibleTo Pattern Integer) then - convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x) - - if (S has PatternMatchable Integer) then - patternMatch(x:%, p:Pattern Integer, - l:PatternMatchResult(Integer, %)) == - patternMatch(x, p, - l)$PatternMatchQuotientFieldCategory(Integer, S, %) - - if (S has ConvertibleTo Pattern Float) then - convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x) - - if (S has PatternMatchable Float) then - patternMatch(x:%, p:Pattern Float, - l:PatternMatchResult(Float, %)) == - patternMatch(x, p, - l)$PatternMatchQuotientFieldCategory(Float, S, %) - - if S has RetractableTo Integer then - coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::% - - if not(S is Integer) then - retract(x:%):Integer == retract(retract(x)@S) - - retractIfCan(x:%):Union(Integer, "failed") == - (u := retractIfCan(x)@Union(S, "failed")) case "failed" => - "failed" - retractIfCan(u::S) - - if S has IntegerNumberSystem then - random():% == - while zero?(d:=random()$S) repeat d - random()$S / d - - reducedSystem(m:Matrix %, v:Vector %): - Record(mat:Matrix S, vec:Vector S) == - n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S) - [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n, - maxColIndex n), column(n, minColIndex n)] - -\end{chunk} -\begin{chunk}{QFCAT.dotabb} -"QFCAT" - [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"]; -"QFCAT" -> "ALGEBRA" -"QFCAT" -> "DIFEXT" -"QFCAT" -> "FIELD" -"QFCAT" -> "FEVALAB" -"QFCAT" -> "FLINEXP" -"QFCAT" -> "FPATMAB" -"QFCAT" -> "PATAB" -"QFCAT" -> "RETRACT" - -\end{chunk} -\begin{chunk}{QFCAT.dotfull} -"QuotientFieldCategory(a:IntegralDomain)" - [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"]; -"QuotientFieldCategory(a:IntegralDomain)" -> "Field()" -"QuotientFieldCategory(a:IntegralDomain)" -> "Algebra(IntegralDomain)" -"QuotientFieldCategory(a:IntegralDomain)" -> "RetractableTo(IntegralDomain)" -"QuotientFieldCategory(a:IntegralDomain)" -> - "FullyEvalableOver(IntegralDomain)" -"QuotientFieldCategory(a:IntegralDomain)" -> - "DifferentialExtension(IntegralDomain)" -"QuotientFieldCategory(a:IntegralDomain)" -> - "FullyLinearlyExplicitRingOver(IntegralDomain)" -"QuotientFieldCategory(a:IntegralDomain)" -> - "Patternable(IntegralDomain)" -"QuotientFieldCategory(a:IntegralDomain)" -> - "FullyPatternMatchable(IntegralDomain)" - -\end{chunk} -\begin{chunk}{QFCAT.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; - -"QuotientFieldCategory(a:IntegralDomain)" [color=lightblue]; -"QuotientFieldCategory(a:IntegralDomain)" -> "ALGEBRA..." -"QuotientFieldCategory(a:IntegralDomain)" -> "DIFEXT..." -"QuotientFieldCategory(a:IntegralDomain)" -> "FIELD..." -"QuotientFieldCategory(a:IntegralDomain)" -> "FEVALAB..." -"QuotientFieldCategory(a:IntegralDomain)" -> "FLINEXP..." -"QuotientFieldCategory(a:IntegralDomain)" -> "FPATMAB..." -"QuotientFieldCategory(a:IntegralDomain)" -> "PATAB..." -"QuotientFieldCategory(a:IntegralDomain)" -> "RETRACT..." - -"ALGEBRA..." [color=lightblue]; -"DIFEXT..." [color=lightblue]; -"FIELD..." [color=lightblue]; -"FEVALAB..." [color=lightblue]; -"FLINEXP..." [color=lightblue]; -"FPATMAB..." [color=lightblue]; -"PATAB..." [color=lightblue]; -"RETRACT..." [color=lightblue]; - -} +} \end{chunk} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{RealClosedField}{RCFIELD} -\pagepic{ps/v102realclosedfield.ps}{RCFIELD}{0.50} +\pagehead{PseudoAlgebraicClosureOfPerfectFieldCategory}{PACPERC} +\pagepic{ps/v102pseudoalgebraicclosureofperfectfieldcategory.ps}{PACPERC}{0.50} -\begin{chunk}{RealClosedField.input} +\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.input} )set break resume -)sys rm -f RealClosedField.output -)spool RealClosedField.output +)sys rm -f PseudoAlgebraicClosureOfPerfectFieldCategory.output +)spool PseudoAlgebraicClosureOfPerfectFieldCategory.output )set message test on )set message auto off )clear all --S 1 of 1 -)show RealClosedField +)show PseudoAlgebraicClosureOfPerfectFieldCategory --R ---R RealClosedField is a category constructor ---R Abbreviation for RealClosedField is RCFIELD +--R PseudoAlgebraicClosureOfPerfectFieldCategory is a category constructor +--R Abbreviation for PseudoAlgebraicClosureOfPerfectFieldCategory is PACPERC --R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for RCFIELD +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for PACPERC --R --R------------------------------- Operations -------------------------------- ---R ?*? : (%,Fraction(Integer)) -> % ?*? : (Fraction(Integer),%) -> % ---R ?*? : (%,Integer) -> % ?*? : (Integer,%) -> % ---R ?*? : (%,Fraction(Integer)) -> % ?*? : (Fraction(Integer),%) -> % +--R ?*? : (Fraction(Integer),%) -> % ?*? : (%,Fraction(Integer)) -> % --R ?*? : (%,%) -> % ?*? : (Integer,%) -> % --R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % ---R ?**? : (%,Fraction(Integer)) -> % ?**? : (%,Integer) -> % ---R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % ---R ?+? : (%,%) -> % ?-? : (%,%) -> % ---R -? : % -> % ?/? : (%,%) -> % ---R ? Boolean ?<=? : (%,%) -> Boolean ---R ?=? : (%,%) -> Boolean ?>? : (%,%) -> Boolean ---R ?>=? : (%,%) -> Boolean 1 : () -> % ---R 0 : () -> % ?^? : (%,Integer) -> % ---R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % ---R abs : % -> % associates? : (%,%) -> Boolean ---R coerce : Fraction(Integer) -> % coerce : Integer -> % +--R ?**? : (%,Integer) -> % ?**? : (%,NonNegativeInteger) -> % +--R ?**? : (%,PositiveInteger) -> % ?+? : (%,%) -> % +--R ?-? : (%,%) -> % -? : % -> % +--R ?/? : (%,%) -> % ?=? : (%,%) -> Boolean +--R 1 : () -> % 0 : () -> % +--R ?^? : (%,Integer) -> % ?^? : (%,NonNegativeInteger) -> % +--R ?^? : (%,PositiveInteger) -> % associates? : (%,%) -> Boolean --R coerce : Fraction(Integer) -> % coerce : % -> % ---R coerce : Fraction(Integer) -> % coerce : Integer -> % ---R coerce : % -> OutputForm factor : % -> Factored(%) ---R gcd : (%,%) -> % gcd : List(%) -> % ---R hash : % -> SingleInteger inv : % -> % ---R latex : % -> String lcm : (%,%) -> % ---R lcm : List(%) -> % max : (%,%) -> % ---R min : (%,%) -> % negative? : % -> Boolean ---R nthRoot : (%,Integer) -> % one? : % -> Boolean ---R positive? : % -> Boolean prime? : % -> Boolean +--R coerce : Integer -> % coerce : % -> OutputForm +--R conjugate : % -> % extDegree : % -> PositiveInteger +--R factor : % -> Factored(%) fullOutput : % -> OutputForm +--R gcd : List(%) -> % gcd : (%,%) -> % +--R ground? : % -> Boolean hash : % -> SingleInteger +--R inv : % -> % latex : % -> String +--R lcm : List(%) -> % lcm : (%,%) -> % +--R maxTower : List(%) -> % one? : % -> Boolean +--R previousTower : % -> % prime? : % -> Boolean --R ?quo? : (%,%) -> % recip : % -> Union(%,"failed") ---R ?rem? : (%,%) -> % rename : (%,OutputForm) -> % ---R rename! : (%,OutputForm) -> % retract : % -> Fraction(Integer) ---R sample : () -> % sign : % -> Integer ---R sizeLess? : (%,%) -> Boolean sqrt : Integer -> % ---R sqrt : Fraction(Integer) -> % sqrt : (%,NonNegativeInteger) -> % ---R sqrt : % -> % squareFree : % -> Factored(%) ---R squareFreePart : % -> % unit? : % -> Boolean ---R unitCanonical : % -> % zero? : % -> Boolean +--R ?rem? : (%,%) -> % sample : () -> % +--R setTower! : % -> Void sizeLess? : (%,%) -> Boolean +--R squareFree : % -> Factored(%) squareFreePart : % -> % +--R unit? : % -> Boolean unitCanonical : % -> % +--R vectorise : (%,%) -> Vector(%) zero? : % -> Boolean --R ?~=? : (%,%) -> Boolean ---R allRootsOf : Polynomial(Integer) -> List(%) ---R allRootsOf : Polynomial(Fraction(Integer)) -> List(%) ---R allRootsOf : Polynomial(%) -> List(%) ---R allRootsOf : SparseUnivariatePolynomial(Integer) -> List(%) ---R allRootsOf : SparseUnivariatePolynomial(Fraction(Integer)) -> List(%) ---R allRootsOf : SparseUnivariatePolynomial(%) -> List(%) ---R approximate : (%,%) -> Fraction(Integer) --R characteristic : () -> NonNegativeInteger +--R definingPolynomial : % -> SparseUnivariatePolynomial(%) +--R definingPolynomial : () -> SparseUnivariatePolynomial(%) +--R distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%) --R divide : (%,%) -> Record(quotient: %,remainder: %) --R euclideanSize : % -> NonNegativeInteger --R expressIdealMember : (List(%),%) -> Union(List(%),"failed") --R exquo : (%,%) -> Union(%,"failed") ---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) --R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") +--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) --R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) --R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) ---R mainDefiningPolynomial : % -> Union(SparseUnivariatePolynomial(%),"failed") ---R mainForm : % -> Union(OutputForm,"failed") ---R mainValue : % -> Union(SparseUnivariatePolynomial(%),"failed") +--R lift : (%,%) -> SparseUnivariatePolynomial(%) +--R lift : % -> SparseUnivariatePolynomial(%) --R multiEuclidean : (List(%),%) -> Union(List(%),"failed") +--R newElement : (SparseUnivariatePolynomial(%),Symbol) -> % +--R newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> % --R principalIdeal : List(%) -> Record(coef: List(%),generator: %) ---R retract : % -> Fraction(Integer) if Fraction(Integer) has RETRACT(FRAC(INT)) ---R retract : % -> Integer if Fraction(Integer) has RETRACT(INT) ---R retractIfCan : % -> Union(Fraction(Integer),"failed") ---R retractIfCan : % -> Union(Fraction(Integer),"failed") if Fraction(Integer) has RETRACT(FRAC(INT)) ---R retractIfCan : % -> Union(Integer,"failed") if Fraction(Integer) has RETRACT(INT) ---R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) -> Union(%,"failed") ---R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger,OutputForm) -> Union(%,"failed") +--R reduce : SparseUnivariatePolynomial(%) -> % --R subtractIfCan : (%,%) -> Union(%,"failed") --R unitNormal : % -> Record(unit: %,canonical: %,associate: %) --R @@ -64747,533 +73108,431 @@ digraph pic { )spool )lisp (bye) \end{chunk} -\begin{chunk}{RealClosedField.help} + +\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.help} ==================================================================== -RealClosedField examples +PseudoAlgebraicClosureOfPerfectFieldCategory examples ==================================================================== -RealClosedField provides common access functions for all real closed fields. -It provides computations with generic real roots of polynomials. +This category exports the function for domains which implement dynamic +extension using the simple notion of tower extensions. A tower extension +T of the ground field K is any sequence of field extensions + (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K +and for + i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 +and defined by an irreducible polynomial p(Z) in K_{i-1}. + +Two towers + (T_1: K_01, K_11,...,K_i1,...,K_n1) +and + (T_2: K_02, K_12,...,K_i2,...,K_n2) +are said to be related if + T_1 <= T_2 (or T_1 >= T_2), +that is if + K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). + +Any algebraic operations defined for several elements are only defined +if all of the concerned elements are coming from a set of related tower +extensions. See Also: -o )show RealClosedField +o )show PseudoAlgebraicClosureOfPerfectFieldCategory \end{chunk} -{\bf See:} -\pagefrom{Algebra}{ALGEBRA} -\pagefrom{CharacteristicZero}{CHARZ} -\pagefrom{CommutativeRing}{COMRING} \pagefrom{Field}{FIELD} -\pagefrom{FullyRetractableTo}{FRETRCT} -\pagefrom{OrderedRing}{ORDRING} -\pagefrom{RadicalCategory}{RADCAT} {\bf Exports:}\\ - \begin{tabular}{llll} -\cross{RCFIELD}{0} & -\cross{RCFIELD}{1} & -\cross{RCFIELD}{abs} & -\cross{RCFIELD}{allRootsOf} \\ -\cross{RCFIELD}{approximate} & -\cross{RCFIELD}{associates?} & -\cross{RCFIELD}{characteristic} & -\cross{RCFIELD}{coerce} \\ -\cross{RCFIELD}{divide} & -\cross{RCFIELD}{euclideanSize} & -\cross{RCFIELD}{expressIdealMember} & -\cross{RCFIELD}{exquo} \\ -\cross{RCFIELD}{extendedEuclidean} & -\cross{RCFIELD}{factor} & -\cross{RCFIELD}{gcd} & -\cross{RCFIELD}{gcdPolynomial} \\ -\cross{RCFIELD}{hash} & -\cross{RCFIELD}{inv} & -\cross{RCFIELD}{latex} & -\cross{RCFIELD}{lcm} \\ -\cross{RCFIELD}{mainDefiningPolynomial} & -\cross{RCFIELD}{mainForm} & -\cross{RCFIELD}{mainValue} & -\cross{RCFIELD}{max} \\ -\cross{RCFIELD}{min} & -\cross{RCFIELD}{multiEuclidean} & -\cross{RCFIELD}{negative?} & -\cross{RCFIELD}{nthRoot} \\ -\cross{RCFIELD}{one?} & -\cross{RCFIELD}{positive?} & -\cross{RCFIELD}{prime?} & -\cross{RCFIELD}{principalIdeal} \\ -\cross{RCFIELD}{recip} & -\cross{RCFIELD}{rename} & -\cross{RCFIELD}{rename!} & -\cross{RCFIELD}{retract} \\ -\cross{RCFIELD}{retractIfCan} & -\cross{RCFIELD}{rootOf} & -\cross{RCFIELD}{sample} & -\cross{RCFIELD}{sign} \\ -\cross{RCFIELD}{sizeLess?} & -\cross{RCFIELD}{sqrt} & -\cross{RCFIELD}{squareFree} & -\cross{RCFIELD}{squareFreePart} \\ -\cross{RCFIELD}{subtractIfCan} & -\cross{RCFIELD}{unit?} & -\cross{RCFIELD}{unitCanonical} & -\cross{RCFIELD}{unitNormal} \\ -\cross{RCFIELD}{zero?} & -\cross{RCFIELD}{?*?} & -\cross{RCFIELD}{?**?} & -\cross{RCFIELD}{?+?} \\ -\cross{RCFIELD}{?-?} & -\cross{RCFIELD}{-?} & -\cross{RCFIELD}{?/?} & -\cross{RCFIELD}{?$<$?} \\ -\cross{RCFIELD}{?$<=$?} & -\cross{RCFIELD}{?=?} & -\cross{RCFIELD}{?$>$?} & -\cross{RCFIELD}{?$>=$?} \\ -\cross{RCFIELD}{?\^{}?} & -\cross{RCFIELD}{?\~{}=?} & -\cross{RCFIELD}{?quo?} & -\cross{RCFIELD}{?rem?} \\ -\end{tabular} +\cross{PACPERC}{0} & +\cross{PACPERC}{1} & +\cross{PACPERC}{associates?} & +\cross{PACPERC}{characteristic} \\ +\cross{PACPERC}{coerce} & +\cross{PACPERC}{conjugate} & +\cross{PACPERC}{definingPolynomial} & +\cross{PACPERC}{distinguishedRootsOf} \\ +\cross{PACPERC}{divide} & +\cross{PACPERC}{euclideanSize} & +\cross{PACPERC}{expressIdealMember} & +\cross{PACPERC}{exquo} \\ +\cross{PACPERC}{extDegree} & +\cross{PACPERC}{extendedEuclidean} & +\cross{PACPERC}{factor} & +\cross{PACPERC}{fullOutput} \\ +\cross{PACPERC}{gcd} & +\cross{PACPERC}{gcdPolynomial} & +\cross{PACPERC}{ground?} & +\cross{PACPERC}{hash} \\ +\cross{PACPERC}{inv} & +\cross{PACPERC}{latex} & +\cross{PACPERC}{lcm} & +\cross{PACPERC}{lift} \\ +\cross{PACPERC}{maxTower} & +\cross{PACPERC}{multiEuclidean} & +\cross{PACPERC}{newElement} & +\cross{PACPERC}{one?} \\ +\cross{PACPERC}{previousTower} & +\cross{PACPERC}{prime?} & +\cross{PACPERC}{principalIdeal} & +\cross{PACPERC}{?quo?} \\ +\cross{PACPERC}{recip} & +\cross{PACPERC}{reduce} & +\cross{PACPERC}{?rem?} & +\cross{PACPERC}{sample} \\ +\cross{PACPERC}{setTower!} & +\cross{PACPERC}{sizeLess?} & +\cross{PACPERC}{squareFree} & +\cross{PACPERC}{squareFreePart} \\ +\cross{PACPERC}{subtractIfCan} & +\cross{PACPERC}{unit?} & +\cross{PACPERC}{unitCanonical} & +\cross{PACPERC}{unitNormal} \\ +\cross{PACPERC}{vectorise} & +\cross{PACPERC}{zero?} & +\cross{PACPERC}{?*?} & +\cross{PACPERC}{?**?} \\ +\cross{PACPERC}{?+?} & +\cross{PACPERC}{?-?} & +\cross{PACPERC}{-?} & +\cross{PACPERC}{?/?} \\ +\cross{PACPERC}{?=?} & +\cross{PACPERC}{?\^{}?} & +\cross{PACPERC}{?\~{}=?} & +\end{tabular} {\bf Attributes Exported:} \begin{itemize} -\item {\bf \cross{RCFIELD}{noZeroDivisors}} -is true if $x * y \ne 0$ implies both x and y are non-zero. -\item {\bf \cross{RCFIELD}{canonicalUnitNormal}} +\item {\bf \cross{PACPERC}{canonicalUnitNormal}} is true if we can choose a canonical representative for each class of associate elements, that is {\tt associates?(a,b)} returns true if and only if {\tt unitCanonical(a) = unitCanonical(b)}. -\item {\bf \cross{RCFIELD}{canonicalsClosed}} +\item {\bf \cross{PACPERC}{canonicalsClosed}} is true if\hfill\\ {\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}. -\item {\bf \cross{RCFIELD}{unitsKnown}} +\item {\bf \cross{PACPERC}{noZeroDivisors}} +is true if $x * y \ne 0$ implies both x and y are non-zero. +\item {\bf \cross{PACPERC}{commutative(``*'')}} +is true if it has an operation $"*": (D,D) -> D$ +which is commutative. +\item {\bf \cross{PACPERC}{unitsKnown}} is true if a monoid (a multiplicative semigroup with a 1) has unitsKnown means that the operation {\tt recip} can only return ``failed'' if its argument is not a unit. -\item {\bf \cross{RCFIELD}{leftUnitary}} +\item {\bf \cross{PACPERC}{leftUnitary}} is true if $1 * x = x$ for all x. -\item {\bf \cross{RCFIELD}{rightUnitary}} +\item {\bf \cross{PACPERC}{rightUnitary}} is true if $x * 1 = x$ for all x. -\item {\bf \cross{RCFIELD}{commutative(``*'')}} -is true if it has an operation $"*": (D,D) -> D$ -which is commutative. \end{itemize} These are directly exported but not implemented: \begin{verbatim} - allRootsOf : SparseUnivariatePolynomial % -> List % - approximate : (%,%) -> Fraction Integer - mainDefiningPolynomial : - % -> Union(SparseUnivariatePolynomial %,"failed") - mainForm : % -> Union(OutputForm,"failed") - mainValue : % -> Union(SparseUnivariatePolynomial %,"failed") - rename : (%,OutputForm) -> % - rename! : (%,OutputForm) -> % + conjugate: % -> % + definingPolynomial: () -> SUP(%) + definingPolynomial: % -> SUP % + distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List % + extDegree: % -> PI + fullOutput: % -> OutputForm + ground_? : % -> Boolean + lift: % -> SUP(%) + lift: (%,%) -> SUP(%) + maxTower: List % -> % + newElement: (SUP(%), %, Symbol) -> % + newElement: (SUP(%), Symbol) -> % + previousTower: % -> % + reduce: SUP(%) -> % + setTower_!: % -> Void + vectorise: (%,%) -> Vector(%) \end{verbatim} -These are implemented by this category: +These exports come from \refto{Field}(): \begin{verbatim} - allRootsOf : Polynomial Integer -> List % - allRootsOf : Polynomial Fraction Integer -> List % - allRootsOf : Polynomial % -> List % - allRootsOf : SparseUnivariatePolynomial Integer -> List % - allRootsOf : SparseUnivariatePolynomial Fraction Integer -> List % - characteristic : () -> NonNegativeInteger - nthRoot : (%,Integer) -> % - rootOf : - (SparseUnivariatePolynomial %,PositiveInteger) -> - Union(%,"failed") - rootOf : - (SparseUnivariatePolynomial %,PositiveInteger,OutputForm) -> - Union(%,"failed") - sqrt : (%,NonNegativeInteger) -> % - sqrt : Integer -> % - sqrt : Fraction Integer -> % - sqrt : % -> % - ?**? : (%,Fraction Integer) -> % + associates? : (%,%) -> Boolean + divide : (%,%) -> Record(quotient: %,remainder: %) + euclideanSize : % -> NonNegativeInteger + exquo : (%,%) -> Union(%,"failed") + factor : % -> Factored % + gcd : (%,%) -> % + inv : % -> % + prime? : % -> Boolean + squareFree : % -> Factored % + unitCanonical : % -> % + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + ?/? : (%,%) -> % \end{verbatim} -These exports come from \refto{CharacteristicZero}(): +These exports come from \refto{EuclideanDomain}(): \begin{verbatim} - 0 : () -> % - 1 : () -> % - coerce : Integer -> % - coerce : % -> OutputForm - hash : % -> SingleInteger - latex : % -> String - one? : % -> Boolean - recip : % -> Union(%,"failed") - sample : () -> % + 0 : () -> % + 1 : () -> % + characteristic : () -> NonNegativeInteger + coerce : % -> % + coerce : Integer -> % + coerce : % -> OutputForm + expressIdealMember : (List %,%) -> Union(List %,"failed") + extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") + extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) + gcd : List % -> % + gcdPolynomial : (SparseUnivariatePolynomial %, + SparseUnivariatePolynomial %) -> + SparseUnivariatePolynomial % + hash : % -> SingleInteger + latex : % -> String + lcm : List % -> % + lcm : (%,%) -> % + multiEuclidean : (List %,%) -> Union(List %,"failed") + one? : % -> Boolean + principalIdeal : List % -> Record(coef: List %,generator: %) + recip : % -> Union(%,"failed") + sample : () -> % + sizeLess? : (%,%) -> Boolean subtractIfCan : (%,%) -> Union(%,"failed") - zero? : % -> Boolean - ?~=? : (%,%) -> Boolean - ?^? : (%,NonNegativeInteger) -> % - ?^? : (%,PositiveInteger) -> % + unit? : % -> Boolean + zero? : % -> Boolean + ?+? : (%,%) -> % + ?=? : (%,%) -> Boolean + ?~=? : (%,%) -> Boolean ?*? : (%,%) -> % - ?*? : (NonNegativeInteger,%) -> % ?*? : (Integer,%) -> % ?*? : (PositiveInteger,%) -> % - ?**? : (%,PositiveInteger) -> % + ?*? : (NonNegativeInteger,%) -> % + ?-? : (%,%) -> % + -? : % -> % + ?**? : (%,PositiveInteger) -> % ?**? : (%,NonNegativeInteger) -> % - ?+? : (%,%) -> % - ?-? : (%,%) -> % - -? : % -> % - ?=? : (%,%) -> Boolean + ?^? : (%,PositiveInteger) -> % + ?^? : (%,NonNegativeInteger) -> % + ?quo? : (%,%) -> % + ?rem? : (%,%) -> % \end{verbatim} -These exports come from \refto{OrderedRing}(): +These exports come from \refto{UniqueFactorizationDomain}(): \begin{verbatim} - abs : % -> % - coerce : Integer -> % - max : (%,%) -> % - min : (%,%) -> % - negative? : % -> Boolean - positive? : % -> Boolean - sign : % -> Integer - ? Boolean - ?<=? : (%,%) -> Boolean - ?>? : (%,%) -> Boolean - ?>=? : (%,%) -> Boolean - ?*? : (Integer,%) -> % + squareFreePart : % -> % \end{verbatim} -These exports come from \refto{Field}(): +These exports come from \refto{DivisionRing}(): \begin{verbatim} - associates? : (%,%) -> Boolean - coerce : % -> % coerce : Fraction Integer -> % - coerce : Fraction Integer -> % - coerce : Fraction Integer -> % - divide : (%,%) -> Record(quotient: %,remainder: %) - euclideanSize : % -> NonNegativeInteger - expressIdealMember : (List %,%) -> Union(List %,"failed") - exquo : (%,%) -> Union(%,"failed") - extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) - extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") - factor : % -> Factored % - gcd : (%,%) -> % - gcd : List % -> % - gcdPolynomial : - (SparseUnivariatePolynomial %, - SparseUnivariatePolynomial %) -> - SparseUnivariatePolynomial % - inv : % -> % - lcm : (%,%) -> % - lcm : List % -> % - multiEuclidean : (List %,%) -> Union(List %,"failed") - prime? : % -> Boolean - principalIdeal : List % -> Record(coef: List %,generator: %) - sizeLess? : (%,%) -> Boolean - squareFree : % -> Factored % - squareFreePart : % -> % - unit? : % -> Boolean - unitCanonical : % -> % - unitNormal : % -> Record(unit: %,canonical: %,associate: %) - ?/? : (%,%) -> % - ?*? : (Fraction Integer,%) -> % - ?*? : (Fraction Integer,%) -> % - ?*? : (%,Fraction Integer) -> % - ?*? : (%,Fraction Integer) -> % - ?**? : (%,Integer) -> % - ?^? : (%,Integer) -> % - ?quo? : (%,%) -> % - ?rem? : (%,%) -> % -\end{verbatim} - -These exports come from \refto{FullyRetractableTo}(Fraction(Integer)): -\begin{verbatim} - retract : % -> Fraction Integer - retract : % -> Fraction Integer - if Fraction Integer has RETRACT FRAC INT - retract : % -> Integer if Fraction Integer has RETRACT INT - retractIfCan : % -> Union(Fraction Integer,"failed") - retractIfCan : % -> Union(Fraction Integer,"failed") - if Fraction Integer has RETRACT FRAC INT - retractIfCan : % -> Union(Integer,"failed") - if Fraction Integer has RETRACT INT -\end{verbatim} - -These exports come from \refto{Algebra}(Integer): -\begin{verbatim} - ?*? : (%,Integer) -> % + ?*? : (Fraction Integer,%) -> % + ?*? : (%,Fraction Integer) -> % + ?**? : (%,Integer) -> % + ?^? : (%,Integer) -> % \end{verbatim} -\begin{chunk}{category RCFIELD RealClosedField} -)abbrev category RCFIELD RealClosedField -++ Author: Renaud Rioboo -++ Date Created: may 1993 -++ Date Last Updated: January 2004 -++ Description: -++ \axiomType{RealClosedField} provides common access -++ functions for all real closed fields. -++ provides computations with generic real roots of polynomials - -RealClosedField : Category == PUB where - - E ==> OutputForm - SUP ==> SparseUnivariatePolynomial - OFIELD ==> Join(OrderedRing,Field) - PME ==> SUP($) - N ==> NonNegativeInteger - PI ==> PositiveInteger - RN ==> Fraction(Integer) - Z ==> Integer - POLY ==> Polynomial - PACK ==> SparseUnivariatePolynomialFunctions2 - - PUB == Join(CharacteristicZero, - OrderedRing, - CommutativeRing, - Field, - FullyRetractableTo(Fraction(Integer)), - Algebra Integer, - Algebra(Fraction(Integer)), - RadicalCategory) with - - mainForm : $ -> Union(E,"failed") - ++ \axiom{mainForm(x)} is the main algebraic quantity name of - ++ \axiom{x} - - mainDefiningPolynomial : $ -> Union(PME,"failed") - ++ \axiom{mainDefiningPolynomial(x)} is the defining - ++ polynomial for the main algebraic quantity of \axiom{x} - - mainValue : $ -> Union(PME,"failed") - ++ \axiom{mainValue(x)} is the expression of \axiom{x} in terms - ++ of \axiom{SparseUnivariatePolynomial($)} - - rootOf: (PME,PI,E) -> Union($,"failed") - ++ \axiom{rootOf(pol,n,name)} creates the nth root for the order - ++ of \axiom{pol} and names it \axiom{name} - - rootOf: (PME,PI) -> Union($,"failed") - ++ \axiom{rootOf(pol,n)} creates the nth root for the order - ++ of \axiom{pol} and gives it unique name - - allRootsOf: PME -> List $ - ++ \axiom{allRootsOf(pol)} creates all the roots - ++ of \axiom{pol} naming each uniquely - - allRootsOf: (SUP(RN)) -> List $ - ++ \axiom{allRootsOf(pol)} creates all the roots - ++ of \axiom{pol} naming each uniquely - - allRootsOf: (SUP(Z)) -> List $ - ++ \axiom{allRootsOf(pol)} creates all the roots - ++ of \axiom{pol} naming each uniquely - - allRootsOf: (POLY($)) -> List $ - ++ \axiom{allRootsOf(pol)} creates all the roots - ++ of \axiom{pol} naming each uniquely - - allRootsOf: (POLY(RN)) -> List $ - ++ \axiom{allRootsOf(pol)} creates all the roots - ++ of \axiom{pol} naming each uniquely - - allRootsOf: (POLY(Z)) -> List $ - ++ \axiom{allRootsOf(pol)} creates all the roots - ++ of \axiom{pol} naming each uniquely - - sqrt: ($,N) -> $ - ++ \axiom{sqrt(x,n)} is \axiom{x ** (1/n)} - - sqrt: $ -> $ - ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)} - - sqrt: RN -> $ - ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)} - - sqrt: Z -> $ - ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)} - - rename! : ($,E) -> $ - ++ \axiom{rename!(x,name)} changes the way \axiom{x} is printed - - rename : ($,E) -> $ - ++ \axiom{rename(x,name)} gives a new number that prints as name - - approximate: ($,$) -> RN - ++ \axiom{approximate(n,p)} gives an approximation of \axiom{n} - ++ that has precision \axiom{p} - - add - - sqrt(a:$):$ == sqrt(a,2) - - sqrt(a:RN):$ == sqrt(a::$,2) - - sqrt(a:Z):$ == sqrt(a::$,2) - - characteristic() == 0 - - rootOf(pol,n,o) == - r := rootOf(pol,n) - r case "failed" => "failed" - rename!(r,o) - - rootOf(pol,n) == - liste:List($):= allRootsOf(pol) - # liste > n => "failed" - liste.n +\begin{chunk}{category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory} +)abbrev category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory +++ Authors: Gaetan Hache +++ Date Created: may 1997 +++ Date Last Updated: April 2010, by Tim Daly +++ Description: +++ This category exports the function for domains +++ which implement dynamic extension using the simple notion of tower +++ extensions. ++ A tower extension T of the ground +++ field K is any sequence of field extension +++ (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K +++ and for i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 +++ and defined by an irreducible polynomial p(Z) in K_{i-1}. +++ Two towers (T_1: K_01, K_11,...,K_i1,...,K_n1) +++ and (T_2: K_02, K_12,...,K_i2,...,K_n2) +++ are said to be related if T_1 <= T_2 (or T_1 >= T_2), +++ that is if K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). +++ Any algebraic operations defined for several elements +++ are only defined if all of the concerned elements are coming from +++ a set of related tower extensions. +PseudoAlgebraicClosureOfPerfectFieldCategory() : Category == PUB where + INT ==> Integer + K ==> Fraction Integer + NNI ==> NonNegativeInteger + SUP ==> SparseUnivariatePolynomial + BOOLEAN ==> Boolean + PI ==> PositiveInteger + FFFACTSE ==> FiniteFieldFactorizationWithSizeParseBySideEffect - sqrt(x,n) == - n = 0 => 1 - n = 1 => x - zero?(x) => 0 - one?(x) => 1 - if odd?(n) - then - r := rootOf(monomial(1,n) - (x :: PME), 1) - else - r := rootOf(monomial(1,n) - (x :: PME), 2) - r case "failed" => error "no roots" - n = 2 => rename(r,root(x::E)$E) - rename(r,root(x :: E, n :: E)$E) + PUB ==> Field with - (x : $) ** (rn : RN) == sqrt(x**numer(rn),denom(rn)::N) + definingPolynomial: () -> SUP(%) + definingPolynomial: % -> SUP % - nthRoot(x, n) == - zero?(n) => x - negative?(n) => inv(sqrt(x,(-n) :: N)) - sqrt(x,n :: N) + lift: % -> SUP(%) + lift: (%,%) -> SUP(%) + reduce: SUP(%) -> % - allRootsOf(p:SUP(RN)) == allRootsOf(map(z +-> z::$ ,p)$PACK(RN,$)) + distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List % + ++ distinguishedRootsOf(p,a) returns a (distinguised) root for each + ++ irreducible factor of the polynomial p (factored over the field defined + ++ by the element a). + + ground_? : % -> Boolean + maxTower: List % -> % + ++ maxTower(l) returns the tower in the list having the maximal extension + ++ degree over the ground field. It has no meaning if the towers are + ++ not related. + extDegree: % -> PI + ++ extDegree(a) returns the extension degree of the extension tower + ++ over which the element is defined. + previousTower: % -> % + ++ previousTower(a) returns the previous tower extension over which + ++ the element a is defined. - allRootsOf(p:SUP(Z)) == allRootsOf(map(z +-> z::$ ,p)$PACK(Z,$)) + vectorise: (%,%) -> Vector(%) - allRootsOf(p:POLY($)) == allRootsOf(univariate(p)) + conjugate: % -> % + newElement: (SUP(%), %, Symbol) -> % + newElement: (SUP(%), Symbol) -> % + setTower_!: % -> Void + fullOutput: % -> OutputForm - allRootsOf(p:POLY(RN)) == allRootsOf(univariate(p)) +\end{chunk} - allRootsOf(p:POLY(Z)) == allRootsOf(univariate(p)) +\begin{chunk}{PACPERC.dotabb} +"PACPERC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"]; +"PACPERC" -> "FIELD" \end{chunk} -\begin{chunk}{RCFIELD.dotabb} -"RCFIELD" - [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"]; -"RCFIELD" -> "ALGEBRA" -"RCFIELD" -> "CHARZ" -"RCFIELD" -> "COMRING" -"RCFIELD" -> "FIELD" -"RCFIELD" -> "FRETRCT" -"RCFIELD" -> "ORDRING" -"RCFIELD" -> "RADCAT" -\end{chunk} -\begin{chunk}{RCFIELD.dotfull} -"RealClosedField()" - [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"]; -"RealClosedField()" -> "Algebra(Integer)" -"RealClosedField()" -> "Algebra(Fraction(Integer))" -"RealClosedField()" -> "CharacteristicZero()" -"RealClosedField()" -> "CommutativeRing()" -"RealClosedField()" -> "Field()" -"RealClosedField()" -> "FullyRetractableTo(Fraction(Integer))" -"RealClosedField()" -> "OrderedRing()" -"RealClosedField()" -> "RadicalCategory()" +\begin{chunk}{PACPERC.dotfull} +"PseudoAlgebraicClosureOfPerfectFieldCategory" + [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"]; +"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "Field()" \end{chunk} -\begin{chunk}{RCFIELD.dotpic} + +\begin{chunk}{PACPERC.dotpic} digraph pic { fontsize=10; bgcolor="#ECEA81"; node [shape=box, color=white, style=filled]; -"RealClosedField()" [color=lightblue]; -"RealClosedField()" -> "ALGEBRA..." -"RealClosedField()" -> "CHARZ..." -"RealClosedField()" -> "COMRING..." -"RealClosedField()" -> "FIELD..." -"RealClosedField()" -> "FRETRCT..." -"RealClosedField()" -> "ORDRING..." -"RealClosedField()" -> "RADCAT..." +"PseudoAlgebraicClosureOfPerfectFieldCategory" [color=lightblue]; +"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "FIELD..." -"ALGEBRA..." [color=lightblue]; -"CHARZ..." [color=lightblue]; -"COMRING..." [color=lightblue]; "FIELD..." [color=lightblue]; -"FRETRCT..." [color=lightblue]; -"ORDRING..." [color=lightblue]; -"RADCAT..." [color=lightblue]; } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{RealNumberSystem}{RNS} -\pagepic{ps/v102realnumbersystem.ps}{RNS}{0.50} +\pagehead{QuotientFieldCategory}{QFCAT} +\pagepic{ps/v102quotientfieldcategory.ps}{QFCAT}{0.50} -\begin{chunk}{RealNumberSystem.input} +\begin{chunk}{QuotientFieldCategory.input} )set break resume -)sys rm -f RealNumberSystem.output -)spool RealNumberSystem.output +)sys rm -f QuotientFieldCategory.output +)spool QuotientFieldCategory.output )set message test on )set message auto off )clear all --S 1 of 1 -)show RealNumberSystem +)show QuotientFieldCategory --R ---R RealNumberSystem is a category constructor ---R Abbreviation for RealNumberSystem is RNS +--R QuotientFieldCategory(S: IntegralDomain) is a category constructor +--R Abbreviation for QuotientFieldCategory is QFCAT --R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for RNS +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for QFCAT --R --R------------------------------- Operations -------------------------------- +--R ?*? : (%,S) -> % ?*? : (S,%) -> % --R ?*? : (Fraction(Integer),%) -> % ?*? : (%,Fraction(Integer)) -> % --R ?*? : (%,%) -> % ?*? : (Integer,%) -> % --R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % ---R ?**? : (%,Fraction(Integer)) -> % ?**? : (%,Integer) -> % ---R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % ---R ?+? : (%,%) -> % ?-? : (%,%) -> % ---R -? : % -> % ?/? : (%,%) -> % ---R ? Boolean ?<=? : (%,%) -> Boolean ---R ?=? : (%,%) -> Boolean ?>? : (%,%) -> Boolean ---R ?>=? : (%,%) -> Boolean 1 : () -> % +--R ?**? : (%,Integer) -> % ?**? : (%,NonNegativeInteger) -> % +--R ?**? : (%,PositiveInteger) -> % ?+? : (%,%) -> % +--R ?-? : (%,%) -> % -? : % -> % +--R ?/? : (S,S) -> % ?/? : (%,%) -> % +--R ?=? : (%,%) -> Boolean D : (%,(S -> S)) -> % +--R D : % -> % if S has DIFRING 1 : () -> % --R 0 : () -> % ?^? : (%,Integer) -> % --R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % ---R abs : % -> % associates? : (%,%) -> Boolean ---R ceiling : % -> % coerce : Fraction(Integer) -> % ---R coerce : Integer -> % coerce : Fraction(Integer) -> % ---R coerce : % -> % coerce : Integer -> % ---R coerce : % -> OutputForm convert : % -> Pattern(Float) ---R convert : % -> DoubleFloat convert : % -> Float ---R factor : % -> Factored(%) floor : % -> % ---R fractionPart : % -> % gcd : List(%) -> % ---R gcd : (%,%) -> % hash : % -> SingleInteger +--R abs : % -> % if S has OINTDOM associates? : (%,%) -> Boolean +--R ceiling : % -> S if S has INS coerce : S -> % +--R coerce : Fraction(Integer) -> % coerce : % -> % +--R coerce : Integer -> % coerce : % -> OutputForm +--R convert : % -> Float if S has REAL denom : % -> S +--R denominator : % -> % differentiate : (%,(S -> S)) -> % +--R factor : % -> Factored(%) floor : % -> S if S has INS +--R gcd : List(%) -> % gcd : (%,%) -> % +--R hash : % -> SingleInteger init : () -> % if S has STEP --R inv : % -> % latex : % -> String --R lcm : List(%) -> % lcm : (%,%) -> % ---R max : (%,%) -> % min : (%,%) -> % ---R negative? : % -> Boolean norm : % -> % ---R nthRoot : (%,Integer) -> % one? : % -> Boolean ---R positive? : % -> Boolean prime? : % -> Boolean ---R ?quo? : (%,%) -> % recip : % -> Union(%,"failed") ---R ?rem? : (%,%) -> % retract : % -> Fraction(Integer) ---R retract : % -> Integer round : % -> % ---R sample : () -> % sign : % -> Integer ---R sizeLess? : (%,%) -> Boolean sqrt : % -> % +--R map : ((S -> S),%) -> % max : (%,%) -> % if S has ORDSET +--R min : (%,%) -> % if S has ORDSET numer : % -> S +--R numerator : % -> % one? : % -> Boolean +--R prime? : % -> Boolean ?quo? : (%,%) -> % +--R random : () -> % if S has INS recip : % -> Union(%,"failed") +--R ?rem? : (%,%) -> % retract : % -> S +--R sample : () -> % sizeLess? : (%,%) -> Boolean --R squareFree : % -> Factored(%) squareFreePart : % -> % ---R truncate : % -> % unit? : % -> Boolean ---R unitCanonical : % -> % wholePart : % -> Integer ---R zero? : % -> Boolean ?~=? : (%,%) -> Boolean +--R unit? : % -> Boolean unitCanonical : % -> % +--R wholePart : % -> S if S has EUCDOM zero? : % -> Boolean +--R ?~=? : (%,%) -> Boolean +--R ? Boolean if S has ORDSET +--R ?<=? : (%,%) -> Boolean if S has ORDSET +--R ?>? : (%,%) -> Boolean if S has ORDSET +--R ?>=? : (%,%) -> Boolean if S has ORDSET +--R D : (%,(S -> S),NonNegativeInteger) -> % +--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) +--R D : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) +--R D : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) +--R D : (%,Symbol) -> % if S has PDRING(SYMBOL) +--R D : (%,NonNegativeInteger) -> % if S has DIFRING --R characteristic : () -> NonNegativeInteger +--R charthRoot : % -> Union(%,"failed") if S has CHARNZ or and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit)) +--R coerce : Symbol -> % if S has RETRACT(SYMBOL) +--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit)) +--R convert : % -> DoubleFloat if S has REAL +--R convert : % -> InputForm if S has KONVERT(INFORM) +--R convert : % -> Pattern(Float) if S has KONVERT(PATTERN(FLOAT)) +--R convert : % -> Pattern(Integer) if S has KONVERT(PATTERN(INT)) +--R differentiate : (%,(S -> S),NonNegativeInteger) -> % +--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) +--R differentiate : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) +--R differentiate : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) +--R differentiate : (%,Symbol) -> % if S has PDRING(SYMBOL) +--R differentiate : (%,NonNegativeInteger) -> % if S has DIFRING +--R differentiate : % -> % if S has DIFRING --R divide : (%,%) -> Record(quotient: %,remainder: %) +--R ?.? : (%,S) -> % if S has ELTAB(S,S) --R euclideanSize : % -> NonNegativeInteger +--R eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S) +--R eval : (%,List(Symbol),List(S)) -> % if S has IEVALAB(SYMBOL,S) +--R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) +--R eval : (%,Equation(S)) -> % if S has EVALAB(S) +--R eval : (%,S,S) -> % if S has EVALAB(S) +--R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) --R expressIdealMember : (List(%),%) -> Union(List(%),"failed") --R exquo : (%,%) -> Union(%,"failed") --R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") --R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) +--R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT +--R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT +--R fractionPart : % -> % if S has EUCDOM --R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) --R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) --R multiEuclidean : (List(%),%) -> Union(List(%),"failed") ---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) +--R negative? : % -> Boolean if S has OINTDOM +--R nextItem : % -> Union(%,"failed") if S has STEP +--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if S has PATMAB(FLOAT) +--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if S has PATMAB(INT) +--R positive? : % -> Boolean if S has OINTDOM --R principalIdeal : List(%) -> Record(coef: List(%),generator: %) ---R retractIfCan : % -> Union(Fraction(Integer),"failed") ---R retractIfCan : % -> Union(Integer,"failed") +--R reducedSystem : Matrix(%) -> Matrix(S) +--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(S),vec: Vector(S)) +--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if S has LINEXP(INT) +--R reducedSystem : Matrix(%) -> Matrix(Integer) if S has LINEXP(INT) +--R retract : % -> Integer if S has RETRACT(INT) +--R retract : % -> Fraction(Integer) if S has RETRACT(INT) +--R retract : % -> Symbol if S has RETRACT(SYMBOL) +--R retractIfCan : % -> Union(Integer,"failed") if S has RETRACT(INT) +--R retractIfCan : % -> Union(Fraction(Integer),"failed") if S has RETRACT(INT) +--R retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT(SYMBOL) +--R retractIfCan : % -> Union(S,"failed") +--R sign : % -> Integer if S has OINTDOM +--R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if S has PFECAT +--R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT --R subtractIfCan : (%,%) -> Union(%,"failed") --R unitNormal : % -> Record(unit: %,canonical: %,associate: %) --R @@ -65282,134 +73541,199 @@ digraph pic { )spool )lisp (bye) \end{chunk} -\begin{chunk}{RealNumberSystem.help} + +\begin{chunk}{QuotientFieldCategory.help} ==================================================================== -RealNumberSystem examples +QuotientFieldCategory examples ==================================================================== -The real number system category is intended as a model for the real -numbers. The real numbers form an ordered normed field. Note that -we have purposely not included DifferentialRing or the elementary -functions (see TranscendentalFunctionCategory) in the definition. +QuotientField(S) is the category of fractions of an Integral Domain S. See Also: -o )show RealNumberSystem -o )show TranscendentalFunctionCategory +o )show QuotientFieldCategory \end{chunk} {\bf See:} -\pageto{FloatingPointSystem}{FPS} +\pagefrom{Algebra}{ALGEBRA} +\pagefrom{CharacteristicNonZero}{CHARNZ} \pagefrom{CharacteristicZero}{CHARZ} \pagefrom{ConvertibleTo}{KONVERT} +\pagefrom{DifferentialExtension}{DIFEXT} +\pagefrom{EuclideanDomain}{EUCDOM} \pagefrom{Field}{FIELD} -\pagefrom{OrderedRing}{ORDRING} -\pagefrom{PatternMatchable}{PATMAB} -\pagefrom{RadicalCategory}{RADCAT} +\pagefrom{FullyEvalableOver}{FEVALAB} +\pagefrom{FullyLinearlyExplicitRingOver}{FLINEXP} +\pagefrom{FullyPatternMatchable}{FPATMAB} +\pagefrom{OrderedIntegralDomain}{OINTDOM} +\pagefrom{OrderedSet}{ORDSET} +\pagefrom{Patternable}{PATAB} +\pagefrom{PolynomialFactorizationExplicit}{PFECAT} \pagefrom{RealConstant}{REAL} \pagefrom{RetractableTo}{RETRACT} +\pagefrom{StepThrough}{STEP} {\bf Exports:}\\ -\begin{tabular}{llll} -\cross{RNS}{0} & -\cross{RNS}{1} & -\cross{RNS}{abs} & -\cross{RNS}{associates?} \\ -\cross{RNS}{ceiling} & -\cross{RNS}{characteristic} & -\cross{RNS}{coerce} & -\cross{RNS}{convert} \\ -\cross{RNS}{divide} & -\cross{RNS}{euclideanSize} & -\cross{RNS}{expressIdealMember} & -\cross{RNS}{exquo} \\ -\cross{RNS}{extendedEuclidean} & -\cross{RNS}{factor} & -\cross{RNS}{floor} & -\cross{RNS}{fractionPart} \\ -\cross{RNS}{gcd} & -\cross{RNS}{gcdPolynomial} & -\cross{RNS}{hash} & -\cross{RNS}{inv} \\ -\cross{RNS}{latex} & -\cross{RNS}{lcm} & -\cross{RNS}{max} & -\cross{RNS}{min} \\ -\cross{RNS}{multiEuclidean} & -\cross{RNS}{negative?} & -\cross{RNS}{norm} & -\cross{RNS}{nthRoot} \\ -\cross{RNS}{one?} & -\cross{RNS}{patternMatch} & -\cross{RNS}{positive?} & -\cross{RNS}{prime?} \\ -\cross{RNS}{principalIdeal} & -\cross{RNS}{recip} & -\cross{RNS}{retract} & -\cross{RNS}{retractIfCan} \\ -\cross{RNS}{round} & -\cross{RNS}{sample} & -\cross{RNS}{sign} & -\cross{RNS}{sizeLess?} \\ -\cross{RNS}{sqrt} & -\cross{RNS}{squareFree} & -\cross{RNS}{squareFreePart} & -\cross{RNS}{subtractIfCan} \\ -\cross{RNS}{truncate} & -\cross{RNS}{unit?} & -\cross{RNS}{unitCanonical} & -\cross{RNS}{unitNormal} \\ -\cross{RNS}{wholePart} & -\cross{RNS}{zero?} & -\cross{RNS}{?*?} & -\cross{RNS}{?**?} \\ -\cross{RNS}{?+?} & -\cross{RNS}{?-?} & -\cross{RNS}{-?} & -\cross{RNS}{?/?} \\ -\cross{RNS}{?$<$?} & -\cross{RNS}{?$<=$?} & -\cross{RNS}{?=?} & -\cross{RNS}{?$>$?} \\ -\cross{RNS}{?$>=$?} & -\cross{RNS}{?\^{}?} & -\cross{RNS}{?quo?} & -\cross{RNS}{?rem?} \\ -\cross{RNS}{?\~{}=?} && +\begin{tabular}{lllll} +\cross{QFCAT}{0} & +\cross{QFCAT}{1} & +\cross{QFCAT}{abs} \\ +\cross{QFCAT}{associates?} & +\cross{QFCAT}{ceiling} & +\cross{QFCAT}{characteristic} \\ +\cross{QFCAT}{charthRoot} & +\cross{QFCAT}{coerce} & +\cross{QFCAT}{conditionP} \\ +\cross{QFCAT}{convert} & +\cross{QFCAT}{D} & +\cross{QFCAT}{denom} \\ +\cross{QFCAT}{denominator} & +\cross{QFCAT}{differentiate} & +\cross{QFCAT}{divide} \\ +\cross{QFCAT}{euclideanSize} & +\cross{QFCAT}{eval} & +\cross{QFCAT}{expressIdealMember} \\ +\cross{QFCAT}{exquo} & +\cross{QFCAT}{extendedEuclidean} & +\cross{QFCAT}{factor} \\ +\cross{QFCAT}{factorPolynomial} & +\cross{QFCAT}{factorSquareFreePolynomial} & +\cross{QFCAT}{floor} \\ +\cross{QFCAT}{fractionPart} & +\cross{QFCAT}{gcd} & +\cross{QFCAT}{gcdPolynomial} \\ +\cross{QFCAT}{hash} & +\cross{QFCAT}{init} & +\cross{QFCAT}{inv} \\ +\cross{QFCAT}{latex} & +\cross{QFCAT}{lcm} & +\cross{QFCAT}{map} \\ +\cross{QFCAT}{max} & +\cross{QFCAT}{min} & +\cross{QFCAT}{multiEuclidean} \\ +\cross{QFCAT}{negative?} & +\cross{QFCAT}{nextItem} & +\cross{QFCAT}{numer} \\ +\cross{QFCAT}{numerator} & +\cross{QFCAT}{one?} & +\cross{QFCAT}{patternMatch} \\ +\cross{QFCAT}{positive?} & +\cross{QFCAT}{prime?} & +\cross{QFCAT}{principalIdeal} \\ +\cross{QFCAT}{random} & +\cross{QFCAT}{recip} & +\cross{QFCAT}{reducedSystem} \\ +\cross{QFCAT}{retract} & +\cross{QFCAT}{retractIfCan} & +\cross{QFCAT}{sample} \\ +\cross{QFCAT}{sign} & +\cross{QFCAT}{sizeLess?} & +\cross{QFCAT}{solveLinearPolynomialEquation} \\ +\cross{QFCAT}{squareFree} & +\cross{QFCAT}{squareFreePart} & +\cross{QFCAT}{squareFreePolynomial} \\ +\cross{QFCAT}{subtractIfCan} & +\cross{QFCAT}{unit?} & +\cross{QFCAT}{unitNormal} \\ +\cross{QFCAT}{unitCanonical} & +\cross{QFCAT}{wholePart} & +\cross{QFCAT}{zero?} \\ +\cross{QFCAT}{?.?} & +\cross{QFCAT}{?*?} & +\cross{QFCAT}{?**?} \\ +\cross{QFCAT}{?+?} & +\cross{QFCAT}{?-?} & +\cross{QFCAT}{-?} \\ +\cross{QFCAT}{?/?} & +\cross{QFCAT}{?=?} & +\cross{QFCAT}{?\^{}?} \\ +\cross{QFCAT}{?quo?} & +\cross{QFCAT}{?rem?} & +\cross{QFCAT}{?\~{}=?} \\ +\cross{QFCAT}{?$<$?} & +\cross{QFCAT}{?$<=$?} & +\cross{QFCAT}{?$>$?} \\ +\cross{QFCAT}{?$>=$?} && \end{tabular} +{\bf Attributes Exported:} +\begin{itemize} +\item {\bf \cross{QFCAT}{canonicalUnitNormal}} +is true if we can choose a canonical representative for each class +of associate elements, that is {\tt associates?(a,b)} returns true +if and only if {\tt unitCanonical(a) = unitCanonical(b)}. +\item {\bf \cross{QFCAT}{canonicalsClosed}} +is true if\hfill\\ +{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}. +\item {\bf \cross{QFCAT}{noZeroDivisors}} +is true if $x * y \ne 0$ implies both x and y are non-zero. +\item {\bf \cross{QFCAT}{commutative(``*'')}} +is true if it has an operation $"*": (D,D) -> D$ +which is commutative. +\item {\bf \cross{QFCAT}{unitsKnown}} +is true if a monoid (a multiplicative semigroup with a 1) has +unitsKnown means that the operation {\tt recip} can only return +``failed'' if its argument is not a unit. +\item {\bf \cross{QFCAT}{leftUnitary}} +is true if $1 * x = x$ for all x. +\item {\bf \cross{QFCAT}{rightUnitary}} +is true if $x * 1 = x$ for all x. +\item {\bf nil} +\end{itemize} + These are directly exported but not implemented: \begin{verbatim} - abs : % -> % - wholePart : % -> Integer + ceiling : % -> S if S has INS + denom : % -> S + floor : % -> S if S has INS + numer : % -> S + wholePart : % -> S if S has EUCDOM + ?/? : (S,S) -> % \end{verbatim} These are implemented by this category: \begin{verbatim} characteristic : () -> NonNegativeInteger - ceiling : % -> % + coerce : Symbol -> % if S has RETRACT SYMBOL coerce : Fraction Integer -> % - convert : % -> Pattern Float - floor : % -> % - fractionPart : % -> % - norm : % -> % + convert : % -> InputForm if S has KONVERT INFORM + convert : % -> DoubleFloat if S has REAL + convert : % -> Float if S has REAL + convert : % -> Pattern Integer if S has KONVERT PATTERN INT + convert : % -> Pattern Float if S has KONVERT PATTERN FLOAT + denominator : % -> % + differentiate : (%,(S -> S)) -> % + fractionPart : % -> % if S has EUCDOM + init : () -> % if S has STEP + map : ((S -> S),%) -> % + nextItem : % -> Union(%,"failed") if S has STEP + numerator : % -> % patternMatch : - (%,Pattern Float,PatternMatchResult(Float,%)) -> - PatternMatchResult(Float,%) - round : % -> % - truncate : % -> % + (%,Pattern Float,PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + if S has PATMAB FLOAT + patternMatch : + (%,Pattern Integer,PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) + if S has PATMAB INT + random : () -> % if S has INS + reducedSystem : Matrix % -> Matrix S + reducedSystem : (Matrix %,Vector %) -> Record(mat: Matrix S,vec: Vector S) + retract : % -> Symbol if S has RETRACT SYMBOL + retract : % -> Integer if S has RETRACT INT + retractIfCan : % -> Union(Integer,"failed") if S has RETRACT INT + retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT SYMBOL + ? Boolean if S has ORDSET \end{verbatim} These exports come from \refto{Field}(): \begin{verbatim} 0 : () -> % 1 : () -> % - associates? : (%,%) -> Boolean + associates? : (%,%) -> Boolean coerce : % -> % - coerce : Integer -> % coerce : Integer -> % - coerce : Fraction Integer -> % coerce : % -> OutputForm divide : (%,%) -> Record(quotient: %,remainder: %) euclideanSize : % -> NonNegativeInteger @@ -65417,1309 +73741,3567 @@ These exports come from \refto{Field}(): extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) exquo : (%,%) -> Union(%,"failed") - factor : % -> Factored % - gcd : List % -> % + factor : % -> Factored % gcd : (%,%) -> % + gcd : List % -> % gcdPolynomial : (SparseUnivariatePolynomial %, SparseUnivariatePolynomial %) -> - SparseUnivariatePolynomial % + SparseUnivariatePolynomial % hash : % -> SingleInteger - inv : % -> % - latex : % -> String - lcm : List % -> % - lcm : (%,%) -> % + inv : % -> % + latex : % -> String + lcm : List % -> % + lcm : (%,%) -> % multiEuclidean : (List %,%) -> Union(List %,"failed") - one? : % -> Boolean + one? : % -> Boolean prime? : % -> Boolean principalIdeal : List % -> Record(coef: List %,generator: %) - recip : % -> Union(%,"failed") - sample : () -> % + recip : % -> Union(%,"failed") + sample : () -> % sizeLess? : (%,%) -> Boolean - squareFree : % -> Factored % - squareFreePart : % -> % + squareFree : % -> Factored % + squareFreePart : % -> % subtractIfCan : (%,%) -> Union(%,"failed") unit? : % -> Boolean unitCanonical : % -> % unitNormal : % -> Record(unit: %,canonical: %,associate: %) - zero? : % -> Boolean - ?+? : (%,%) -> % - ?=? : (%,%) -> Boolean - ?~=? : (%,%) -> Boolean + zero? : % -> Boolean ?*? : (Fraction Integer,%) -> % ?*? : (%,Fraction Integer) -> % - ?**? : (%,Fraction Integer) -> % + ?**? : (%,Integer) -> % ?^? : (%,Integer) -> % + ?+? : (%,%) -> % + ?=? : (%,%) -> Boolean + ?~=? : (%,%) -> Boolean ?*? : (%,%) -> % ?*? : (Integer,%) -> % ?*? : (PositiveInteger,%) -> % ?*? : (NonNegativeInteger,%) -> % - ?-? : (%,%) -> % - -? : % -> % - ?**? : (%,PositiveInteger) -> % + ?-? : (%,%) -> % + -? : % -> % + ?**? : (%,PositiveInteger) -> % ?**? : (%,NonNegativeInteger) -> % ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % ?/? : (%,%) -> % ?quo? : (%,%) -> % - ?rem? : (%,%) -> % + ?rem? : (%,%) -> % \end{verbatim} -These exports come from \refto{OrderedRing}(): +These exports come from \refto{Algebra}(S:IntegralDomain): \begin{verbatim} - negative? : % -> Boolean - positive? : % -> Boolean - sign : % -> Integer - max : (%,%) -> % - min : (%,%) -> % - ? Boolean - ?<=? : (%,%) -> Boolean - ?>? : (%,%) -> Boolean - ?>=? : (%,%) -> Boolean + coerce : S -> % + ?*? : (%,S) -> % + ?*? : (S,%) -> % \end{verbatim} -These exports come from \refto{RealConstant}(): +These exports come from \refto{RetractableTo}(S:IntegralDomain): \begin{verbatim} - convert : % -> DoubleFloat - convert : % -> Float + retract : % -> S + retractIfCan : % -> Union(S,"failed") \end{verbatim} -These exports come from \refto{RetractableTo}(Integer): +These exports come from \refto{FullyEvalableOver}(S:IntegralDomain): \begin{verbatim} - retract : % -> Integer - retractIfCan : % -> Union(Integer,"failed") + ?.? : (%,S) -> % if S has ELTAB(S,S) + eval : (%,Equation S) -> % if S has EVALAB S + eval : (%,List Symbol,List S) -> % if S has IEVALAB(SYMBOL,S) + eval : (%,List Equation S) -> % if S has EVALAB S + eval : (%,S,S) -> % if S has EVALAB S + eval : (%,List S,List S) -> % if S has EVALAB S + eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S) +\end{verbatim} + +These exports come from \refto{DifferentialExtension}(S:IntegralDomain): +\begin{verbatim} + D : (%,(S -> S)) -> % + D : (%,(S -> S),NonNegativeInteger) -> % + D : % -> % if S has DIFRING + D : (%,NonNegativeInteger) -> % if S has DIFRING + D : (%,List Symbol,List NonNegativeInteger) -> % + if S has PDRING SYMBOL + D : (%,Symbol,NonNegativeInteger) -> % + if S has PDRING SYMBOL + D : (%,List Symbol) -> % if S has PDRING SYMBOL + D : (%,Symbol) -> % if S has PDRING SYMBOL + differentiate : (%,List Symbol) -> % + if S has PDRING SYMBOL + differentiate : (%,Symbol,NonNegativeInteger) -> % + if S has PDRING SYMBOL + differentiate : (%,List Symbol,List NonNegativeInteger) -> % + if S has PDRING SYMBOL + differentiate : (%,NonNegativeInteger) -> % if S has DIFRING + differentiate : % -> % if S has DIFRING + differentiate : (%,Symbol) -> % if S has PDRING SYMBOL + differentiate : (%,(S -> S),NonNegativeInteger) -> % +\end{verbatim} + +These exports come from +\refto{FullyLinearlyExplicitRingOver}(S:IntegralDomain): +\begin{verbatim} + reducedSystem : (Matrix %,Vector %) -> + Record(mat: Matrix Integer,vec: Vector Integer) + if S has LINEXP INT + reducedSystem : Matrix % -> Matrix Integer if S has LINEXP INT \end{verbatim} These exports come from \refto{RetractableTo}(Fraction(Integer)): \begin{verbatim} - retract : % -> Fraction Integer - retractIfCan : % -> Union(Fraction Integer,"failed") + retract : % -> Fraction Integer if S has RETRACT INT + retractIfCan : % -> Union(Fraction Integer,"failed") + if S has RETRACT INT \end{verbatim} -These exports come from \refto{RadicalCategory}(): +These exports come from \refto{OrderedSet}(): \begin{verbatim} - nthRoot : (%,Integer) -> % - sqrt : % -> % + max : (%,%) -> % if S has ORDSET + min : (%,%) -> % if S has ORDSET + ?<=? : (%,%) -> Boolean if S has ORDSET + ?>? : (%,%) -> Boolean if S has ORDSET + ?>=? : (%,%) -> Boolean if S has ORDSET \end{verbatim} -These exports come from \refto{ConvertibleTo}(Pattern(Float)): +These exports come from \refto{OrderedIntegralDomain}(): \begin{verbatim} + abs : % -> % if S has OINTDOM + negative? : % -> Boolean if S has OINTDOM + positive? : % -> Boolean if S has OINTDOM + sign : % -> Integer if S has OINTDOM \end{verbatim} -These exports come from \refto{PatternMatchable}(Float): +These exports come from \refto{CharacteristicNonZero}(): \begin{verbatim} + charthRoot : % -> Union(%,"failed") + if S has CHARNZ + or and(has($,CharacteristicNonZero), + has(S,PolynomialFactorizationExplicit)) \end{verbatim} -These exports come from \refto{CharacteristicZero}(): +These exports come from \refto{PolynomialFactorizationExplicit}(): \begin{verbatim} + conditionP : Matrix % -> Union(Vector %,"failed") + if and(has($,CharacteristicNonZero), + has(S,PolynomialFactorizationExplicit)) + factorPolynomial : + SparseUnivariatePolynomial % -> + Factored SparseUnivariatePolynomial % + if S has PFECAT + factorSquareFreePolynomial : + SparseUnivariatePolynomial % -> + Factored SparseUnivariatePolynomial % + if S has PFECAT + solveLinearPolynomialEquation : + (List SparseUnivariatePolynomial %, + SparseUnivariatePolynomial %) -> + Union(List SparseUnivariatePolynomial %,"failed") + if S has PFECAT + squareFreePolynomial : + SparseUnivariatePolynomial % -> + Factored SparseUnivariatePolynomial % + if S has PFECAT \end{verbatim} -\begin{chunk}{category RNS RealNumberSystem} -)abbrev category RNS RealNumberSystem -++ Author: Michael Monagan and Stephen M. Watt -++ Date Created: January 1988 -++ Description: -++ The real number system category is intended as a model for the real -++ numbers. The real numbers form an ordered normed field. Note that -++ we have purposely not included \spadtype{DifferentialRing} or -++ the elementary functions (see \spadtype{TranscendentalFunctionCategory}) -++ in the definition. +\begin{chunk}{category QFCAT QuotientFieldCategory} +)abbrev category QFCAT QuotientFieldCategory +++ Date Last Updated: 5th March 1996 +++ Description: +++ QuotientField(S) is the category of fractions of an Integral Domain S. + +QuotientFieldCategory(S: IntegralDomain): Category == + Join(Field, Algebra S, RetractableTo S, FullyEvalableOver S, + DifferentialExtension S, FullyLinearlyExplicitRingOver S, + Patternable S, FullyPatternMatchable S) with + _/ : (S, S) -> % + ++ d1 / d2 returns the fraction d1 divided by d2. + numer : % -> S + ++ numer(x) returns the numerator of the fraction x. + denom : % -> S + ++ denom(x) returns the denominator of the fraction x. + numerator : % -> % + ++ numerator(x) is the numerator of the fraction x converted to %. + denominator : % -> % + ++ denominator(x) is the denominator of the fraction x converted to %. + if S has StepThrough then StepThrough + if S has RetractableTo Integer then + RetractableTo Integer + RetractableTo Fraction Integer + if S has OrderedSet then OrderedSet + if S has OrderedIntegralDomain then OrderedIntegralDomain + if S has RealConstant then RealConstant + if S has ConvertibleTo InputForm then ConvertibleTo InputForm + if S has CharacteristicZero then CharacteristicZero + if S has CharacteristicNonZero then CharacteristicNonZero + if S has RetractableTo Symbol then RetractableTo Symbol + if S has EuclideanDomain then + wholePart: % -> S + ++ wholePart(x) returns the whole part of the fraction x + ++ i.e. the truncated quotient of the numerator by the denominator. + fractionPart: % -> % + ++ fractionPart(x) returns the fractional part of x. + ++ x = wholePart(x) + fractionPart(x) + if S has IntegerNumberSystem then + random: () -> % + ++ random() returns a random fraction. + ceiling : % -> S + ++ ceiling(x) returns the smallest integral element above x. + floor: % -> S + ++ floor(x) returns the largest integral element below x. + if S has PolynomialFactorizationExplicit then + PolynomialFactorizationExplicit -RealNumberSystem(): Category == - Join(Field, OrderedRing, RealConstant, RetractableTo Integer, - RetractableTo Fraction Integer, RadicalCategory, - ConvertibleTo Pattern Float, PatternMatchable Float, - CharacteristicZero) with - norm : % -> % - ++ norm x returns the same as absolute value. - ceiling : % -> % - ++ ceiling x returns the small integer \spad{>= x}. - floor: % -> % - ++ floor x returns the largest integer \spad{<= x}. - wholePart : % -> Integer - ++ wholePart x returns the integer part of x. - fractionPart : % -> % - ++ fractionPart x returns the fractional part of x. - truncate: % -> % - ++ truncate x returns the integer between x and 0 closest to x. - round: % -> % - ++ round x computes the integer closest to x. - abs : % -> % - ++ abs x returns the absolute value of x. add - characteristic() == 0 + import MatrixCommonDenominator(S, %) - fractionPart x == x - truncate x + numerator(x) == numer(x)::% - truncate x == (negative? x => -floor(-x); floor x) + denominator(x) == denom(x) ::% - round x == (negative? x => truncate(x-1/2::%); truncate(x+1/2::%)) + if S has StepThrough then + init() == init()$S / 1$S - norm x == abs x + nextItem(n) == + m:= nextItem(numer(n)) + m case "failed" => + error "We seem to have a Fraction of a finite object" + m / 1 - coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::% + map(fn, x) == (fn numer x) / (fn denom x) - convert(x:%):Pattern(Float) == convert(x)@Float :: Pattern(Float) + reducedSystem(m:Matrix %):Matrix S == clearDenominator m - floor x == - x1 := (wholePart x) :: % - x = x1 => x - x < 0 => (x1 - 1) - x1 + characteristic() == characteristic()$S - ceiling x == - x1 := (wholePart x)::% - x = x1 => x - x >= 0 => (x1 + 1) - x1 + differentiate(x:%, deriv:S -> S) == + n := numer x + d := denom x + (deriv n * d - n * deriv d) / (d**2) - patternMatch(x, p, l) == - generic? p => addMatch(p, x, l) - constant? p => - (r := retractIfCan(p)@Union(Float, "failed")) case Float => - convert(x)@Float = r::Float => l - failed() - failed() - failed() + if S has ConvertibleTo InputForm then + convert(x:%):InputForm == (convert numer x) / (convert denom x) -\end{chunk} -\begin{chunk}{RNS.dotabb} -"RNS" - [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"]; -"RNS" -> "FIELD" -"RNS" -> "ORDRING" -"RNS" -> "REAL" -"RNS" -> "RETRACT" -"RNS" -> "RADCAT" -"RNS" -> "KONVERT" -"RNS" -> "PATMAB" -"RNS" -> "CHARZ" + if S has RealConstant then + convert(x:%):Float == (convert numer x) / (convert denom x) -\end{chunk} -\begin{chunk}{RNS.dotfull} -"RealNumberSystem()" - [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"]; -"RealNumberSystem()" -> "Field()" -"RealNumberSystem()" -> "OrderedRing()" -"RealNumberSystem()" -> "RealConstant()" -"RealNumberSystem()" -> "RetractableTo(Integer)" -"RealNumberSystem()" -> "RetractableTo(Fraction(Integer))" -"RealNumberSystem()" -> "RadicalCategory()" -"RealNumberSystem()" -> "ConvertibleTo(Pattern(Float))" -"RealNumberSystem()" -> "PatternMatchable(Float)" -"RealNumberSystem()" -> "CharacteristicZero()" + convert(x:%):DoubleFloat == (convert numer x) / (convert denom x) -\end{chunk} -\begin{chunk}{RNS.dotpic} -digraph pic { - fontsize=10; - bgcolor="#ECEA81"; - node [shape=box, color=white, style=filled]; + -- Note that being a Join(OrderedSet,IntegralDomain) is not the same + -- as being an OrderedIntegralDomain. + if S has OrderedIntegralDomain then + if S has canonicalUnitNormal then + x:% < y:% == + (numer x * denom y) < (numer y * denom x) + else + x:% < y:% == + if denom(x) < 0 then (x,y):=(y,x) + if denom(y) < 0 then (x,y):=(y,x) + (numer x * denom y) < (numer y * denom x) + else if S has OrderedSet then + x:% < y:% == + (numer x * denom y) < (numer y * denom x) -"RealNumberSystem()" [color=lightblue]; -"RealNumberSystem()" -> "FIELD..." -"RealNumberSystem()" -> "ORDRING..." -"RealNumberSystem()" -> "REAL..." -"RealNumberSystem()" -> "RETRACT..." -"RealNumberSystem()" -> "RADCAT..." -"RealNumberSystem()" -> "KONVERT..." -"RealNumberSystem()" -> "PATMAB..." -"RealNumberSystem()" -> "CHARZ..." + if (S has EuclideanDomain) then + fractionPart x == x - (wholePart(x)::%) -"FIELD..." [color=lightblue]; -"ORDRING..." [color=lightblue]; -"REAL..." [color=lightblue]; -"RETRACT..." [color=lightblue]; -"RADCAT..." [color=lightblue]; -"KONVERT..." [color=lightblue]; -"PATMAB..." [color=lightblue]; -"CHARZ..." [color=lightblue]; -} + if S has RetractableTo Symbol then + coerce(s:Symbol):% == s::S::% -\end{chunk} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\pagehead{RecursivePolynomialCategory}{RPOLCAT} -\pagepic{ps/v102recursivepolynomialcategory.ps}{RPOLCAT}{0.30} + retract(x:%):Symbol == retract(retract(x)@S) -\begin{chunk}{RecursivePolynomialCategory.input} + retractIfCan(x:%):Union(Symbol, "failed") == + (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed" + retractIfCan(r::S) + + if (S has ConvertibleTo Pattern Integer) then + convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x) + + if (S has PatternMatchable Integer) then + patternMatch(x:%, p:Pattern Integer, + l:PatternMatchResult(Integer, %)) == + patternMatch(x, p, + l)$PatternMatchQuotientFieldCategory(Integer, S, %) + + if (S has ConvertibleTo Pattern Float) then + convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x) + + if (S has PatternMatchable Float) then + patternMatch(x:%, p:Pattern Float, + l:PatternMatchResult(Float, %)) == + patternMatch(x, p, + l)$PatternMatchQuotientFieldCategory(Float, S, %) + + if S has RetractableTo Integer then + coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::% + + if not(S is Integer) then + retract(x:%):Integer == retract(retract(x)@S) + + retractIfCan(x:%):Union(Integer, "failed") == + (u := retractIfCan(x)@Union(S, "failed")) case "failed" => + "failed" + retractIfCan(u::S) + + if S has IntegerNumberSystem then + random():% == + while zero?(d:=random()$S) repeat d + random()$S / d + + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix S, vec:Vector S) == + n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S) + [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n, + maxColIndex n), column(n, minColIndex n)] + +\end{chunk} + +\begin{chunk}{COQ QFCAT} +(* category QFCAT *) +(* + import MatrixCommonDenominator(S, %) + + numerator : % -> % + numerator(x) == numer(x)::% + + denominator : % -> % + denominator(x) == denom(x) ::% + + if S has StepThrough then + + init : () -> % + init() == init()$S / 1$S + + nextItem : % -> Union(%,"failed") + nextItem(n) == + m:= nextItem(numer(n)) + m case "failed" => + error "We seem to have a Fraction of a finite object" + m / 1 + + map : ((S -> S),%) -> % + map(fn, x) == (fn numer x) / (fn denom x) + + reducedSystem : Matrix(%) -> Matrix(S) + reducedSystem(m:Matrix %):Matrix S == clearDenominator m + + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$S + + differentiate : (%,(S -> S)) -> % + differentiate(x:%, deriv:S -> S) == + n := numer x + d := denom x + (deriv n * d - n * deriv d) / (d**2) + + if S has ConvertibleTo InputForm then + + convert : % -> InputForm + convert(x:%):InputForm == (convert numer x) / (convert denom x) + + if S has RealConstant then + + convert : % -> Float + convert(x:%):Float == (convert numer x) / (convert denom x) + + convert : % -> DoubleFloat + convert(x:%):DoubleFloat == (convert numer x) / (convert denom x) + + -- Note that being a Join(OrderedSet,IntegralDomain) is not the same + -- as being an OrderedIntegralDomain. + if S has OrderedIntegralDomain then + + if S has canonicalUnitNormal then + + ? Boolean + x:% < y:% == + (numer x * denom y) < (numer y * denom x) + + else + + ? Boolean + x:% < y:% == + if denom(x) < 0 then (x,y):=(y,x) + if denom(y) < 0 then (x,y):=(y,x) + (numer x * denom y) < (numer y * denom x) + + else if S has OrderedSet then + + ? Boolean + x:% < y:% == + (numer x * denom y) < (numer y * denom x) + + if (S has EuclideanDomain) then + + fractionPart : % -> % + fractionPart x == x - (wholePart(x)::%) + + if S has RetractableTo Symbol then + + coerce : S -> % + coerce(s:Symbol):% == s::S::% + + retract : % -> S + retract(x:%):Symbol == retract(retract(x)@S) + + retractIfCan : % -> Union(Symbol,"failed") + retractIfCan(x:%):Union(Symbol, "failed") == + (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed" + retractIfCan(r::S) + + if (S has ConvertibleTo Pattern Integer) then + + convert : % -> Pattern(Integer) + convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x) + + if (S has PatternMatchable Integer) then + + patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) + patternMatch(x:%, p:Pattern Integer, + l:PatternMatchResult(Integer, %)) == + patternMatch(x, p, + l)$PatternMatchQuotientFieldCategory(Integer, S, %) + + if (S has ConvertibleTo Pattern Float) then + + convert : % -> Pattern(Float) + convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x) + + if (S has PatternMatchable Float) then + + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + patternMatch(x:%, p:Pattern Float, + l:PatternMatchResult(Float, %)) == + patternMatch(x, p, + l)$PatternMatchQuotientFieldCategory(Float, S, %) + + if S has RetractableTo Integer then + + coerce : Fraction(Integer) -> % + coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::% + + if not(S is Integer) then + + retract : % -> Integer + retract(x:%):Integer == retract(retract(x)@S) + + retractIfCan : % -> Union(Integer,"failed") + retractIfCan(x:%):Union(Integer, "failed") == + (u := retractIfCan(x)@Union(S, "failed")) case "failed" => + "failed" + retractIfCan(u::S) + + if S has IntegerNumberSystem then + + random : () -> % + random():% == + while zero?(d:=random()$S) repeat d + random()$S / d + + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(S),vec: Vector(S)) + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix S, vec:Vector S) == + n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S) + [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n, + maxColIndex n), column(n, minColIndex n)] + +*) + +\end{chunk} + +\begin{chunk}{QFCAT.dotabb} +"QFCAT" + [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"]; +"QFCAT" -> "ALGEBRA" +"QFCAT" -> "DIFEXT" +"QFCAT" -> "FIELD" +"QFCAT" -> "FEVALAB" +"QFCAT" -> "FLINEXP" +"QFCAT" -> "FPATMAB" +"QFCAT" -> "PATAB" +"QFCAT" -> "RETRACT" + +\end{chunk} +\begin{chunk}{QFCAT.dotfull} +"QuotientFieldCategory(a:IntegralDomain)" + [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"]; +"QuotientFieldCategory(a:IntegralDomain)" -> "Field()" +"QuotientFieldCategory(a:IntegralDomain)" -> "Algebra(IntegralDomain)" +"QuotientFieldCategory(a:IntegralDomain)" -> "RetractableTo(IntegralDomain)" +"QuotientFieldCategory(a:IntegralDomain)" -> + "FullyEvalableOver(IntegralDomain)" +"QuotientFieldCategory(a:IntegralDomain)" -> + "DifferentialExtension(IntegralDomain)" +"QuotientFieldCategory(a:IntegralDomain)" -> + "FullyLinearlyExplicitRingOver(IntegralDomain)" +"QuotientFieldCategory(a:IntegralDomain)" -> + "Patternable(IntegralDomain)" +"QuotientFieldCategory(a:IntegralDomain)" -> + "FullyPatternMatchable(IntegralDomain)" + +\end{chunk} +\begin{chunk}{QFCAT.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; + +"QuotientFieldCategory(a:IntegralDomain)" [color=lightblue]; +"QuotientFieldCategory(a:IntegralDomain)" -> "ALGEBRA..." +"QuotientFieldCategory(a:IntegralDomain)" -> "DIFEXT..." +"QuotientFieldCategory(a:IntegralDomain)" -> "FIELD..." +"QuotientFieldCategory(a:IntegralDomain)" -> "FEVALAB..." +"QuotientFieldCategory(a:IntegralDomain)" -> "FLINEXP..." +"QuotientFieldCategory(a:IntegralDomain)" -> "FPATMAB..." +"QuotientFieldCategory(a:IntegralDomain)" -> "PATAB..." +"QuotientFieldCategory(a:IntegralDomain)" -> "RETRACT..." + +"ALGEBRA..." [color=lightblue]; +"DIFEXT..." [color=lightblue]; +"FIELD..." [color=lightblue]; +"FEVALAB..." [color=lightblue]; +"FLINEXP..." [color=lightblue]; +"FPATMAB..." [color=lightblue]; +"PATAB..." [color=lightblue]; +"RETRACT..." [color=lightblue]; + +} + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\pagehead{RealClosedField}{RCFIELD} +\pagepic{ps/v102realclosedfield.ps}{RCFIELD}{0.50} + +\begin{chunk}{RealClosedField.input} )set break resume -)sys rm -f RecursivePolynomialCategory.output -)spool RecursivePolynomialCategory.output +)sys rm -f RealClosedField.output +)spool RealClosedField.output )set message test on )set message auto off )clear all --S 1 of 1 -)show RecursivePolynomialCategory +)show RealClosedField --R ---R RecursivePolynomialCategory(R: Ring,E: OrderedAbelianMonoidSup,V: OrderedSet) is a category constructor ---R Abbreviation for RecursivePolynomialCategory is RPOLCAT +--R RealClosedField is a category constructor +--R Abbreviation for RealClosedField is RCFIELD --R This constructor is exposed in this frame. ---R Issue )edit bookvol10.2.pamphlet to see algebra source code for RPOLCAT +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for RCFIELD --R --R------------------------------- Operations -------------------------------- ---R ?*? : (%,R) -> % ?*? : (R,%) -> % +--R ?*? : (%,Fraction(Integer)) -> % ?*? : (Fraction(Integer),%) -> % +--R ?*? : (%,Integer) -> % ?*? : (Integer,%) -> % +--R ?*? : (%,Fraction(Integer)) -> % ?*? : (Fraction(Integer),%) -> % --R ?*? : (%,%) -> % ?*? : (Integer,%) -> % --R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % +--R ?**? : (%,Fraction(Integer)) -> % ?**? : (%,Integer) -> % --R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % --R ?+? : (%,%) -> % ?-? : (%,%) -> % ---R -? : % -> % ?/? : (%,R) -> % if R has FIELD ---R ?=? : (%,%) -> Boolean D : (%,V,NonNegativeInteger) -> % ---R D : (%,List(V)) -> % D : (%,V) -> % ---R 1 : () -> % 0 : () -> % +--R -? : % -> % ?/? : (%,%) -> % +--R ? Boolean ?<=? : (%,%) -> Boolean +--R ?=? : (%,%) -> Boolean ?>? : (%,%) -> Boolean +--R ?>=? : (%,%) -> Boolean 1 : () -> % +--R 0 : () -> % ?^? : (%,Integer) -> % --R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % ---R coefficient : (%,E) -> R coefficients : % -> List(R) ---R coerce : % -> % if R has INTDOM coerce : V -> % ---R coerce : R -> % coerce : Integer -> % ---R coerce : % -> OutputForm content : % -> R if R has GCDDOM ---R deepestInitial : % -> % deepestTail : % -> % ---R degree : % -> E differentiate : (%,List(V)) -> % ---R differentiate : (%,V) -> % eval : (%,List(V),List(%)) -> % ---R eval : (%,V,%) -> % eval : (%,List(V),List(R)) -> % ---R eval : (%,V,R) -> % eval : (%,List(%),List(%)) -> % ---R eval : (%,%,%) -> % eval : (%,Equation(%)) -> % ---R eval : (%,List(Equation(%))) -> % gcd : (%,%) -> % if R has GCDDOM ---R gcd : List(%) -> % if R has GCDDOM gcd : (R,%) -> R if R has GCDDOM ---R ground : % -> R ground? : % -> Boolean ---R hash : % -> SingleInteger head : % -> % ---R headReduce : (%,%) -> % headReduced? : (%,%) -> Boolean ---R infRittWu? : (%,%) -> Boolean init : % -> % ---R initiallyReduce : (%,%) -> % iteratedInitials : % -> List(%) ---R latex : % -> String lazyPquo : (%,%,V) -> % ---R lazyPquo : (%,%) -> % lazyPrem : (%,%,V) -> % ---R lazyPrem : (%,%) -> % lcm : (%,%) -> % if R has GCDDOM ---R lcm : List(%) -> % if R has GCDDOM leadingCoefficient : (%,V) -> % ---R leadingCoefficient : % -> R leadingMonomial : % -> % ---R leastMonomial : % -> % mainCoefficients : % -> List(%) ---R mainMonomial : % -> % mainMonomials : % -> List(%) ---R map : ((R -> R),%) -> % mapExponents : ((E -> E),%) -> % ---R max : (%,%) -> % if R has ORDSET mdeg : % -> NonNegativeInteger ---R min : (%,%) -> % if R has ORDSET minimumDegree : % -> E ---R monic? : % -> Boolean monicModulo : (%,%) -> % ---R monomial : (R,E) -> % monomial? : % -> Boolean ---R monomials : % -> List(%) mvar : % -> V ---R normalized? : (%,%) -> Boolean one? : % -> Boolean ---R pomopo! : (%,R,E,%) -> % pquo : (%,%,V) -> % ---R pquo : (%,%) -> % prem : (%,%,V) -> % ---R prem : (%,%) -> % primitiveMonomials : % -> List(%) ---R quasiMonic? : % -> Boolean recip : % -> Union(%,"failed") ---R reduced? : (%,List(%)) -> Boolean reduced? : (%,%) -> Boolean ---R reductum : (%,V) -> % reductum : % -> % ---R retract : % -> V retract : % -> R ---R sample : () -> % supRittWu? : (%,%) -> Boolean ---R tail : % -> % variables : % -> List(V) ---R zero? : % -> Boolean ?~=? : (%,%) -> Boolean ---R ?*? : (Fraction(Integer),%) -> % if R has ALGEBRA(FRAC(INT)) ---R ?*? : (%,Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) ---R ? Boolean if R has ORDSET ---R ?<=? : (%,%) -> Boolean if R has ORDSET ---R ?>? : (%,%) -> Boolean if R has ORDSET ---R ?>=? : (%,%) -> Boolean if R has ORDSET ---R D : (%,List(V),List(NonNegativeInteger)) -> % ---R LazardQuotient : (%,%,NonNegativeInteger) -> % if R has INTDOM ---R LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % if R has INTDOM ---R RittWuCompare : (%,%) -> Union(Boolean,"failed") ---R associates? : (%,%) -> Boolean if R has INTDOM ---R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING +--R abs : % -> % associates? : (%,%) -> Boolean +--R coerce : Fraction(Integer) -> % coerce : Integer -> % +--R coerce : Fraction(Integer) -> % coerce : % -> % +--R coerce : Fraction(Integer) -> % coerce : Integer -> % +--R coerce : % -> OutputForm factor : % -> Factored(%) +--R gcd : (%,%) -> % gcd : List(%) -> % +--R hash : % -> SingleInteger inv : % -> % +--R latex : % -> String lcm : (%,%) -> % +--R lcm : List(%) -> % max : (%,%) -> % +--R min : (%,%) -> % negative? : % -> Boolean +--R nthRoot : (%,Integer) -> % one? : % -> Boolean +--R positive? : % -> Boolean prime? : % -> Boolean +--R ?quo? : (%,%) -> % recip : % -> Union(%,"failed") +--R ?rem? : (%,%) -> % rename : (%,OutputForm) -> % +--R rename! : (%,OutputForm) -> % retract : % -> Fraction(Integer) +--R sample : () -> % sign : % -> Integer +--R sizeLess? : (%,%) -> Boolean sqrt : Integer -> % +--R sqrt : Fraction(Integer) -> % sqrt : (%,NonNegativeInteger) -> % +--R sqrt : % -> % squareFree : % -> Factored(%) +--R squareFreePart : % -> % unit? : % -> Boolean +--R unitCanonical : % -> % zero? : % -> Boolean +--R ?~=? : (%,%) -> Boolean +--R allRootsOf : Polynomial(Integer) -> List(%) +--R allRootsOf : Polynomial(Fraction(Integer)) -> List(%) +--R allRootsOf : Polynomial(%) -> List(%) +--R allRootsOf : SparseUnivariatePolynomial(Integer) -> List(%) +--R allRootsOf : SparseUnivariatePolynomial(Fraction(Integer)) -> List(%) +--R allRootsOf : SparseUnivariatePolynomial(%) -> List(%) +--R approximate : (%,%) -> Fraction(Integer) --R characteristic : () -> NonNegativeInteger ---R charthRoot : % -> Union(%,"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit)) or R has CHARNZ ---R coefficient : (%,List(V),List(NonNegativeInteger)) -> % ---R coefficient : (%,V,NonNegativeInteger) -> % ---R coerce : Fraction(Integer) -> % if R has RETRACT(FRAC(INT)) or R has ALGEBRA(FRAC(INT)) ---R coerce : % -> Polynomial(R) if V has KONVERT(SYMBOL) ---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit)) ---R content : (%,V) -> % if R has GCDDOM ---R convert : % -> Polynomial(R) if V has KONVERT(SYMBOL) ---R convert : % -> String if R has RETRACT(INT) and V has KONVERT(SYMBOL) ---R convert : Polynomial(R) -> % if V has KONVERT(SYMBOL) ---R convert : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R convert : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R convert : % -> InputForm if V has KONVERT(INFORM) and R has KONVERT(INFORM) ---R convert : % -> Pattern(Integer) if V has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT)) ---R convert : % -> Pattern(Float) if V has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT)) ---R degree : (%,List(V)) -> List(NonNegativeInteger) ---R degree : (%,V) -> NonNegativeInteger ---R differentiate : (%,List(V),List(NonNegativeInteger)) -> % ---R differentiate : (%,V,NonNegativeInteger) -> % ---R discriminant : (%,V) -> % if R has COMRING ---R exactQuotient : (%,%) -> % if R has INTDOM ---R exactQuotient : (%,R) -> % if R has INTDOM ---R exactQuotient! : (%,%) -> % if R has INTDOM ---R exactQuotient! : (%,R) -> % if R has INTDOM ---R exquo : (%,%) -> Union(%,"failed") if R has INTDOM ---R exquo : (%,R) -> Union(%,"failed") if R has INTDOM ---R extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) if R has INTDOM ---R factor : % -> Factored(%) if R has PFECAT ---R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT ---R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT ---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) if R has GCDDOM ---R halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) if R has INTDOM ---R halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) if R has INTDOM ---R headReduced? : (%,List(%)) -> Boolean ---R initiallyReduced? : (%,List(%)) -> Boolean ---R initiallyReduced? : (%,%) -> Boolean ---R isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed") ---R isPlus : % -> Union(List(%),"failed") ---R isTimes : % -> Union(List(%),"failed") ---R lastSubResultant : (%,%) -> % if R has INTDOM ---R lazyPremWithDefault : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,remainder: %) ---R lazyPremWithDefault : (%,%) -> Record(coef: %,gap: NonNegativeInteger,remainder: %) ---R lazyPseudoDivide : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) ---R lazyPseudoDivide : (%,%) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) ---R lazyResidueClass : (%,%) -> Record(polnum: %,polden: %,power: NonNegativeInteger) ---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM ---R mainContent : % -> % if R has GCDDOM ---R mainPrimitivePart : % -> % if R has GCDDOM ---R mainSquareFreePart : % -> % if R has GCDDOM ---R mainVariable : % -> Union(V,"failed") ---R minimumDegree : (%,List(V)) -> List(NonNegativeInteger) ---R minimumDegree : (%,V) -> NonNegativeInteger ---R monicDivide : (%,%,V) -> Record(quotient: %,remainder: %) ---R monomial : (%,List(V),List(NonNegativeInteger)) -> % ---R monomial : (%,V,NonNegativeInteger) -> % ---R multivariate : (SparseUnivariatePolynomial(%),V) -> % ---R multivariate : (SparseUnivariatePolynomial(R),V) -> % ---R nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM ---R normalized? : (%,List(%)) -> Boolean ---R numberOfMonomials : % -> NonNegativeInteger ---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if V has PATMAB(INT) and R has PATMAB(INT) ---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if V has PATMAB(FLOAT) and R has PATMAB(FLOAT) ---R primPartElseUnitCanonical : % -> % if R has INTDOM ---R primPartElseUnitCanonical! : % -> % if R has INTDOM ---R prime? : % -> Boolean if R has PFECAT ---R primitivePart : (%,V) -> % if R has GCDDOM ---R primitivePart : % -> % if R has GCDDOM ---R primitivePart! : % -> % if R has GCDDOM ---R pseudoDivide : (%,%) -> Record(quotient: %,remainder: %) ---R reducedSystem : Matrix(%) -> Matrix(R) ---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(R),vec: Vector(R)) ---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if R has LINEXP(INT) ---R reducedSystem : Matrix(%) -> Matrix(Integer) if R has LINEXP(INT) ---R resultant : (%,%) -> % if R has INTDOM ---R resultant : (%,%,V) -> % if R has COMRING ---R retract : Polynomial(R) -> % if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R retract : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R retract : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R retract : % -> Integer if R has RETRACT(INT) ---R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT)) ---R retractIfCan : Polynomial(R) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R retractIfCan : Polynomial(Integer) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R retractIfCan : Polynomial(Fraction(Integer)) -> Union(%,"failed") if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) ---R retractIfCan : % -> Union(V,"failed") ---R retractIfCan : % -> Union(Integer,"failed") if R has RETRACT(INT) ---R retractIfCan : % -> Union(Fraction(Integer),"failed") if R has RETRACT(FRAC(INT)) ---R retractIfCan : % -> Union(R,"failed") ---R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT ---R squareFree : % -> Factored(%) if R has GCDDOM ---R squareFreePart : % -> % if R has GCDDOM ---R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT ---R subResultantChain : (%,%) -> List(%) if R has INTDOM ---R subResultantGcd : (%,%) -> % if R has INTDOM +--R divide : (%,%) -> Record(quotient: %,remainder: %) +--R euclideanSize : % -> NonNegativeInteger +--R expressIdealMember : (List(%),%) -> Union(List(%),"failed") +--R exquo : (%,%) -> Union(%,"failed") +--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) +--R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") +--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) +--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) +--R mainDefiningPolynomial : % -> Union(SparseUnivariatePolynomial(%),"failed") +--R mainForm : % -> Union(OutputForm,"failed") +--R mainValue : % -> Union(SparseUnivariatePolynomial(%),"failed") +--R multiEuclidean : (List(%),%) -> Union(List(%),"failed") +--R principalIdeal : List(%) -> Record(coef: List(%),generator: %) +--R retract : % -> Fraction(Integer) if Fraction(Integer) has RETRACT(FRAC(INT)) +--R retract : % -> Integer if Fraction(Integer) has RETRACT(INT) +--R retractIfCan : % -> Union(Fraction(Integer),"failed") +--R retractIfCan : % -> Union(Fraction(Integer),"failed") if Fraction(Integer) has RETRACT(FRAC(INT)) +--R retractIfCan : % -> Union(Integer,"failed") if Fraction(Integer) has RETRACT(INT) +--R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) -> Union(%,"failed") +--R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger,OutputForm) -> Union(%,"failed") --R subtractIfCan : (%,%) -> Union(%,"failed") ---R totalDegree : (%,List(V)) -> NonNegativeInteger ---R totalDegree : % -> NonNegativeInteger ---R unit? : % -> Boolean if R has INTDOM ---R unitCanonical : % -> % if R has INTDOM ---R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if R has INTDOM ---R univariate : % -> SparseUnivariatePolynomial(R) ---R univariate : (%,V) -> SparseUnivariatePolynomial(%) +--R unitNormal : % -> Record(unit: %,canonical: %,associate: %) --R --E 1 )spool )lisp (bye) \end{chunk} -\begin{chunk}{RecursivePolynomialCategory.help} + +\begin{chunk}{RealClosedField.help} ==================================================================== -RecursivePolynomialCategory examples +RealClosedField examples ==================================================================== -A category for general multi-variate polynomials with coefficients -in a ring, variables in an ordered set, and exponents from an -ordered abelian monoid, with a sup operation. - -When not constant, such a polynomial is viewed as a univariate polynomial -in its main variable w. r. t. to the total ordering on the elements in -the ordered set, so that some operations usually defined for univariate -polynomials make sense here. +RealClosedField provides common access functions for all real closed fields. +It provides computations with generic real roots of polynomials. See Also: -o )show RecursivePolynomialCategory +o )show RealClosedField \end{chunk} {\bf See:} -\pagefrom{PolynomialCategory}{POLYCAT} +\pagefrom{Algebra}{ALGEBRA} +\pagefrom{CharacteristicZero}{CHARZ} +\pagefrom{CommutativeRing}{COMRING} +\pagefrom{Field}{FIELD} +\pagefrom{FullyRetractableTo}{FRETRCT} +\pagefrom{OrderedRing}{ORDRING} +\pagefrom{RadicalCategory}{RADCAT} {\bf Exports:}\\ -\begin{tabular}{lll} -\cross{RPOLCAT}{0} & -\cross{RPOLCAT}{1} & -\cross{RPOLCAT}{associates?} \\ -\cross{RPOLCAT}{binomThmExpt} & -\cross{RPOLCAT}{characteristic} & -\cross{RPOLCAT}{charthRoot} \\ -\cross{RPOLCAT}{coefficient} & -\cross{RPOLCAT}{coefficients} & -\cross{RPOLCAT}{coerce} \\ -\cross{RPOLCAT}{conditionP} & -\cross{RPOLCAT}{convert} & -\cross{RPOLCAT}{D} \\ -\cross{RPOLCAT}{deepestInitial} & -\cross{RPOLCAT}{deepestTail} & -\cross{RPOLCAT}{degree} \\ -\cross{RPOLCAT}{differentiate} & -\cross{RPOLCAT}{discriminant} & -\cross{RPOLCAT}{eval} \\ -\cross{RPOLCAT}{exactQuotient} & -\cross{RPOLCAT}{exactQuotient!} & -\cross{RPOLCAT}{exquo} \\ -\cross{RPOLCAT}{extendedSubResultantGcd} & -\cross{RPOLCAT}{factor} & -\cross{RPOLCAT}{factorPolynomial} \\ -\cross{RPOLCAT}{factorSquareFreePolynomial} & -\cross{RPOLCAT}{gcd} & -\cross{RPOLCAT}{gcdPolynomial} \\ -\cross{RPOLCAT}{ground} & -\cross{RPOLCAT}{ground?} & -\cross{RPOLCAT}{halfExtendedSubResultantGcd1} \\ -\cross{RPOLCAT}{halfExtendedSubResultantGcd2} & -\cross{RPOLCAT}{hash} & -\cross{RPOLCAT}{head} \\ -\cross{RPOLCAT}{headReduce} & -\cross{RPOLCAT}{headReduced?} & -\cross{RPOLCAT}{infRittWu?} \\ -\cross{RPOLCAT}{init} & -\cross{RPOLCAT}{initiallyReduce} & -\cross{RPOLCAT}{initiallyReduced?} \\ -\cross{RPOLCAT}{isExpt} & -\cross{RPOLCAT}{isPlus} & -\cross{RPOLCAT}{isTimes} \\ -\cross{RPOLCAT}{iteratedInitials} & -\cross{RPOLCAT}{lastSubResultant} & -\cross{RPOLCAT}{latex} \\ -\cross{RPOLCAT}{LazardQuotient} & -\cross{RPOLCAT}{LazardQuotient2} & -\cross{RPOLCAT}{lazyPquo} \\ -\cross{RPOLCAT}{lazyPrem} & -\cross{RPOLCAT}{lazyPremWithDefault} & -\cross{RPOLCAT}{lazyPseudoDivide} \\ -\cross{RPOLCAT}{lazyResidueClass} & -\cross{RPOLCAT}{lcm} & -\cross{RPOLCAT}{leadingCoefficient} \\ -\cross{RPOLCAT}{leadingMonomial} & -\cross{RPOLCAT}{leastMonomial} & -\cross{RPOLCAT}{mainCoefficients} \\ -\cross{RPOLCAT}{mainContent} & -\cross{RPOLCAT}{mainMonomial} & -\cross{RPOLCAT}{mainPrimitivePart} \\ -\cross{RPOLCAT}{mainSquareFreePart} & -\cross{RPOLCAT}{mainVariable} & -\cross{RPOLCAT}{map} \\ -\cross{RPOLCAT}{mapExponents} & -\cross{RPOLCAT}{max} & -\cross{RPOLCAT}{mdeg} \\ -\cross{RPOLCAT}{min} & -\cross{RPOLCAT}{minimumDegree} & -\cross{RPOLCAT}{monic?} \\ -\cross{RPOLCAT}{monicDivide} & -\cross{RPOLCAT}{monicModulo} & -\cross{RPOLCAT}{monomial} \\ -\cross{RPOLCAT}{monomial?} & -\cross{RPOLCAT}{monomials} & -\cross{RPOLCAT}{multivariate} \\ -\cross{RPOLCAT}{mvar} & -\cross{RPOLCAT}{nextsubResultant2} & -\cross{RPOLCAT}{normalized?} \\ -\cross{RPOLCAT}{numberOfMonomials} & -\cross{RPOLCAT}{one?} & -\cross{RPOLCAT}{patternMatch} \\ -\cross{RPOLCAT}{pomopo!} & -\cross{RPOLCAT}{pquo} & -\cross{RPOLCAT}{prem} \\ -\cross{RPOLCAT}{primPartElseUnitCanonical} & -\cross{RPOLCAT}{primPartElseUnitCanonical!} & -\cross{RPOLCAT}{prime?} \\ -\cross{RPOLCAT}{primitiveMonomials} & -\cross{RPOLCAT}{primitivePart} & -\cross{RPOLCAT}{primitivePart!} \\ -\cross{RPOLCAT}{pseudoDivide} & -\cross{RPOLCAT}{quasiMonic?} & -\cross{RPOLCAT}{recip} \\ -\cross{RPOLCAT}{reduced?} & -\cross{RPOLCAT}{reducedSystem} & -\cross{RPOLCAT}{reductum} \\ -\cross{RPOLCAT}{resultant} & -\cross{RPOLCAT}{retract} & -\cross{RPOLCAT}{retractIfCan} \\ -\cross{RPOLCAT}{RittWuCompare} & -\cross{RPOLCAT}{sample} & -\cross{RPOLCAT}{solveLinearPolynomialEquation} \\ -\cross{RPOLCAT}{squareFree} & -\cross{RPOLCAT}{squareFreePart} & -\cross{RPOLCAT}{squareFreePolynomial} \\ -\cross{RPOLCAT}{subResultantChain} & -\cross{RPOLCAT}{subResultantGcd} & -\cross{RPOLCAT}{subtractIfCan} \\ -\cross{RPOLCAT}{supRittWu?} & -\cross{RPOLCAT}{tail} & -\cross{RPOLCAT}{totalDegree} \\ -\cross{RPOLCAT}{unit?} & -\cross{RPOLCAT}{unitCanonical} & -\cross{RPOLCAT}{unitNormal} \\ -\cross{RPOLCAT}{univariate} & -\cross{RPOLCAT}{variables} & -\cross{RPOLCAT}{zero?} \\ -\cross{RPOLCAT}{?*?} & -\cross{RPOLCAT}{?**?} & -\cross{RPOLCAT}{?+?} \\ -\cross{RPOLCAT}{?-?} & -\cross{RPOLCAT}{-?} & -\cross{RPOLCAT}{?=?} \\ -\cross{RPOLCAT}{?\^{}?} & -\cross{RPOLCAT}{?\~{}=?} & -\cross{RPOLCAT}{?/?} \\ -\cross{RPOLCAT}{?$<$?} & -\cross{RPOLCAT}{?$<=$?} & -\cross{RPOLCAT}{?$>$?} \\ -\cross{RPOLCAT}{?$>=$?} && +\begin{tabular}{llll} +\cross{RCFIELD}{0} & +\cross{RCFIELD}{1} & +\cross{RCFIELD}{abs} & +\cross{RCFIELD}{allRootsOf} \\ +\cross{RCFIELD}{approximate} & +\cross{RCFIELD}{associates?} & +\cross{RCFIELD}{characteristic} & +\cross{RCFIELD}{coerce} \\ +\cross{RCFIELD}{divide} & +\cross{RCFIELD}{euclideanSize} & +\cross{RCFIELD}{expressIdealMember} & +\cross{RCFIELD}{exquo} \\ +\cross{RCFIELD}{extendedEuclidean} & +\cross{RCFIELD}{factor} & +\cross{RCFIELD}{gcd} & +\cross{RCFIELD}{gcdPolynomial} \\ +\cross{RCFIELD}{hash} & +\cross{RCFIELD}{inv} & +\cross{RCFIELD}{latex} & +\cross{RCFIELD}{lcm} \\ +\cross{RCFIELD}{mainDefiningPolynomial} & +\cross{RCFIELD}{mainForm} & +\cross{RCFIELD}{mainValue} & +\cross{RCFIELD}{max} \\ +\cross{RCFIELD}{min} & +\cross{RCFIELD}{multiEuclidean} & +\cross{RCFIELD}{negative?} & +\cross{RCFIELD}{nthRoot} \\ +\cross{RCFIELD}{one?} & +\cross{RCFIELD}{positive?} & +\cross{RCFIELD}{prime?} & +\cross{RCFIELD}{principalIdeal} \\ +\cross{RCFIELD}{recip} & +\cross{RCFIELD}{rename} & +\cross{RCFIELD}{rename!} & +\cross{RCFIELD}{retract} \\ +\cross{RCFIELD}{retractIfCan} & +\cross{RCFIELD}{rootOf} & +\cross{RCFIELD}{sample} & +\cross{RCFIELD}{sign} \\ +\cross{RCFIELD}{sizeLess?} & +\cross{RCFIELD}{sqrt} & +\cross{RCFIELD}{squareFree} & +\cross{RCFIELD}{squareFreePart} \\ +\cross{RCFIELD}{subtractIfCan} & +\cross{RCFIELD}{unit?} & +\cross{RCFIELD}{unitCanonical} & +\cross{RCFIELD}{unitNormal} \\ +\cross{RCFIELD}{zero?} & +\cross{RCFIELD}{?*?} & +\cross{RCFIELD}{?**?} & +\cross{RCFIELD}{?+?} \\ +\cross{RCFIELD}{?-?} & +\cross{RCFIELD}{-?} & +\cross{RCFIELD}{?/?} & +\cross{RCFIELD}{?$<$?} \\ +\cross{RCFIELD}{?$<=$?} & +\cross{RCFIELD}{?=?} & +\cross{RCFIELD}{?$>$?} & +\cross{RCFIELD}{?$>=$?} \\ +\cross{RCFIELD}{?\^{}?} & +\cross{RCFIELD}{?\~{}=?} & +\cross{RCFIELD}{?quo?} & +\cross{RCFIELD}{?rem?} \\ \end{tabular} {\bf Attributes Exported:} \begin{itemize} -\item if \#1 has CommutativeRing then commutative(``*'') where -{\bf \cross{RPOLCAT}{commutative(``*'')}} -is true if it has an operation $"*": (D,D) -> D$ -which is commutative. -\item if \#1 has IntegralDomain then noZeroDivisors where -{\bf \cross{RPOLCAT}{noZeroDivisors}} +\item {\bf \cross{RCFIELD}{noZeroDivisors}} is true if $x * y \ne 0$ implies both x and y are non-zero. -\item if \#1 has canonicalUnitNormal then canonicalUnitNormal -where {\bf \cross{RPOLCAT}{canonicalUnitNormal}} +\item {\bf \cross{RCFIELD}{canonicalUnitNormal}} is true if we can choose a canonical representative for each class of associate elements, that is {\tt associates?(a,b)} returns true if and only if {\tt unitCanonical(a) = unitCanonical(b)}. -\item {\bf \cross{RPOLCAT}{unitsKnown}} +\item {\bf \cross{RCFIELD}{canonicalsClosed}} +is true if\hfill\\ +{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}. +\item {\bf \cross{RCFIELD}{unitsKnown}} is true if a monoid (a multiplicative semigroup with a 1) has unitsKnown means that the operation {\tt recip} can only return ``failed'' if its argument is not a unit. -\item {\bf \cross{RPOLCAT}{leftUnitary}} +\item {\bf \cross{RCFIELD}{leftUnitary}} is true if $1 * x = x$ for all x. -\item {\bf \cross{RPOLCAT}{rightUnitary}} +\item {\bf \cross{RCFIELD}{rightUnitary}} is true if $x * 1 = x$ for all x. +\item {\bf \cross{RCFIELD}{commutative(``*'')}} +is true if it has an operation $"*": (D,D) -> D$ +which is commutative. \end{itemize} These are directly exported but not implemented: \begin{verbatim} - exactQuotient! : (%,R) -> % if R has INTDOM - extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) - if R has INTDOM - halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) - if R has INTDOM - halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) - if R has INTDOM - lastSubResultant : (%,%) -> % if R has INTDOM - LazardQuotient : (%,%,NonNegativeInteger) -> % - if R has INTDOM - LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % - if R has INTDOM - nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM - resultant : (%,%) -> % if R has INTDOM - subResultantChain : (%,%) -> List % if R has INTDOM - subResultantGcd : (%,%) -> % if R has INTDOM + allRootsOf : SparseUnivariatePolynomial % -> List % + approximate : (%,%) -> Fraction Integer + mainDefiningPolynomial : + % -> Union(SparseUnivariatePolynomial %,"failed") + mainForm : % -> Union(OutputForm,"failed") + mainValue : % -> Union(SparseUnivariatePolynomial %,"failed") + rename : (%,OutputForm) -> % + rename! : (%,OutputForm) -> % \end{verbatim} These are implemented by this category: \begin{verbatim} - coerce : % -> OutputForm - coerce : % -> Polynomial R if V has KONVERT SYMBOL - convert : % -> String - if R has RETRACT INT - and V has KONVERT SYMBOL - convert : % -> Polynomial R if V has KONVERT SYMBOL - convert : Polynomial R -> % if V has KONVERT SYMBOL - convert : Polynomial Integer -> % - if not has(R,Algebra Fraction Integer) - and R has ALGEBRA INT - and V has KONVERT SYMBOL - or R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - convert : Polynomial Fraction Integer -> % - if R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - deepestInitial : % -> % - deepestTail : % -> % - exactQuotient : (%,R) -> % if R has INTDOM - exactQuotient : (%,%) -> % if R has INTDOM - exactQuotient! : (%,%) -> % if R has INTDOM - gcd : (R,%) -> R if R has GCDDOM - head : % -> % - headReduce : (%,%) -> % - headReduced? : (%,List %) -> Boolean - headReduced? : (%,%) -> Boolean - infRittWu? : (%,%) -> Boolean - init : % -> % - initiallyReduce : (%,%) -> % - initiallyReduced? : (%,%) -> Boolean - initiallyReduced? : (%,List %) -> Boolean - iteratedInitials : % -> List % - lazyPremWithDefault : (%,%) -> - Record(coef: %,gap: NonNegativeInteger,remainder: %) - lazyPremWithDefault : (%,%,V) -> - Record(coef: %,gap: NonNegativeInteger,remainder: %) - lazyPquo : (%,%) -> % - lazyPquo : (%,%,V) -> % - lazyPrem : (%,%,V) -> % - lazyPrem : (%,%) -> % - lazyPseudoDivide : (%,%) -> - Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) - lazyPseudoDivide : (%,%,V) -> - Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) - lazyResidueClass : (%,%) -> - Record(polnum: %,polden: %,power: NonNegativeInteger) - leadingCoefficient : (%,V) -> % - leastMonomial : % -> % - mainCoefficients : % -> List % - mainContent : % -> % if R has GCDDOM - mainMonomial : % -> % - mainMonomials : % -> List % - mainPrimitivePart : % -> % if R has GCDDOM - mainSquareFreePart : % -> % if R has GCDDOM - mdeg : % -> NonNegativeInteger - monic? : % -> Boolean - monicModulo : (%,%) -> % - mvar : % -> V - normalized? : (%,%) -> Boolean - normalized? : (%,List %) -> Boolean - pquo : (%,%) -> % - pquo : (%,%,V) -> % - prem : (%,%,V) -> % - prem : (%,%) -> % - primitivePart! : % -> % if R has GCDDOM - primPartElseUnitCanonical : % -> % if R has INTDOM - primPartElseUnitCanonical! : % -> % if R has INTDOM - pseudoDivide : (%,%) -> Record(quotient: %,remainder: %) - quasiMonic? : % -> Boolean - reduced? : (%,%) -> Boolean - reduced? : (%,List %) -> Boolean - reductum : (%,V) -> % - retract : Polynomial R -> % - if not has(R,Algebra Fraction Integer) - and not has(R,Algebra Integer) - and V has KONVERT SYMBOL - or not has(R,IntegerNumberSystem) - and not has(R,Algebra Fraction Integer) - and R has ALGEBRA INT - and V has KONVERT SYMBOL - or not has(R,QuotientFieldCategory Integer) - and R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - retract : Polynomial Integer -> % - if not has(R,Algebra Fraction Integer) - and R has ALGEBRA INT - and V has KONVERT SYMBOL - or R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - retract : Polynomial Fraction Integer -> % - if R has ALGEBRA FRAC INT and V has KONVERT SYMBOL - retractIfCan : Polynomial R -> Union(%,"failed") - if not has(R,Algebra Fraction Integer) - and not has(R,Algebra Integer) - and V has KONVERT SYMBOL - or not has(R,IntegerNumberSystem) - and not has(R,Algebra Fraction Integer) - and R has ALGEBRA INT - and V has KONVERT SYMBOL - or not has(R,QuotientFieldCategory Integer) - and R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - retractIfCan : Polynomial Fraction Integer -> Union(%,"failed") - if R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - retractIfCan : Polynomial Integer -> Union(%,"failed") - if not has(R,Algebra Fraction Integer) - and R has ALGEBRA INT - and V has KONVERT SYMBOL - or R has ALGEBRA FRAC INT - and V has KONVERT SYMBOL - RittWuCompare : (%,%) -> Union(Boolean,"failed") - supRittWu? : (%,%) -> Boolean - tail : % -> % + allRootsOf : Polynomial Integer -> List % + allRootsOf : Polynomial Fraction Integer -> List % + allRootsOf : Polynomial % -> List % + allRootsOf : SparseUnivariatePolynomial Integer -> List % + allRootsOf : SparseUnivariatePolynomial Fraction Integer -> List % + characteristic : () -> NonNegativeInteger + nthRoot : (%,Integer) -> % + rootOf : + (SparseUnivariatePolynomial %,PositiveInteger) -> + Union(%,"failed") + rootOf : + (SparseUnivariatePolynomial %,PositiveInteger,OutputForm) -> + Union(%,"failed") + sqrt : (%,NonNegativeInteger) -> % + sqrt : Integer -> % + sqrt : Fraction Integer -> % + sqrt : % -> % + ?**? : (%,Fraction Integer) -> % \end{verbatim} -These exports come from \refto{PolynomialCategory}(R,E,V)\hfill\\ -where R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet: +These exports come from \refto{CharacteristicZero}(): \begin{verbatim} - 0 : () -> % - 1 : () -> % - associates? : (%,%) -> Boolean - if R has INTDOM - binomThmExpt : (%,%,NonNegativeInteger) -> % - if R has COMRING - characteristic : () -> NonNegativeInteger - charthRoot : % -> Union(%,"failed") - if and(has($,CharacteristicNonZero), - has(R,PolynomialFactorizationExplicit)) - or R has CHARNZ - coefficient : (%,List V,List NonNegativeInteger) -> % - coefficient : (%,V,NonNegativeInteger) -> % - coefficient : (%,E) -> R - coefficients : % -> List R - coerce : R -> % + 0 : () -> % + 1 : () -> % + coerce : Integer -> % + coerce : % -> OutputForm + hash : % -> SingleInteger + latex : % -> String + one? : % -> Boolean + recip : % -> Union(%,"failed") + sample : () -> % + subtractIfCan : (%,%) -> Union(%,"failed") + zero? : % -> Boolean + ?~=? : (%,%) -> Boolean + ?^? : (%,NonNegativeInteger) -> % + ?^? : (%,PositiveInteger) -> % + ?*? : (%,%) -> % + ?*? : (NonNegativeInteger,%) -> % + ?*? : (Integer,%) -> % + ?*? : (PositiveInteger,%) -> % + ?**? : (%,PositiveInteger) -> % + ?**? : (%,NonNegativeInteger) -> % + ?+? : (%,%) -> % + ?-? : (%,%) -> % + -? : % -> % + ?=? : (%,%) -> Boolean +\end{verbatim} + +These exports come from \refto{OrderedRing}(): +\begin{verbatim} + abs : % -> % + coerce : Integer -> % + max : (%,%) -> % + min : (%,%) -> % + negative? : % -> Boolean + positive? : % -> Boolean + sign : % -> Integer + ? Boolean + ?<=? : (%,%) -> Boolean + ?>? : (%,%) -> Boolean + ?>=? : (%,%) -> Boolean + ?*? : (Integer,%) -> % +\end{verbatim} + +These exports come from \refto{Field}(): +\begin{verbatim} + associates? : (%,%) -> Boolean + coerce : % -> % coerce : Fraction Integer -> % - if R has RETRACT FRAC INT or R has ALGEBRA FRAC INT - coerce : V -> % - coerce : % -> % if R has INTDOM - coerce : Integer -> % - conditionP : Matrix % -> Union(Vector %,"failed") - if and(has($,CharacteristicNonZero), - has(R,PolynomialFactorizationExplicit)) - content : % -> R if R has GCDDOM - content : (%,V) -> % if R has GCDDOM - convert : % -> Pattern Integer - if V has KONVERT PATTERN INT and R has KONVERT PATTERN INT - convert : % -> Pattern Float - if V has KONVERT PATTERN FLOAT and R has KONVERT PATTERN FLOAT - convert : % -> InputForm - if V has KONVERT INFORM and R has KONVERT INFORM - D : (%,List V) -> % - D : (%,V) -> % - D : (%,List V,List NonNegativeInteger) -> % - D : (%,V,NonNegativeInteger) -> % - degree : % -> E - degree : (%,List V) -> List NonNegativeInteger - degree : (%,V) -> NonNegativeInteger - differentiate : (%,List V,List NonNegativeInteger) -> % - differentiate : (%,V,NonNegativeInteger) -> % - differentiate : (%,List V) -> % - differentiate : (%,V) -> % - discriminant : (%,V) -> % if R has COMRING - eval : (%,List Equation %) -> % - eval : (%,Equation %) -> % - eval : (%,List %,List %) -> % - eval : (%,%,%) -> % - eval : (%,V,R) -> % - eval : (%,List V,List R) -> % - eval : (%,V,%) -> % - eval : (%,List V,List %) -> % - exquo : (%,R) -> Union(%,"failed") if R has INTDOM - exquo : (%,%) -> Union(%,"failed") if R has INTDOM - factor : % -> Factored % if R has PFECAT - factorPolynomial : - SparseUnivariatePolynomial % -> - Factored SparseUnivariatePolynomial % - if R has PFECAT - factorSquareFreePolynomial : - SparseUnivariatePolynomial % -> - Factored SparseUnivariatePolynomial % - if R has PFECAT - gcd : (%,%) -> % if R has GCDDOM - gcd : List % -> % if R has GCDDOM - gcdPolynomial : + coerce : Fraction Integer -> % + coerce : Fraction Integer -> % + divide : (%,%) -> Record(quotient: %,remainder: %) + euclideanSize : % -> NonNegativeInteger + expressIdealMember : (List %,%) -> Union(List %,"failed") + exquo : (%,%) -> Union(%,"failed") + extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) + extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") + factor : % -> Factored % + gcd : (%,%) -> % + gcd : List % -> % + gcdPolynomial : (SparseUnivariatePolynomial %, - SparseUnivariatePolynomial %) -> - SparseUnivariatePolynomial % - if R has GCDDOM - ground : % -> R - ground? : % -> Boolean - hash : % -> SingleInteger - isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed") - isPlus : % -> Union(List %,"failed") - isTimes : % -> Union(List %,"failed") - latex : % -> String - lcm : (%,%) -> % if R has GCDDOM - lcm : List % -> % if R has GCDDOM - leadingCoefficient : % -> R - leadingMonomial : % -> % - mainVariable : % -> Union(V,"failed") - map : ((R -> R),%) -> % - mapExponents : ((E -> E),%) -> % - max : (%,%) -> % if R has ORDSET - min : (%,%) -> % if R has ORDSET - minimumDegree : % -> E - minimumDegree : (%,List V) -> List NonNegativeInteger - minimumDegree : (%,V) -> NonNegativeInteger - monicDivide : (%,%,V) -> Record(quotient: %,remainder: %) - monomial : (%,V,NonNegativeInteger) -> % - monomial : (%,List V,List NonNegativeInteger) -> % - monomial : (R,E) -> % - monomial? : % -> Boolean - monomials : % -> List % - multivariate : (SparseUnivariatePolynomial %,V) -> % - multivariate : (SparseUnivariatePolynomial R,V) -> % - numberOfMonomials : % -> NonNegativeInteger - one? : % -> Boolean - patternMatch : - (%,Pattern Integer,PatternMatchResult(Integer,%)) -> - PatternMatchResult(Integer,%) - if V has PATMAB INT and R has PATMAB INT - patternMatch : - (%,Pattern Float,PatternMatchResult(Float,%)) -> - PatternMatchResult(Float,%) - if V has PATMAB FLOAT and R has PATMAB FLOAT - pomopo! : (%,R,E,%) -> % - prime? : % -> Boolean if R has PFECAT - primitiveMonomials : % -> List % - primitivePart : (%,V) -> % if R has GCDDOM - primitivePart : % -> % if R has GCDDOM - recip : % -> Union(%,"failed") - reducedSystem : Matrix % -> Matrix R - reducedSystem : (Matrix %,Vector %) -> - Record(mat: Matrix R,vec: Vector R) - reducedSystem : (Matrix %,Vector %) -> - Record(mat: Matrix Integer,vec: Vector Integer) - if R has LINEXP INT - reducedSystem : Matrix % -> Matrix Integer - if R has LINEXP INT - reductum : % -> % - resultant : (%,%,V) -> % if R has COMRING - retract : % -> R - retract : % -> Integer if R has RETRACT INT - retract : % -> Fraction Integer - if R has RETRACT FRAC INT - retract : % -> V - retractIfCan : % -> Union(R,"failed") - retractIfCan : % -> Union(Integer,"failed") - if R has RETRACT INT - retractIfCan : % -> Union(Fraction Integer,"failed") - if R has RETRACT FRAC INT - retractIfCan : % -> Union(V,"failed") - sample : () -> % - solveLinearPolynomialEquation : - (List SparseUnivariatePolynomial %, - SparseUnivariatePolynomial %) -> - Union(List SparseUnivariatePolynomial %,"failed") - if R has PFECAT - squareFree : % -> Factored % if R has GCDDOM - squareFreePart : % -> % if R has GCDDOM - squareFreePolynomial : - SparseUnivariatePolynomial % -> - Factored SparseUnivariatePolynomial % - if R has PFECAT - subtractIfCan : (%,%) -> Union(%,"failed") - totalDegree : (%,List V) -> NonNegativeInteger - totalDegree : % -> NonNegativeInteger - unit? : % -> Boolean if R has INTDOM - unitCanonical : % -> % if R has INTDOM + SparseUnivariatePolynomial %) -> + SparseUnivariatePolynomial % + inv : % -> % + lcm : (%,%) -> % + lcm : List % -> % + multiEuclidean : (List %,%) -> Union(List %,"failed") + prime? : % -> Boolean + principalIdeal : List % -> Record(coef: List %,generator: %) + sizeLess? : (%,%) -> Boolean + squareFree : % -> Factored % + squareFreePart : % -> % + unit? : % -> Boolean + unitCanonical : % -> % unitNormal : % -> Record(unit: %,canonical: %,associate: %) - if R has INTDOM - univariate : % -> SparseUnivariatePolynomial R - univariate : (%,V) -> SparseUnivariatePolynomial % - variables : % -> List V - zero? : % -> Boolean - ?+? : (%,%) -> % - ?=? : (%,%) -> Boolean - ?~=? : (%,%) -> Boolean - ?*? : (%,R) -> % - ?*? : (R,%) -> % - ?*? : (Fraction Integer,%) -> % if R has ALGEBRA FRAC INT - ?*? : (%,Fraction Integer) -> % if R has ALGEBRA FRAC INT - ?*? : (%,%) -> % - ?*? : (Integer,%) -> % - ?*? : (PositiveInteger,%) -> % - ?*? : (NonNegativeInteger,%) -> % - ?/? : (%,R) -> % if R has FIELD - ?-? : (%,%) -> % - -? : % -> % - ?**? : (%,PositiveInteger) -> % - ?**? : (%,NonNegativeInteger) -> % - ?^? : (%,NonNegativeInteger) -> % - ?^? : (%,PositiveInteger) -> % - ? Boolean if R has ORDSET - ?<=? : (%,%) -> Boolean if R has ORDSET - ?>? : (%,%) -> Boolean if R has ORDSET - ?>=? : (%,%) -> Boolean if R has ORDSET + ?/? : (%,%) -> % + ?*? : (Fraction Integer,%) -> % + ?*? : (Fraction Integer,%) -> % + ?*? : (%,Fraction Integer) -> % + ?*? : (%,Fraction Integer) -> % + ?**? : (%,Integer) -> % + ?^? : (%,Integer) -> % + ?quo? : (%,%) -> % + ?rem? : (%,%) -> % +\end{verbatim} + +These exports come from \refto{FullyRetractableTo}(Fraction(Integer)): +\begin{verbatim} + retract : % -> Fraction Integer + retract : % -> Fraction Integer + if Fraction Integer has RETRACT FRAC INT + retract : % -> Integer if Fraction Integer has RETRACT INT + retractIfCan : % -> Union(Fraction Integer,"failed") + retractIfCan : % -> Union(Fraction Integer,"failed") + if Fraction Integer has RETRACT FRAC INT + retractIfCan : % -> Union(Integer,"failed") + if Fraction Integer has RETRACT INT +\end{verbatim} + +These exports come from \refto{Algebra}(Integer): +\begin{verbatim} + ?*? : (%,Integer) -> % \end{verbatim} -\begin{chunk}{category RPOLCAT RecursivePolynomialCategory} -)abbrev category RPOLCAT RecursivePolynomialCategory -++ Author: Marc Moreno Maza -++ Date Created: 04/22/1994 -++ Date Last Updated: 14/12/1998 -++ Description: +\begin{chunk}{category RCFIELD RealClosedField} +)abbrev category RCFIELD RealClosedField +++ Author: Renaud Rioboo +++ Date Created: may 1993 +++ Date Last Updated: January 2004 +++ Description: +++ \axiomType{RealClosedField} provides common access +++ functions for all real closed fields. +++ provides computations with generic real roots of polynomials + +RealClosedField : Category == PUB where + + E ==> OutputForm + SUP ==> SparseUnivariatePolynomial + OFIELD ==> Join(OrderedRing,Field) + PME ==> SUP($) + N ==> NonNegativeInteger + PI ==> PositiveInteger + RN ==> Fraction(Integer) + Z ==> Integer + POLY ==> Polynomial + PACK ==> SparseUnivariatePolynomialFunctions2 + + PUB == Join(CharacteristicZero, + OrderedRing, + CommutativeRing, + Field, + FullyRetractableTo(Fraction(Integer)), + Algebra Integer, + Algebra(Fraction(Integer)), + RadicalCategory) with + + mainForm : $ -> Union(E,"failed") + ++ \axiom{mainForm(x)} is the main algebraic quantity name of + ++ \axiom{x} + + mainDefiningPolynomial : $ -> Union(PME,"failed") + ++ \axiom{mainDefiningPolynomial(x)} is the defining + ++ polynomial for the main algebraic quantity of \axiom{x} + + mainValue : $ -> Union(PME,"failed") + ++ \axiom{mainValue(x)} is the expression of \axiom{x} in terms + ++ of \axiom{SparseUnivariatePolynomial($)} + + rootOf: (PME,PI,E) -> Union($,"failed") + ++ \axiom{rootOf(pol,n,name)} creates the nth root for the order + ++ of \axiom{pol} and names it \axiom{name} + + rootOf: (PME,PI) -> Union($,"failed") + ++ \axiom{rootOf(pol,n)} creates the nth root for the order + ++ of \axiom{pol} and gives it unique name + + allRootsOf: PME -> List $ + ++ \axiom{allRootsOf(pol)} creates all the roots + ++ of \axiom{pol} naming each uniquely + + allRootsOf: (SUP(RN)) -> List $ + ++ \axiom{allRootsOf(pol)} creates all the roots + ++ of \axiom{pol} naming each uniquely + + allRootsOf: (SUP(Z)) -> List $ + ++ \axiom{allRootsOf(pol)} creates all the roots + ++ of \axiom{pol} naming each uniquely + + allRootsOf: (POLY($)) -> List $ + ++ \axiom{allRootsOf(pol)} creates all the roots + ++ of \axiom{pol} naming each uniquely + + allRootsOf: (POLY(RN)) -> List $ + ++ \axiom{allRootsOf(pol)} creates all the roots + ++ of \axiom{pol} naming each uniquely + + allRootsOf: (POLY(Z)) -> List $ + ++ \axiom{allRootsOf(pol)} creates all the roots + ++ of \axiom{pol} naming each uniquely + + sqrt: ($,N) -> $ + ++ \axiom{sqrt(x,n)} is \axiom{x ** (1/n)} + + sqrt: $ -> $ + ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)} + + sqrt: RN -> $ + ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)} + + sqrt: Z -> $ + ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)} + + rename! : ($,E) -> $ + ++ \axiom{rename!(x,name)} changes the way \axiom{x} is printed + + rename : ($,E) -> $ + ++ \axiom{rename(x,name)} gives a new number that prints as name + + approximate: ($,$) -> RN + ++ \axiom{approximate(n,p)} gives an approximation of \axiom{n} + ++ that has precision \axiom{p} + + add + + sqrt(a:$):$ == sqrt(a,2) + + sqrt(a:RN):$ == sqrt(a::$,2) + + sqrt(a:Z):$ == sqrt(a::$,2) + + characteristic() == 0 + + rootOf(pol,n,o) == + r := rootOf(pol,n) + r case "failed" => "failed" + rename!(r,o) + + rootOf(pol,n) == + liste:List($):= allRootsOf(pol) + # liste > n => "failed" + liste.n + + + sqrt(x,n) == + n = 0 => 1 + n = 1 => x + zero?(x) => 0 + one?(x) => 1 + if odd?(n) + then + r := rootOf(monomial(1,n) - (x :: PME), 1) + else + r := rootOf(monomial(1,n) - (x :: PME), 2) + r case "failed" => error "no roots" + n = 2 => rename(r,root(x::E)$E) + rename(r,root(x :: E, n :: E)$E) + + (x : $) ** (rn : RN) == sqrt(x**numer(rn),denom(rn)::N) + + nthRoot(x, n) == + zero?(n) => x + negative?(n) => inv(sqrt(x,(-n) :: N)) + sqrt(x,n :: N) + + allRootsOf(p:SUP(RN)) == allRootsOf(map(z +-> z::$ ,p)$PACK(RN,$)) + + allRootsOf(p:SUP(Z)) == allRootsOf(map(z +-> z::$ ,p)$PACK(Z,$)) + + allRootsOf(p:POLY($)) == allRootsOf(univariate(p)) + + allRootsOf(p:POLY(RN)) == allRootsOf(univariate(p)) + + allRootsOf(p:POLY(Z)) == allRootsOf(univariate(p)) + +\end{chunk} + +\begin{chunk}{COQ RCFIELD} +(* category RCFIELD *) +(* + + sqrt : % -> % + sqrt(a:$):$ == sqrt(a,2) + + sqrt : Fraction(Integer) -> % + sqrt(a:RN):$ == sqrt(a::$,2) + + sqrt : Integer -> % + sqrt(a:Z):$ == sqrt(a::$,2) + + characteristic : () -> NonNegativeInteger + characteristic() == 0 + + rootOf : (SparseUnivariatePolynomial(%),PositiveInteger,OutputForm) -> + Union(%,"failed") + rootOf(pol,n,o) == + r := rootOf(pol,n) + r case "failed" => "failed" + rename!(r,o) + + rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) -> + Union(%,"failed") + rootOf(pol,n) == + liste:List($):= allRootsOf(pol) + # liste > n => "failed" + liste.n + + sqrt : Fraction(Integer) -> % + sqrt(x,n) == + n = 0 => 1 + n = 1 => x + zero?(x) => 0 + one?(x) => 1 + if odd?(n) + then + r := rootOf(monomial(1,n) - (x :: PME), 1) + else + r := rootOf(monomial(1,n) - (x :: PME), 2) + r case "failed" => error "no roots" + n = 2 => rename(r,root(x::E)$E) + rename(r,root(x :: E, n :: E)$E) + + ?**? : (%,Fraction(Integer)) -> % + (x : $) ** (rn : RN) == sqrt(x**numer(rn),denom(rn)::N) + + nthRoot : (%,Integer) -> % + nthRoot(x, n) == + zero?(n) => x + negative?(n) => inv(sqrt(x,(-n) :: N)) + sqrt(x,n :: N) + + allRootsOf : SparseUnivariatePolynomial(Fraction(Integer)) -> List(%) + allRootsOf(p:SUP(RN)) == allRootsOf(map(z +-> z::$ ,p)$PACK(RN,$)) + + allRootsOf : SparseUnivariatePolynomial(Integer) -> List(%) + allRootsOf(p:SUP(Z)) == allRootsOf(map(z +-> z::$ ,p)$PACK(Z,$)) + + allRootsOf : Polynomial(%) -> List(%) + allRootsOf(p:POLY($)) == allRootsOf(univariate(p)) + + allRootsOf : Polynomial(Fraction(Integer)) -> List(%) + allRootsOf(p:POLY(RN)) == allRootsOf(univariate(p)) + + allRootsOf : Polynomial(Integer) -> List(%) + allRootsOf(p:POLY(Z)) == allRootsOf(univariate(p)) +*) + +\end{chunk} + +\begin{chunk}{RCFIELD.dotabb} +"RCFIELD" + [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"]; +"RCFIELD" -> "ALGEBRA" +"RCFIELD" -> "CHARZ" +"RCFIELD" -> "COMRING" +"RCFIELD" -> "FIELD" +"RCFIELD" -> "FRETRCT" +"RCFIELD" -> "ORDRING" +"RCFIELD" -> "RADCAT" + +\end{chunk} +\begin{chunk}{RCFIELD.dotfull} +"RealClosedField()" + [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"]; +"RealClosedField()" -> "Algebra(Integer)" +"RealClosedField()" -> "Algebra(Fraction(Integer))" +"RealClosedField()" -> "CharacteristicZero()" +"RealClosedField()" -> "CommutativeRing()" +"RealClosedField()" -> "Field()" +"RealClosedField()" -> "FullyRetractableTo(Fraction(Integer))" +"RealClosedField()" -> "OrderedRing()" +"RealClosedField()" -> "RadicalCategory()" + +\end{chunk} +\begin{chunk}{RCFIELD.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; + +"RealClosedField()" [color=lightblue]; +"RealClosedField()" -> "ALGEBRA..." +"RealClosedField()" -> "CHARZ..." +"RealClosedField()" -> "COMRING..." +"RealClosedField()" -> "FIELD..." +"RealClosedField()" -> "FRETRCT..." +"RealClosedField()" -> "ORDRING..." +"RealClosedField()" -> "RADCAT..." + +"ALGEBRA..." [color=lightblue]; +"CHARZ..." [color=lightblue]; +"COMRING..." [color=lightblue]; +"FIELD..." [color=lightblue]; +"FRETRCT..." [color=lightblue]; +"ORDRING..." [color=lightblue]; +"RADCAT..." [color=lightblue]; + +} + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\pagehead{RealNumberSystem}{RNS} +\pagepic{ps/v102realnumbersystem.ps}{RNS}{0.50} + +\begin{chunk}{RealNumberSystem.input} +)set break resume +)sys rm -f RealNumberSystem.output +)spool RealNumberSystem.output +)set message test on +)set message auto off +)clear all + +--S 1 of 1 +)show RealNumberSystem +--R +--R RealNumberSystem is a category constructor +--R Abbreviation for RealNumberSystem is RNS +--R This constructor is exposed in this frame. +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for RNS +--R +--R------------------------------- Operations -------------------------------- +--R ?*? : (Fraction(Integer),%) -> % ?*? : (%,Fraction(Integer)) -> % +--R ?*? : (%,%) -> % ?*? : (Integer,%) -> % +--R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % +--R ?**? : (%,Fraction(Integer)) -> % ?**? : (%,Integer) -> % +--R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % +--R ?+? : (%,%) -> % ?-? : (%,%) -> % +--R -? : % -> % ?/? : (%,%) -> % +--R ? Boolean ?<=? : (%,%) -> Boolean +--R ?=? : (%,%) -> Boolean ?>? : (%,%) -> Boolean +--R ?>=? : (%,%) -> Boolean 1 : () -> % +--R 0 : () -> % ?^? : (%,Integer) -> % +--R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % +--R abs : % -> % associates? : (%,%) -> Boolean +--R ceiling : % -> % coerce : Fraction(Integer) -> % +--R coerce : Integer -> % coerce : Fraction(Integer) -> % +--R coerce : % -> % coerce : Integer -> % +--R coerce : % -> OutputForm convert : % -> Pattern(Float) +--R convert : % -> DoubleFloat convert : % -> Float +--R factor : % -> Factored(%) floor : % -> % +--R fractionPart : % -> % gcd : List(%) -> % +--R gcd : (%,%) -> % hash : % -> SingleInteger +--R inv : % -> % latex : % -> String +--R lcm : List(%) -> % lcm : (%,%) -> % +--R max : (%,%) -> % min : (%,%) -> % +--R negative? : % -> Boolean norm : % -> % +--R nthRoot : (%,Integer) -> % one? : % -> Boolean +--R positive? : % -> Boolean prime? : % -> Boolean +--R ?quo? : (%,%) -> % recip : % -> Union(%,"failed") +--R ?rem? : (%,%) -> % retract : % -> Fraction(Integer) +--R retract : % -> Integer round : % -> % +--R sample : () -> % sign : % -> Integer +--R sizeLess? : (%,%) -> Boolean sqrt : % -> % +--R squareFree : % -> Factored(%) squareFreePart : % -> % +--R truncate : % -> % unit? : % -> Boolean +--R unitCanonical : % -> % wholePart : % -> Integer +--R zero? : % -> Boolean ?~=? : (%,%) -> Boolean +--R characteristic : () -> NonNegativeInteger +--R divide : (%,%) -> Record(quotient: %,remainder: %) +--R euclideanSize : % -> NonNegativeInteger +--R expressIdealMember : (List(%),%) -> Union(List(%),"failed") +--R exquo : (%,%) -> Union(%,"failed") +--R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") +--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) +--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) +--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) +--R multiEuclidean : (List(%),%) -> Union(List(%),"failed") +--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) +--R principalIdeal : List(%) -> Record(coef: List(%),generator: %) +--R retractIfCan : % -> Union(Fraction(Integer),"failed") +--R retractIfCan : % -> Union(Integer,"failed") +--R subtractIfCan : (%,%) -> Union(%,"failed") +--R unitNormal : % -> Record(unit: %,canonical: %,associate: %) +--R +--E 1 + +)spool +)lisp (bye) +\end{chunk} + +\begin{chunk}{RealNumberSystem.help} +==================================================================== +RealNumberSystem examples +==================================================================== + +The real number system category is intended as a model for the real +numbers. The real numbers form an ordered normed field. Note that +we have purposely not included DifferentialRing or the elementary +functions (see TranscendentalFunctionCategory) in the definition. + +See Also: +o )show RealNumberSystem +o )show TranscendentalFunctionCategory + +\end{chunk} +{\bf See:} + +\pageto{FloatingPointSystem}{FPS} +\pagefrom{CharacteristicZero}{CHARZ} +\pagefrom{ConvertibleTo}{KONVERT} +\pagefrom{Field}{FIELD} +\pagefrom{OrderedRing}{ORDRING} +\pagefrom{PatternMatchable}{PATMAB} +\pagefrom{RadicalCategory}{RADCAT} +\pagefrom{RealConstant}{REAL} +\pagefrom{RetractableTo}{RETRACT} + +{\bf Exports:}\\ + +\begin{tabular}{llll} +\cross{RNS}{0} & +\cross{RNS}{1} & +\cross{RNS}{abs} & +\cross{RNS}{associates?} \\ +\cross{RNS}{ceiling} & +\cross{RNS}{characteristic} & +\cross{RNS}{coerce} & +\cross{RNS}{convert} \\ +\cross{RNS}{divide} & +\cross{RNS}{euclideanSize} & +\cross{RNS}{expressIdealMember} & +\cross{RNS}{exquo} \\ +\cross{RNS}{extendedEuclidean} & +\cross{RNS}{factor} & +\cross{RNS}{floor} & +\cross{RNS}{fractionPart} \\ +\cross{RNS}{gcd} & +\cross{RNS}{gcdPolynomial} & +\cross{RNS}{hash} & +\cross{RNS}{inv} \\ +\cross{RNS}{latex} & +\cross{RNS}{lcm} & +\cross{RNS}{max} & +\cross{RNS}{min} \\ +\cross{RNS}{multiEuclidean} & +\cross{RNS}{negative?} & +\cross{RNS}{norm} & +\cross{RNS}{nthRoot} \\ +\cross{RNS}{one?} & +\cross{RNS}{patternMatch} & +\cross{RNS}{positive?} & +\cross{RNS}{prime?} \\ +\cross{RNS}{principalIdeal} & +\cross{RNS}{recip} & +\cross{RNS}{retract} & +\cross{RNS}{retractIfCan} \\ +\cross{RNS}{round} & +\cross{RNS}{sample} & +\cross{RNS}{sign} & +\cross{RNS}{sizeLess?} \\ +\cross{RNS}{sqrt} & +\cross{RNS}{squareFree} & +\cross{RNS}{squareFreePart} & +\cross{RNS}{subtractIfCan} \\ +\cross{RNS}{truncate} & +\cross{RNS}{unit?} & +\cross{RNS}{unitCanonical} & +\cross{RNS}{unitNormal} \\ +\cross{RNS}{wholePart} & +\cross{RNS}{zero?} & +\cross{RNS}{?*?} & +\cross{RNS}{?**?} \\ +\cross{RNS}{?+?} & +\cross{RNS}{?-?} & +\cross{RNS}{-?} & +\cross{RNS}{?/?} \\ +\cross{RNS}{?$<$?} & +\cross{RNS}{?$<=$?} & +\cross{RNS}{?=?} & +\cross{RNS}{?$>$?} \\ +\cross{RNS}{?$>=$?} & +\cross{RNS}{?\^{}?} & +\cross{RNS}{?quo?} & +\cross{RNS}{?rem?} \\ +\cross{RNS}{?\~{}=?} && +\end{tabular} + +These are directly exported but not implemented: +\begin{verbatim} + abs : % -> % + wholePart : % -> Integer +\end{verbatim} + +These are implemented by this category: +\begin{verbatim} + characteristic : () -> NonNegativeInteger + ceiling : % -> % + coerce : Fraction Integer -> % + convert : % -> Pattern Float + floor : % -> % + fractionPart : % -> % + norm : % -> % + patternMatch : + (%,Pattern Float,PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + round : % -> % + truncate : % -> % +\end{verbatim} + +These exports come from \refto{Field}(): +\begin{verbatim} + 0 : () -> % + 1 : () -> % + associates? : (%,%) -> Boolean + coerce : % -> % + coerce : Integer -> % + coerce : Integer -> % + coerce : Fraction Integer -> % + coerce : % -> OutputForm + divide : (%,%) -> Record(quotient: %,remainder: %) + euclideanSize : % -> NonNegativeInteger + expressIdealMember : (List %,%) -> Union(List %,"failed") + extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") + extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) + exquo : (%,%) -> Union(%,"failed") + factor : % -> Factored % + gcd : List % -> % + gcd : (%,%) -> % + gcdPolynomial : + (SparseUnivariatePolynomial %, + SparseUnivariatePolynomial %) -> + SparseUnivariatePolynomial % + hash : % -> SingleInteger + inv : % -> % + latex : % -> String + lcm : List % -> % + lcm : (%,%) -> % + multiEuclidean : (List %,%) -> Union(List %,"failed") + one? : % -> Boolean + prime? : % -> Boolean + principalIdeal : List % -> Record(coef: List %,generator: %) + recip : % -> Union(%,"failed") + sample : () -> % + sizeLess? : (%,%) -> Boolean + squareFree : % -> Factored % + squareFreePart : % -> % + subtractIfCan : (%,%) -> Union(%,"failed") + unit? : % -> Boolean + unitCanonical : % -> % + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + zero? : % -> Boolean + ?+? : (%,%) -> % + ?=? : (%,%) -> Boolean + ?~=? : (%,%) -> Boolean + ?*? : (Fraction Integer,%) -> % + ?*? : (%,Fraction Integer) -> % + ?**? : (%,Fraction Integer) -> % + ?^? : (%,Integer) -> % + ?*? : (%,%) -> % + ?*? : (Integer,%) -> % + ?*? : (PositiveInteger,%) -> % + ?*? : (NonNegativeInteger,%) -> % + ?-? : (%,%) -> % + -? : % -> % + ?**? : (%,PositiveInteger) -> % + ?**? : (%,NonNegativeInteger) -> % + ?^? : (%,NonNegativeInteger) -> % + ?^? : (%,PositiveInteger) -> % + ?/? : (%,%) -> % + ?quo? : (%,%) -> % + ?rem? : (%,%) -> % +\end{verbatim} + +These exports come from \refto{OrderedRing}(): +\begin{verbatim} + negative? : % -> Boolean + positive? : % -> Boolean + sign : % -> Integer + max : (%,%) -> % + min : (%,%) -> % + ? Boolean + ?<=? : (%,%) -> Boolean + ?>? : (%,%) -> Boolean + ?>=? : (%,%) -> Boolean +\end{verbatim} + +These exports come from \refto{RealConstant}(): +\begin{verbatim} + convert : % -> DoubleFloat + convert : % -> Float +\end{verbatim} + +These exports come from \refto{RetractableTo}(Integer): +\begin{verbatim} + retract : % -> Integer + retractIfCan : % -> Union(Integer,"failed") +\end{verbatim} + +These exports come from \refto{RetractableTo}(Fraction(Integer)): +\begin{verbatim} + retract : % -> Fraction Integer + retractIfCan : % -> Union(Fraction Integer,"failed") +\end{verbatim} + +These exports come from \refto{RadicalCategory}(): +\begin{verbatim} + nthRoot : (%,Integer) -> % + sqrt : % -> % +\end{verbatim} + +These exports come from \refto{ConvertibleTo}(Pattern(Float)): +\begin{verbatim} +\end{verbatim} + +These exports come from \refto{PatternMatchable}(Float): +\begin{verbatim} +\end{verbatim} + +These exports come from \refto{CharacteristicZero}(): +\begin{verbatim} +\end{verbatim} + +\begin{chunk}{category RNS RealNumberSystem} +)abbrev category RNS RealNumberSystem +++ Author: Michael Monagan and Stephen M. Watt +++ Date Created: January 1988 +++ Description: +++ The real number system category is intended as a model for the real +++ numbers. The real numbers form an ordered normed field. Note that +++ we have purposely not included \spadtype{DifferentialRing} or +++ the elementary functions (see \spadtype{TranscendentalFunctionCategory}) +++ in the definition. + +RealNumberSystem(): Category == + Join(Field, OrderedRing, RealConstant, RetractableTo Integer, + RetractableTo Fraction Integer, RadicalCategory, + ConvertibleTo Pattern Float, PatternMatchable Float, + CharacteristicZero) with + norm : % -> % + ++ norm x returns the same as absolute value. + ceiling : % -> % + ++ ceiling x returns the small integer \spad{>= x}. + floor: % -> % + ++ floor x returns the largest integer \spad{<= x}. + wholePart : % -> Integer + ++ wholePart x returns the integer part of x. + fractionPart : % -> % + ++ fractionPart x returns the fractional part of x. + truncate: % -> % + ++ truncate x returns the integer between x and 0 closest to x. + round: % -> % + ++ round x computes the integer closest to x. + abs : % -> % + ++ abs x returns the absolute value of x. + add + characteristic() == 0 + + fractionPart x == x - truncate x + + truncate x == (negative? x => -floor(-x); floor x) + + round x == (negative? x => truncate(x-1/2::%); truncate(x+1/2::%)) + + norm x == abs x + + coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::% + + convert(x:%):Pattern(Float) == convert(x)@Float :: Pattern(Float) + + floor x == + x1 := (wholePart x) :: % + x = x1 => x + x < 0 => (x1 - 1) + x1 + + ceiling x == + x1 := (wholePart x)::% + x = x1 => x + x >= 0 => (x1 + 1) + x1 + + patternMatch(x, p, l) == + generic? p => addMatch(p, x, l) + constant? p => + (r := retractIfCan(p)@Union(Float, "failed")) case Float => + convert(x)@Float = r::Float => l + failed() + failed() + failed() + +\end{chunk} + +\begin{chunk}{COQ RNS} +(* category RNS *) +(* + + characteristic : () -> NonNegativeInteger + characteristic() == 0 + + fractionPart : % -> % + fractionPart x == x - truncate x + + truncate : % -> % + truncate x == (negative? x => -floor(-x); floor x) + + round : % -> % + round x == (negative? x => truncate(x-1/2::%); truncate(x+1/2::%)) + + norm : % -> % + norm x == abs x + + coerce : Fraction(Integer) -> % + coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::% + + convert : % -> Pattern(Float) + convert(x:%):Pattern(Float) == convert(x)@Float :: Pattern(Float) + + floor : % -> % + floor x == + x1 := (wholePart x) :: % + x = x1 => x + x < 0 => (x1 - 1) + x1 + + ceiling : % -> % + ceiling x == + x1 := (wholePart x)::% + x = x1 => x + x >= 0 => (x1 + 1) + x1 + + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + patternMatch(x, p, l) == + generic? p => addMatch(p, x, l) + constant? p => + (r := retractIfCan(p)@Union(Float, "failed")) case Float => + convert(x)@Float = r::Float => l + failed() + failed() + failed() +*) + +\end{chunk} + +\begin{chunk}{RNS.dotabb} +"RNS" + [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"]; +"RNS" -> "FIELD" +"RNS" -> "ORDRING" +"RNS" -> "REAL" +"RNS" -> "RETRACT" +"RNS" -> "RADCAT" +"RNS" -> "KONVERT" +"RNS" -> "PATMAB" +"RNS" -> "CHARZ" + +\end{chunk} +\begin{chunk}{RNS.dotfull} +"RealNumberSystem()" + [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"]; +"RealNumberSystem()" -> "Field()" +"RealNumberSystem()" -> "OrderedRing()" +"RealNumberSystem()" -> "RealConstant()" +"RealNumberSystem()" -> "RetractableTo(Integer)" +"RealNumberSystem()" -> "RetractableTo(Fraction(Integer))" +"RealNumberSystem()" -> "RadicalCategory()" +"RealNumberSystem()" -> "ConvertibleTo(Pattern(Float))" +"RealNumberSystem()" -> "PatternMatchable(Float)" +"RealNumberSystem()" -> "CharacteristicZero()" + +\end{chunk} +\begin{chunk}{RNS.dotpic} +digraph pic { + fontsize=10; + bgcolor="#ECEA81"; + node [shape=box, color=white, style=filled]; + +"RealNumberSystem()" [color=lightblue]; +"RealNumberSystem()" -> "FIELD..." +"RealNumberSystem()" -> "ORDRING..." +"RealNumberSystem()" -> "REAL..." +"RealNumberSystem()" -> "RETRACT..." +"RealNumberSystem()" -> "RADCAT..." +"RealNumberSystem()" -> "KONVERT..." +"RealNumberSystem()" -> "PATMAB..." +"RealNumberSystem()" -> "CHARZ..." + +"FIELD..." [color=lightblue]; +"ORDRING..." [color=lightblue]; +"REAL..." [color=lightblue]; +"RETRACT..." [color=lightblue]; +"RADCAT..." [color=lightblue]; +"KONVERT..." [color=lightblue]; +"PATMAB..." [color=lightblue]; +"CHARZ..." [color=lightblue]; +} + +\end{chunk} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\pagehead{RecursivePolynomialCategory}{RPOLCAT} +\pagepic{ps/v102recursivepolynomialcategory.ps}{RPOLCAT}{0.30} + +\begin{chunk}{RecursivePolynomialCategory.input} +)set break resume +)sys rm -f RecursivePolynomialCategory.output +)spool RecursivePolynomialCategory.output +)set message test on +)set message auto off +)clear all + +--S 1 of 1 +)show RecursivePolynomialCategory +--R +--R RecursivePolynomialCategory(R: Ring,E: OrderedAbelianMonoidSup,V: OrderedSet) is a category constructor +--R Abbreviation for RecursivePolynomialCategory is RPOLCAT +--R This constructor is exposed in this frame. +--R Issue )edit bookvol10.2.pamphlet to see algebra source code for RPOLCAT +--R +--R------------------------------- Operations -------------------------------- +--R ?*? : (%,R) -> % ?*? : (R,%) -> % +--R ?*? : (%,%) -> % ?*? : (Integer,%) -> % +--R ?*? : (NonNegativeInteger,%) -> % ?*? : (PositiveInteger,%) -> % +--R ?**? : (%,NonNegativeInteger) -> % ?**? : (%,PositiveInteger) -> % +--R ?+? : (%,%) -> % ?-? : (%,%) -> % +--R -? : % -> % ?/? : (%,R) -> % if R has FIELD +--R ?=? : (%,%) -> Boolean D : (%,V,NonNegativeInteger) -> % +--R D : (%,List(V)) -> % D : (%,V) -> % +--R 1 : () -> % 0 : () -> % +--R ?^? : (%,NonNegativeInteger) -> % ?^? : (%,PositiveInteger) -> % +--R coefficient : (%,E) -> R coefficients : % -> List(R) +--R coerce : % -> % if R has INTDOM coerce : V -> % +--R coerce : R -> % coerce : Integer -> % +--R coerce : % -> OutputForm content : % -> R if R has GCDDOM +--R deepestInitial : % -> % deepestTail : % -> % +--R degree : % -> E differentiate : (%,List(V)) -> % +--R differentiate : (%,V) -> % eval : (%,List(V),List(%)) -> % +--R eval : (%,V,%) -> % eval : (%,List(V),List(R)) -> % +--R eval : (%,V,R) -> % eval : (%,List(%),List(%)) -> % +--R eval : (%,%,%) -> % eval : (%,Equation(%)) -> % +--R eval : (%,List(Equation(%))) -> % gcd : (%,%) -> % if R has GCDDOM +--R gcd : List(%) -> % if R has GCDDOM gcd : (R,%) -> R if R has GCDDOM +--R ground : % -> R ground? : % -> Boolean +--R hash : % -> SingleInteger head : % -> % +--R headReduce : (%,%) -> % headReduced? : (%,%) -> Boolean +--R infRittWu? : (%,%) -> Boolean init : % -> % +--R initiallyReduce : (%,%) -> % iteratedInitials : % -> List(%) +--R latex : % -> String lazyPquo : (%,%,V) -> % +--R lazyPquo : (%,%) -> % lazyPrem : (%,%,V) -> % +--R lazyPrem : (%,%) -> % lcm : (%,%) -> % if R has GCDDOM +--R lcm : List(%) -> % if R has GCDDOM leadingCoefficient : (%,V) -> % +--R leadingCoefficient : % -> R leadingMonomial : % -> % +--R leastMonomial : % -> % mainCoefficients : % -> List(%) +--R mainMonomial : % -> % mainMonomials : % -> List(%) +--R map : ((R -> R),%) -> % mapExponents : ((E -> E),%) -> % +--R max : (%,%) -> % if R has ORDSET mdeg : % -> NonNegativeInteger +--R min : (%,%) -> % if R has ORDSET minimumDegree : % -> E +--R monic? : % -> Boolean monicModulo : (%,%) -> % +--R monomial : (R,E) -> % monomial? : % -> Boolean +--R monomials : % -> List(%) mvar : % -> V +--R normalized? : (%,%) -> Boolean one? : % -> Boolean +--R pomopo! : (%,R,E,%) -> % pquo : (%,%,V) -> % +--R pquo : (%,%) -> % prem : (%,%,V) -> % +--R prem : (%,%) -> % primitiveMonomials : % -> List(%) +--R quasiMonic? : % -> Boolean recip : % -> Union(%,"failed") +--R reduced? : (%,List(%)) -> Boolean reduced? : (%,%) -> Boolean +--R reductum : (%,V) -> % reductum : % -> % +--R retract : % -> V retract : % -> R +--R sample : () -> % supRittWu? : (%,%) -> Boolean +--R tail : % -> % variables : % -> List(V) +--R zero? : % -> Boolean ?~=? : (%,%) -> Boolean +--R ?*? : (Fraction(Integer),%) -> % if R has ALGEBRA(FRAC(INT)) +--R ?*? : (%,Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) +--R ? Boolean if R has ORDSET +--R ?<=? : (%,%) -> Boolean if R has ORDSET +--R ?>? : (%,%) -> Boolean if R has ORDSET +--R ?>=? : (%,%) -> Boolean if R has ORDSET +--R D : (%,List(V),List(NonNegativeInteger)) -> % +--R LazardQuotient : (%,%,NonNegativeInteger) -> % if R has INTDOM +--R LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % if R has INTDOM +--R RittWuCompare : (%,%) -> Union(Boolean,"failed") +--R associates? : (%,%) -> Boolean if R has INTDOM +--R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING +--R characteristic : () -> NonNegativeInteger +--R charthRoot : % -> Union(%,"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit)) or R has CHARNZ +--R coefficient : (%,List(V),List(NonNegativeInteger)) -> % +--R coefficient : (%,V,NonNegativeInteger) -> % +--R coerce : Fraction(Integer) -> % if R has RETRACT(FRAC(INT)) or R has ALGEBRA(FRAC(INT)) +--R coerce : % -> Polynomial(R) if V has KONVERT(SYMBOL) +--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit)) +--R content : (%,V) -> % if R has GCDDOM +--R convert : % -> Polynomial(R) if V has KONVERT(SYMBOL) +--R convert : % -> String if R has RETRACT(INT) and V has KONVERT(SYMBOL) +--R convert : Polynomial(R) -> % if V has KONVERT(SYMBOL) +--R convert : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R convert : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R convert : % -> InputForm if V has KONVERT(INFORM) and R has KONVERT(INFORM) +--R convert : % -> Pattern(Integer) if V has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT)) +--R convert : % -> Pattern(Float) if V has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT)) +--R degree : (%,List(V)) -> List(NonNegativeInteger) +--R degree : (%,V) -> NonNegativeInteger +--R differentiate : (%,List(V),List(NonNegativeInteger)) -> % +--R differentiate : (%,V,NonNegativeInteger) -> % +--R discriminant : (%,V) -> % if R has COMRING +--R exactQuotient : (%,%) -> % if R has INTDOM +--R exactQuotient : (%,R) -> % if R has INTDOM +--R exactQuotient! : (%,%) -> % if R has INTDOM +--R exactQuotient! : (%,R) -> % if R has INTDOM +--R exquo : (%,%) -> Union(%,"failed") if R has INTDOM +--R exquo : (%,R) -> Union(%,"failed") if R has INTDOM +--R extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) if R has INTDOM +--R factor : % -> Factored(%) if R has PFECAT +--R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT +--R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT +--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) if R has GCDDOM +--R halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) if R has INTDOM +--R halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) if R has INTDOM +--R headReduced? : (%,List(%)) -> Boolean +--R initiallyReduced? : (%,List(%)) -> Boolean +--R initiallyReduced? : (%,%) -> Boolean +--R isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed") +--R isPlus : % -> Union(List(%),"failed") +--R isTimes : % -> Union(List(%),"failed") +--R lastSubResultant : (%,%) -> % if R has INTDOM +--R lazyPremWithDefault : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,remainder: %) +--R lazyPremWithDefault : (%,%) -> Record(coef: %,gap: NonNegativeInteger,remainder: %) +--R lazyPseudoDivide : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) +--R lazyPseudoDivide : (%,%) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) +--R lazyResidueClass : (%,%) -> Record(polnum: %,polden: %,power: NonNegativeInteger) +--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM +--R mainContent : % -> % if R has GCDDOM +--R mainPrimitivePart : % -> % if R has GCDDOM +--R mainSquareFreePart : % -> % if R has GCDDOM +--R mainVariable : % -> Union(V,"failed") +--R minimumDegree : (%,List(V)) -> List(NonNegativeInteger) +--R minimumDegree : (%,V) -> NonNegativeInteger +--R monicDivide : (%,%,V) -> Record(quotient: %,remainder: %) +--R monomial : (%,List(V),List(NonNegativeInteger)) -> % +--R monomial : (%,V,NonNegativeInteger) -> % +--R multivariate : (SparseUnivariatePolynomial(%),V) -> % +--R multivariate : (SparseUnivariatePolynomial(R),V) -> % +--R nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM +--R normalized? : (%,List(%)) -> Boolean +--R numberOfMonomials : % -> NonNegativeInteger +--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if V has PATMAB(INT) and R has PATMAB(INT) +--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if V has PATMAB(FLOAT) and R has PATMAB(FLOAT) +--R primPartElseUnitCanonical : % -> % if R has INTDOM +--R primPartElseUnitCanonical! : % -> % if R has INTDOM +--R prime? : % -> Boolean if R has PFECAT +--R primitivePart : (%,V) -> % if R has GCDDOM +--R primitivePart : % -> % if R has GCDDOM +--R primitivePart! : % -> % if R has GCDDOM +--R pseudoDivide : (%,%) -> Record(quotient: %,remainder: %) +--R reducedSystem : Matrix(%) -> Matrix(R) +--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(R),vec: Vector(R)) +--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if R has LINEXP(INT) +--R reducedSystem : Matrix(%) -> Matrix(Integer) if R has LINEXP(INT) +--R resultant : (%,%) -> % if R has INTDOM +--R resultant : (%,%,V) -> % if R has COMRING +--R retract : Polynomial(R) -> % if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R retract : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R retract : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R retract : % -> Integer if R has RETRACT(INT) +--R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT)) +--R retractIfCan : Polynomial(R) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R retractIfCan : Polynomial(Integer) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R retractIfCan : Polynomial(Fraction(Integer)) -> Union(%,"failed") if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL) +--R retractIfCan : % -> Union(V,"failed") +--R retractIfCan : % -> Union(Integer,"failed") if R has RETRACT(INT) +--R retractIfCan : % -> Union(Fraction(Integer),"failed") if R has RETRACT(FRAC(INT)) +--R retractIfCan : % -> Union(R,"failed") +--R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT +--R squareFree : % -> Factored(%) if R has GCDDOM +--R squareFreePart : % -> % if R has GCDDOM +--R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT +--R subResultantChain : (%,%) -> List(%) if R has INTDOM +--R subResultantGcd : (%,%) -> % if R has INTDOM +--R subtractIfCan : (%,%) -> Union(%,"failed") +--R totalDegree : (%,List(V)) -> NonNegativeInteger +--R totalDegree : % -> NonNegativeInteger +--R unit? : % -> Boolean if R has INTDOM +--R unitCanonical : % -> % if R has INTDOM +--R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if R has INTDOM +--R univariate : % -> SparseUnivariatePolynomial(R) +--R univariate : (%,V) -> SparseUnivariatePolynomial(%) +--R +--E 1 + +)spool +)lisp (bye) +\end{chunk} + +\begin{chunk}{RecursivePolynomialCategory.help} +==================================================================== +RecursivePolynomialCategory examples +==================================================================== + +A category for general multi-variate polynomials with coefficients +in a ring, variables in an ordered set, and exponents from an +ordered abelian monoid, with a sup operation. + +When not constant, such a polynomial is viewed as a univariate polynomial +in its main variable w. r. t. to the total ordering on the elements in +the ordered set, so that some operations usually defined for univariate +polynomials make sense here. + +See Also: +o )show RecursivePolynomialCategory + +\end{chunk} +{\bf See:} + +\pagefrom{PolynomialCategory}{POLYCAT} + +{\bf Exports:}\\ + +\begin{tabular}{lll} +\cross{RPOLCAT}{0} & +\cross{RPOLCAT}{1} & +\cross{RPOLCAT}{associates?} \\ +\cross{RPOLCAT}{binomThmExpt} & +\cross{RPOLCAT}{characteristic} & +\cross{RPOLCAT}{charthRoot} \\ +\cross{RPOLCAT}{coefficient} & +\cross{RPOLCAT}{coefficients} & +\cross{RPOLCAT}{coerce} \\ +\cross{RPOLCAT}{conditionP} & +\cross{RPOLCAT}{convert} & +\cross{RPOLCAT}{D} \\ +\cross{RPOLCAT}{deepestInitial} & +\cross{RPOLCAT}{deepestTail} & +\cross{RPOLCAT}{degree} \\ +\cross{RPOLCAT}{differentiate} & +\cross{RPOLCAT}{discriminant} & +\cross{RPOLCAT}{eval} \\ +\cross{RPOLCAT}{exactQuotient} & +\cross{RPOLCAT}{exactQuotient!} & +\cross{RPOLCAT}{exquo} \\ +\cross{RPOLCAT}{extendedSubResultantGcd} & +\cross{RPOLCAT}{factor} & +\cross{RPOLCAT}{factorPolynomial} \\ +\cross{RPOLCAT}{factorSquareFreePolynomial} & +\cross{RPOLCAT}{gcd} & +\cross{RPOLCAT}{gcdPolynomial} \\ +\cross{RPOLCAT}{ground} & +\cross{RPOLCAT}{ground?} & +\cross{RPOLCAT}{halfExtendedSubResultantGcd1} \\ +\cross{RPOLCAT}{halfExtendedSubResultantGcd2} & +\cross{RPOLCAT}{hash} & +\cross{RPOLCAT}{head} \\ +\cross{RPOLCAT}{headReduce} & +\cross{RPOLCAT}{headReduced?} & +\cross{RPOLCAT}{infRittWu?} \\ +\cross{RPOLCAT}{init} & +\cross{RPOLCAT}{initiallyReduce} & +\cross{RPOLCAT}{initiallyReduced?} \\ +\cross{RPOLCAT}{isExpt} & +\cross{RPOLCAT}{isPlus} & +\cross{RPOLCAT}{isTimes} \\ +\cross{RPOLCAT}{iteratedInitials} & +\cross{RPOLCAT}{lastSubResultant} & +\cross{RPOLCAT}{latex} \\ +\cross{RPOLCAT}{LazardQuotient} & +\cross{RPOLCAT}{LazardQuotient2} & +\cross{RPOLCAT}{lazyPquo} \\ +\cross{RPOLCAT}{lazyPrem} & +\cross{RPOLCAT}{lazyPremWithDefault} & +\cross{RPOLCAT}{lazyPseudoDivide} \\ +\cross{RPOLCAT}{lazyResidueClass} & +\cross{RPOLCAT}{lcm} & +\cross{RPOLCAT}{leadingCoefficient} \\ +\cross{RPOLCAT}{leadingMonomial} & +\cross{RPOLCAT}{leastMonomial} & +\cross{RPOLCAT}{mainCoefficients} \\ +\cross{RPOLCAT}{mainContent} & +\cross{RPOLCAT}{mainMonomial} & +\cross{RPOLCAT}{mainPrimitivePart} \\ +\cross{RPOLCAT}{mainSquareFreePart} & +\cross{RPOLCAT}{mainVariable} & +\cross{RPOLCAT}{map} \\ +\cross{RPOLCAT}{mapExponents} & +\cross{RPOLCAT}{max} & +\cross{RPOLCAT}{mdeg} \\ +\cross{RPOLCAT}{min} & +\cross{RPOLCAT}{minimumDegree} & +\cross{RPOLCAT}{monic?} \\ +\cross{RPOLCAT}{monicDivide} & +\cross{RPOLCAT}{monicModulo} & +\cross{RPOLCAT}{monomial} \\ +\cross{RPOLCAT}{monomial?} & +\cross{RPOLCAT}{monomials} & +\cross{RPOLCAT}{multivariate} \\ +\cross{RPOLCAT}{mvar} & +\cross{RPOLCAT}{nextsubResultant2} & +\cross{RPOLCAT}{normalized?} \\ +\cross{RPOLCAT}{numberOfMonomials} & +\cross{RPOLCAT}{one?} & +\cross{RPOLCAT}{patternMatch} \\ +\cross{RPOLCAT}{pomopo!} & +\cross{RPOLCAT}{pquo} & +\cross{RPOLCAT}{prem} \\ +\cross{RPOLCAT}{primPartElseUnitCanonical} & +\cross{RPOLCAT}{primPartElseUnitCanonical!} & +\cross{RPOLCAT}{prime?} \\ +\cross{RPOLCAT}{primitiveMonomials} & +\cross{RPOLCAT}{primitivePart} & +\cross{RPOLCAT}{primitivePart!} \\ +\cross{RPOLCAT}{pseudoDivide} & +\cross{RPOLCAT}{quasiMonic?} & +\cross{RPOLCAT}{recip} \\ +\cross{RPOLCAT}{reduced?} & +\cross{RPOLCAT}{reducedSystem} & +\cross{RPOLCAT}{reductum} \\ +\cross{RPOLCAT}{resultant} & +\cross{RPOLCAT}{retract} & +\cross{RPOLCAT}{retractIfCan} \\ +\cross{RPOLCAT}{RittWuCompare} & +\cross{RPOLCAT}{sample} & +\cross{RPOLCAT}{solveLinearPolynomialEquation} \\ +\cross{RPOLCAT}{squareFree} & +\cross{RPOLCAT}{squareFreePart} & +\cross{RPOLCAT}{squareFreePolynomial} \\ +\cross{RPOLCAT}{subResultantChain} & +\cross{RPOLCAT}{subResultantGcd} & +\cross{RPOLCAT}{subtractIfCan} \\ +\cross{RPOLCAT}{supRittWu?} & +\cross{RPOLCAT}{tail} & +\cross{RPOLCAT}{totalDegree} \\ +\cross{RPOLCAT}{unit?} & +\cross{RPOLCAT}{unitCanonical} & +\cross{RPOLCAT}{unitNormal} \\ +\cross{RPOLCAT}{univariate} & +\cross{RPOLCAT}{variables} & +\cross{RPOLCAT}{zero?} \\ +\cross{RPOLCAT}{?*?} & +\cross{RPOLCAT}{?**?} & +\cross{RPOLCAT}{?+?} \\ +\cross{RPOLCAT}{?-?} & +\cross{RPOLCAT}{-?} & +\cross{RPOLCAT}{?=?} \\ +\cross{RPOLCAT}{?\^{}?} & +\cross{RPOLCAT}{?\~{}=?} & +\cross{RPOLCAT}{?/?} \\ +\cross{RPOLCAT}{?$<$?} & +\cross{RPOLCAT}{?$<=$?} & +\cross{RPOLCAT}{?$>$?} \\ +\cross{RPOLCAT}{?$>=$?} && +\end{tabular} + +{\bf Attributes Exported:} +\begin{itemize} +\item if \#1 has CommutativeRing then commutative(``*'') where +{\bf \cross{RPOLCAT}{commutative(``*'')}} +is true if it has an operation $"*": (D,D) -> D$ +which is commutative. +\item if \#1 has IntegralDomain then noZeroDivisors where +{\bf \cross{RPOLCAT}{noZeroDivisors}} +is true if $x * y \ne 0$ implies both x and y are non-zero. +\item if \#1 has canonicalUnitNormal then canonicalUnitNormal +where {\bf \cross{RPOLCAT}{canonicalUnitNormal}} +is true if we can choose a canonical representative for each class +of associate elements, that is {\tt associates?(a,b)} returns true +if and only if {\tt unitCanonical(a) = unitCanonical(b)}. +\item {\bf \cross{RPOLCAT}{unitsKnown}} +is true if a monoid (a multiplicative semigroup with a 1) has +unitsKnown means that the operation {\tt recip} can only return +``failed'' if its argument is not a unit. +\item {\bf \cross{RPOLCAT}{leftUnitary}} +is true if $1 * x = x$ for all x. +\item {\bf \cross{RPOLCAT}{rightUnitary}} +is true if $x * 1 = x$ for all x. +\end{itemize} + +These are directly exported but not implemented: +\begin{verbatim} + exactQuotient! : (%,R) -> % if R has INTDOM + extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) + if R has INTDOM + halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) + if R has INTDOM + halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) + if R has INTDOM + lastSubResultant : (%,%) -> % if R has INTDOM + LazardQuotient : (%,%,NonNegativeInteger) -> % + if R has INTDOM + LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % + if R has INTDOM + nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM + resultant : (%,%) -> % if R has INTDOM + subResultantChain : (%,%) -> List % if R has INTDOM + subResultantGcd : (%,%) -> % if R has INTDOM +\end{verbatim} + +These are implemented by this category: +\begin{verbatim} + coerce : % -> OutputForm + coerce : % -> Polynomial R if V has KONVERT SYMBOL + convert : % -> String + if R has RETRACT INT + and V has KONVERT SYMBOL + convert : % -> Polynomial R if V has KONVERT SYMBOL + convert : Polynomial R -> % if V has KONVERT SYMBOL + convert : Polynomial Integer -> % + if not has(R,Algebra Fraction Integer) + and R has ALGEBRA INT + and V has KONVERT SYMBOL + or R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + convert : Polynomial Fraction Integer -> % + if R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + deepestInitial : % -> % + deepestTail : % -> % + exactQuotient : (%,R) -> % if R has INTDOM + exactQuotient : (%,%) -> % if R has INTDOM + exactQuotient! : (%,%) -> % if R has INTDOM + gcd : (R,%) -> R if R has GCDDOM + head : % -> % + headReduce : (%,%) -> % + headReduced? : (%,List %) -> Boolean + headReduced? : (%,%) -> Boolean + infRittWu? : (%,%) -> Boolean + init : % -> % + initiallyReduce : (%,%) -> % + initiallyReduced? : (%,%) -> Boolean + initiallyReduced? : (%,List %) -> Boolean + iteratedInitials : % -> List % + lazyPremWithDefault : (%,%) -> + Record(coef: %,gap: NonNegativeInteger,remainder: %) + lazyPremWithDefault : (%,%,V) -> + Record(coef: %,gap: NonNegativeInteger,remainder: %) + lazyPquo : (%,%) -> % + lazyPquo : (%,%,V) -> % + lazyPrem : (%,%,V) -> % + lazyPrem : (%,%) -> % + lazyPseudoDivide : (%,%) -> + Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) + lazyPseudoDivide : (%,%,V) -> + Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) + lazyResidueClass : (%,%) -> + Record(polnum: %,polden: %,power: NonNegativeInteger) + leadingCoefficient : (%,V) -> % + leastMonomial : % -> % + mainCoefficients : % -> List % + mainContent : % -> % if R has GCDDOM + mainMonomial : % -> % + mainMonomials : % -> List % + mainPrimitivePart : % -> % if R has GCDDOM + mainSquareFreePart : % -> % if R has GCDDOM + mdeg : % -> NonNegativeInteger + monic? : % -> Boolean + monicModulo : (%,%) -> % + mvar : % -> V + normalized? : (%,%) -> Boolean + normalized? : (%,List %) -> Boolean + pquo : (%,%) -> % + pquo : (%,%,V) -> % + prem : (%,%,V) -> % + prem : (%,%) -> % + primitivePart! : % -> % if R has GCDDOM + primPartElseUnitCanonical : % -> % if R has INTDOM + primPartElseUnitCanonical! : % -> % if R has INTDOM + pseudoDivide : (%,%) -> Record(quotient: %,remainder: %) + quasiMonic? : % -> Boolean + reduced? : (%,%) -> Boolean + reduced? : (%,List %) -> Boolean + reductum : (%,V) -> % + retract : Polynomial R -> % + if not has(R,Algebra Fraction Integer) + and not has(R,Algebra Integer) + and V has KONVERT SYMBOL + or not has(R,IntegerNumberSystem) + and not has(R,Algebra Fraction Integer) + and R has ALGEBRA INT + and V has KONVERT SYMBOL + or not has(R,QuotientFieldCategory Integer) + and R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + retract : Polynomial Integer -> % + if not has(R,Algebra Fraction Integer) + and R has ALGEBRA INT + and V has KONVERT SYMBOL + or R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + retract : Polynomial Fraction Integer -> % + if R has ALGEBRA FRAC INT and V has KONVERT SYMBOL + retractIfCan : Polynomial R -> Union(%,"failed") + if not has(R,Algebra Fraction Integer) + and not has(R,Algebra Integer) + and V has KONVERT SYMBOL + or not has(R,IntegerNumberSystem) + and not has(R,Algebra Fraction Integer) + and R has ALGEBRA INT + and V has KONVERT SYMBOL + or not has(R,QuotientFieldCategory Integer) + and R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + retractIfCan : Polynomial Fraction Integer -> Union(%,"failed") + if R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + retractIfCan : Polynomial Integer -> Union(%,"failed") + if not has(R,Algebra Fraction Integer) + and R has ALGEBRA INT + and V has KONVERT SYMBOL + or R has ALGEBRA FRAC INT + and V has KONVERT SYMBOL + RittWuCompare : (%,%) -> Union(Boolean,"failed") + supRittWu? : (%,%) -> Boolean + tail : % -> % +\end{verbatim} + +These exports come from \refto{PolynomialCategory}(R,E,V)\hfill\\ +where R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet: +\begin{verbatim} + 0 : () -> % + 1 : () -> % + associates? : (%,%) -> Boolean + if R has INTDOM + binomThmExpt : (%,%,NonNegativeInteger) -> % + if R has COMRING + characteristic : () -> NonNegativeInteger + charthRoot : % -> Union(%,"failed") + if and(has($,CharacteristicNonZero), + has(R,PolynomialFactorizationExplicit)) + or R has CHARNZ + coefficient : (%,List V,List NonNegativeInteger) -> % + coefficient : (%,V,NonNegativeInteger) -> % + coefficient : (%,E) -> R + coefficients : % -> List R + coerce : R -> % + coerce : Fraction Integer -> % + if R has RETRACT FRAC INT or R has ALGEBRA FRAC INT + coerce : V -> % + coerce : % -> % if R has INTDOM + coerce : Integer -> % + conditionP : Matrix % -> Union(Vector %,"failed") + if and(has($,CharacteristicNonZero), + has(R,PolynomialFactorizationExplicit)) + content : % -> R if R has GCDDOM + content : (%,V) -> % if R has GCDDOM + convert : % -> Pattern Integer + if V has KONVERT PATTERN INT and R has KONVERT PATTERN INT + convert : % -> Pattern Float + if V has KONVERT PATTERN FLOAT and R has KONVERT PATTERN FLOAT + convert : % -> InputForm + if V has KONVERT INFORM and R has KONVERT INFORM + D : (%,List V) -> % + D : (%,V) -> % + D : (%,List V,List NonNegativeInteger) -> % + D : (%,V,NonNegativeInteger) -> % + degree : % -> E + degree : (%,List V) -> List NonNegativeInteger + degree : (%,V) -> NonNegativeInteger + differentiate : (%,List V,List NonNegativeInteger) -> % + differentiate : (%,V,NonNegativeInteger) -> % + differentiate : (%,List V) -> % + differentiate : (%,V) -> % + discriminant : (%,V) -> % if R has COMRING + eval : (%,List Equation %) -> % + eval : (%,Equation %) -> % + eval : (%,List %,List %) -> % + eval : (%,%,%) -> % + eval : (%,V,R) -> % + eval : (%,List V,List R) -> % + eval : (%,V,%) -> % + eval : (%,List V,List %) -> % + exquo : (%,R) -> Union(%,"failed") if R has INTDOM + exquo : (%,%) -> Union(%,"failed") if R has INTDOM + factor : % -> Factored % if R has PFECAT + factorPolynomial : + SparseUnivariatePolynomial % -> + Factored SparseUnivariatePolynomial % + if R has PFECAT + factorSquareFreePolynomial : + SparseUnivariatePolynomial % -> + Factored SparseUnivariatePolynomial % + if R has PFECAT + gcd : (%,%) -> % if R has GCDDOM + gcd : List % -> % if R has GCDDOM + gcdPolynomial : + (SparseUnivariatePolynomial %, + SparseUnivariatePolynomial %) -> + SparseUnivariatePolynomial % + if R has GCDDOM + ground : % -> R + ground? : % -> Boolean + hash : % -> SingleInteger + isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed") + isPlus : % -> Union(List %,"failed") + isTimes : % -> Union(List %,"failed") + latex : % -> String + lcm : (%,%) -> % if R has GCDDOM + lcm : List % -> % if R has GCDDOM + leadingCoefficient : % -> R + leadingMonomial : % -> % + mainVariable : % -> Union(V,"failed") + map : ((R -> R),%) -> % + mapExponents : ((E -> E),%) -> % + max : (%,%) -> % if R has ORDSET + min : (%,%) -> % if R has ORDSET + minimumDegree : % -> E + minimumDegree : (%,List V) -> List NonNegativeInteger + minimumDegree : (%,V) -> NonNegativeInteger + monicDivide : (%,%,V) -> Record(quotient: %,remainder: %) + monomial : (%,V,NonNegativeInteger) -> % + monomial : (%,List V,List NonNegativeInteger) -> % + monomial : (R,E) -> % + monomial? : % -> Boolean + monomials : % -> List % + multivariate : (SparseUnivariatePolynomial %,V) -> % + multivariate : (SparseUnivariatePolynomial R,V) -> % + numberOfMonomials : % -> NonNegativeInteger + one? : % -> Boolean + patternMatch : + (%,Pattern Integer,PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) + if V has PATMAB INT and R has PATMAB INT + patternMatch : + (%,Pattern Float,PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + if V has PATMAB FLOAT and R has PATMAB FLOAT + pomopo! : (%,R,E,%) -> % + prime? : % -> Boolean if R has PFECAT + primitiveMonomials : % -> List % + primitivePart : (%,V) -> % if R has GCDDOM + primitivePart : % -> % if R has GCDDOM + recip : % -> Union(%,"failed") + reducedSystem : Matrix % -> Matrix R + reducedSystem : (Matrix %,Vector %) -> + Record(mat: Matrix R,vec: Vector R) + reducedSystem : (Matrix %,Vector %) -> + Record(mat: Matrix Integer,vec: Vector Integer) + if R has LINEXP INT + reducedSystem : Matrix % -> Matrix Integer + if R has LINEXP INT + reductum : % -> % + resultant : (%,%,V) -> % if R has COMRING + retract : % -> R + retract : % -> Integer if R has RETRACT INT + retract : % -> Fraction Integer + if R has RETRACT FRAC INT + retract : % -> V + retractIfCan : % -> Union(R,"failed") + retractIfCan : % -> Union(Integer,"failed") + if R has RETRACT INT + retractIfCan : % -> Union(Fraction Integer,"failed") + if R has RETRACT FRAC INT + retractIfCan : % -> Union(V,"failed") + sample : () -> % + solveLinearPolynomialEquation : + (List SparseUnivariatePolynomial %, + SparseUnivariatePolynomial %) -> + Union(List SparseUnivariatePolynomial %,"failed") + if R has PFECAT + squareFree : % -> Factored % if R has GCDDOM + squareFreePart : % -> % if R has GCDDOM + squareFreePolynomial : + SparseUnivariatePolynomial % -> + Factored SparseUnivariatePolynomial % + if R has PFECAT + subtractIfCan : (%,%) -> Union(%,"failed") + totalDegree : (%,List V) -> NonNegativeInteger + totalDegree : % -> NonNegativeInteger + unit? : % -> Boolean if R has INTDOM + unitCanonical : % -> % if R has INTDOM + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + if R has INTDOM + univariate : % -> SparseUnivariatePolynomial R + univariate : (%,V) -> SparseUnivariatePolynomial % + variables : % -> List V + zero? : % -> Boolean + ?+? : (%,%) -> % + ?=? : (%,%) -> Boolean + ?~=? : (%,%) -> Boolean + ?*? : (%,R) -> % + ?*? : (R,%) -> % + ?*? : (Fraction Integer,%) -> % if R has ALGEBRA FRAC INT + ?*? : (%,Fraction Integer) -> % if R has ALGEBRA FRAC INT + ?*? : (%,%) -> % + ?*? : (Integer,%) -> % + ?*? : (PositiveInteger,%) -> % + ?*? : (NonNegativeInteger,%) -> % + ?/? : (%,R) -> % if R has FIELD + ?-? : (%,%) -> % + -? : % -> % + ?**? : (%,PositiveInteger) -> % + ?**? : (%,NonNegativeInteger) -> % + ?^? : (%,NonNegativeInteger) -> % + ?^? : (%,PositiveInteger) -> % + ? Boolean if R has ORDSET + ?<=? : (%,%) -> Boolean if R has ORDSET + ?>? : (%,%) -> Boolean if R has ORDSET + ?>=? : (%,%) -> Boolean if R has ORDSET +\end{verbatim} + +\begin{chunk}{category RPOLCAT RecursivePolynomialCategory} +)abbrev category RPOLCAT RecursivePolynomialCategory +++ Author: Marc Moreno Maza +++ Date Created: 04/22/1994 +++ Date Last Updated: 14/12/1998 +++ Description: + +RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ + Category == + PolynomialCategory(R, E, V) with + mvar : $ -> V + ++ \axiom{mvar(p)} returns an error if \axiom{p} belongs to + ++ \axiom{R}, otherwise returns its main variable w. r. t. to the + ++ total ordering on the elements in \axiom{V}. + mdeg : $ -> NonNegativeInteger + ++ \axiom{mdeg(p)} returns an error if \axiom{p} is \axiom{0}, + ++ otherwise, if \axiom{p} belongs to \axiom{R} returns \axiom{0}, + ++ otherwise, returns the degree of \axiom{p} in its main variable. + init : $ -> $ + ++ \axiom{init(p)} returns an error if \axiom{p} belongs to + ++ \axiom{R}, otherwise returns its leading coefficient, where + ++ \axiom{p} is viewed as a univariate polynomial in its main + ++ variable. + head : $ -> $ + ++ \axiom{head(p)} returns \axiom{p} if \axiom{p} belongs to + ++ \axiom{R}, otherwise returns its leading term (monomial in the + ++ AXIOM sense), where \axiom{p} is viewed as a univariate polynomial + ++ in its main variable. + tail : $ -> $ + ++ \axiom{tail(p)} returns its reductum, where \axiom{p} is viewed + ++ as a univariate polynomial in its main variable. + deepestTail : $ -> $ + ++ \axiom{deepestTail(p)} returns \axiom{0} if \axiom{p} belongs to + ++ \axiom{R}, otherwise returns tail(p), if \axiom{tail(p)} belongs + ++ to \axiom{R} or \axiom{mvar(tail(p)) < mvar(p)}, otherwise + ++ returns \axiom{deepestTail(tail(p))}. + iteratedInitials : $ -> List $ + ++ \axiom{iteratedInitials(p)} returns \axiom{[]} if \axiom{p} + ++ belongs to \axiom{R}, + ++ otherwise returns the list of the iterated initials of \axiom{p}. + deepestInitial : $ -> $ + ++ \axiom{deepestInitial(p)} returns an error if \axiom{p} belongs + ++ to \axiom{R}, + ++ otherwise returns the last term of \axiom{iteratedInitials(p)}. + leadingCoefficient : ($,V) -> $ + ++ \axiom{leadingCoefficient(p,v)} returns the leading coefficient + ++ of \axiom{p}, where \axiom{p} is viewed as A univariate + ++ polynomial in \axiom{v}. + reductum : ($,V) -> $ + ++ \axiom{reductum(p,v)} returns the reductum of \axiom{p}, where + ++ \axiom{p} is viewed as a univariate polynomial in \axiom{v}. + monic? : $ -> Boolean + ++ \axiom{monic?(p)} returns false if \axiom{p} belongs to \axiom{R}, + ++ otherwise returns true iff \axiom{p} is monic as a univariate + ++ polynomial in its main variable. + quasiMonic? : $ -> Boolean + ++ \axiom{quasiMonic?(p)} returns false if \axiom{p} belongs to + ++ \axiom{R}, otherwise returns true iff the initial of \axiom{p} + ++ lies in the base ring \axiom{R}. + mainMonomial : $ -> $ + ++ \axiom{mainMonomial(p)} returns an error if \axiom{p} is + ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns + ++ \axiom{1}, otherwise, \axiom{mvar(p)} raised to the power + ++ \axiom{mdeg(p)}. + leastMonomial : $ -> $ + ++ \axiom{leastMonomial(p)} returns an error if \axiom{p} is + ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns + ++ \axiom{1}, otherwise, the monomial of \axiom{p} with lowest + ++ degree, where \axiom{p} is viewed as a univariate polynomial in + ++ its main variable. + mainCoefficients : $ -> List $ + ++ \axiom{mainCoefficients(p)} returns an error if \axiom{p} is + ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns + ++ [p], otherwise returns the list of the coefficients of \axiom{p}, + ++ where \axiom{p} is viewed as a univariate polynomial in its main + ++ variable. + mainMonomials : $ -> List $ + ++ \axiom{mainMonomials(p)} returns an error if \axiom{p} is + ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns + ++ [1], otherwise returns the list of the monomials of \axiom{p}, + ++ where \axiom{p} is viewed as a univariate polynomial in its main + ++ variable. + RittWuCompare : ($, $) -> Union(Boolean,"failed") + ++ \axiom{RittWuCompare(a,b)} returns \axiom{"failed"} if \axiom{a} + ++ and \axiom{b} have same rank w.r.t. + ++ Ritt and Wu Wen Tsun ordering using the refinement of Lazard, + ++ otherwise returns \axiom{infRittWu?(a,b)}. + infRittWu? : ($, $) -> Boolean + ++ \axiom{infRittWu?(a,b)} returns true if \axiom{a} is less than + ++ \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the + ++ refinement of Lazard. + supRittWu? : ($, $) -> Boolean + ++ \axiom{supRittWu?(a,b)} returns true if \axiom{a} is greater + ++ than \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the + ++ refinement of Lazard. + reduced? : ($,$) -> Boolean + ++ \axiom{reduced?(a,b)} returns true iff + ++ \axiom{degree(a,mvar(b)) < mdeg(b)}. + reduced? : ($,List($)) -> Boolean + ++ \axiom{reduced?(q,lp)} returns true iff \axiom{reduced?(q,p)} + ++ holds for every \axiom{p} in \axiom{lp}. + headReduced? : ($,$) -> Boolean + ++ \axiom{headReduced?(a,b)} returns true iff + ++ \axiom{degree(head(a),mvar(b)) < mdeg(b)}. + headReduced? : ($,List($)) -> Boolean + ++ \axiom{headReduced?(q,lp)} returns true iff + ++ \axiom{headReduced?(q,p)} holds for every \axiom{p} in \axiom{lp}. + initiallyReduced? : ($,$) -> Boolean + ++ \axiom{initiallyReduced?(a,b)} returns false iff there exists an + ++ iterated initial of \axiom{a} which is not reduced w.r.t \axiom{b}. + initiallyReduced? : ($,List($)) -> Boolean + ++ \axiom{initiallyReduced?(q,lp)} returns true iff + ++ \axiom{initiallyReduced?(q,p)} holds for every \axiom{p} in + ++ \axiom{lp}. + normalized? : ($,$) -> Boolean + ++ \axiom{normalized?(a,b)} returns true iff \axiom{a} and its + ++ iterated initials have degree zero w.r.t. the main variable of + ++ \axiom{b} + normalized? : ($,List($)) -> Boolean + ++ \axiom{normalized?(q,lp)} returns true iff + ++ \axiom{normalized?(q,p)} holds + ++ for every \axiom{p} in \axiom{lp}. + prem : ($, $) -> $ + ++ \axiom{prem(a,b)} computes the pseudo-remainder of \axiom{a} by + ++ \axiom{b}, both viewed as univariate polynomials in the main + ++ variable of \axiom{b}. + pquo : ($, $) -> $ + ++ \axiom{pquo(a,b)} computes the pseudo-quotient of \axiom{a} by + ++ \axiom{b}, both viewed as univariate polynomials in the main + ++ variable of \axiom{b}. + prem : ($, $, V) -> $ + ++ \axiom{prem(a,b,v)} computes the pseudo-remainder of \axiom{a} + ++ by \axiom{b}, both viewed as univariate polynomials in \axiom{v}. + pquo : ($, $, V) -> $ + ++ \axiom{pquo(a,b,v)} computes the pseudo-quotient of \axiom{a} by + ++ \axiom{b}, both viewed as univariate polynomials in \axiom{v}. + lazyPrem : ($, $) -> $ + ++ \axiom{lazyPrem(a,b)} returns the polynomial \axiom{r} reduced + ++ w.r.t. \axiom{b} and such that \axiom{b} divides + ++ \axiom{init(b)^e a - r} where \axiom{e} + ++ is the number of steps of this pseudo-division. + lazyPquo : ($, $) -> $ + ++ \axiom{lazyPquo(a,b)} returns the polynomial \axiom{q} such that + ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]}. + lazyPrem : ($, $, V) -> $ + ++ \axiom{lazyPrem(a,b,v)} returns the polynomial \axiom{r} + ++ reduced w.r.t. \axiom{b} viewed as univariate polynomials in the + ++ variable \axiom{v} such that \axiom{b} divides + ++ \axiom{init(b)^e a - r} where \axiom{e} is the number of steps of + ++ this pseudo-division. + lazyPquo : ($, $, V) -> $ + ++ \axiom{lazyPquo(a,b,v)} returns the polynomial \axiom{q} such that + ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]}. + lazyPremWithDefault : ($, $) -> _ + Record (coef : $, gap : NonNegativeInteger, remainder : $) + ++ \axiom{lazyPremWithDefault(a,b)} returns \axiom{[c,g,r]} + ++ such that \axiom{r = lazyPrem(a,b)} and + ++ \axiom{(c**g)*r = prem(a,b)}. + lazyPremWithDefault : ($, $, V) -> _ + Record (coef : $, gap : NonNegativeInteger, remainder : $) + ++ \axiom{lazyPremWithDefault(a,b,v)} returns \axiom{[c,g,r]} + ++ such that \axiom{r = lazyPrem(a,b,v)} and + ++ \axiom{(c**g)*r = prem(a,b,v)}. + lazyPseudoDivide : ($,$) -> _ + Record(coef:$, gap: NonNegativeInteger,quotient:$, remainder:$) + ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]} + ++ such that \axiom{[c,g,r] = lazyPremWithDefault(a,b)} and + ++ \axiom{q} is the pseudo-quotient computed in this lazy + ++ pseudo-division. + lazyPseudoDivide : ($,$,V) -> _ + Record(coef:$, gap:NonNegativeInteger, quotient:$, remainder: $) + ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]} such + ++ that \axiom{r = lazyPrem(a,b,v)}, \axiom{(c**g)*r = prem(a,b,v)} + ++ and \axiom{q} is the pseudo-quotient computed in this lazy + ++ pseudo-division. + pseudoDivide : ($, $) -> Record (quotient : $, remainder : $) + ++ \axiom{pseudoDivide(a,b)} computes \axiom{[pquo(a,b),prem(a,b)]}, + ++ both polynomials viewed as univariate polynomials in the main + ++ variable of \axiom{b}, if \axiom{b} is not a constant polynomial. + monicModulo : ($, $) -> $ + ++ \axiom{monicModulo(a,b)} computes \axiom{a mod b}, if \axiom{b} is + ++ monic as univariate polynomial in its main variable. + lazyResidueClass : ($,$) -> _ + Record(polnum:$, polden:$, power:NonNegativeInteger) + ++ \axiom{lazyResidueClass(a,b)} returns \axiom{[p,q,n]} where + ++ \axiom{p / q**n} represents the residue class of \axiom{a} + ++ modulo \axiom{b} and \axiom{p} is reduced w.r.t. \axiom{b} and + ++ \axiom{q} is \axiom{init(b)}. + headReduce: ($, $) -> $ + ++ \axiom{headReduce(a,b)} returns a polynomial \axiom{r} such that + ++ \axiom{headReduced?(r,b)} holds and there exists an integer + ++ \axiom{e} such that \axiom{init(b)^e a - r} is zero modulo + ++ \axiom{b}. + initiallyReduce: ($, $) -> $ + ++ \axiom{initiallyReduce(a,b)} returns a polynomial \axiom{r} such + ++ that \axiom{initiallyReduced?(r,b)} holds and there exists an + ++ integer \axiom{e} such that \axiom{init(b)^e a - r} is zero + ++ modulo \axiom{b}. + + if (V has ConvertibleTo(Symbol)) + then + CoercibleTo(Polynomial R) + ConvertibleTo(Polynomial R) + if R has Algebra Fraction Integer + then + retractIfCan : Polynomial Fraction Integer -> Union($,"failed") + ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of + ++ the current domain if all its variables belong to \axiom{V}. + retract : Polynomial Fraction Integer -> $ + ++ \axiom{retract(p)} returns \axiom{p} as an element of the + ++ current domain if \axiom{retractIfCan(p)} does not return + ++ "failed", otherwise an error is produced. + convert : Polynomial Fraction Integer -> $ + ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}. + retractIfCan : Polynomial Integer -> Union($,"failed") + ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of + ++ the current domain if all its variables belong to \axiom{V}. + retract : Polynomial Integer -> $ + ++ \axiom{retract(p)} returns \axiom{p} as an element of the + ++ current domain if \axiom{retractIfCan(p)} does not return + ++ "failed", otherwise an error is produced. + convert : Polynomial Integer -> $ + ++ \axiom{convert(p)} returns the same as \axiom{retract(p)} + if not (R has QuotientFieldCategory(Integer)) + then + retractIfCan : Polynomial R -> Union($,"failed") + ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element + ++ of the current domain if all its variables belong to + ++ \axiom{V}. + retract : Polynomial R -> $ + ++ \axiom{retract(p)} returns \axiom{p} as an element of the + ++ current domain if \axiom{retractIfCan(p)} does not + ++ return "failed", otherwise an error is produced. + if (R has Algebra Integer) and not(R has Algebra Fraction Integer) + then + retractIfCan : Polynomial Integer -> Union($,"failed") + ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of + ++ the current domain if all its variables belong to \axiom{V}. + retract : Polynomial Integer -> $ + ++ \axiom{retract(p)} returns \axiom{p} as an element of the + ++ current domain if \axiom{retractIfCan(p)} does not return + ++ "failed", otherwise an error is produced. + convert : Polynomial Integer -> $ + ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}. + if not (R has IntegerNumberSystem) + then + retractIfCan : Polynomial R -> Union($,"failed") + ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element + ++ of the current domain if all its variables belong to + ++ \axiom{V}. + retract : Polynomial R -> $ + ++ \axiom{retract(p)} returns \axiom{p} as an element of the + ++ current domain if \axiom{retractIfCan(p)} does not + ++ return "failed", otherwise an error is produced. + if not(R has Algebra Integer) and not(R has Algebra Fraction Integer) + then + retractIfCan : Polynomial R -> Union($,"failed") + ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of + ++ the current domain if all its variables belong to \axiom{V}. + retract : Polynomial R -> $ + ++ \axiom{retract(p)} returns \axiom{p} as an element of the + ++ current domain if \axiom{retractIfCan(p)} does not return + ++ "failed", otherwise an error is produced. + convert : Polynomial R -> $ + ++ \axiom{convert(p)} returns \axiom{p} as an element of the current + ++ domain if all its variables belong to \axiom{V}, otherwise an + ++ error is produced. + + if R has RetractableTo(Integer) + then + ConvertibleTo(String) + + if R has IntegralDomain + then + primPartElseUnitCanonical : $ -> $ + ++ \axiom{primPartElseUnitCanonical(p)} returns + ++ \axiom{primitivePart(p)} if \axiom{R} is a gcd-domain, + ++ otherwise \axiom{unitCanonical(p)}. + primPartElseUnitCanonical! : $ -> $ + ++ \axiom{primPartElseUnitCanonical!(p)} replaces \axiom{p} + ++ by \axiom{primPartElseUnitCanonical(p)}. + exactQuotient : ($,R) -> $ + ++ \axiom{exactQuotient(p,r)} computes the exact quotient of + ++ \axiom{p} by \axiom{r}, which is assumed to be a divisor of + ++ \axiom{p}. No error is returned if this exact quotient fails! + exactQuotient! : ($,R) -> $ + ++ \axiom{exactQuotient!(p,r)} replaces \axiom{p} by + ++ \axiom{exactQuotient(p,r)}. + exactQuotient : ($,$) -> $ + ++ \axiom{exactQuotient(a,b)} computes the exact quotient of + ++ \axiom{a} by \axiom{b}, which is assumed to be a divisor of + ++ \axiom{a}. No error is returned if this exact quotient fails! + exactQuotient! : ($,$) -> $ + ++ \axiom{exactQuotient!(a,b)} replaces \axiom{a} by + ++ \axiom{exactQuotient(a,b)} + subResultantGcd : ($, $) -> $ + ++ \axiom{subResultantGcd(a,b)} computes a gcd of \axiom{a} and + ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the + ++ same main variable \axiom{v} and are viewed as univariate + ++ polynomials in \axiom{v} with coefficients in the fraction + ++ field of the polynomial ring generated by their other variables + ++ over \axiom{R}. + extendedSubResultantGcd : ($, $) -> _ + Record (gcd : $, coef1 : $, coef2 : $) + ++ \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[ca,cb,r]} + ++ such that \axiom{r} is \axiom{subResultantGcd(a,b)} and we have + ++ \axiom{ca * a + cb * cb = r} . + halfExtendedSubResultantGcd1: ($, $) -> Record (gcd : $, coef1 : $) + ++ \axiom{halfExtendedSubResultantGcd1(a,b)} returns \axiom{[g,ca]} + ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]} + ++ otherwise produces an error. + halfExtendedSubResultantGcd2: ($, $) -> Record (gcd : $, coef2 : $) + ++ \axiom{halfExtendedSubResultantGcd2(a,b)} returns \axiom{[g,cb]} + ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]} + ++ otherwise produces an error. + resultant : ($, $) -> $ + ++ \axiom{resultant(a,b)} computes the resultant of \axiom{a} and + ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the + ++ same main variable \axiom{v} and are viewed as univariate + ++ polynomials in \axiom{v}. + subResultantChain : ($, $) -> List $ + ++ \axiom{subResultantChain(a,b)}, where \axiom{a} and \axiom{b} + ++ are not contant polynomials with the same main variable, returns + ++ the subresultant chain of \axiom{a} and \axiom{b}. + lastSubResultant: ($, $) -> $ + ++ \axiom{lastSubResultant(a,b)} returns the last non-zero + ++ subresultant of \axiom{a} and \axiom{b} where \axiom{a} and + ++ \axiom{b} are assumed to have the same main variable \axiom{v} + ++ and are viewed as univariate polynomials in \axiom{v}. + LazardQuotient: ($, $, NonNegativeInteger) -> $ + ++ \axiom{LazardQuotient(a,b,n)} returns \axiom{a**n exquo b**(n-1)} + ++ assuming that this quotient does not fail. + LazardQuotient2: ($, $, $, NonNegativeInteger) -> $ + ++ \axiom{LazardQuotient2(p,a,b,n)} returns + ++ \axiom{(a**(n-1) * p) exquo b**(n-1)} + ++ assuming that this quotient does not fail. + next_subResultant2: ($, $, $, $) -> $ + ++ \axiom{nextsubResultant2(p,q,z,s)} is the multivariate version + ++ of the operation + ++ next_sousResultant2 from PseudoRemainderSequence from + ++ the \axiomType{PseudoRemainderSequence} constructor. + + if R has GcdDomain + then + gcd : (R,$) -> R + ++ \axiom{gcd(r,p)} returns the gcd of \axiom{r} and the content + ++ of \axiom{p}. + primitivePart! : $ -> $ + ++ \axiom{primitivePart!(p)} replaces \axiom{p} by its primitive + ++ part. + mainContent : $ -> $ + ++ \axiom{mainContent(p)} returns the content of \axiom{p} viewed + ++ as a univariate polynomial in its main variable and with + ++ coefficients in the polynomial ring generated by its other + ++ variables over \axiom{R}. + mainPrimitivePart : $ -> $ + ++ \axiom{mainPrimitivePart(p)} returns the primitive part of + ++ \axiom{p} viewed as a univariate polynomial in its main + ++ variable and with coefficients in the polynomial ring generated + ++ by its other variables over \axiom{R}. + mainSquareFreePart : $ -> $ + ++ \axiom{mainSquareFreePart(p)} returns the square free part of + ++ \axiom{p} viewed as a univariate polynomial in its main + ++ variable and with coefficients in the polynomial ring + ++ generated by its other variables over \axiom{R}. + + add + O ==> OutputForm + NNI ==> NonNegativeInteger + INT ==> Integer + + exactQuo : (R,R) -> R + + coerce(p:$):O == + ground? (p) => (ground(p))::O + if (((ip := init(p))) = 1) + then + if zero?((tp := tail(p))) + then + if (((dp := mdeg(p))) = 1) + then + return((mvar(p))::O) + else + return(((mvar(p))::O **$O (dp::O))) + else + if (((dp := mdeg(p))) = 1) + then + return((mvar(p))::O +$O (tp::O)) + else + return(((mvar(p))::O **$O (dp::O)) +$O (tp::O)) + else + if zero?((tp := tail(p))) + then + if (((dp := mdeg(p))) = 1) + then + return((ip::O) *$O (mvar(p))::O) + else + return((ip::O) *$O ((mvar(p))::O **$O (dp::O))) + else + if ((mdeg(p)) = 1) + then + return(((ip::O) *$O (mvar(p))::O) +$O (tp::O)) + ((ip)::O *$O ((mvar(p))::O **$O ((mdeg(p)::O))) +$O (tail(p)::O)) + + mvar p == + ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant." + mainVariable(p)::V + + mdeg p == + ground?(p) => 0$NNI + degree(p,mainVariable(p)::V) + + init p == + ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant." + v := mainVariable(p)::V + coefficient(p,v,degree(p,v)) + + leadingCoefficient (p,v) == + zero? (d := degree(p,v)) => p + coefficient(p,v,d) + + head p == + ground? p => p + v := mainVariable(p)::V + d := degree(p,v) + monomial(coefficient(p,v,d),v,d) + + reductum(p,v) == + zero? (d := degree(p,v)) => 0$$ + p - monomial(coefficient(p,v,d),v,d) + + tail p == + ground? p => 0$$ + p - head(p) + + deepestTail p == + ground? p => 0$$ + ground? tail(p) => tail(p) + mvar(p) > mvar(tail(p)) => tail(p) + deepestTail(tail(p)) + + iteratedInitials p == + ground? p => [] + p := init(p) + cons(p,iteratedInitials(p)) + + localDeepestInitial (p : $) : $ == + ground? p => p + localDeepestInitial init p + + deepestInitial p == + ground? p => _ + error"Error in deepestInitial from RPOLCAT : #1 is constant." + localDeepestInitial init p + + monic? p == + ground? p => false + (recip(init(p))$$ case $)@Boolean + + quasiMonic? p == + ground? p => false + ground?(init(p)) + + mainMonomial p == + zero? p => error"Error in mainMonomial from RPOLCAT : #1 is zero" + ground? p => 1$$ + v := mainVariable(p)::V + monomial(1$$,v,degree(p,v)) + + leastMonomial p == + zero? p => error"Error in leastMonomial from RPOLCAT : #1 is zero" + ground? p => 1$$ + v := mainVariable(p)::V + monomial(1$$,v,minimumDegree(p,v)) + + mainCoefficients p == + zero? p => error"Error in mainCoefficients from RPOLCAT : #1 is zero" + ground? p => [p] + v := mainVariable(p)::V + coefficients(univariate(p,v)@SparseUnivariatePolynomial($)) + + mainMonomials p == + zero? p => error"Error in mainMonomials from RPOLCAT : #1 is zero" + ground? p => [1$$] + v := mainVariable(p)::V + lm := monomials(univariate(p,v)@SparseUnivariatePolynomial($)) + [monomial(1$$,v,degree(m)) for m in lm] + + RittWuCompare (a,b) == + (ground? b and ground? a) => "failed"::Union(Boolean,"failed") + ground? b => false::Union(Boolean,"failed") + ground? a => true::Union(Boolean,"failed") + mvar(a) < mvar(b) => true::Union(Boolean,"failed") + mvar(a) > mvar(b) => false::Union(Boolean,"failed") + mdeg(a) < mdeg(b) => true::Union(Boolean,"failed") + mdeg(a) > mdeg(b) => false::Union(Boolean,"failed") + lc := RittWuCompare(init(a),init(b)) + lc case Boolean => lc + RittWuCompare(tail(a),tail(b)) + + infRittWu? (a,b) == + lc : Union(Boolean,"failed") := RittWuCompare(a,b) + lc case Boolean => lc::Boolean + false + + supRittWu? (a,b) == + infRittWu? (b,a) + + prem (a:$, b:$) : $ == + cP := lazyPremWithDefault (a,b) + ((cP.coef) ** (cP.gap)) * cP.remainder + + pquo (a:$, b:$) : $ == + cPS := lazyPseudoDivide (a,b) + c := (cPS.coef) ** (cPS.gap) + c * cPS.quotient + + prem (a:$, b:$, v:V) : $ == + cP := lazyPremWithDefault (a,b,v) + ((cP.coef) ** (cP.gap)) * cP.remainder + + pquo (a:$, b:$, v:V) : $ == + cPS := lazyPseudoDivide (a,b,v) + c := (cPS.coef) ** (cPS.gap) + c * cPS.quotient + + lazyPrem (a:$, b:$) : $ == + (not ground?(b)) and (monic?(b)) => monicModulo(a,b) + (lazyPremWithDefault (a,b)).remainder + + lazyPquo (a:$, b:$) : $ == + (lazyPseudoDivide (a,b)).quotient + + lazyPrem (a:$, b:$, v:V) : $ == + zero? b => _ + error"Error in lazyPrem : ($,$,V) -> $ from RPOLCAT : #2 is zero" + ground?(b) => 0$$ + (v = mvar(b)) => lazyPrem(a,b) + dbv : NNI := degree(b,v) + zero? dbv => 0$$ + dav : NNI := degree(a,v) + zero? dav => a + test : INT := dav::INT - dbv + lcbv : $ := leadingCoefficient(b,v) + while not zero?(a) and not negative?(test) repeat + lcav := leadingCoefficient(a,v) + term := monomial(lcav,v,test::NNI) + a := lcbv * a - term * b + test := degree(a,v)::INT - dbv + a + + lazyPquo (a:$, b:$, v:V) : $ == + (lazyPseudoDivide (a,b,v)).quotient + + headReduce (a:$,b:$) == + ground? b => error _ + "Error in headReduce : ($,$) -> Boolean from TSETCAT : #2 is constant" + ground? a => a + mvar(a) = mvar(b) => lazyPrem(a,b) + while not reduced?((ha := head a),b) repeat + lrc := lazyResidueClass(ha,b) + if zero? tail(a) + then + a := lrc.polnum + else + a := lrc.polnum + (lrc.polden)**(lrc.power) * tail(a) + a + + initiallyReduce(a:$,b:$) == + ground? b => error _ + "Error in initiallyReduce : ($,$) -> Boolean from TSETCAT : #2 is constant" + ground? a => a + v := mvar(b) + mvar(a) = v => lazyPrem(a,b) + ia := a + ma := 1$$ + ta := 0$$ + while (not ground?(ia)) and (mvar(ia) >= mvar(b)) repeat + if (mvar(ia) = mvar(b)) and (mdeg(ia) >= mdeg(b)) + then + iamodb := lazyResidueClass(ia,b) + ia := iamodb.polnum + if not zero? ta + then + ta := (iamodb.polden)**(iamodb.power) * ta + if zero? ia + then + ia := ta + ma := 1$$ + ta := 0$$ + else + if not ground?(ia) + then + ta := tail(ia) * ma + ta + ma := mainMonomial(ia) * ma + ia := init(ia) + ia * ma + ta + + lazyPremWithDefault (a,b) == + ground?(b) => error _ + "Error in lazyPremWithDefault from RPOLCAT : #2 is constant" + ground?(a) => [1$$,0$NNI,a] + xa := mvar a + xb := mvar b + xa < xb => [1$$,0$NNI,a] + lcb : $ := init b + db : NNI := mdeg b + test : INT := degree(a,xb)::INT - db + delta : INT := max(test + 1$INT, 0$INT) + if xa = xb + then + b := tail b + while not zero?(a) and not negative?(test) repeat + term := monomial(init(a),xb,test::NNI) + a := lcb * tail(a) - term * b + delta := delta - 1$INT + test := degree(a,xb)::INT - db + else + while not zero?(a) and not negative?(test) repeat + term := monomial(leadingCoefficient(a,xb),xb,test::NNI) + a := lcb * a - term * b + delta := delta - 1$INT + test := degree(a,xb)::INT - db + [lcb, (delta::NNI), a] + + lazyPremWithDefault (a,b,v) == + zero? b => error _ + "Error in lazyPremWithDefault : ($,$,V) -> $ from RPOLCAT : #2 is zero" + ground?(b) => [b,1$NNI,0$$] + (v = mvar(b)) => lazyPremWithDefault(a,b) + dbv : NNI := degree(b,v) + zero? dbv => [b,1$NNI,0$$] + dav : NNI := degree(a,v) + zero? dav => [1$$,0$NNI,a] + test : INT := dav::INT - dbv + delta : INT := max(test + 1$INT, 0$INT) + lcbv : $ := leadingCoefficient(b,v) + while not zero?(a) and not negative?(test) repeat + lcav := leadingCoefficient(a,v) + term := monomial(lcav,v,test::NNI) + a := lcbv * a - term * b + delta := delta - 1$INT + test := degree(a,v)::INT - dbv + [lcbv, (delta::NNI), a] + + pseudoDivide (a,b) == + cPS := lazyPseudoDivide (a,b) + c := (cPS.coef) ** (cPS.gap) + [c * cPS.quotient, c * cPS.remainder] + + lazyPseudoDivide (a,b) == + ground?(b) => error _ + "Error in lazyPseudoDivide from RPOLCAT : #2 is constant" + ground?(a) => [1$$,0$NNI,0$$,a] + xa := mvar a + xb := mvar b + xa < xb => [1$$,0$NNI,0$$, a] + lcb : $ := init b + db : NNI := mdeg b + q := 0$$ + test : INT := degree(a,xb)::INT - db + delta : INT := max(test + 1$INT, 0$INT) + if xa = xb + then + b := tail b + while not zero?(a) and not negative?(test) repeat + term := monomial(init(a),xb,test::NNI) + a := lcb * tail(a) - term * b + q := lcb * q + term + delta := delta - 1$INT + test := degree(a,xb)::INT - db + else + while not zero?(a) and not negative?(test) repeat + term := monomial(leadingCoefficient(a,xb),xb,test::NNI) + a := lcb * a - term * b + q := lcb * q + term + delta := delta - 1$INT + test := degree(a,xb)::INT - db + [lcb, (delta::NNI), q, a] + + lazyPseudoDivide (a,b,v) == + zero? b => error _ + "Error in lazyPseudoDivide : ($,$,V) -> $ from RPOLCAT : #2 is zero" + ground?(b) => [b,1$NNI,a,0$$] + (v = mvar(b)) => lazyPseudoDivide(a,b) + dbv : NNI := degree(b,v) + zero? dbv => [b,1$NNI,a,0$$] + dav : NNI := degree(a,v) + zero? dav => [1$$,0$NNI,0$$, a] + test : INT := dav::INT - dbv + delta : INT := max(test + 1$INT, 0$INT) + lcbv : $ := leadingCoefficient(b,v) + q := 0$$ + while not zero?(a) and not negative?(test) repeat + lcav := leadingCoefficient(a,v) + term := monomial(lcav,v,test::NNI) + a := lcbv * a - term * b + q := lcbv * q + term + delta := delta - 1$INT + test := degree(a,v)::INT - dbv + [lcbv, (delta::NNI), q, a] + + monicModulo (a,b) == + ground?(b) => error"Error in monicModulo from RPOLCAT : #2 is constant" + rec : Union($,"failed") + rec := recip((ib := init(b)))$$ + (rec case "failed")@Boolean => error _ + "Error in monicModulo from RPOLCAT : #2 is not monic" + ground? a => a + ib * ((lazyPremWithDefault ((rec::$) * a,(rec::$) * b)).remainder) + + lazyResidueClass(a,b) == + zero? b => [a,1$$,0$NNI] + ground? b => [0$$,1$$,0$NNI] + ground? a => [a,1$$,0$NNI] + xa := mvar a + xb := mvar b + xa < xb => [a,1$$,0$NNI] + monic?(b) => [monicModulo(a,b),1$$,0$NNI] + lcb : $ := init b + db : NNI := mdeg b + test : INT := degree(a,xb)::INT - db + pow : NNI := 0 + if xa = xb + then + b := tail b + while not zero?(a) and not negative?(test) repeat + term := monomial(init(a),xb,test::NNI) + a := lcb * tail(a) - term * b + pow := pow + 1$NNI + test := degree(a,xb)::INT - db + else + while not zero?(a) and not negative?(test) repeat + term := monomial(leadingCoefficient(a,xb),xb,test::NNI) + a := lcb * a - term * b + pow := pow + 1$NNI + test := degree(a,xb)::INT - db + [a,lcb,pow] + + reduced? (a:$,b:$) : Boolean == + degree(a,mvar(b)) < mdeg(b) + + reduced? (p:$, lq : List($)) : Boolean == + ground? p => true + while (not empty? lq) and (reduced?(p, first lq)) repeat + lq := rest lq + empty? lq + + headReduced? (a:$,b:$) : Boolean == + reduced?(head(a),b) + + headReduced? (p:$, lq : List($)) : Boolean == + reduced?(head(p),lq) + + initiallyReduced? (a:$,b:$) : Boolean == + ground? b => error _ + "Error in initiallyReduced? : ($,$) -> Bool. from RPOLCAT : #2 is constant" + ground?(a) => true + mvar(a) < mvar(b) => true + (mvar(a) = mvar(b)) => reduced?(a,b) + initiallyReduced?(init(a),b) + + initiallyReduced? (p:$, lq : List($)) : Boolean == + ground? p => true + while (not empty? lq) and (initiallyReduced?(p, first lq)) repeat + lq := rest lq + empty? lq + + normalized?(a:$,b:$) : Boolean == + ground? b => error _ + "Error in normalized? : ($,$) -> Boolean from TSETCAT : #2 is constant" + ground? a => true + mvar(a) < mvar(b) => true + (mvar(a) = mvar(b)) => false + normalized?(init(a),b) + + normalized? (p:$, lq : List($)) : Boolean == + while (not empty? lq) and (normalized?(p, first lq)) repeat + lq := rest lq + empty? lq + + if R has IntegralDomain + then + + if R has EuclideanDomain + then + exactQuo(r:R,s:R):R == + r quo$R s + else + exactQuo(r:R,s:R):R == + (r exquo$R s)::R + + exactQuotient (p:$,r:R) == + (p exquo$$ r)::$ + + exactQuotient (a:$,b:$) == + ground? b => exactQuotient(a,ground(b)) + (a exquo$$ b)::$ + + exactQuotient! (a:$,b:$) == + ground? b => exactQuotient!(a,ground(b)) + a := (a exquo$$ b)::$ + + if (R has GcdDomain) and not(R has Field) + then + + primPartElseUnitCanonical p == + primitivePart p + + primitivePart! p == + zero? p => p + if ((cp := content(p)) = 1) + then + p := unitCanonical p + else + p := unitCanonical exactQuotient!(p,cp) + p + + primPartElseUnitCanonical! p == + primitivePart! p + + else + primPartElseUnitCanonical p == + unitCanonical p + + primPartElseUnitCanonical! p == + p := unitCanonical p + + + if R has GcdDomain + then + + gcd(r:R,p:$):R == + (r = 1) => r + zero? p => r + ground? p => gcd(r,ground(p))$R + gcd(gcd(r,init(p)),tail(p)) + + mainContent p == + zero? p => p + "gcd"/mainCoefficients(p) + + mainPrimitivePart p == + zero? p => p + (unitNormal((p exquo$$ mainContent(p))::$)).canonical + + mainSquareFreePart p == + ground? p => p + v := mainVariable(p)::V + sfp : SparseUnivariatePolynomial($) + sfp := squareFreePart(univariate(p,v)@SparseUnivariatePolynomial($)) + multivariate(sfp,v) + + if (V has ConvertibleTo(Symbol)) + then + + PR ==> Polynomial R + PQ ==> Polynomial Fraction Integer + PZ ==> Polynomial Integer + IES ==> IndexedExponents(Symbol) + Q ==> Fraction Integer + Z ==> Integer + + convert(p:$) : PR == + ground? p => (ground(p)$$)::PR + v : V := mvar(p) + d : NNI := mdeg(p) + convert(init(p))@PR *$PR _ + ((convert(v)@Symbol)::PR)**d +$PR convert(tail(p))@PR + + coerce(p:$) : PR == + convert(p)@PR + + localRetract : PR -> $ + localRetractPQ : PQ -> $ + localRetractPZ : PZ -> $ + localRetractIfCan : PR -> Union($,"failed") + localRetractIfCanPQ : PQ -> Union($,"failed") + localRetractIfCanPZ : PZ -> Union($,"failed") + + if V has Finite + then + + sizeV : NNI := size()$V + lv : List Symbol + lv := _ + [convert(index(i::PositiveInteger)$V)@Symbol for i in 1..sizeV] + + localRetract(p : PR) : $ == + ground? p => (ground(p)$PR)::$ + mvp : Symbol := (mainVariable(p)$PR)::Symbol + d : NNI + imvp : PositiveInteger := _ + (position(mvp,lv)$(List Symbol))::PositiveInteger + vimvp : V := index(imvp)$V + xvimvp,c : $ + newp := 0$$ + while (not zero? (d := degree(p,mvp))) repeat + c := localRetract(coefficient(p,mvp,d)$PR) + xvimvp := monomial(c,vimvp,d)$$ + newp := newp +$$ xvimvp + p := p -$PR monomial(coefficient(p,mvp,d)$PR,mvp,d)$PR + newp +$$ localRetract(p) + + if R has Algebra Fraction Integer + then + localRetractPQ(pq:PQ):$ == + ground? pq => ((ground(pq)$PQ)::R)::$ + mvp : Symbol := (mainVariable(pq)$PQ)::Symbol + d : NNI + imvp : PositiveInteger := _ + (position(mvp,lv)$(List Symbol))::PositiveInteger + vimvp : V := index(imvp)$V + xvimvp,c : $ + newp := 0$$ + while (not zero? (d := degree(pq,mvp))) repeat + c := localRetractPQ(coefficient(pq,mvp,d)$PQ) + xvimvp := monomial(c,vimvp,d)$$ + newp := newp +$$ xvimvp + pq := pq -$PQ monomial(coefficient(pq,mvp,d)$PQ,mvp,d)$PQ + newp +$$ localRetractPQ(pq) + + if R has Algebra Integer + then + localRetractPZ(pz:PZ):$ == + ground? pz => ((ground(pz)$PZ)::R)::$ + mvp : Symbol := (mainVariable(pz)$PZ)::Symbol + d : NNI + imvp : PositiveInteger := _ + (position(mvp,lv)$(List Symbol))::PositiveInteger + vimvp : V := index(imvp)$V + xvimvp,c : $ + newp := 0$$ + while (not zero? (d := degree(pz,mvp))) repeat + c := localRetractPZ(coefficient(pz,mvp,d)$PZ) + xvimvp := monomial(c,vimvp,d)$$ + newp := newp +$$ xvimvp + pz := pz -$PZ monomial(coefficient(pz,mvp,d)$PZ,mvp,d)$PZ + newp +$$ localRetractPZ(pz) + + retractable?(p:PR):Boolean == + lvp := variables(p)$PR + while not empty? lvp and member?(first lvp,lv) repeat + lvp := rest lvp + empty? lvp + + retractablePQ?(p:PQ):Boolean == + lvp := variables(p)$PQ + while not empty? lvp and member?(first lvp,lv) repeat + lvp := rest lvp + empty? lvp + + retractablePZ?(p:PZ):Boolean == + lvp := variables(p)$PZ + while not empty? lvp and member?(first lvp,lv) repeat + lvp := rest lvp + empty? lvp + + localRetractIfCan(p : PR): Union($,"failed") == + not retractable?(p) => "failed"::Union($,"failed") + localRetract(p)::Union($,"failed") + + localRetractIfCanPQ(p : PQ): Union($,"failed") == + not retractablePQ?(p) => "failed"::Union($,"failed") + localRetractPQ(p)::Union($,"failed") + + localRetractIfCanPZ(p : PZ): Union($,"failed") == + not retractablePZ?(p) => "failed"::Union($,"failed") + localRetractPZ(p)::Union($,"failed") + + if R has Algebra Fraction Integer + then + + mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR) + mpc2Q := MPolyCatFunctions2(Symbol,IES,IES,Q,R,PQ,PR) + ZToR (z:Z):R == coerce(z)@R + QToR (q:Q):R == coerce(q)@R + PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z + PQToPR (pq:PQ):PR == map(QToR,pq)$mpc2Q + + retract(pz:PZ) == + rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed") + (rif case "failed") => error _ + "failed in retract: POLY Z -> $ from RPOLCAT" + rif::$ + + convert(pz:PZ) == + retract(pz)@$ + + retract(pq:PQ) == + rif : Union($,"failed") := retractIfCan(pq)@Union($,"failed") + (rif case "failed") => error _ + "failed in retract: POLY Z -> $ from RPOLCAT" + rif::$ + + convert(pq:PQ) == + retract(pq)@$ + + if not (R has QuotientFieldCategory(Integer)) + then + -- the only operation to implement is + -- retractIfCan : PR -> Union($,"failed") + -- when V does not have Finite + + if V has Finite + then + retractIfCan(pr:PR) == + localRetractIfCan(pr)@Union($,"failed") + + retractIfCan(pq:PQ) == + localRetractIfCanPQ(pq)@Union($,"failed") + else + retractIfCan(pq:PQ) == + pr : PR := PQToPR(pq) + retractIfCan(pr)@Union($,"failed") + + retractIfCan(pz:PZ) == + pr : PR := PZToPR(pz) + retractIfCan(pr)@Union($,"failed") + + retract(pr:PR) == + rif : Union($,"failed") := _ + retractIfCan(pr)@Union($,"failed") + (rif case "failed") => error _ + "failed in retract: POLY Z -> $ from RPOLCAT" + rif::$ + + convert(pr:PR) == + retract(pr)@$ + + else + -- the only operation to implement is + -- retractIfCan : PQ -> Union($,"failed") + -- when V does not have Finite + mpc2ZQ := MPolyCatFunctions2(Symbol,IES,IES,Z,Q,PZ,PQ) + mpc2RQ := MPolyCatFunctions2(Symbol,IES,IES,R,Q,PR,PQ) + ZToQ(z:Z):Q == coerce(z)@Q + RToQ(r:R):Q == retract(r)@Q + + PZToPQ (pz:PZ):PQ == map(ZToQ,pz)$mpc2ZQ + PRToPQ (pr:PR):PQ == map(RToQ,pr)$mpc2RQ + + retractIfCan(pz:PZ) == + pq : PQ := PZToPQ(pz) + retractIfCan(pq)@Union($,"failed") + + if V has Finite + then + retractIfCan(pq:PQ) == + localRetractIfCanPQ(pq)@Union($,"failed") + + convert(pr:PR) == + lrif : Union($,"failed") := _ + localRetractIfCan(pr)@Union($,"failed") + (lrif case "failed") => error _ + "failed in convert: PR->$ from RPOLCAT" + lrif::$ + else + convert(pr:PR) == + pq : PQ := PRToPQ(pr) + retract(pq)@$ + + if (R has Algebra Integer) and not(R has Algebra Fraction Integer) + then + + mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR) + ZToR (z:Z):R == coerce(z)@R + PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z + + retract(pz:PZ) == + rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed") + (rif case "failed") => error _ + "failed in retract: POLY Z -> $ from RPOLCAT" + rif::$ + + convert(pz:PZ) == + retract(pz)@$ + + if not (R has IntegerNumberSystem) + then + -- the only operation to implement is + -- retractIfCan : PR -> Union($,"failed") + -- when V does not have Finite + + if V has Finite + then + retractIfCan(pr:PR) == + localRetractIfCan(pr)@Union($,"failed") + + retractIfCan(pz:PZ) == + localRetractIfCanPZ(pz)@Union($,"failed") + else + retractIfCan(pz:PZ) == + pr : PR := PZToPR(pz) + retractIfCan(pr)@Union($,"failed") + + retract(pr:PR) == + rif : Union($,"failed"):=retractIfCan(pr)@Union($,"failed") + (rif case "failed") => error _ + "failed in retract: POLY Z -> $ from RPOLCAT" + rif::$ + + convert(pr:PR) == + retract(pr)@$ -RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ - Category == - PolynomialCategory(R, E, V) with - mvar : $ -> V - ++ \axiom{mvar(p)} returns an error if \axiom{p} belongs to - ++ \axiom{R}, otherwise returns its main variable w. r. t. to the - ++ total ordering on the elements in \axiom{V}. - mdeg : $ -> NonNegativeInteger - ++ \axiom{mdeg(p)} returns an error if \axiom{p} is \axiom{0}, - ++ otherwise, if \axiom{p} belongs to \axiom{R} returns \axiom{0}, - ++ otherwise, returns the degree of \axiom{p} in its main variable. - init : $ -> $ - ++ \axiom{init(p)} returns an error if \axiom{p} belongs to - ++ \axiom{R}, otherwise returns its leading coefficient, where - ++ \axiom{p} is viewed as a univariate polynomial in its main - ++ variable. - head : $ -> $ - ++ \axiom{head(p)} returns \axiom{p} if \axiom{p} belongs to - ++ \axiom{R}, otherwise returns its leading term (monomial in the - ++ AXIOM sense), where \axiom{p} is viewed as a univariate polynomial - ++ in its main variable. - tail : $ -> $ - ++ \axiom{tail(p)} returns its reductum, where \axiom{p} is viewed - ++ as a univariate polynomial in its main variable. - deepestTail : $ -> $ - ++ \axiom{deepestTail(p)} returns \axiom{0} if \axiom{p} belongs to - ++ \axiom{R}, otherwise returns tail(p), if \axiom{tail(p)} belongs - ++ to \axiom{R} or \axiom{mvar(tail(p)) < mvar(p)}, otherwise - ++ returns \axiom{deepestTail(tail(p))}. - iteratedInitials : $ -> List $ - ++ \axiom{iteratedInitials(p)} returns \axiom{[]} if \axiom{p} - ++ belongs to \axiom{R}, - ++ otherwise returns the list of the iterated initials of \axiom{p}. - deepestInitial : $ -> $ - ++ \axiom{deepestInitial(p)} returns an error if \axiom{p} belongs - ++ to \axiom{R}, - ++ otherwise returns the last term of \axiom{iteratedInitials(p)}. - leadingCoefficient : ($,V) -> $ - ++ \axiom{leadingCoefficient(p,v)} returns the leading coefficient - ++ of \axiom{p}, where \axiom{p} is viewed as A univariate - ++ polynomial in \axiom{v}. - reductum : ($,V) -> $ - ++ \axiom{reductum(p,v)} returns the reductum of \axiom{p}, where - ++ \axiom{p} is viewed as a univariate polynomial in \axiom{v}. - monic? : $ -> Boolean - ++ \axiom{monic?(p)} returns false if \axiom{p} belongs to \axiom{R}, - ++ otherwise returns true iff \axiom{p} is monic as a univariate - ++ polynomial in its main variable. - quasiMonic? : $ -> Boolean - ++ \axiom{quasiMonic?(p)} returns false if \axiom{p} belongs to - ++ \axiom{R}, otherwise returns true iff the initial of \axiom{p} - ++ lies in the base ring \axiom{R}. - mainMonomial : $ -> $ - ++ \axiom{mainMonomial(p)} returns an error if \axiom{p} is - ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns - ++ \axiom{1}, otherwise, \axiom{mvar(p)} raised to the power - ++ \axiom{mdeg(p)}. - leastMonomial : $ -> $ - ++ \axiom{leastMonomial(p)} returns an error if \axiom{p} is - ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns - ++ \axiom{1}, otherwise, the monomial of \axiom{p} with lowest - ++ degree, where \axiom{p} is viewed as a univariate polynomial in - ++ its main variable. - mainCoefficients : $ -> List $ - ++ \axiom{mainCoefficients(p)} returns an error if \axiom{p} is - ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns - ++ [p], otherwise returns the list of the coefficients of \axiom{p}, - ++ where \axiom{p} is viewed as a univariate polynomial in its main - ++ variable. - mainMonomials : $ -> List $ - ++ \axiom{mainMonomials(p)} returns an error if \axiom{p} is - ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns - ++ [1], otherwise returns the list of the monomials of \axiom{p}, - ++ where \axiom{p} is viewed as a univariate polynomial in its main - ++ variable. - RittWuCompare : ($, $) -> Union(Boolean,"failed") - ++ \axiom{RittWuCompare(a,b)} returns \axiom{"failed"} if \axiom{a} - ++ and \axiom{b} have same rank w.r.t. - ++ Ritt and Wu Wen Tsun ordering using the refinement of Lazard, - ++ otherwise returns \axiom{infRittWu?(a,b)}. - infRittWu? : ($, $) -> Boolean - ++ \axiom{infRittWu?(a,b)} returns true if \axiom{a} is less than - ++ \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the - ++ refinement of Lazard. - supRittWu? : ($, $) -> Boolean - ++ \axiom{supRittWu?(a,b)} returns true if \axiom{a} is greater - ++ than \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the - ++ refinement of Lazard. - reduced? : ($,$) -> Boolean - ++ \axiom{reduced?(a,b)} returns true iff - ++ \axiom{degree(a,mvar(b)) < mdeg(b)}. - reduced? : ($,List($)) -> Boolean - ++ \axiom{reduced?(q,lp)} returns true iff \axiom{reduced?(q,p)} - ++ holds for every \axiom{p} in \axiom{lp}. - headReduced? : ($,$) -> Boolean - ++ \axiom{headReduced?(a,b)} returns true iff - ++ \axiom{degree(head(a),mvar(b)) < mdeg(b)}. - headReduced? : ($,List($)) -> Boolean - ++ \axiom{headReduced?(q,lp)} returns true iff - ++ \axiom{headReduced?(q,p)} holds for every \axiom{p} in \axiom{lp}. - initiallyReduced? : ($,$) -> Boolean - ++ \axiom{initiallyReduced?(a,b)} returns false iff there exists an - ++ iterated initial of \axiom{a} which is not reduced w.r.t \axiom{b}. - initiallyReduced? : ($,List($)) -> Boolean - ++ \axiom{initiallyReduced?(q,lp)} returns true iff - ++ \axiom{initiallyReduced?(q,p)} holds for every \axiom{p} in - ++ \axiom{lp}. - normalized? : ($,$) -> Boolean - ++ \axiom{normalized?(a,b)} returns true iff \axiom{a} and its - ++ iterated initials have degree zero w.r.t. the main variable of - ++ \axiom{b} - normalized? : ($,List($)) -> Boolean - ++ \axiom{normalized?(q,lp)} returns true iff - ++ \axiom{normalized?(q,p)} holds - ++ for every \axiom{p} in \axiom{lp}. - prem : ($, $) -> $ - ++ \axiom{prem(a,b)} computes the pseudo-remainder of \axiom{a} by - ++ \axiom{b}, both viewed as univariate polynomials in the main - ++ variable of \axiom{b}. - pquo : ($, $) -> $ - ++ \axiom{pquo(a,b)} computes the pseudo-quotient of \axiom{a} by - ++ \axiom{b}, both viewed as univariate polynomials in the main - ++ variable of \axiom{b}. - prem : ($, $, V) -> $ - ++ \axiom{prem(a,b,v)} computes the pseudo-remainder of \axiom{a} - ++ by \axiom{b}, both viewed as univariate polynomials in \axiom{v}. - pquo : ($, $, V) -> $ - ++ \axiom{pquo(a,b,v)} computes the pseudo-quotient of \axiom{a} by - ++ \axiom{b}, both viewed as univariate polynomials in \axiom{v}. - lazyPrem : ($, $) -> $ - ++ \axiom{lazyPrem(a,b)} returns the polynomial \axiom{r} reduced - ++ w.r.t. \axiom{b} and such that \axiom{b} divides - ++ \axiom{init(b)^e a - r} where \axiom{e} - ++ is the number of steps of this pseudo-division. - lazyPquo : ($, $) -> $ - ++ \axiom{lazyPquo(a,b)} returns the polynomial \axiom{q} such that - ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]}. - lazyPrem : ($, $, V) -> $ - ++ \axiom{lazyPrem(a,b,v)} returns the polynomial \axiom{r} - ++ reduced w.r.t. \axiom{b} viewed as univariate polynomials in the - ++ variable \axiom{v} such that \axiom{b} divides - ++ \axiom{init(b)^e a - r} where \axiom{e} is the number of steps of - ++ this pseudo-division. - lazyPquo : ($, $, V) -> $ - ++ \axiom{lazyPquo(a,b,v)} returns the polynomial \axiom{q} such that - ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]}. - lazyPremWithDefault : ($, $) -> _ - Record (coef : $, gap : NonNegativeInteger, remainder : $) - ++ \axiom{lazyPremWithDefault(a,b)} returns \axiom{[c,g,r]} - ++ such that \axiom{r = lazyPrem(a,b)} and - ++ \axiom{(c**g)*r = prem(a,b)}. - lazyPremWithDefault : ($, $, V) -> _ - Record (coef : $, gap : NonNegativeInteger, remainder : $) - ++ \axiom{lazyPremWithDefault(a,b,v)} returns \axiom{[c,g,r]} - ++ such that \axiom{r = lazyPrem(a,b,v)} and - ++ \axiom{(c**g)*r = prem(a,b,v)}. - lazyPseudoDivide : ($,$) -> _ - Record(coef:$, gap: NonNegativeInteger,quotient:$, remainder:$) - ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]} - ++ such that \axiom{[c,g,r] = lazyPremWithDefault(a,b)} and - ++ \axiom{q} is the pseudo-quotient computed in this lazy - ++ pseudo-division. - lazyPseudoDivide : ($,$,V) -> _ - Record(coef:$, gap:NonNegativeInteger, quotient:$, remainder: $) - ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]} such - ++ that \axiom{r = lazyPrem(a,b,v)}, \axiom{(c**g)*r = prem(a,b,v)} - ++ and \axiom{q} is the pseudo-quotient computed in this lazy - ++ pseudo-division. - pseudoDivide : ($, $) -> Record (quotient : $, remainder : $) - ++ \axiom{pseudoDivide(a,b)} computes \axiom{[pquo(a,b),prem(a,b)]}, - ++ both polynomials viewed as univariate polynomials in the main - ++ variable of \axiom{b}, if \axiom{b} is not a constant polynomial. - monicModulo : ($, $) -> $ - ++ \axiom{monicModulo(a,b)} computes \axiom{a mod b}, if \axiom{b} is - ++ monic as univariate polynomial in its main variable. - lazyResidueClass : ($,$) -> _ - Record(polnum:$, polden:$, power:NonNegativeInteger) - ++ \axiom{lazyResidueClass(a,b)} returns \axiom{[p,q,n]} where - ++ \axiom{p / q**n} represents the residue class of \axiom{a} - ++ modulo \axiom{b} and \axiom{p} is reduced w.r.t. \axiom{b} and - ++ \axiom{q} is \axiom{init(b)}. - headReduce: ($, $) -> $ - ++ \axiom{headReduce(a,b)} returns a polynomial \axiom{r} such that - ++ \axiom{headReduced?(r,b)} holds and there exists an integer - ++ \axiom{e} such that \axiom{init(b)^e a - r} is zero modulo - ++ \axiom{b}. - initiallyReduce: ($, $) -> $ - ++ \axiom{initiallyReduce(a,b)} returns a polynomial \axiom{r} such - ++ that \axiom{initiallyReduced?(r,b)} holds and there exists an - ++ integer \axiom{e} such that \axiom{init(b)^e a - r} is zero - ++ modulo \axiom{b}. + else + -- the only operation to implement is + -- retractIfCan : PZ -> Union($,"failed") + -- when V does not have Finite - if (V has ConvertibleTo(Symbol)) - then - CoercibleTo(Polynomial R) - ConvertibleTo(Polynomial R) - if R has Algebra Fraction Integer - then - retractIfCan : Polynomial Fraction Integer -> Union($,"failed") - ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of - ++ the current domain if all its variables belong to \axiom{V}. - retract : Polynomial Fraction Integer -> $ - ++ \axiom{retract(p)} returns \axiom{p} as an element of the - ++ current domain if \axiom{retractIfCan(p)} does not return - ++ "failed", otherwise an error is produced. - convert : Polynomial Fraction Integer -> $ - ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}. - retractIfCan : Polynomial Integer -> Union($,"failed") - ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of - ++ the current domain if all its variables belong to \axiom{V}. - retract : Polynomial Integer -> $ - ++ \axiom{retract(p)} returns \axiom{p} as an element of the - ++ current domain if \axiom{retractIfCan(p)} does not return - ++ "failed", otherwise an error is produced. - convert : Polynomial Integer -> $ - ++ \axiom{convert(p)} returns the same as \axiom{retract(p)} - if not (R has QuotientFieldCategory(Integer)) - then - retractIfCan : Polynomial R -> Union($,"failed") - ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element - ++ of the current domain if all its variables belong to - ++ \axiom{V}. - retract : Polynomial R -> $ - ++ \axiom{retract(p)} returns \axiom{p} as an element of the - ++ current domain if \axiom{retractIfCan(p)} does not - ++ return "failed", otherwise an error is produced. - if (R has Algebra Integer) and not(R has Algebra Fraction Integer) - then - retractIfCan : Polynomial Integer -> Union($,"failed") - ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of - ++ the current domain if all its variables belong to \axiom{V}. - retract : Polynomial Integer -> $ - ++ \axiom{retract(p)} returns \axiom{p} as an element of the - ++ current domain if \axiom{retractIfCan(p)} does not return - ++ "failed", otherwise an error is produced. - convert : Polynomial Integer -> $ - ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}. - if not (R has IntegerNumberSystem) - then - retractIfCan : Polynomial R -> Union($,"failed") - ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element - ++ of the current domain if all its variables belong to - ++ \axiom{V}. - retract : Polynomial R -> $ - ++ \axiom{retract(p)} returns \axiom{p} as an element of the - ++ current domain if \axiom{retractIfCan(p)} does not - ++ return "failed", otherwise an error is produced. - if not(R has Algebra Integer) and not(R has Algebra Fraction Integer) - then - retractIfCan : Polynomial R -> Union($,"failed") - ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of - ++ the current domain if all its variables belong to \axiom{V}. - retract : Polynomial R -> $ - ++ \axiom{retract(p)} returns \axiom{p} as an element of the - ++ current domain if \axiom{retractIfCan(p)} does not return - ++ "failed", otherwise an error is produced. - convert : Polynomial R -> $ - ++ \axiom{convert(p)} returns \axiom{p} as an element of the current - ++ domain if all its variables belong to \axiom{V}, otherwise an - ++ error is produced. + mpc2RZ := MPolyCatFunctions2(Symbol,IES,IES,R,Z,PR,PZ) + RToZ(r:R):Z == retract(r)@Z + PRToPZ (pr:PR):PZ == map(RToZ,pr)$mpc2RZ - if R has RetractableTo(Integer) - then - ConvertibleTo(String) + if V has Finite + then + convert(pr:PR) == + lrif : Union($,"failed") := _ + localRetractIfCan(pr)@Union($,"failed") + (lrif case "failed") => error _ + "failed in convert: PR->$ from RPOLCAT" + lrif::$ + retractIfCan(pz:PZ) == + localRetractIfCanPZ(pz)@Union($,"failed") + else + convert(pr:PR) == + pz : PZ := PRToPZ(pr) + retract(pz)@$ - if R has IntegralDomain - then - primPartElseUnitCanonical : $ -> $ - ++ \axiom{primPartElseUnitCanonical(p)} returns - ++ \axiom{primitivePart(p)} if \axiom{R} is a gcd-domain, - ++ otherwise \axiom{unitCanonical(p)}. - primPartElseUnitCanonical! : $ -> $ - ++ \axiom{primPartElseUnitCanonical!(p)} replaces \axiom{p} - ++ by \axiom{primPartElseUnitCanonical(p)}. - exactQuotient : ($,R) -> $ - ++ \axiom{exactQuotient(p,r)} computes the exact quotient of - ++ \axiom{p} by \axiom{r}, which is assumed to be a divisor of - ++ \axiom{p}. No error is returned if this exact quotient fails! - exactQuotient! : ($,R) -> $ - ++ \axiom{exactQuotient!(p,r)} replaces \axiom{p} by - ++ \axiom{exactQuotient(p,r)}. - exactQuotient : ($,$) -> $ - ++ \axiom{exactQuotient(a,b)} computes the exact quotient of - ++ \axiom{a} by \axiom{b}, which is assumed to be a divisor of - ++ \axiom{a}. No error is returned if this exact quotient fails! - exactQuotient! : ($,$) -> $ - ++ \axiom{exactQuotient!(a,b)} replaces \axiom{a} by - ++ \axiom{exactQuotient(a,b)} - subResultantGcd : ($, $) -> $ - ++ \axiom{subResultantGcd(a,b)} computes a gcd of \axiom{a} and - ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the - ++ same main variable \axiom{v} and are viewed as univariate - ++ polynomials in \axiom{v} with coefficients in the fraction - ++ field of the polynomial ring generated by their other variables - ++ over \axiom{R}. - extendedSubResultantGcd : ($, $) -> _ - Record (gcd : $, coef1 : $, coef2 : $) - ++ \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[ca,cb,r]} - ++ such that \axiom{r} is \axiom{subResultantGcd(a,b)} and we have - ++ \axiom{ca * a + cb * cb = r} . - halfExtendedSubResultantGcd1: ($, $) -> Record (gcd : $, coef1 : $) - ++ \axiom{halfExtendedSubResultantGcd1(a,b)} returns \axiom{[g,ca]} - ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]} - ++ otherwise produces an error. - halfExtendedSubResultantGcd2: ($, $) -> Record (gcd : $, coef2 : $) - ++ \axiom{halfExtendedSubResultantGcd2(a,b)} returns \axiom{[g,cb]} - ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]} - ++ otherwise produces an error. - resultant : ($, $) -> $ - ++ \axiom{resultant(a,b)} computes the resultant of \axiom{a} and - ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the - ++ same main variable \axiom{v} and are viewed as univariate - ++ polynomials in \axiom{v}. - subResultantChain : ($, $) -> List $ - ++ \axiom{subResultantChain(a,b)}, where \axiom{a} and \axiom{b} - ++ are not contant polynomials with the same main variable, returns - ++ the subresultant chain of \axiom{a} and \axiom{b}. - lastSubResultant: ($, $) -> $ - ++ \axiom{lastSubResultant(a,b)} returns the last non-zero - ++ subresultant of \axiom{a} and \axiom{b} where \axiom{a} and - ++ \axiom{b} are assumed to have the same main variable \axiom{v} - ++ and are viewed as univariate polynomials in \axiom{v}. - LazardQuotient: ($, $, NonNegativeInteger) -> $ - ++ \axiom{LazardQuotient(a,b,n)} returns \axiom{a**n exquo b**(n-1)} - ++ assuming that this quotient does not fail. - LazardQuotient2: ($, $, $, NonNegativeInteger) -> $ - ++ \axiom{LazardQuotient2(p,a,b,n)} returns - ++ \axiom{(a**(n-1) * p) exquo b**(n-1)} - ++ assuming that this quotient does not fail. - next_subResultant2: ($, $, $, $) -> $ - ++ \axiom{nextsubResultant2(p,q,z,s)} is the multivariate version - ++ of the operation - ++ next_sousResultant2 from PseudoRemainderSequence from - ++ the \axiomType{PseudoRemainderSequence} constructor. - if R has GcdDomain - then - gcd : (R,$) -> R - ++ \axiom{gcd(r,p)} returns the gcd of \axiom{r} and the content - ++ of \axiom{p}. - primitivePart! : $ -> $ - ++ \axiom{primitivePart!(p)} replaces \axiom{p} by its primitive - ++ part. - mainContent : $ -> $ - ++ \axiom{mainContent(p)} returns the content of \axiom{p} viewed - ++ as a univariate polynomial in its main variable and with - ++ coefficients in the polynomial ring generated by its other - ++ variables over \axiom{R}. - mainPrimitivePart : $ -> $ - ++ \axiom{mainPrimitivePart(p)} returns the primitive part of - ++ \axiom{p} viewed as a univariate polynomial in its main - ++ variable and with coefficients in the polynomial ring generated - ++ by its other variables over \axiom{R}. - mainSquareFreePart : $ -> $ - ++ \axiom{mainSquareFreePart(p)} returns the square free part of - ++ \axiom{p} viewed as a univariate polynomial in its main - ++ variable and with coefficients in the polynomial ring - ++ generated by its other variables over \axiom{R}. + if not(R has Algebra Integer) and not(R has Algebra Fraction Integer) + then + -- the only operation to implement is + -- retractIfCan : PR -> Union($,"failed") - add + if V has Finite + then + retractIfCan(pr:PR) == + localRetractIfCan(pr)@Union($,"failed") + + retract(pr:PR) == + rif : Union($,"failed") := retractIfCan(pr)@Union($,"failed") + (rif case "failed") => error _ + "failed in retract: POLY Z -> $ from RPOLCAT" + rif::$ + + convert(pr:PR) == + retract(pr)@$ + + if (R has RetractableTo(INT)) + then + + convert(pol:$):String == + ground?(pol) => convert(retract(ground(pol))@INT)@String + ipol : $ := init(pol) + vpol : V := mvar(pol) + dpol : NNI := mdeg(pol) + tpol: $ := tail(pol) + sipol,svpol,sdpol,stpol : String + if (ipol = 1) + then + sipol := empty()$String + else + if ((-ipol) = 1) + then + sipol := "-" + else + sipol := convert(ipol)@String + if not monomial?(ipol) + then + sipol := concat(["(",sipol,")*"])$String + else + sipol := concat(sipol,"*")$String + svpol := string(convert(vpol)@Symbol) + if (dpol = 1) + then + sdpol := empty()$String + else + sdpol := _ + concat("**",convert(convert(dpol)@INT)@String )$String + if zero? tpol + then + stpol := empty()$String + else + if ground?(tpol) + then + n := retract(ground(tpol))@INT + if n > 0 + then + stpol := concat(" +",convert(n)@String)$String + else + stpol := convert(n)@String + else + stpol := convert(tpol)@String + if _ + not member?((stpol.1)::String,["+","-"])$(List String) + then + stpol := concat(" + ",stpol)$String + concat([sipol,svpol,sdpol,stpol])$String + +\end{chunk} + +\begin{chunk}{COQ RPOLCAT} +(* category RPOLCAT *) +(* O ==> OutputForm NNI ==> NonNegativeInteger INT ==> Integer - exactQuo : (R,R) -> R - + coerce : % -> OutputForm coerce(p:$):O == ground? (p) => (ground(p))::O --- if one?((ip := init(p))) if (((ip := init(p))) = 1) then if zero?((tp := tail(p))) then --- if one?((dp := mdeg(p))) if (((dp := mdeg(p))) = 1) then return((mvar(p))::O) else return(((mvar(p))::O **$O (dp::O))) else --- if one?((dp := mdeg(p))) if (((dp := mdeg(p))) = 1) then return((mvar(p))::O +$O (tp::O)) @@ -66728,96 +77310,111 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ else if zero?((tp := tail(p))) then --- if one?((dp := mdeg(p))) if (((dp := mdeg(p))) = 1) then return((ip::O) *$O (mvar(p))::O) else return((ip::O) *$O ((mvar(p))::O **$O (dp::O))) else --- if one?(mdeg(p)) if ((mdeg(p)) = 1) then return(((ip::O) *$O (mvar(p))::O) +$O (tp::O)) ((ip)::O *$O ((mvar(p))::O **$O ((mdeg(p)::O))) +$O (tail(p)::O)) + mvar : % -> V mvar p == ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant." mainVariable(p)::V + mdeg : % -> NonNegativeInteger mdeg p == ground?(p) => 0$NNI degree(p,mainVariable(p)::V) + init : % -> % init p == ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant." v := mainVariable(p)::V coefficient(p,v,degree(p,v)) + leadingCoefficient : (%,V) -> % leadingCoefficient (p,v) == zero? (d := degree(p,v)) => p coefficient(p,v,d) + head : % -> % head p == ground? p => p v := mainVariable(p)::V d := degree(p,v) monomial(coefficient(p,v,d),v,d) + reductum : (%,V) -> % reductum(p,v) == zero? (d := degree(p,v)) => 0$$ p - monomial(coefficient(p,v,d),v,d) + tail : % -> % tail p == ground? p => 0$$ p - head(p) + deepestTail : % -> % deepestTail p == ground? p => 0$$ ground? tail(p) => tail(p) mvar(p) > mvar(tail(p)) => tail(p) deepestTail(tail(p)) + iteratedInitials : % -> List(%) iteratedInitials p == ground? p => [] p := init(p) cons(p,iteratedInitials(p)) + localDeepestInitial : $ -> $ localDeepestInitial (p : $) : $ == ground? p => p localDeepestInitial init p + deepestInitial : % -> % deepestInitial p == ground? p => _ error"Error in deepestInitial from RPOLCAT : #1 is constant." localDeepestInitial init p + monic? : % -> Boolean monic? p == ground? p => false (recip(init(p))$$ case $)@Boolean + quasiMonic? : % -> Boolean quasiMonic? p == ground? p => false ground?(init(p)) + mainMonomial : % -> % mainMonomial p == zero? p => error"Error in mainMonomial from RPOLCAT : #1 is zero" ground? p => 1$$ v := mainVariable(p)::V monomial(1$$,v,degree(p,v)) + leastMonomial : % -> % leastMonomial p == zero? p => error"Error in leastMonomial from RPOLCAT : #1 is zero" ground? p => 1$$ v := mainVariable(p)::V monomial(1$$,v,minimumDegree(p,v)) + mainCoefficients : % -> List(%) mainCoefficients p == zero? p => error"Error in mainCoefficients from RPOLCAT : #1 is zero" ground? p => [p] v := mainVariable(p)::V coefficients(univariate(p,v)@SparseUnivariatePolynomial($)) + mainMonomials : % -> List(%) mainMonomials p == zero? p => error"Error in mainMonomials from RPOLCAT : #1 is zero" ground? p => [1$$] @@ -66825,6 +77422,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ lm := monomials(univariate(p,v)@SparseUnivariatePolynomial($)) [monomial(1$$,v,degree(m)) for m in lm] + RittWuCompare : (%,%) -> Union(Boolean,"failed") RittWuCompare (a,b) == (ground? b and ground? a) => "failed"::Union(Boolean,"failed") ground? b => false::Union(Boolean,"failed") @@ -66837,39 +77435,48 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ lc case Boolean => lc RittWuCompare(tail(a),tail(b)) + infRittWu? : (%,%) -> Boolean infRittWu? (a,b) == lc : Union(Boolean,"failed") := RittWuCompare(a,b) lc case Boolean => lc::Boolean false + supRittWu? : (%,%) -> Boolean supRittWu? (a,b) == infRittWu? (b,a) + prem : (%,%) -> % prem (a:$, b:$) : $ == cP := lazyPremWithDefault (a,b) ((cP.coef) ** (cP.gap)) * cP.remainder + pquo : (%,%) -> % pquo (a:$, b:$) : $ == cPS := lazyPseudoDivide (a,b) c := (cPS.coef) ** (cPS.gap) c * cPS.quotient + prem : (%,%,V) -> % prem (a:$, b:$, v:V) : $ == cP := lazyPremWithDefault (a,b,v) ((cP.coef) ** (cP.gap)) * cP.remainder + pquo : (%,%,V) -> % pquo (a:$, b:$, v:V) : $ == cPS := lazyPseudoDivide (a,b,v) c := (cPS.coef) ** (cPS.gap) c * cPS.quotient + lazyPrem : (%,%) -> % lazyPrem (a:$, b:$) : $ == (not ground?(b)) and (monic?(b)) => monicModulo(a,b) (lazyPremWithDefault (a,b)).remainder + lazyPquo : (%,%) -> % lazyPquo (a:$, b:$) : $ == (lazyPseudoDivide (a,b)).quotient + lazyPrem : (%,%,V) -> % lazyPrem (a:$, b:$, v:V) : $ == zero? b => _ error"Error in lazyPrem : ($,$,V) -> $ from RPOLCAT : #2 is zero" @@ -66888,9 +77495,11 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ test := degree(a,v)::INT - dbv a + lazyPquo : (%,%,V) -> % lazyPquo (a:$, b:$, v:V) : $ == (lazyPseudoDivide (a,b,v)).quotient + headReduce : (%,%) -> % headReduce (a:$,b:$) == ground? b => error _ "Error in headReduce : ($,$) -> Boolean from TSETCAT : #2 is constant" @@ -66905,6 +77514,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ a := lrc.polnum + (lrc.polden)**(lrc.power) * tail(a) a + initiallyReduce : (%,%) -> % initiallyReduce(a:$,b:$) == ground? b => error _ "Error in initiallyReduce : ($,$) -> Boolean from TSETCAT : #2 is constant" @@ -66935,6 +77545,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ ia := init(ia) ia * ma + ta + lazyPremWithDefault : (%,%) -> + Record(coef: %,gap: NonNegativeInteger,remainder: %) lazyPremWithDefault (a,b) == ground?(b) => error _ "Error in lazyPremWithDefault from RPOLCAT : #2 is constant" @@ -66962,7 +77574,9 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ test := degree(a,xb)::INT - db [lcb, (delta::NNI), a] - lazyPremWithDefault (a,b,v) == + lazyPremWithDefault : (%,%,V) -> + Record(coef: %,gap: NonNegativeInteger,remainder: %) + lazyPremWithDefault (a,b,v) == zero? b => error _ "Error in lazyPremWithDefault : ($,$,V) -> $ from RPOLCAT : #2 is zero" ground?(b) => [b,1$NNI,0$$] @@ -66982,11 +77596,14 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ test := degree(a,v)::INT - dbv [lcbv, (delta::NNI), a] + pseudoDivide : (%,%) -> Record(quotient: %,remainder: %) pseudoDivide (a,b) == cPS := lazyPseudoDivide (a,b) c := (cPS.coef) ** (cPS.gap) [c * cPS.quotient, c * cPS.remainder] + lazyPseudoDivide : (%,%) -> + Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) lazyPseudoDivide (a,b) == ground?(b) => error _ "Error in lazyPseudoDivide from RPOLCAT : #2 is constant" @@ -67017,6 +77634,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ test := degree(a,xb)::INT - db [lcb, (delta::NNI), q, a] + lazyPseudoDivide : (%,%,V) -> + Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) lazyPseudoDivide (a,b,v) == zero? b => error _ "Error in lazyPseudoDivide : ($,$,V) -> $ from RPOLCAT : #2 is zero" @@ -67039,6 +77658,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ test := degree(a,v)::INT - dbv [lcbv, (delta::NNI), q, a] + monicModulo : (%,%) -> % monicModulo (a,b) == ground?(b) => error"Error in monicModulo from RPOLCAT : #2 is constant" rec : Union($,"failed") @@ -67048,6 +77668,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ ground? a => a ib * ((lazyPremWithDefault ((rec::$) * a,(rec::$) * b)).remainder) + lazyResidueClass : (%,%) -> + Record(polnum: %,polden: %,power: NonNegativeInteger) lazyResidueClass(a,b) == zero? b => [a,1$$,0$NNI] ground? b => [0$$,1$$,0$NNI] @@ -67076,21 +77698,26 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ test := degree(a,xb)::INT - db [a,lcb,pow] + reduced? : (%,%) -> Boolean reduced? (a:$,b:$) : Boolean == degree(a,mvar(b)) < mdeg(b) + reduced? : (%,List(%)) -> Boolean reduced? (p:$, lq : List($)) : Boolean == ground? p => true while (not empty? lq) and (reduced?(p, first lq)) repeat lq := rest lq empty? lq + headReduced? : (%,%) -> Boolean headReduced? (a:$,b:$) : Boolean == reduced?(head(a),b) + headReduced? : (%,List(%)) -> Boolean headReduced? (p:$, lq : List($)) : Boolean == reduced?(head(p),lq) + initiallyReduced? : (%,%) -> Boolean initiallyReduced? (a:$,b:$) : Boolean == ground? b => error _ "Error in initiallyReduced? : ($,$) -> Bool. from RPOLCAT : #2 is constant" @@ -67099,12 +77726,14 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ (mvar(a) = mvar(b)) => reduced?(a,b) initiallyReduced?(init(a),b) + initiallyReduced? : (%,List(%)) -> Boolean initiallyReduced? (p:$, lq : List($)) : Boolean == ground? p => true while (not empty? lq) and (initiallyReduced?(p, first lq)) repeat lq := rest lq empty? lq + normalized? : (%,%) -> Boolean normalized?(a:$,b:$) : Boolean == ground? b => error _ "Error in normalized? : ($,$) -> Boolean from TSETCAT : #2 is constant" @@ -67113,6 +77742,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ (mvar(a) = mvar(b)) => false normalized?(init(a),b) + normalized? : (%,List(%)) -> Boolean normalized? (p:$, lq : List($)) : Boolean == while (not empty? lq) and (normalized?(p, first lq)) repeat lq := rest lq @@ -67123,19 +77753,27 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if R has EuclideanDomain then + + exactQuo : (R,R) -> R exactQuo(r:R,s:R):R == r quo$R s + else + + exactQuo : (R,R) -> R exactQuo(r:R,s:R):R == (r exquo$R s)::R + exactQuotient : (%,R) -> % exactQuotient (p:$,r:R) == (p exquo$$ r)::$ + exactQuotient : (%,%) -> % exactQuotient (a:$,b:$) == ground? b => exactQuotient(a,ground(b)) (a exquo$$ b)::$ + exactQuotient! : (%,%) -> % exactQuotient! (a:$,b:$) == ground? b => exactQuotient!(a,ground(b)) a := (a exquo$$ b)::$ @@ -67143,12 +77781,13 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if (R has GcdDomain) and not(R has Field) then + primPartElseUnitCanonical : % -> % primPartElseUnitCanonical p == primitivePart p + primitivePart! : % -> % primitivePart! p == zero? p => p --- if one?(cp := content(p)) if ((cp := content(p)) = 1) then p := unitCanonical p @@ -67156,13 +77795,17 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ p := unitCanonical exactQuotient!(p,cp) p + primPartElseUnitCanonical! : % -> % if R has INTDOM primPartElseUnitCanonical! p == primitivePart! p else + + primPartElseUnitCanonical : % -> % primPartElseUnitCanonical p == unitCanonical p + primPartElseUnitCanonical! : % -> % if R has INTDOM primPartElseUnitCanonical! p == p := unitCanonical p @@ -67170,21 +77813,24 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if R has GcdDomain then + gcd : (%,%) -> % gcd(r:R,p:$):R == --- one? r => r (r = 1) => r zero? p => r ground? p => gcd(r,ground(p))$R gcd(gcd(r,init(p)),tail(p)) + mainContent : % -> % mainContent p == zero? p => p "gcd"/mainCoefficients(p) + mainPrimitivePart : % -> % mainPrimitivePart p == zero? p => p (unitNormal((p exquo$$ mainContent(p))::$)).canonical + mainSquareFreePart : % -> % mainSquareFreePart p == ground? p => p v := mainVariable(p)::V @@ -67202,6 +77848,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ Q ==> Fraction Integer Z ==> Integer + convert : % -> Polynomial(R) convert(p:$) : PR == ground? p => (ground(p)$$)::PR v : V := mvar(p) @@ -67209,24 +77856,20 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ convert(init(p))@PR *$PR _ ((convert(v)@Symbol)::PR)**d +$PR convert(tail(p))@PR + coerce : % -> Polynomial(R) coerce(p:$) : PR == convert(p)@PR - localRetract : PR -> $ - localRetractPQ : PQ -> $ - localRetractPZ : PZ -> $ - localRetractIfCan : PR -> Union($,"failed") - localRetractIfCanPQ : PQ -> Union($,"failed") - localRetractIfCanPZ : PZ -> Union($,"failed") - if V has Finite then sizeV : NNI := size()$V + lv : List Symbol lv := _ [convert(index(i::PositiveInteger)$V)@Symbol for i in 1..sizeV] + localRetract : PR -> $ localRetract(p : PR) : $ == ground? p => (ground(p)$PR)::$ mvp : Symbol := (mainVariable(p)$PR)::Symbol @@ -67245,6 +77888,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if R has Algebra Fraction Integer then + + localRetractPQ : PQ -> $ localRetractPQ(pq:PQ):$ == ground? pq => ((ground(pq)$PQ)::R)::$ mvp : Symbol := (mainVariable(pq)$PQ)::Symbol @@ -67263,6 +77908,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if R has Algebra Integer then + + localRetractPZ : PZ -> $ localRetractPZ(pz:PZ):$ == ground? pz => ((ground(pz)$PZ)::R)::$ mvp : Symbol := (mainVariable(pz)$PZ)::Symbol @@ -67279,32 +77926,38 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ pz := pz -$PZ monomial(coefficient(pz,mvp,d)$PZ,mvp,d)$PZ newp +$$ localRetractPZ(pz) + retractable? : PR -> Boolean retractable?(p:PR):Boolean == lvp := variables(p)$PR while not empty? lvp and member?(first lvp,lv) repeat lvp := rest lvp empty? lvp + retractablePQ? : PQ -> Boolean retractablePQ?(p:PQ):Boolean == lvp := variables(p)$PQ while not empty? lvp and member?(first lvp,lv) repeat lvp := rest lvp empty? lvp + retractablePZ? : PZ -> Boolean retractablePZ?(p:PZ):Boolean == lvp := variables(p)$PZ while not empty? lvp and member?(first lvp,lv) repeat lvp := rest lvp empty? lvp + localRetractIfCan : PR -> Union($,"failed") localRetractIfCan(p : PR): Union($,"failed") == not retractable?(p) => "failed"::Union($,"failed") localRetract(p)::Union($,"failed") + localRetractIfCanPQ : PQ -> Union($,"failed") localRetractIfCanPQ(p : PQ): Union($,"failed") == not retractablePQ?(p) => "failed"::Union($,"failed") localRetractPQ(p)::Union($,"failed") + localRetractIfCanPZ : PZ -> Union($,"failed") localRetractIfCanPZ(p : PZ): Union($,"failed") == not retractablePZ?(p) => "failed"::Union($,"failed") localRetractPZ(p)::Union($,"failed") @@ -67314,26 +77967,38 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR) mpc2Q := MPolyCatFunctions2(Symbol,IES,IES,Q,R,PQ,PR) + + ZToR : Z -> R ZToR (z:Z):R == coerce(z)@R + + QToR : Q -> R QToR (q:Q):R == coerce(q)@R + + PZToPR : PZ -> PR PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z + + PQToPR : PQ -> PR PQToPR (pq:PQ):PR == map(QToR,pq)$mpc2Q + retract : Polynomial(Integer) -> % retract(pz:PZ) == rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed") (rif case "failed") => error _ "failed in retract: POLY Z -> $ from RPOLCAT" rif::$ + convert : Polynomial(Integer) -> % convert(pz:PZ) == retract(pz)@$ + retract : Polynomial(Fraction(Integer)) -> % retract(pq:PQ) == rif : Union($,"failed") := retractIfCan(pq)@Union($,"failed") (rif case "failed") => error _ "failed in retract: POLY Z -> $ from RPOLCAT" rif::$ + convert : Polynomial(Fraction(Integer)) -> % convert(pq:PQ) == retract(pq)@$ @@ -67345,20 +78010,29 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if V has Finite then + + retractIfCan : Polynomial(R) -> Union(%,"failed") retractIfCan(pr:PR) == localRetractIfCan(pr)@Union($,"failed") + retractIfCan : Polynomial(Fraction(Integer)) -> + Union(%,"failed") retractIfCan(pq:PQ) == localRetractIfCanPQ(pq)@Union($,"failed") else + + retractIfCan : Polynomial(Fraction(Integer)) -> + Union(%,"failed") retractIfCan(pq:PQ) == pr : PR := PQToPR(pq) retractIfCan(pr)@Union($,"failed") + retractIfCan : Polynomial(Integer) -> Union(%,"failed") retractIfCan(pz:PZ) == pr : PR := PZToPR(pz) retractIfCan(pr)@Union($,"failed") + retract : Polynomial(R) -> % retract(pr:PR) == rif : Union($,"failed") := _ retractIfCan(pr)@Union($,"failed") @@ -67366,30 +78040,44 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ "failed in retract: POLY Z -> $ from RPOLCAT" rif::$ + convert : Polynomial(R) -> % convert(pr:PR) == retract(pr)@$ else + -- the only operation to implement is -- retractIfCan : PQ -> Union($,"failed") -- when V does not have Finite mpc2ZQ := MPolyCatFunctions2(Symbol,IES,IES,Z,Q,PZ,PQ) mpc2RQ := MPolyCatFunctions2(Symbol,IES,IES,R,Q,PR,PQ) + + ZToQ : Z -> Q ZToQ(z:Z):Q == coerce(z)@Q + + RToQ : R -> Q RToQ(r:R):Q == retract(r)@Q + PZToPQ : PZ -> PQ PZToPQ (pz:PZ):PQ == map(ZToQ,pz)$mpc2ZQ + + PRToPQ : PR -> PQ PRToPQ (pr:PR):PQ == map(RToQ,pr)$mpc2RQ + retractIfCan : Polynomial(Integer) -> Union(%,"failed") retractIfCan(pz:PZ) == pq : PQ := PZToPQ(pz) retractIfCan(pq)@Union($,"failed") if V has Finite then + + retractIfCan : Polynomial(Fraction(Integer)) -> + Union(%,"failed") retractIfCan(pq:PQ) == localRetractIfCanPQ(pq)@Union($,"failed") + convert : Polynomial(R) -> % convert(pr:PR) == lrif : Union($,"failed") := _ localRetractIfCan(pr)@Union($,"failed") @@ -67397,6 +78085,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ "failed in convert: PR->$ from RPOLCAT" lrif::$ else + + convert : Polynomial(R) -> % convert(pr:PR) == pq : PQ := PRToPQ(pr) retract(pq)@$ @@ -67405,15 +78095,21 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ then mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR) + + ZToR : Z -> R ZToR (z:Z):R == coerce(z)@R + + PZToPR : PZ -> PR PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z + retract : Polynomial(Integer) -> % retract(pz:PZ) == rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed") (rif case "failed") => error _ "failed in retract: POLY Z -> $ from RPOLCAT" rif::$ + convert : Polynomial(Integer) -> % convert(pz:PZ) == retract(pz)@$ @@ -67425,22 +78121,32 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if V has Finite then + + retractIfCan : Polynomial(R) -> Union(%,"failed") retractIfCan(pr:PR) == localRetractIfCan(pr)@Union($,"failed") + retractIfCan : Polynomial(Fraction(Integer)) -> + Union(%,"failed") retractIfCan(pz:PZ) == localRetractIfCanPZ(pz)@Union($,"failed") + else + + retractIfCan : Polynomial(Fraction(Integer)) -> + Union(%,"failed") retractIfCan(pz:PZ) == pr : PR := PZToPR(pz) retractIfCan(pr)@Union($,"failed") + retract : Polynomial(R) -> % retract(pr:PR) == rif : Union($,"failed"):=retractIfCan(pr)@Union($,"failed") (rif case "failed") => error _ "failed in retract: POLY Z -> $ from RPOLCAT" rif::$ + convert : % -> Polynomial(R) convert(pr:PR) == retract(pr)@$ @@ -67450,20 +78156,31 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ -- when V does not have Finite mpc2RZ := MPolyCatFunctions2(Symbol,IES,IES,R,Z,PR,PZ) + + RToZ : R -> Z RToZ(r:R):Z == retract(r)@Z + + PRToPZ : PR -> PZ PRToPZ (pr:PR):PZ == map(RToZ,pr)$mpc2RZ if V has Finite then + + convert : % -> Polynomial(R) convert(pr:PR) == lrif : Union($,"failed") := _ localRetractIfCan(pr)@Union($,"failed") (lrif case "failed") => error _ "failed in convert: PR->$ from RPOLCAT" lrif::$ + + retractIfCan : Polynomial(Integer) -> Union(%,"failed") retractIfCan(pz:PZ) == localRetractIfCanPZ(pz)@Union($,"failed") + else + + convert : % -> Polynomial(R) convert(pr:PR) == pz : PZ := PRToPZ(pr) retract(pz)@$ @@ -67476,21 +78193,26 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ if V has Finite then + + retractIfCan : Polynomial(R) -> Union(%,"failed") retractIfCan(pr:PR) == localRetractIfCan(pr)@Union($,"failed") + retract : Polynomial(R) -> % retract(pr:PR) == rif : Union($,"failed") := retractIfCan(pr)@Union($,"failed") (rif case "failed") => error _ "failed in retract: POLY Z -> $ from RPOLCAT" rif::$ + convert : % -> Polynomial(R) convert(pr:PR) == retract(pr)@$ if (R has RetractableTo(INT)) then + convert : % -> String convert(pol:$):String == ground?(pol) => convert(retract(ground(pol))@INT)@String ipol : $ := init(pol) @@ -67498,12 +78220,10 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ dpol : NNI := mdeg(pol) tpol: $ := tail(pol) sipol,svpol,sdpol,stpol : String --- if one? ipol if (ipol = 1) then sipol := empty()$String else --- if one?(-ipol) if ((-ipol) = 1) then sipol := "-" @@ -67515,7 +78235,6 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ else sipol := concat(sipol,"*")$String svpol := string(convert(vpol)@Symbol) --- if one? dpol if (dpol = 1) then sdpol := empty()$String @@ -67542,13 +78261,17 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ stpol := concat(" + ",stpol)$String concat([sipol,svpol,sdpol,stpol])$String +*) + \end{chunk} + \begin{chunk}{RPOLCAT.dotabb} "RPOLCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=RPOLCAT"]; "RPOLCAT" -> "POLYCAT" \end{chunk} + \begin{chunk}{RPOLCAT.dotfull} "RecursivePolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" [color=lightblue,href="bookvol10.2.pdf#nameddest=RPOLCAT"]; @@ -67556,6 +78279,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_ -> "PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)" \end{chunk} + \begin{chunk}{RPOLCAT.dotpic} digraph pic { fontsize=10; @@ -67610,6 +78334,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnivariateLaurentSeriesCategory}{ULSCAT} \pagepic{ps/v102univariatelaurentseriescategory.ps}{ULSCAT}{0.50} @@ -67761,6 +78486,7 @@ rationalFunction(w,0) )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariateLaurentSeriesCategory.help} ==================================================================== UnivariateLaurentSeriesCategory examples @@ -68198,6 +78924,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where --++ In fact, K((x)) is the quotient field of K[[x]]. \end{chunk} + \begin{chunk}{ULSCAT.dotabb} "ULSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCAT"]; @@ -68207,6 +78934,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where "ULSCAT" -> "RADCAT" \end{chunk} + \begin{chunk}{ULSCAT.dotfull} "UnivariateLaurentSeriesCategory(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCAT"]; @@ -68220,6 +78948,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where "UnivariatePowerSeriesCategory(a:Ring,Integer)" \end{chunk} + \begin{chunk}{ULSCAT.dotpic} digraph pic { fontsize=10; @@ -68262,6 +78991,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnivariatePuiseuxSeriesCategory}{UPXSCAT} \pagepic{ps/v102univariatepuiseuxseriescategory.ps}{UPXSCAT}{0.50} @@ -68406,6 +79136,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariatePuiseuxSeriesCategory.help} ==================================================================== UnivariatePuiseuxSeriesCategory examples @@ -68809,6 +79540,7 @@ UnivariatePuiseuxSeriesCategory(Coef): Category == Definition where --++ Univariate Puiseux series over a field form a field. \end{chunk} + \begin{chunk}{UPXSCAT.dotabb} "UPXSCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCAT"]; @@ -68818,6 +79550,7 @@ UnivariatePuiseuxSeriesCategory(Coef): Category == Definition where "UPXSCAT" -> "UPSCAT" \end{chunk} + \begin{chunk}{UPXSCAT.dotfull} "UnivariatePuiseuxSeriesCategory(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCAT"]; @@ -68831,6 +79564,7 @@ UnivariatePuiseuxSeriesCategory(Coef): Category == Definition where "RadicalCategory()" \end{chunk} + \begin{chunk}{UPXSCAT.dotpic} digraph pic { fontsize=10; @@ -68873,6 +79607,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnivariatePolynomialCategory}{UPOLYC} \pagepic{ps/v102univariatepolynomialcategory.ps}{UPOLYC}{0.35} @@ -69085,6 +79820,7 @@ t3:UP(x,FRAC(INT)):=unvectorise(t2) )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariatePolynomialCategory.help} ==================================================================== UnivariatePolynomialCategory examples @@ -70006,6 +80742,370 @@ UnivariatePolynomialCategory(R:Ring): Category == ans \end{chunk} + +\begin{chunk}{COQ UPOLYC} +(* category UPOLYC *) +(* + pp,qq: SparseUnivariatePolynomial % + + variables : % -> List(SingletonAsOrderedSet) + variables(p) == + zero? p or zero?(degree p) => [] + [create()] + + degree : (%,List(SingletonAsOrderedSet)) -> List(NonNegativeInteger) + degree(p:%,v:SingletonAsOrderedSet) == degree p + + totalDegree : (%,List(SingletonAsOrderedSet)) -> NonNegativeInteger + totalDegree(p:%,lv:List SingletonAsOrderedSet) == + empty? lv => 0 + totalDegree p + + degree : (%,List(SingletonAsOrderedSet)) -> List(NonNegativeInteger) + degree(p:%,lv:List SingletonAsOrderedSet) == + empty? lv => [] + [degree p] + + eval : (%,List(SingletonAsOrderedSet),List(%)) -> % + eval(p:%,lv: List SingletonAsOrderedSet,lq: List %):% == + empty? lv => p + not empty? rest lv => _ + error "can only eval a univariate polynomial once" + eval(p,first lv,first lq)$% + + eval : (%,SingletonAsOrderedSet,%) -> % + eval(p:%,v:SingletonAsOrderedSet,q:%):% == p(q) + + eval(p:%,lv: List SingletonAsOrderedSet,lr: List R):% == + empty? lv => p + not empty? rest lv => _ + error "can only eval a univariate polynomial once" + eval(p,first lv,first lr)$% + + eval : (%,List(SingletonAsOrderedSet),List(R)) -> % + eval(p:%,v:SingletonAsOrderedSet,r:R):% == p(r)::% + + eval : (%,List(Equation(%))) -> % + eval(p:%,le:List Equation %):% == + empty? le => p + not empty? rest le => _ + error "can only eval a univariate polynomial once" + mainVariable(lhs first le) case "failed" => p + p(rhs first le) + + mainVariable : % -> Union(SingletonAsOrderedSet,"failed") + mainVariable(p:%) == + zero? degree p => "failed" + create()$SingletonAsOrderedSet + + minimumDegree : (%,SingletonAsOrderedSet) -> NonNegativeInteger + minimumDegree(p:%,v:SingletonAsOrderedSet) == minimumDegree p + + minimumDegree : (%,List(SingletonAsOrderedSet)) -> List(NonNegativeInteger) + minimumDegree(p:%,lv:List SingletonAsOrderedSet) == + empty? lv => [] + [minimumDegree p] + + monomial : (%,SingletonAsOrderedSet,NonNegativeInteger) -> % + monomial(p:%,v:SingletonAsOrderedSet,n:NonNegativeInteger) == + mapExponents(x1+->x1+n,p) + + coerce : SingletonAsOrderedSet -> % + coerce(v:SingletonAsOrderedSet):% == monomial(1,1) + + makeSUP : % -> SparseUnivariatePolynomial(R) + makeSUP p == + zero? p => 0 + monomial(leadingCoefficient p,degree p) + makeSUP reductum p + + unmakeSUP : SparseUnivariatePolynomial(R) -> % + unmakeSUP sp == + zero? sp => 0 + monomial(leadingCoefficient sp,degree sp) + unmakeSUP reductum sp + + karatsubaDivide: (%,NonNegativeInteger) -> Record(quotient: %,remainder: %) + karatsubaDivide(p:%,n:NonNegativeInteger) == monicDivide(p,monomial(1,n)) + + shiftRight : (%,NonNegativeInteger) -> % + shiftRight(p:%,n:NonNegativeInteger) == + monicDivide(p,monomial(1,n)).quotient + + shiftLeft : (%,NonNegativeInteger) -> % + shiftLeft(p:%,n:NonNegativeInteger) == p * monomial(1,n) + + if R has PolynomialFactorizationExplicit then + + PFBRU ==> PolynomialFactorizationByRecursionUnivariate(R,%) + + pp,qq:SparseUnivariatePolynomial % + + lpp:List SparseUnivariatePolynomial % + + SupR ==> SparseUnivariatePolynomial R + + sp:SupR + + solveLinearPolynomialEquation : + (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT + solveLinearPolynomialEquation(lpp,pp) == + solveLinearPolynomialEquationByRecursion(lpp,pp)$PFBRU + + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + factorPolynomial(pp) == + factorByRecursion(pp)$PFBRU + + factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + factorSquareFreePolynomial(pp) == + factorSquareFreeByRecursion(pp)$PFBRU + + import FactoredFunctions2(SupR,S) + + factor : % -> Factored(%) + factor p == + zero? degree p => + ansR:=factor leadingCoefficient p + makeFR(unit(ansR)::%, + [[w.flg,w.fctr::%,w.xpnt] for w in factorList ansR]) + map(unmakeSUP,factorPolynomial(makeSUP p)$R) + + vectorise : (%,NonNegativeInteger) -> Vector(R) + vectorise(p, n) == + m := minIndex(v := new(n, 0)$Vector(R)) + for i in minIndex v .. maxIndex v repeat + qsetelt_!(v, i, coefficient(p, (i - m)::NonNegativeInteger)) + v + + unvectorise : Vector(R) -> % + unvectorise(v : Vector R) : % == + p : % := 0 + for i in 1..#v repeat + p := p + monomial(v(i), (i-1)::NonNegativeInteger) + p + + retract : % -> R + retract(p:%):R == + zero? p => 0 + zero? degree p => leadingCoefficient p + error "Polynomial is not of degree 0" + + retractIfCan : % -> Union(R,"failed") + retractIfCan(p:%):Union(R, "failed") == + zero? p => 0 + zero? degree p => leadingCoefficient p + "failed" + + if R has StepThrough then + + init : () -> % + init() == init()$R::% + + nextItemInner: % -> Union(%,"failed") + nextItemInner(n) == + zero? n => nextItem(0$R)::R::% -- assumed not to fail + zero? degree n => + nn:=nextItem leadingCoefficient n + nn case "failed" => "failed" + nn::R::% + n1:=reductum n + n2:=nextItemInner n1 -- try stepping the reductum + n2 case % => monomial(leadingCoefficient n,degree n) + n2 + 1+degree n1 < degree n => -- there was a hole between lt n and n1 + monomial(leadingCoefficient n,degree n)+ + monomial(nextItem(init()$R)::R,1+degree n1) + n3:=nextItem leadingCoefficient n + n3 case "failed" => "failed" + monomial(n3,degree n) + + nextItem : % -> Union(%,"failed") + nextItem(n) == + n1:=nextItemInner n + n1 case "failed" => monomial(nextItem(init()$R)::R,1+degree(n)) + n1 + + if R has GcdDomain then + + content : (%,SingletonAsOrderedSet) -> % + content(p:%,v:SingletonAsOrderedSet) == content(p)::% + + primeFactor: (%, %) -> % + primeFactor(p, q) == + (p1 := (p exquo gcd(p, q))::%) = p => p + primeFactor(p1, q) + + separate : (%,%) -> Record(primePart: %,commonPart: %) + separate(p, q) == + a := primeFactor(p, q) + [a, (p exquo a)::%] + + if R has CommutativeRing then + + differentiate : (%,(R -> R),%) -> % + differentiate(x:%, deriv:R -> R, x':%) == + d:% := 0 + while (dg := degree x) > 0 repeat + lc := leadingCoefficient x + d := d + x' * monomial(dg * lc, (dg - 1)::NonNegativeInteger) + + monomial(deriv lc, dg) + x := reductum x + d + deriv(leadingCoefficient x)::% + + else + + -- computes d(x**n) given dx = x', non-commutative case + ncdiff: (NonNegativeInteger, %) -> % + ncdiff(n, x') == + zero? n => 0 + zero?(n1 := (n - 1)::NonNegativeInteger) => x' + x' * monomial(1, n1) + monomial(1, 1) * ncdiff(n1, x') + + differentiate : (%,(R -> R),%) -> % + differentiate(x:%, deriv:R -> R, x':%) == + d:% := 0 + while (dg := degree x) > 0 repeat + lc := leadingCoefficient x + d := d + monomial(deriv lc, dg) + lc * ncdiff(dg, x') + x := reductum x + d + deriv(leadingCoefficient x)::% + + differentiate : (%,(R -> R)) -> % + differentiate(x:%, deriv:R -> R) == differentiate(x, deriv, 1$%)$% + + differentiate : % -> % + differentiate(x:%) == + d:% := 0 + while (dg := degree x) > 0 repeat + d:=d+monomial(dg*leadingCoefficient x,(dg-1)::NonNegativeInteger) + x := reductum x + d + + differentiate : (%,SingletonAsOrderedSet) -> % + differentiate(x:%,v:SingletonAsOrderedSet) == differentiate x + + if R has IntegralDomain then + + elt : (Fraction(%),Fraction(%)) -> Fraction(%) + elt(g:Fraction %, f:Fraction %) == ((numer g) f) / ((denom g) f) + + pseudoQuotient : (%,%) -> % + pseudoQuotient(p, q) == + (n := degree(p)::Integer - degree q + 1) < 1 => 0 + ((leadingCoefficient(q)**(n::NonNegativeInteger) * p + - pseudoRemainder(p, q)) exquo q)::% + + pseudoDivide : (%,%) -> Record(coef: R,quotient: %,remainder: %) + pseudoDivide(p, q) == + (n := degree(p)::Integer - degree q + 1) < 1 => [1, 0, p] + prem := pseudoRemainder(p, q) + lc := leadingCoefficient(q)**(n::NonNegativeInteger) + [lc,((lc*p - prem) exquo q)::%, prem] + + composite : (Fraction(%),%) -> Union(Fraction(%),"failed") + composite(f:Fraction %, q:%) == + (n := composite(numer f, q)) case "failed" => "failed" + (d := composite(denom f, q)) case "failed" => "failed" + n::% / d::% + + composite : (%,%) -> Union(%,"failed") + composite(p:%, q:%) == + ground? p => p + cqr := pseudoDivide(p, q) + ground?(cqr.remainder) and + ((v := cqr.remainder exquo cqr.coef) case %) and + ((u := composite(cqr.quotient, q)) case %) and + ((w := (u::%) exquo cqr.coef) case %) => + v::% + monomial(1, 1) * w::% + "failed" + + ?.? : (%,R) -> R + elt(p:%, f:Fraction %) == + zero? p => 0 + ans:Fraction(%) := (leadingCoefficient p)::%::Fraction(%) + n := degree p + while not zero?(p:=reductum p) repeat + ans := ans * f ** (n - (n := degree p))::NonNegativeInteger + + (leadingCoefficient p)::%::Fraction(%) + zero? n => ans + ans * f ** n + + order : (%,%) -> NonNegativeInteger + order(p, q) == + zero? p => error "order: arguments must be nonzero" + degree(q) < 1 => error "order: place must be non-trivial" + ans:NonNegativeInteger := 0 + repeat + (u := p exquo q) case "failed" => return ans + p := u::% + ans := ans + 1 + + if R has GcdDomain then + + squareFree : % -> Factored(%) + squareFree(p:%) == + squareFree(p)$UnivariatePolynomialSquareFree(R, %) + + squareFreePart : % -> % + squareFreePart(p:%) == + squareFreePart(p)$UnivariatePolynomialSquareFree(R, %) + + if R has PolynomialFactorizationExplicit then + + gcdPolynomial : + (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) + gcdPolynomial(pp,qq) == + zero? pp => unitCanonical qq -- subResultantGcd can't handle 0 + zero? qq => unitCanonical pp + unitCanonical(gcd(content (pp),content(qq))* + primitivePart + subResultantGcd(primitivePart pp,primitivePart qq)) + + squareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + squareFreePolynomial pp == + squareFree(pp)$UnivariatePolynomialSquareFree(%, + SparseUnivariatePolynomial %) + + if R has Field then + + elt : (Fraction(%),R) -> R + elt(f:Fraction %, r:R) == ((numer f) r) / ((denom f) r) + + euclideanSize : % -> NonNegativeInteger + euclideanSize x == + zero? x => + error "euclideanSize called on 0 in Univariate Polynomial" + degree x + + divide : (%,%) -> Record(quotient: %,remainder: %) + divide(x,y) == + zero? y => error "division by 0 in Univariate Polynomials" + quot:=0 + lc := inv leadingCoefficient y + while not zero?(x) and (degree x >= degree y) repeat + f:=lc*leadingCoefficient x + n:=(degree x - degree y)::NonNegativeInteger + quot:=quot+monomial(f,n) + x:=x-monomial(f,n)*y + [quot,x] + + if R has Algebra Fraction Integer then + + integrate : % -> % + integrate p == + ans:% := 0 + while p ^= 0 repeat + l := leadingCoefficient p + d := 1 + degree p + ans := ans + inv(d::Fraction(Integer)) * monomial(l, d) + p := reductum p + ans +*) + +\end{chunk} + \begin{chunk}{UPOLYC.dotabb} "UPOLYC" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPOLYC"]; @@ -70022,6 +81122,7 @@ UnivariatePolynomialCategory(R:Ring): Category == "UPOLYC" -> "PFECAT" \end{chunk} + \begin{chunk}{UPOLYC.dotfull} "UnivariatePolynomialCategory(a:Ring)" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPOLYC"]; @@ -70051,6 +81152,7 @@ UnivariatePolynomialCategory(R:Ring): Category == "PolynomialFactorizationExplicit()" \end{chunk} + \begin{chunk}{UPOLYC.dotpic} digraph pic { fontsize=10; @@ -70085,6 +81187,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 17} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{AlgebraicallyClosedFunctionSpace}{ACFS} @@ -70267,6 +81370,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{AlgebraicallyClosedFunctionSpace.help} ==================================================================== AlgebraicallyClosedFunctionSpace examples @@ -70782,6 +81886,78 @@ AlgebraicallyClosedFunctionSpace(R:Join(OrderedSet, IntegralDomain)): zeroOf(p, y)$AlgebraicallyClosedField_&($) \end{chunk} + +\begin{chunk}{COQ ACFS} +(* category ACFS *) +(* + + rootOf : % -> % + rootOf(p:$) == + empty?(l := variables p) => error "rootOf: constant expression" + rootOf(p, first l) + + rootsOf : % -> List(%) + rootsOf(p:$) == + empty?(l := variables p) => error "rootsOf: constant expression" + rootsOf(p, first l) + + zerosOf : % -> List(%) + zeroOf(p:$) == + empty?(l := variables p) => error "zeroOf: constant expression" + zeroOf(p, first l) + + zerosOf : % -> List(%) + zerosOf(p:$) == + empty?(l := variables p) => error "zerosOf: constant expression" + zerosOf(p, first l) + + zeroOf : (%,Symbol) -> % + zeroOf(p:$, x:Symbol) == + n := numer(f := univariate(p, kernel(x)$Kernel($))) + degree denom f > 0 => error "zeroOf: variable appears in denom" + degree n = 0 => error "zeroOf: constant expression" + zeroOf(n, x) + + rootOf : (%,Symbol) -> % + rootOf(p:$, x:Symbol) == + n := numer(f := univariate(p, kernel(x)$Kernel($))) + degree denom f > 0 => error "roofOf: variable appears in denom" + degree n = 0 => error "rootOf: constant expression" + rootOf(n, x) + + zerosOf : (%,Symbol) -> List(%) + zerosOf(p:$, x:Symbol) == + n := numer(f := univariate(p, kernel(x)$Kernel($))) + degree denom f > 0 => error "zerosOf: variable appears in denom" + degree n = 0 => empty() + zerosOf(n, x) + + rootsOf : (%,Symbol) -> List(%) + rootsOf(p:$, x:Symbol) == + n := numer(f := univariate(p, kernel(x)$Kernel($))) + degree denom f > 0 => error "roofsOf: variable appears in denom" + degree n = 0 => empty() + rootsOf(n, x) + + rootsOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%) + rootsOf(p:SparseUnivariatePolynomial $, y:Symbol) == + (r := retractIfCan(p)@Union($,"failed")) case $ => rootsOf(r::$,y) + rootsOf(p, y)$AlgebraicallyClosedField_&($) + + zerosOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%) + zerosOf(p:SparseUnivariatePolynomial $, y:Symbol) == + (r := retractIfCan(p)@Union($,"failed")) case $ => zerosOf(r::$,y) + zerosOf(p, y)$AlgebraicallyClosedField_&($) + + zeroOf : (SparseUnivariatePolynomial(%),Symbol) -> % + zeroOf(p:SparseUnivariatePolynomial $, y:Symbol) == + (r := retractIfCan(p)@Union($,"failed")) case $ => zeroOf(r::$, y) + zeroOf(p, y)$AlgebraicallyClosedField_&($) + +*) + +\end{chunk} + \begin{chunk}{ACFS.dotabb} "ACFS" [color=lightblue,href="bookvol10.2.pdf#nameddest=ACFS"]; @@ -70789,6 +81965,7 @@ AlgebraicallyClosedFunctionSpace(R:Join(OrderedSet, IntegralDomain)): "ACFS" -> "FS" \end{chunk} + \begin{chunk}{ACFS.dotfull} "AlgebraicallyClosedFunctionSpace(a:Join(OrderedSet,IntegralDomain))" [color=lightblue,href="bookvol10.2.pdf#nameddest=ACFS"]; @@ -70798,6 +81975,7 @@ AlgebraicallyClosedFunctionSpace(R:Join(OrderedSet, IntegralDomain)): -> "FunctionSpace(a:OrderedSet)" \end{chunk} + \begin{chunk}{ACFS.dotpic} digraph pic { fontsize=10; @@ -70851,6 +82029,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{ExtensionField}{XF} \pagepic{ps/v102extensionfield.ps}{XF}{0.75} @@ -70929,6 +82108,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ExtensionField.help} ==================================================================== ExtensionField examples @@ -71194,6 +82374,31 @@ ExtensionField(F:Field) : Category == _ Frobenius(a,s) == a ** (size()$F ** s) \end{chunk} + +\begin{chunk}{COQ XF} +(* category XF *) +(* + + algebraic? : % -> Boolean + algebraic?(a) == not infinite? (degree(a)@OnePointCompletion_ + (PositiveInteger))$OnePointCompletion(PositiveInteger) + + transcendent? : % -> Boolean + transcendent? a == infinite?(degree(a)@OnePointCompletion _ + (PositiveInteger))$OnePointCompletion(PositiveInteger) + + if F has Finite then + + Frobenius : % -> % + Frobenius(a) == a ** size()$F + + Frobenius : (%,NonNegativeInteger) -> % + Frobenius(a,s) == a ** (size()$F ** s) + +*) + +\end{chunk} + \begin{chunk}{XF.dotabb} "XF" [color=lightblue,href="bookvol10.2.pdf#nameddest=XF"]; @@ -71203,6 +82408,7 @@ ExtensionField(F:Field) : Category == _ "XF" -> "FPC" \end{chunk} + \begin{chunk}{XF.dotfull} "ExtensionField(a:Field)" [color=lightblue,href="bookvol10.2.pdf#nameddest=XF"]; @@ -71212,6 +82418,7 @@ ExtensionField(F:Field) : Category == _ "ExtensionField(a:Field)" -> "FieldOfPrimeCharacteristic()" \end{chunk} + \begin{chunk}{XF.dotpic} digraph pic { fontsize=10; @@ -71258,6 +82465,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteFieldCategory}{FFIELDC} \pagepic{ps/v102finitefieldcategory.ps}{FFIELDC}{0.70} @@ -71339,6 +82547,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FiniteFieldCategory.help} ==================================================================== FiniteFieldCategory examples @@ -71572,7 +82781,6 @@ These exports come from \refto{DifferentialRing}(): FiniteFieldCategory() : Category ==_ Join(FieldOfPrimeCharacteristic,Finite,StepThrough,DifferentialRing) with --- ,PolynomialFactorizationExplicit) with charthRoot: $ -> $ ++ charthRoot(a) takes the characteristic'th root of a. ++ Note that such a root is alway defined in finite fields. @@ -71678,7 +82886,6 @@ FiniteFieldCategory() : Category ==_ q:=(size()-1)@Integer equalone : Boolean := false for exp in explist while not equalone repeat --- equalone := one?(a**(q quo exp.factor)) equalone := ((a**(q quo exp.factor)) = 1) not equalone @@ -71689,7 +82896,6 @@ FiniteFieldCategory() : Category ==_ lof:=factorsOfCyclicGroupSize() for rec in lof repeat -- run through prime divisors a := ord quo (primeDivisor := rec.factor) --- goon := one?(e**a) goon := ((e**a) = 1) -- run through exponents of the prime divisors for j in 0..(rec.exponent)-2 while goon repeat @@ -71697,7 +82903,6 @@ FiniteFieldCategory() : Category ==_ -- continue dividing by primeDivisor ord := a a := ord quo primeDivisor --- goon := one?(e**a) goon := ((e**a) = 1) if goon then ord := a -- as we do a top down search we have found the @@ -71776,21 +82981,208 @@ FiniteFieldCategory() : Category ==_ FRP ==> Factored FP f,g:FP +-- TPDHERE: why is this here? It isn't exported. + squareFreePolynomial(f:FP):FRP == + squareFree(f)$UnivariatePolynomialSquareFree($,FP) + +-- TPDHERE: why is this here? It isn't exported. + factorPolynomial(f:FP):FRP == factor(f)$DistinctDegreeFactorize($,FP) + +-- TPDHERE: why is this here? It isn't exported. + factorSquareFreePolynomial(f:FP):FRP == + f = 0 => 0 + flist := distdfact(f,true)$DistinctDegreeFactorize($,FP) + (flist.cont :: FP) * + (*/[primeFactor(u.irr,u.pow) for u in flist.factors]) + + gcdPolynomial(f:FP,g:FP):FP == + gcd(f,g)$EuclideanDomain_&(FP) + +\end{chunk} + +\begin{chunk}{COQ FFIELDC} +(* category FFIELDC *) +(* + I ==> Integer + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + SUP ==> SparseUnivariatePolynomial + DLP ==> DiscreteLogarithmPackage + + -- exported functions + + differentiate : % -> % + differentiate x == 0 + + init : () -> % + init() == 0 + + nextItem : % -> Union(%,"failed") + nextItem(a) == + zero?(a:=index(lookup(a)+1)) => "failed" + a + + order : % -> OnePointCompletion(PositiveInteger) + order(e):OnePointCompletion(PositiveInteger) == + (order(e)@PI)::OnePointCompletion(PositiveInteger) + + conditionP : Matrix(%) -> Union(Vector(%),"failed") + conditionP(mat:Matrix $) == + l:=nullSpace mat + empty? l or every?(zero?, first l) => "failed" + map(charthRoot,first l) + + charthRoot : % -> % + charthRoot(x:$):$ == x**(size() quo characteristic()) + + charthRoot : % -> Union(%,"failed") + charthRoot(x:%):Union($,"failed") == + (charthRoot(x)@$)::Union($,"failed") + + createPrimitiveElement : () -> % + createPrimitiveElement() == + sm1 : PositiveInteger := (size()$$-1) pretend PositiveInteger + start : Integer := + -- in the polynomial case, index from 1 to characteristic-1 + -- gives prime field elements + representationType = "polynomial" => characteristic()::Integer + 1 + found : Boolean := false + for i in start.. while not found repeat + e : $ := index(i::PositiveInteger) + found := (order(e) = sm1) + e + + primitive? : % -> Boolean + primitive? a == + -- add special implementation for prime field case + zero?(a) => false + explist := factorsOfCyclicGroupSize() + q:=(size()-1)@Integer + equalone : Boolean := false + for exp in explist while not equalone repeat + equalone := ((a**(q quo exp.factor)) = 1) + not equalone + + order : % -> PositiveInteger + order e == + e = 0 => error "order(0) is not defined " + ord:Integer:= size()-1 -- order e divides ord + a:Integer:= 0 + lof:=factorsOfCyclicGroupSize() + for rec in lof repeat -- run through prime divisors + a := ord quo (primeDivisor := rec.factor) + goon := ((e**a) = 1) + -- run through exponents of the prime divisors + for j in 0..(rec.exponent)-2 while goon repeat + -- as long as we get (e**ord = 1) we + -- continue dividing by primeDivisor + ord := a + a := ord quo primeDivisor + goon := ((e**a) = 1) + if goon then ord := a + -- as we do a top down search we have found the + -- correct exponent of primeDivisor in order e + -- and continue with next prime divisor + ord pretend PositiveInteger + + discreteLog : % -> NonNegativeInteger + discreteLog(b) == + zero?(b) => error "discreteLog: logarithm of zero" + faclist:=factorsOfCyclicGroupSize() + a:=b + gen:=primitiveElement() + -- in GF(2) its necessary to have discreteLog(1) = 1 + b = gen => 1 + disclog:Integer:=0 + mult:Integer:=1 + groupord := (size() - 1)@Integer + exp:Integer:=groupord + for f in faclist repeat + fac:=f.factor + for t in 0..f.exponent-1 repeat + exp:=exp quo fac + -- shanks discrete logarithm algorithm + exptable:=tableForDiscreteLogarithm(fac) + n:=#exptable + c:=a**exp + end:=(fac - 1) quo n + found:=false + disc1:Integer:=0 + for i in 0..end while not found repeat + rho:= search(lookup(c),exptable)_ + $Table(PositiveInteger,NNI) + rho case NNI => + found := true + disc1:=((n * i + rho)@Integer) * mult + c:=c* gen**((groupord quo fac) * (-n)) + not found => error "discreteLog: ?? discrete logarithm" + -- end of shanks discrete logarithm algorithm + mult := mult * fac + disclog:=disclog+disc1 + a:=a * (gen ** (-disc1)) + disclog pretend NonNegativeInteger + + discreteLog : (%,%) -> Union(NonNegativeInteger,"failed") + discreteLog(logbase,b) == + zero?(b) => + messagePrint("discreteLog: logarithm of zero")$OutputForm + "failed" + zero?(logbase) => + messagePrint("discreteLog: logarithm to base zero")$OutputForm + "failed" + b = logbase => 1 + not zero?((groupord:=order(logbase)@PI) rem order(b)@PI) => + messagePrint("discreteLog: second argument not in cyclic group_ + generated by first argument")$OutputForm + "failed" + faclist:=factors factor groupord + a:=b + disclog:Integer:=0 + mult:Integer:=1 + exp:Integer:= groupord + for f in faclist repeat + fac:=f.factor + primroot:= logbase ** (groupord quo fac) + for t in 0..f.exponent-1 repeat + exp:=exp quo fac + rhoHelp:= shanksDiscLogAlgorithm(primroot,_ + a**exp,fac pretend NonNegativeInteger)$DLP($) + rhoHelp case "failed" => return "failed" + rho := (rhoHelp :: NNI) * mult + disclog := disclog + rho + mult := mult * fac + a:=a * (logbase ** (-rho)) + disclog pretend NonNegativeInteger + + FP ==> SparseUnivariatePolynomial($) + FRP ==> Factored FP + f,g:FP + +-- TPDHERE: why is this here? It isn't exported. squareFreePolynomial(f:FP):FRP == squareFree(f)$UnivariatePolynomialSquareFree($,FP) +-- TPDHERE: why is this here? It isn't exported. factorPolynomial(f:FP):FRP == factor(f)$DistinctDegreeFactorize($,FP) +-- TPDHERE: why is this here? It isn't exported. factorSquareFreePolynomial(f:FP):FRP == f = 0 => 0 flist := distdfact(f,true)$DistinctDegreeFactorize($,FP) (flist.cont :: FP) * (*/[primeFactor(u.irr,u.pow) for u in flist.factors]) + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) gcdPolynomial(f:FP,g:FP):FP == gcd(f,g)$EuclideanDomain_&(FP) +*) + \end{chunk} + \begin{chunk}{FFIELDC.dotabb} "FFIELDC" [color=lightblue,href="bookvol10.2.pdf#nameddest=FFIELDC"]; @@ -71800,6 +83192,7 @@ FiniteFieldCategory() : Category ==_ "FFIELDC" -> "DIFRING" \end{chunk} + \begin{chunk}{FFIELDC.dotfull} "FiniteFieldCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FFIELDC"]; @@ -71809,6 +83202,7 @@ FiniteFieldCategory() : Category ==_ "FiniteFieldCategory()" -> "DifferentialRing()" \end{chunk} + \begin{chunk}{FFIELDC.dotpic} digraph pic { fontsize=10; @@ -71842,6 +83236,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FloatingPointSystem}{FPS} \pagepic{ps/v102floatingpointsystem.ps}{FPS}{0.50} @@ -71933,6 +83328,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FloatingPointSystem.help} ==================================================================== FloatingPointSystem examples @@ -72289,18 +83685,35 @@ FloatingPointSystem(): Category == RealNumberSystem() with digits() == max(1,4004 * (bits()-1) quo 13301)::PositiveInteger \end{chunk} + +\begin{chunk}{COQ FPS} +(* category FPS *) +(* + + float : (Integer,Integer) -> % + float(ma, ex) == float(ma, ex, base()) + + digits : () -> PositiveInteger + digits() == max(1,4004 * (bits()-1) quo 13301)::PositiveInteger + +*) + +\end{chunk} + \begin{chunk}{FPS.dotabb} "FPS" [color=lightblue,href="bookvol10.2.pdf#nameddest=FPS"]; "FPS" -> "RNS" \end{chunk} + \begin{chunk}{FPS.dotfull} "FloatingPointSystem()" [color=lightblue,href="bookvol10.2.pdf#nameddest=FPS"]; "FloatingPointSystem()" -> "RealNumberSystem()" \end{chunk} + \begin{chunk}{FPS.dotpic} digraph pic { fontsize=10; @@ -72331,6 +83744,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FramedAlgebra}{FRAMALG} \pagepic{ps/v102framedalgebra.ps}{FRAMALG}{0.50} @@ -72388,6 +83802,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FramedAlgebra.help} ==================================================================== FramedAlgebra examples @@ -72596,12 +84011,79 @@ FramedAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): +/[monomial(v.(i+1),i) for i in 0..#v-1] \end{chunk} + +\begin{chunk}{COQ FRAMALG} +(* category FRAMALG *) +(* + + convert : % -> Vector(R) + convert(x:%):Vector(R) == coordinates(x) + + convert : Vector(R) -> % + convert(v:Vector R):% == represents(v) + + traceMatrix : () -> Matrix(R) + traceMatrix() == traceMatrix basis() + + discriminant : () -> R + discriminant() == discriminant basis() + + regularRepresentation : % -> Matrix(R) + regularRepresentation x == regularRepresentation(x, basis()) + + coordinates : % -> Vector(R) + coordinates x == coordinates(x, basis()) + + represents : Vector(R) -> % + represents x == represents(x, basis()) + + coordinates : Vector(%) -> Matrix(R) + coordinates(v:Vector %) == + m := new(#v, rank(), 0)$Matrix(R) + for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat + setRow_!(m, j, coordinates qelt(v, i)) + m + + regularRepresentation : % -> Matrix(R) + regularRepresentation x == + m := new(n := rank(), n, 0)$Matrix(R) + b := basis() + for i in minIndex b .. maxIndex b for j in minRowIndex m .. repeat + setRow_!(m, j, coordinates(x * qelt(b, i))) + m + + characteristicPolynomial : % -> UP + characteristicPolynomial x == + mat00 := (regularRepresentation x) + mat0 := map(y+->y::UP,mat00)$MatrixCategoryFunctions2(R, Vector R, + Vector R, Matrix R, UP, Vector UP,Vector UP, Matrix UP) + mat1 : Matrix UP := scalarMatrix(rank(),monomial(1,1)$UP) + determinant(mat1 - mat0) + + if R has Field then + -- depends on the ordering of results from nullSpace, also see FFP + + minimalPolynomial : % -> UP + minimalPolynomial(x:%):UP == + y:%:=1 + n:=rank() + m:Matrix R:=zero(n,n+1) + for i in 1..n+1 repeat + setColumn_!(m,i,coordinates(y)) + y:=y*x + v:=first nullSpace(m) + +/[monomial(v.(i+1),i) for i in 0..#v-1] +*) + +\end{chunk} + \begin{chunk}{FRAMALG.dotabb} "FRAMALG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FRAMALG"]; "FRAMALG" -> "FINRALG" \end{chunk} + \begin{chunk}{FRAMALG.dotfull} "FramedAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" [color=lightblue,href="bookvol10.2.pdf#nameddest=FRAMALG"]; @@ -72609,6 +84091,7 @@ FramedAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): "FiniteRankAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" \end{chunk} + \begin{chunk}{FRAMALG.dotpic} digraph pic { fontsize=10; @@ -72654,6 +84137,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PseudoAlgebraicClosureOfFiniteFieldCategory}{PACFFC} \pagepic{ps/v102pseudoalgebraicclosureoffinitefieldcategory.ps}{PACFFC}{0.50} @@ -72747,6 +84231,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PseudoAlgebraicClosureOfFiniteFieldCategory.help} ==================================================================== PseudoAlgebraicClosureOfFiniteFieldCategory examples @@ -73017,11 +84502,13 @@ PseudoAlgebraicClosureOfFiniteFieldCategory:Category == Join(FiniteFieldCategory, PseudoAlgebraicClosureOfPerfectFieldCategory) \end{chunk} + \begin{chunk}{PACFFC.dotabb} "PACFFC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACFFC"]; "PACFFC" -> "PACPERC" \end{chunk} + \begin{chunk}{PACFFC.dotfull} "PseudoAlgebraicClosureOfFiniteFieldCategory" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACFFC"]; @@ -73031,6 +84518,7 @@ PseudoAlgebraicClosureOfFiniteFieldCategory:Category == "FiniteFieldCategory()" \end{chunk} + \begin{chunk}{PACFFC.dotpic} digraph pic { fontsize=10; @@ -73047,6 +84535,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnivariateLaurentSeriesConstructorCategory}{ULSCCAT} \pagepic{ps/v102univariatelaurentseriesconstructorcategory.ps}{ULSCCAT}{0.50} @@ -73254,6 +84743,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariateLaurentSeriesConstructorCategory.help} ==================================================================== UnivariateLaurentSeriesConstructorCategory examples @@ -73851,12 +85341,31 @@ UnivariateLaurentSeriesConstructorCategory(Coef,UTS):_ retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x \end{chunk} + +\begin{chunk}{COQ ULSCCAT} +(* category ULSCCAT *) +(* + + zero? : % -> Boolean + zero? x == zero? taylorRep x + + retract : % -> UTS + retract(x:%):UTS == taylor x + + retractIfCan : % -> Union(Symbol,"failed") + retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x + +*) + +\end{chunk} + \begin{chunk}{ULSCCAT.dotabb} "ULSCCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCCAT"]; "ULSCCAT" -> "ULSCAT" \end{chunk} + \begin{chunk}{ULSCCAT.dotfull} "UnivariateLaurentSeriesConstructorCategory(a:Ring,b:UnivariateTaylorSeriesCategory(Ring))" [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCCAT"]; @@ -73864,6 +85373,7 @@ UnivariateLaurentSeriesConstructorCategory(Coef,UTS):_ -> "UnivariateLaurentSeriesCategory(a:Ring)" \end{chunk} + \begin{chunk}{ULSCCAT.dotpic} digraph pic { fontsize=10; @@ -73911,6 +85421,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{UnivariatePuiseuxSeriesConstructorCategory}{UPXSCCA} \pagepic{ps/v102univariatepuiseuxseriesconstructorcategory.ps}{UPXSCCA}{0.50} @@ -74061,6 +85572,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{UnivariatePuiseuxSeriesConstructorCategory.help} ==================================================================== UnivariatePuiseuxSeriesConstructorCategory examples @@ -74462,6 +85974,24 @@ UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS):_ retractIfCan(x:%):Union(ULS,"failed") == laurentIfCan x \end{chunk} + +\begin{chunk}{COQ UPXSCCA} +(* category UPXSCCA *) +(* + + zero? : % -> Boolean + zero? x == zero? laurentRep x + + retract : % -> ULS + retract(x:%):ULS == laurent x + + retractIfCan : % -> Union(ULS,"failed") + retractIfCan(x:%):Union(ULS,"failed") == laurentIfCan x + +*) + +\end{chunk} + \begin{chunk}{UPXSCCA.dotabb} "UPXSCCA" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCCA"]; @@ -74469,6 +85999,7 @@ UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS):_ "UPXSCCA" -> "UPXSCAT" \end{chunk} + \begin{chunk}{UPXSCCA.dotfull} "UnivariatePuiseuxSeriesConstructorCategory(a:Ring,b:UnivariateLaurentSeriesCategory(a))" [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCCA"]; @@ -74478,6 +86009,7 @@ UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS):_ -> "UnivariatePuiseuxSeriesCategory(a:Ring)" \end{chunk} + \begin{chunk}{UPXSCCA.dotpic} digraph pic { fontsize=10; @@ -74528,6 +86060,7 @@ digraph pic { } \end{chunk} + \chapter{Category Layer 18} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FiniteAlgebraicExtensionField}{FAXF} @@ -74645,6 +86178,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FiniteAlgebraicExtensionField.help} ==================================================================== FiniteAlgebraicExtensionField examples @@ -75150,18 +86684,167 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ transcendent? a == false --- This definition is a duplicate and has been removed --- extensionDegree():OnePointCompletion(PositiveInteger) == --- (#basis()) :: PositiveInteger::OnePointCompletion(PositiveInteger) - extensionDegree() == (#basis()) :: PositiveInteger --- These definitions are duplicates and have been removed --- degree(a):OnePointCompletion(PositiveInteger) == --- degree(a)@PI::OnePointCompletion(PositiveInteger) + trace a == + b := basis() + abs : F := 0 + for i in 1..#b repeat + abs := abs + coordinates(a*b.i).i + abs + + norm a == + b := basis() + m := new(#b,#b, 0)$Matrix(F) + for i in 1..#b repeat + setRow_!(m,i, coordinates(a*b.i)) + determinant(m) + + if F has Finite then + linearAssociatedExp(x,f) == + erg:$:=0 + y:=x + for i in 0..degree(f) repeat + erg:=erg + coefficient(f,i) * y + y:=Frobenius(y) + erg + + linearAssociatedLog(b,x) == + x=0 => 0 + l:List List F:=[entries coordinates b] + a:$:=b + extdeg:NNI:=extensionDegree()@PI + for i in 2..extdeg repeat + a:=Frobenius(a) + l:=concat(l,entries coordinates a)$(List List F) + l:=concat(l,entries coordinates x)$(List List F) + m1:=rowEchelon transpose matrix(l)$(Matrix F) + v:=zero(extdeg)$(Vector F) + rown:I:=1 + for i in 1..extdeg repeat + if qelt(m1,rown,i) = 1$F then + v.i:=qelt(m1,rown,extdeg+1) + rown:=rown+1 + p:=+/[monomial(v.(i+1),i::NNI) for i in 0..(#v-1)] + p=0 => + messagePrint("linearAssociatedLog: second argument not in_ + group generated by first argument")$OutputForm + "failed" + p + + linearAssociatedLog(x) == linearAssociatedLog(normalElement(),x) :: + SparseUnivariatePolynomial(F) + + linearAssociatedOrder(x) == + x=0 => 0 + l:List List F:=[entries coordinates x] + a:$:=x + for i in 1..extensionDegree()@PI repeat + a:=Frobenius(a) + l:=concat(l,entries coordinates a)$(List List F) + v:=first nullSpace transpose matrix(l)$(Matrix F) + +/[monomial(v.(i+1),i::NNI) for i in 0..(#v-1)] + + charthRoot(x):Union($,"failed") == + (charthRoot(x)@$)::Union($,"failed") + + minimalPolynomial(a,n) == + extensionDegree()@PI rem n ^= 0 => + error "minimalPolynomial: 2. argument must divide extension degree" + f:SUP $:=monomial(1,1)$(SUP $) - monomial(a,0)$(SUP $) + u:$:=Frobenius(a,n) + while not(u = a) repeat + f:=f * (monomial(1,1)$(SUP $) - monomial(u,0)$(SUP $)) + u:=Frobenius(u,n) + f + + norm(e,s) == + qr := divide(extensionDegree(), s) + zero?(qr.remainder) => + pow := (size()-1) quo (size()$F ** s - 1) + e ** (pow::NonNegativeInteger) + error "norm: second argument must divide degree of extension" + + trace(e,s) == + qr:=divide(extensionDegree(),s) + q:=size()$F + zero?(qr.remainder) => + a:$:=0 + for i in 0..qr.quotient-1 repeat + a:=a + e**(q**(s*i)) + a + error "trace: second argument must divide degree of extension" + + size() == size()$F ** extensionDegree() + + createNormalElement() == + characteristic() = size() => 1 + res : $ + for i in 1.. repeat + res := index(i :: PI) + not inGroundField? res => + normal? res => return res + -- theorem: there exists a normal element, this theorem is + -- unknown to the compiler + res + + normal?(x:$) == + p:SUP $:=(monomial(1,extensionDegree()) - monomial(1,0))@(SUP $) + f:SUP $:= +/[monomial(Frobenius(x,i),i)$(SUP $) _ + for i in 0..extensionDegree()-1] + gcd(p,f) = 1 => true + false + + degree a == + y:$:=Frobenius a + deg:PI:=1 + while y^=a repeat + y := Frobenius(y) + deg:=deg+1 + deg + +\end{chunk} + +\begin{chunk}{COQ FAXF} +(* category FAXF *) +(* + I ==> Integer + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + SUP ==> SparseUnivariatePolynomial + DLP ==> DiscreteLogarithmPackage + + represents : Vector(F) -> % + represents(v) == + a:$:=0 + b:=basis() + for i in 1..extensionDegree()@PI repeat + a:=a+(v.i)*(b.i) + a + + transcendenceDegree : () -> NonNegativeInteger + transcendenceDegree() == 0$NNI + + dimension : () -> CardinalNumber + dimension() == (#basis()) ::NonNegativeInteger::CardinalNumber + + coordinates : Vector(%) -> Matrix(F) + coordinates(v:Vector $) == + m := new(#v, extensionDegree(), 0)$Matrix(F) + for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat + setRow_!(m, j, coordinates qelt(v, i)) + m + + algebraic? : % -> Boolean + algebraic? a == true + + transcendent? : % -> Boolean + transcendent? a == false - -- degree a == degree(minimalPolynomial a)$SUP(F) :: PI + extensionDegree : () -> PositiveInteger + extensionDegree() == (#basis()) :: PositiveInteger + trace : % -> F trace a == b := basis() abs : F := 0 @@ -75169,6 +86852,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ abs := abs + coordinates(a*b.i).i abs + norm : % -> F norm a == b := basis() m := new(#b,#b, 0)$Matrix(F) @@ -75177,6 +86861,8 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ determinant(m) if F has Finite then + + linearAssociatedExp : (%,SparseUnivariatePolynomial(F)) -> % linearAssociatedExp(x,f) == erg:$:=0 y:=x @@ -75185,6 +86871,8 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ y:=Frobenius(y) erg + linearAssociatedLog : (%,%) -> + Union(SparseUnivariatePolynomial(F),"failed") linearAssociatedLog(b,x) == x=0 => 0 l:List List F:=[entries coordinates b] @@ -75208,9 +86896,11 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ "failed" p + linearAssociatedLog : % -> SparseUnivariatePolynomial(F) linearAssociatedLog(x) == linearAssociatedLog(normalElement(),x) :: SparseUnivariatePolynomial(F) + linearAssociatedOrder : % -> SparseUnivariatePolynomial(F) linearAssociatedOrder(x) == x=0 => 0 l:List List F:=[entries coordinates x] @@ -75221,11 +86911,13 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ v:=first nullSpace transpose matrix(l)$(Matrix F) +/[monomial(v.(i+1),i::NNI) for i in 0..(#v-1)] + charthRoot : % -> Union(%,"failed") charthRoot(x):Union($,"failed") == (charthRoot(x)@$)::Union($,"failed") -- norm(e) == norm(e,1) pretend F -- trace(e) == trace(e,1) pretend F + minimalPolynomial : (%,PositiveInteger) -> SparseUnivariatePolynomial(%) minimalPolynomial(a,n) == extensionDegree()@PI rem n ^= 0 => error "minimalPolynomial: 2. argument must divide extension degree" @@ -75236,6 +86928,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ u:=Frobenius(u,n) f + norm : (%,PositiveInteger) -> % norm(e,s) == qr := divide(extensionDegree(), s) zero?(qr.remainder) => @@ -75243,6 +86936,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ e ** (pow::NonNegativeInteger) error "norm: second argument must divide degree of extension" + trace : (%,PositiveInteger) -> % trace(e,s) == qr:=divide(extensionDegree(),s) q:=size()$F @@ -75253,8 +86947,10 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ a error "trace: second argument must divide degree of extension" + size : () -> NonNegativeInteger size() == size()$F ** extensionDegree() + createNormalElement : () -> % createNormalElement() == characteristic() = size() => 1 res : $ @@ -75266,6 +86962,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ -- unknown to the compiler res + normal? : % -> Boolean normal?(x:$) == p:SUP $:=(monomial(1,extensionDegree()) - monomial(1,0))@(SUP $) f:SUP $:= +/[monomial(Frobenius(x,i),i)$(SUP $) _ @@ -75273,6 +86970,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ gcd(p,f) = 1 => true false + degree : % -> PositiveInteger degree a == y:$:=Frobenius a deg:PI:=1 @@ -75280,8 +86978,10 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ y := Frobenius(y) deg:=deg+1 deg +*) \end{chunk} + \begin{chunk}{FAXF.dotabb} "FAXF" [color=lightblue,href="bookvol10.2.pdf#nameddest=FAXF"]; @@ -75289,6 +86989,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ "FAXF" -> "RETRACT" \end{chunk} + \begin{chunk}{FAXF.dotfull} "FiniteAlgebraicExtensionField(a:Field)" [color=lightblue,href="bookvol10.2.pdf#nameddest=FAXF"]; @@ -75296,6 +86997,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _ "FiniteAlgebraicExtensionField(a:Field)" -> "RetractableTo(a:Field)" \end{chunk} + \begin{chunk}{FAXF.dotpic} digraph pic { fontsize=10; @@ -75342,6 +87044,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{MonogenicAlgebra}{MONOGEN} \pagepic{ps/v102monogenicalgebra.ps}{MONOGEN}{0.40} @@ -75478,6 +87181,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{MonogenicAlgebra.help} ==================================================================== MonogenicAlgebra examples @@ -75901,6 +87605,69 @@ MonogenicAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): reduce(bc.coef1) \end{chunk} + +\begin{chunk}{COQ MONOGEN} +(* category MONOGEN *) +(* + + convert : % -> UP + convert(x:%):UP == lift x + + convert : UP -> % + convert(p:UP):% == reduce p + + generator : () -> % + generator() == reduce monomial(1, 1)$UP + + norm : % -> R + norm x == resultant(definingPolynomial(), lift x) + + retract : % -> R + retract(x:%):R == retract lift x + + retractIfCan : % -> Union(R,"failed") + retractIfCan(x:%):Union(R, "failed") == retractIfCan lift x + + basis : () -> Vector(%) + basis() == + [reduce monomial(1,i)$UP for i in 0..(rank()-1)::NonNegativeInteger] + + characteristicPolynomial : % -> UP + characteristicPolynomial(x:%):UP == + characteristicPolynomial(x)$CharacteristicPolynomialInMonogenicalAlgebra(R,UP,%) + + if R has Finite then + + size : () -> NonNegativeInteger + size() == size()$R ** rank() + + random : () -> % + random() == represents [random()$R for i in 1..rank()]$Vector(R) + + if R has Field then + + reduce : UP -> % + reduce(x:Fraction UP) == reduce(numer x) exquo reduce(denom x) + + differentiate : (%,(R -> R)) -> % + differentiate(x:%, d:R -> R) == + p := definingPolynomial() + yprime := - reduce(map(d, p)) / reduce(differentiate p) + reduce(map(d, lift x)) + yprime * reduce differentiate lift x + + derivationCoordinates : (Vector(%),(R -> R)) + derivationCoordinates(b, d) == + coordinates(map(x +-> differentiate(x, d), b), b) + + recip : % -> Union(%,"failed") + recip x == + (bc := extendedEuclidean(lift x, definingPolynomial(), 1)) + case "failed" => "failed" + reduce(bc.coef1) +*) + +\end{chunk} + \begin{chunk}{MONOGEN.dotabb} "MONOGEN" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOGEN"]; @@ -75915,6 +87682,7 @@ MonogenicAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): "MONOGEN" -> "FFIELDC" \end{chunk} + \begin{chunk}{MONOGEN.dotfull} "MonogenicAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOGEN"]; @@ -75935,6 +87703,7 @@ MonogenicAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R): "MonogenicAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" \end{chunk} + \begin{chunk}{MONOGEN.dotpic} digraph pic { fontsize=10; @@ -76068,6 +87837,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PseudoAlgebraicClosureOfRationalNumberCategory.help} ==================================================================== PseudoAlgebraicClosureOfRationalNumberCategory examples @@ -76347,17 +88117,20 @@ PseudoAlgebraicClosureOfRationalNumberCategory:Category == RetractableTo(Fraction(Integer)),ExtensionField(Fraction(Integer))) \end{chunk} + \begin{chunk}{PACRATC.dotabb} "PACRATC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACRATC"]; "PACRATC" -> "XF" \end{chunk} + \begin{chunk}{PACRATC.dotfull} "PseudoAlgebraicClosureOfRationalNumberCategory" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACRATC"]; "PseudoAlgebraicClosureOfRationalNumberCategory" -> "ExtensionField(F:Field)" \end{chunk} + \begin{chunk}{PACRATC.dotpic} digraph pic { fontsize=10; @@ -76564,6 +88337,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{ComplexCategory.help} ==================================================================== ComplexCategory examples @@ -77159,9 +88933,7 @@ ComplexCategory(R:CommutativeRing): Category == zero? i => re outi := "%i"::Symbol::OutputForm ip := --- one? i => outi (i = 1) => outi --- one?(-i) => -outi ((-i) = 1) => -outi ie * outi zero? r => ip @@ -77245,7 +89017,6 @@ ComplexCategory(R:CommutativeRing): Category == if R has IntegralDomain then _exquo(x:%, r:R) == --- one? r => x (r = 1) => x (r1 := real(x) exquo r) case "failed" => "failed" (r2 := imag(x) exquo r) case "failed" => "failed" @@ -77367,47 +89138,576 @@ ComplexCategory(R:CommutativeRing): Category == stoc ==> S_-TO_-C$Lisp ctos ==> C_-TO_-S$Lisp - exp x == ctos EXP(stoc x)$Lisp - log x == ctos LOG(stoc x)$Lisp + exp x == ctos EXP(stoc x)$Lisp + log x == ctos LOG(stoc x)$Lisp + + sin x == ctos SIN(stoc x)$Lisp + cos x == ctos COS(stoc x)$Lisp + tan x == ctos TAN(stoc x)$Lisp + asin x == ctos ASIN(stoc x)$Lisp + acos x == ctos ACOS(stoc x)$Lisp + atan x == ctos ATAN(stoc x)$Lisp + + sinh x == ctos SINH(stoc x)$Lisp + cosh x == ctos COSH(stoc x)$Lisp + tanh x == ctos TANH(stoc x)$Lisp + asinh x == ctos ASINH(stoc x)$Lisp + acosh x == ctos ACOSH(stoc x)$Lisp + atanh x == ctos ATANH(stoc x)$Lisp + + else + atan x == + ix := imaginary()*x + - imaginary() * half * (log(1 + ix) - log(1 - ix)) + + log x == + complex(log(norm x) * half, argument x) + + exp x == + e := exp real x + complex(e * cos imag x, e * sin imag x) + + cos x == + e := exp(imaginary() * x) + half * (e + recip(e)::%) + + sin x == + e := exp(imaginary() * x) + - imaginary() * half * (e - recip(e)::%) + + if R has RealNumberSystem then + polarCoordinates x == + [sqrt norm x, (negative?(t := argument x) => t + 2 * pi(); t)] + + x:% ** q:Fraction(Integer) == + zero? q => + zero? x => error "0 ** 0 is undefined" + 1 + zero? x => 0 + rx := real x + zero? imag x and positive? rx => (rx ** q)::% + zero? imag x and denom q = 2 => complex(0, (-rx)**q) + ax := sqrt(norm x) ** q + tx := q::R * argument x + complex(ax * cos tx, ax * sin tx) + + else if R has RadicalCategory then + x:% ** q:Fraction(Integer) == + zero? q => + zero? x => error "0 ** 0 is undefined" + 1 + r := real x + zero?(i := imag x) => (r ** q)::% + t := numer(q) * recip(denom(q)::R)::R * argument x + e:R := + zero? r => i ** q + norm(x) ** (q / (2::Fraction(Integer))) + complex(e * cos t, e * sin t) + +\end{chunk} + +\begin{chunk}{COQ COMPCAT} +(* category COMPCAT *) +(* + import MatrixCategoryFunctions2(%, Vector %, Vector %, Matrix %, + R, Vector R, Vector R, Matrix R) + + SUP ==> SparseUnivariatePolynomial + + characteristicPolynomial : % -> SparseUnivariatePolynomial(R) + characteristicPolynomial x == + v := monomial(1,1)$SUP(R) + v**2 - trace(x)*v**1 + norm(x)*v**0 + + if R has PolynomialFactorizationExplicit and R has EuclideanDomain then + + SupR ==> SparseUnivariatePolynomial R + + Sup ==> SparseUnivariatePolynomial % + + import FactoredFunctionUtilities Sup + import UnivariatePolynomialCategoryFunctions2(R,SupR,%,Sup) + import UnivariatePolynomialCategoryFunctions2(%,Sup,R,SupR) + + pp,qq:Sup + + if R has IntegerNumberSystem then + + myNextPrime: (%,NonNegativeInteger) -> % + myNextPrime(x,n ) == -- prime is actually in R, and = 3(mod 4) + xr:=real(x)-4::R + while not prime? xr repeat + xr:=xr-4::R + complex(xr,0) + --!TT:=InnerModularGcd(%,Sup,32719 :: %,myNextPrime) + --!gcdPolynomial(pp,qq) == modularGcd(pp,qq)$TT + + solveLinearPolynomialEquation : + (List(SparseUnivariatePolynomial(%)), + SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") + solveLinearPolynomialEquation(lp:List Sup,p:Sup) == + solveLinearPolynomialEquation(lp,p)$ComplexIntegerSolveLinearPolynomialEquation(R,%) + + normPolynomial: Sup -> SupR + normPolynomial pp == + map(z+->retract(z@%)::R,pp * map(conjugate,pp)) + + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + factorPolynomial pp == + refine(squareFree pp,factorSquareFreePolynomial) + + factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) + factorSquareFreePolynomial pp == + pnorm:=normPolynomial pp + k:R:=0 + while degree gcd(pnorm,differentiate pnorm)>0 repeat + k:=k+1 + pnorm:=normPolynomial + elt(pp,monomial(1,1)-monomial(complex(0,k),0)) + fR:=factorSquareFreePolynomial pnorm + numberOfFactors fR = 1 => + makeFR(1,[["irred",pp,1]]) + lF:List Record(flg:Union("nil", "sqfr", "irred", "prime"), + fctr:Sup, xpnt:Integer):=[] + for u in factorList fR repeat + p1:=map((z:R):%+->z::%,u.fctr) + if not zero? k then + p1:=elt(p1,monomial(1,1)+monomial(complex(0,k),0)) + p2:=gcd(p1,pp) + lF:=cons(["irred",p2,1],lF) + pp:=(pp exquo p2)::Sup + makeFR(pp,lF) + + rank : () -> PositiveInteger + rank() == 2 + + discriminant : () -> R + discriminant() == -4 :: R + + norm : % -> R + norm x == real(x)**2 + imag(x)**2 + + trace : % -> R + trace x == 2 * real x + + imaginary : () -> % + imaginary() == complex(0, 1) + + conjugate : % -> % + conjugate x == complex(real x, - imag x) + + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$R + + map : ((R -> R),%) -> % + map(fn, x) == complex(fn real x, fn imag x) + + ?=? : (%,%) -> Boolean + x = y == real(x) = real(y) and imag(x) = imag(y) + + ?+? : (%,%) -> % + x + y == complex(real x + real y, imag x + imag y) + + -? : % -> % + - x == complex(- real x, - imag x) + + ?*? : (R,%) -> % + r:R * x:% == complex(r * real x, r * imag x) + + coordinates : % -> Vector(R) + coordinates(x:%) == [real x, imag x] + + ?*? : (Integer,%) -> % + n:Integer * x:% == complex(n * real x, n * imag x) + + differentiate : (%,(R -> R)) -> % + differentiate(x:%, d:R -> R) == complex(d real x, d imag x) + + definingPolynomial : () -> SparseUnivariatePolynomial(R) + definingPolynomial() == + monomial(1,2)$(SUP R) + monomial(1,0)$(SUP R) + + reduce : SparseUnivariatePolynomial(R) -> % + reduce(pol:SUP R) == + part:= (monicDivide(pol,definingPolynomial())).remainder + complex(coefficient(part,0),coefficient(part,1)) + + lift : % -> SparseUnivariatePolynomial(R) + lift(x) == monomial(real x,0)$(SUP R)+monomial(imag x,1)$(SUP R) + + minimalPolynomial : % -> SparseUnivariatePolynomial(R) + minimalPolynomial x == + zero? imag x => + monomial(1, 1)$(SUP R) - monomial(real x, 0)$(SUP R) + monomial(1, 2)$(SUP R) - monomial(trace x, 1)$(SUP R) + + monomial(norm x, 0)$(SUP R) + + coordinates : (%,Vector(%)) -> Vector(R) + coordinates(x:%, v:Vector %):Vector(R) == + ra := real(a := v(minIndex v)) + rb := real(b := v(maxIndex v)) + (#v ^= 2) or + ((d := recip(ra * (ib := imag b) - (ia := imag a) * rb)) + case "failed") =>error "coordinates: vector is not a basis" + rx := real x + ix := imag x + [d::R * (rx * ib - ix * rb), d::R * (ra * ix - ia * rx)] + + coerce : % -> OutputForm + coerce(x:%):OutputForm == + re := (r := real x)::OutputForm + ie := (i := imag x)::OutputForm + zero? i => re + outi := "%i"::Symbol::OutputForm + ip := + (i = 1) => outi + ((-i) = 1) => -outi + ie * outi + zero? r => ip + re + ip + + retract : % -> R + retract(x:%):R == + not zero?(imag x) => + error "Imaginary part is nonzero. Cannot retract." + real x + + retractIfCan : % -> Union(R,"failed") + retractIfCan(x:%):Union(R, "failed") == + not zero?(imag x) => "failed" + real x + + ?*? : (%,%) -> % + x:% * y:% == + complex(real x * real y - imag x * imag y, + imag x * real y + imag y * real x) + + reducedSystem : Matrix(%) -> Matrix(R) + reducedSystem(m:Matrix %):Matrix R == + vertConcat(map(real, m), map(imag, m)) + + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(R),vec: Vector(R)) + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix R, vec:Vector R) == + rh := reducedSystem(v::Matrix %)@Matrix(R) + [reducedSystem(m)@Matrix(R), column(rh, minColIndex rh)] + + if R has RealNumberSystem then + + abs : % -> % + abs(x:%):% == (sqrt norm x)::% + + if R has RealConstant then + + convert : % -> Complex(DoubleFloat) + convert(x:%):Complex(DoubleFloat) == + complex(convert(real x)@DoubleFloat,convert(imag x)@DoubleFloat) + + convert : % -> Complex(Float) + convert(x:%):Complex(Float) == + complex(convert(real x)@Float, convert(imag x)@Float) + + if R has ConvertibleTo InputForm then + + convert : % -> InputForm + convert(x:%):InputForm == + convert([convert("complex"::Symbol), convert real x, + convert imag x]$List(InputForm))@InputForm + + if R has ConvertibleTo Pattern Integer then + + convert : % -> Pattern(Integer) + convert(x:%):Pattern Integer == + convert(x)$ComplexPattern(Integer, R, %) + + if R has ConvertibleTo Pattern Float then + + convert : % -> Pattern(Float) + convert(x:%):Pattern Float == + convert(x)$ComplexPattern(Float, R, %) + + if R has PatternMatchable Integer then + + patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) + patternMatch(x:%, p:Pattern Integer, + l:PatternMatchResult(Integer, %)) == + patternMatch(x, p, l)$ComplexPatternMatch(Integer, R, %) + + if R has PatternMatchable Float then + + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) + patternMatch(x:%, p:Pattern Float, + l:PatternMatchResult(Float, %)) == + patternMatch(x, p, l)$ComplexPatternMatch(Float, R, %) + + + if R has OrderedSet then + + ? Boolean + x < y == + real x = real y => imag x < imag y + real x < real y + + if R has IntegerNumberSystem then + + rational? : % -> Boolean + rational? x == zero? imag x + + rational : % -> Fraction(Integer) + rational x == + zero? imag x => rational real x + error "Not a rational number" + + rationalIfCan : % -> Union(Fraction(Integer),"failed") + rationalIfCan x == + zero? imag x => rational real x + "failed" + + if R has Field then + + inv : % -> % + inv x == + zero? imag x => (inv real x)::% + r := norm x + complex(real(x) / r, - imag(x) / r) + + if R has IntegralDomain then + + exquo : (%,R) -> Union(%,"failed") + _exquo(x:%, r:R) == + (r = 1) => x + (r1 := real(x) exquo r) case "failed" => "failed" + (r2 := imag(x) exquo r) case "failed" => "failed" + complex(r1, r2) + + exquo : (%,%) -> Union(%,"failed") + _exquo(x:%, y:%) == + zero? imag y => x exquo real y + x * conjugate(y) exquo norm(y) + + recip : % -> Union(%,"failed") + recip(x:%) == 1 exquo x + + if R has OrderedRing then + + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + unitNormal x == + zero? x => [1,x,1] + (u := recip x) case % => [x, 1, u] + zero? real x => + c := unitNormal imag x + [complex(0, c.unit), (c.associate * imag x)::%, + complex(0, - c.associate)] + c := unitNormal real x + x := c.associate * x + imag x < 0 => + x := complex(- imag x, real x) + [- c.unit * imaginary(), x, c.associate * imaginary()] + [c.unit ::%, x, c.associate ::%] + + else + + unitNormal : % -> Record(unit: %,canonical: %,associate: %) + unitNormal x == + zero? x => [1,x,1] + (u := recip x) case % => [x, 1, u] + zero? real x => + c := unitNormal imag x + [complex(0, c.unit), (c.associate * imag x)::%, + complex(0, - c.associate)] + c := unitNormal real x + x := c.associate * x + [c.unit ::%, x, c.associate ::%] + + if R has EuclideanDomain then + + if R has additiveValuation then + + euclideanSize : % -> NonNegativeInteger + euclideanSize x == max(euclideanSize real x, + euclideanSize imag x) + + else + + euclideanSize : % -> NonNegativeInteger + euclideanSize x == euclideanSize(real(x)**2 + imag(x)**2)$R + + if R has IntegerNumberSystem then + + ?rem? : (%,%) -> % if R has EUCDOM + x rem y == + zero? imag y => + yr:=real y + complex(symmetricRemainder(real(x), yr), + symmetricRemainder(imag(x), yr)) + divide(x, y).remainder + + ?quo? : (%,%) -> % if R has EUCDOM + x quo y == + zero? imag y => + yr:= real y + xr:= real x + xi:= imag x + complex((xr-symmetricRemainder(xr,yr)) quo yr, + (xi-symmetricRemainder(xi,yr)) quo yr) + divide(x, y).quotient + + else + + ?rem? : (%,%) -> % if R has EUCDOM + x rem y == + zero? imag y => + yr:=real y + complex(real(x) rem yr,imag(x) rem yr) + divide(x, y).remainder + + ?quo? : (%,%) -> % if R has EUCDOM + x quo y == + zero? imag y => complex(real x quo real y,imag x quo real y) + divide(x, y).quotient + + divide : (%,%) -> Record(quotient: %,remainder: %) + divide(x, y) == + r := norm y + y1 := conjugate y + xx := x * y1 + x1 := real(xx) rem r + a := x1 + if x1^=0 and sizeLess?(r, 2 * x1) then + a := x1 - r + if sizeLess?(x1, a) then a := x1 + r + x2 := imag(xx) rem r + b := x2 + if x2^=0 and sizeLess?(r, 2 * x2) then + b := x2 - r + if sizeLess?(x2, b) then b := x2 + r + y1 := (complex(a, b) exquo y1)::% + [((x - y1) exquo y)::%, y1] + + if R has TranscendentalFunctionCategory then + + half := recip(2::R)::R + + if R has RealNumberSystem then + + atan2loc : R -> R + atan2loc(y: R, x: R): R == + pi1 := pi()$R + pi2 := pi1 * half + x = 0 => if y >= 0 then pi2 else -pi2 + + -- Atan in (-pi/2,pi/2] + theta := atan(y * recip(x)::R) + while theta <= -pi2 repeat theta := theta + pi1 + while theta > pi2 repeat theta := theta - pi1 + + x >= 0 => theta -- I or IV + + if y >= 0 then + theta + pi1 -- II + else + theta - pi1 -- III + + argument : % -> R + argument x == atan2loc(imag x, real x) + + else + + -- Not ordered so dictate two quadrants + argument : % -> R + argument x == + zero? real x => pi()$R * half + atan(imag(x) * recip(real x)::R) + + pi : () -> % + pi() == pi()$R :: % + + if R is DoubleFloat then + + stoc ==> S_-TO_-C$Lisp + ctos ==> C_-TO_-S$Lisp + + exp : % -> % + exp x == ctos EXP(stoc x)$Lisp - sin x == ctos SIN(stoc x)$Lisp - cos x == ctos COS(stoc x)$Lisp - tan x == ctos TAN(stoc x)$Lisp - asin x == ctos ASIN(stoc x)$Lisp - acos x == ctos ACOS(stoc x)$Lisp - atan x == ctos ATAN(stoc x)$Lisp + log : % -> % + log x == ctos LOG(stoc x)$Lisp - sinh x == ctos SINH(stoc x)$Lisp - cosh x == ctos COSH(stoc x)$Lisp - tanh x == ctos TANH(stoc x)$Lisp + sin : % -> % + sin x == ctos SIN(stoc x)$Lisp + + cos : % -> % + cos x == ctos COS(stoc x)$Lisp + + tan : % -> % + tan x == ctos TAN(stoc x)$Lisp + + asin : % -> % + asin x == ctos ASIN(stoc x)$Lisp + + acos : % -> % + acos x == ctos ACOS(stoc x)$Lisp + + atan : % -> % + atan x == ctos ATAN(stoc x)$Lisp + + sinh : % -> % + sinh x == ctos SINH(stoc x)$Lisp + + cosh : % -> % + cosh x == ctos COSH(stoc x)$Lisp + + tanh : % -> % + tanh x == ctos TANH(stoc x)$Lisp + + asinh : % -> % asinh x == ctos ASINH(stoc x)$Lisp + + acosh : % -> % acosh x == ctos ACOSH(stoc x)$Lisp + + atanh : % -> % atanh x == ctos ATANH(stoc x)$Lisp else + + atan : % -> % atan x == ix := imaginary()*x - imaginary() * half * (log(1 + ix) - log(1 - ix)) + log : % -> % log x == complex(log(norm x) * half, argument x) + exp : % -> % exp x == e := exp real x complex(e * cos imag x, e * sin imag x) + cos : % -> % cos x == e := exp(imaginary() * x) half * (e + recip(e)::%) + sin : % -> % sin x == e := exp(imaginary() * x) - imaginary() * half * (e - recip(e)::%) if R has RealNumberSystem then + + polarCoordinates : % -> Record(r: R,phi: R) polarCoordinates x == [sqrt norm x, (negative?(t := argument x) => t + 2 * pi(); t)] + ?**? : (%,Fraction(Integer)) -> % x:% ** q:Fraction(Integer) == zero? q => zero? x => error "0 ** 0 is undefined" @@ -77421,6 +89721,8 @@ ComplexCategory(R:CommutativeRing): Category == complex(ax * cos tx, ax * sin tx) else if R has RadicalCategory then + + ?**? : (%,Fraction(Integer)) -> % x:% ** q:Fraction(Integer) == zero? q => zero? x => error "0 ** 0 is undefined" @@ -77432,8 +89734,10 @@ ComplexCategory(R:CommutativeRing): Category == zero? r => i ** q norm(x) ** (q / (2::Fraction(Integer))) complex(e * cos t, e * sin t) +*) \end{chunk} + \begin{chunk}{COMPCAT.dotabb} "COMPCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPCAT"]; @@ -77448,6 +89752,7 @@ ComplexCategory(R:CommutativeRing): Category == "COMPCAT" -> "ORDSET" \end{chunk} + \begin{chunk}{COMPCAT.dotfull} "ComplexCategory(R:CommutativeRing)" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPCAT"]; @@ -77471,6 +89776,7 @@ ComplexCategory(R:CommutativeRing): Category == "OrderedSet()" \end{chunk} + \begin{chunk}{COMPCAT.dotpic} digraph pic { fontsize=10; @@ -77500,6 +89806,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{FunctionFieldCategory}{FFCAT} \pagepic{ps/v102functionfieldcategory.ps}{FFCAT}{0.70} @@ -77674,6 +89981,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{FunctionFieldCategory.help} ==================================================================== FunctionFieldCategory examples @@ -78467,7 +90775,6 @@ FunctionFieldCategory(F, UP, UPUP): Category == Definition where infOrder f == (degree denom f)::Z - (degree numer f)::Z integral? f == ground?(integralCoordinates(f).den) integral?(f:$, a:F) == (integralCoordinates(f).den)(a) ^= 0 --- absolutelyIrreducible? == one? numberOfComponents() absolutelyIrreducible? == numberOfComponents() = 1 yCoordinates f == splitDenominator coordinates f @@ -78657,12 +90964,246 @@ FunctionFieldCategory(F, UP, UPUP): Category == Definition where differentiate(f, x +-> differentiate(x, d)$RF) \end{chunk} + +\begin{chunk}{COQ FFCAT} +(* category FFCAT *) +(* + import InnerCommonDenominator(UP, RF, Vector UP, Vector RF) + import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) + + Q2RF : Q -> RF + Q2RF q == numer(q)::UP / denom(q)::UP + + infOrder: RF -> Z + infOrder f == (degree denom f)::Z - (degree numer f)::Z + + integral? : % -> Boolean + integral? f == ground?(integralCoordinates(f).den) + + integral? : (%,F) -> Boolean + integral?(f:$, a:F) == (integralCoordinates(f).den)(a) ^= 0 + + absolutelyIrreducible? : () -> Boolean + absolutelyIrreducible? == numberOfComponents() = 1 + + yCoordinates : % -> Record(num: Vector(UP),den: UP) + yCoordinates f == splitDenominator coordinates f + + hyperelliptic : () -> Union(UP,"failed") + hyperelliptic() == + degree(f := definingPolynomial()) ^= 2 => "failed" + (u:=retractIfCan(reductum f)@Union(RF,"failed")) + case "failed" => "failed" + (v:=retractIfCan(-(u::RF) / leadingCoefficient f)@Union(UP, "failed")) + case "failed" => "failed" + odd? degree(p := v::UP) => p + "failed" + + algSplitSimple : (%,(UP -> UP)) -> + Record(num: %,den: UP,derivden: UP,gd: UP) + algSplitSimple(f, derivation) == + cd := splitDenominator lift f + dd := (cd.den exquo (g := gcd(cd.den, derivation(cd.den))))::UP + [reduce(inv(g::RF) * cd.num), dd, derivation dd, + gcd(dd, retract(discriminant())@UP)] + + elliptic : () -> Union(UP,"failed") + elliptic() == + (u := hyperelliptic()) case "failed" => "failed" + degree(p := u::UP) = 3 => p + "failed" + + rationalPoint? : (F,F) -> Boolean + rationalPoint?(x, y) == + zero?((definingPolynomial() (y::UP::RF)) (x::UP::RF)) + + if F has Field then + import PolyGroebner(F) + import MatrixCommonDenominator(UP, RF) + + UP2P : (UP, P) -> P + UP2P(p, x) == + (map((s:F):P +-> s::P, p)_ + $UnivariatePolynomialCategoryFunctions2(F, UP, + P, SparseUnivariatePolynomial P)) x + + UPUP2P: (UPUP, P, P) -> P + UPUP2P(p, x, y) == + (map((s:RF):P +-> UP2P(retract(s)@UP, x),p)_ + $UnivariatePolynomialCategoryFunctions2(RF, UPUP, + P, SparseUnivariatePolynomial P)) y + + nonSingularModel : Symbol -> List(Polynomial(F)) + nonSingularModel u == + d := commonDenominator(coordinates(w := integralBasis()))::RF + vars := [concat(string u, string i)::SY for i in 1..(n := #w)] + x := "%%dummy1"::SY + y := "%%dummy2"::SY + select_!(s+->zero?(degree(s, x)) and zero?(degree(s, y)), + lexGroebner([v::P - UPUP2P(lift(d * w.i), x::P, y::P) + for v in vars for i in 1..n], concat([x, y], vars))) + + if F has Finite then + + ispoint: (UPUP, F, F) -> List F + ispoint(p, x, y) == + jhd:RF:=p(y::UP::RF) + zero?(jhd (x::UP::RF)) => [x, y] + empty() + + rationalPoints : () -> List(List(F)) + rationalPoints() == + p := definingPolynomial() + concat [[pt for y in 1..size()$F | not empty?(pt := + ispoint(p, index(x::PositiveInteger)$F, + index(y::PositiveInteger)$F))]$List(List F) + for x in 1..size()$F]$List(List(List F)) + + intvalue: (Vector UP, F, F) -> F + intvalue(v, x, y) == + singular? x => error "Point is singular" + mini := minIndex(w := integralBasis()) + rec := yCoordinates(+/[qelt(v, i)::RF * qelt(w, i) + for i in mini .. maxIndex w]) + n := +/[(qelt(rec.num, i) x) * + (y ** ((i - mini)::NonNegativeInteger)) + for i in mini .. maxIndex w] + zero?(d := (rec.den) x) => + zero? n => error "0/0 -- cannot compute value yet" + error "Shouldn't happen" + (n exquo d)::F + + elt : (%,F,F) -> F + elt(f, x, y) == + rec := integralCoordinates f + n := intvalue(rec.num, x, y) + zero?(d := (rec.den) x) => + zero? n => error "0/0 -- cannot compute value yet" + error "Function has a pole at the given point" + (n exquo d)::F + + primitivePart : % -> % + primitivePart f == + cd := yCoordinates f + d := gcd([content qelt(cd.num, i) + for i in minIndex(cd.num) .. maxIndex(cd.num)]$List(F)) + * primitivePart(cd.den) + represents [qelt(cd.num, i) / d + for i in minIndex(cd.num) .. maxIndex(cd.num)]$Vector(RF) + + reduceBasisAtInfinity : Vector(%) -> Vector(%) + reduceBasisAtInfinity b == + x := monomial(1, 1)$UP ::RF + concat([[f for j in 0.. while + integralAtInfinity?(f := x**j * qelt(b, i))]$Vector($) + for i in minIndex b .. maxIndex b]$List(Vector $)) + + complementaryBasis : Vector(%) -> Vector(%) + complementaryBasis b == + m := inverse(traceMatrix b)::Matrix(RF) + [represents row(m, i) for i in minRowIndex m .. maxRowIndex m] + + integralAtInfinity? : % -> Boolean + integralAtInfinity? f == + not any?(s +-> infOrder(s) < 0, + coordinates(f) * inverseIntegralMatrixAtInfinity())$Vector(RF) + + numberOfComponents : () -> NonNegativeInteger + numberOfComponents() == + count(integralAtInfinity?, integralBasis())$Vector($) + + represents : (Vector(UP),UP) -> % + represents(v:Vector UP, d:UP) == + represents + [qelt(v, i) / d for i in minIndex v .. maxIndex v]$Vector(RF) + + genus : () -> NonNegativeInteger + genus() == + ds := discriminant() + d := degree(retract(ds)@UP) + infOrder(ds * determinant( + integralMatrixAtInfinity() * inverseIntegralMatrix()) ** 2) + dd := (((d exquo 2)::Z - rank()) exquo numberOfComponents())::Z + (dd + 1)::NonNegativeInteger + + repOrder: (Matrix RF, Z) -> Z + repOrder(m, i) == + nostart:Boolean := true + ans:Z := 0 + r := row(m, i) + for j in minIndex r .. maxIndex r | qelt(r, j) ^= 0 repeat + ans := + nostart => (nostart := false; infOrder qelt(r, j)) + min(ans, infOrder qelt(r,j)) + nostart => error "Null row" + ans + + infValue: RF -> Fraction F + infValue f == + zero? f => 0 + (n := infOrder f) > 0 => 0 + zero? n => + (leadingCoefficient numer f) / (leadingCoefficient denom f) + error "f not locally integral at infinity" + + rfmonom : Z -> RF + rfmonom n == + n < 0 => inv(monomial(1, (-n)::NonNegativeInteger)$UP :: RF) + monomial(1, n::NonNegativeInteger)$UP :: RF + + kmin : (Matrix RF,Vector Q) -> Union(Record(pos:Z,km:Z),"failed") + kmin(m, v) == + nostart:Boolean := true + k:Z := 0 + ii := minRowIndex m - (i0 := minIndex v) + for i in minIndex v .. maxIndex v | qelt(v, i) ^= 0 repeat + nk := repOrder(m, i + ii) + if nostart then (nostart := false; k := nk; i0 := i) + else + if nk < k then (k := nk; i0 := i) + nostart => "failed" + [i0, k] + + normalizeAtInfinity : Vector(%) -> Vector(%) + normalizeAtInfinity w == + ans := copy w + infm := inverseIntegralMatrixAtInfinity() + mhat := zero(rank(), rank())$Matrix(RF) + ii := minIndex w - minRowIndex mhat + repeat + m := coordinates(ans) * infm + r := [rfmonom repOrder(m, i) + for i in minRowIndex m .. maxRowIndex m]$Vector(RF) + for i in minRowIndex m .. maxRowIndex m repeat + for j in minColIndex m .. maxColIndex m repeat + qsetelt_!(mhat, i, j, qelt(r, i + ii) * qelt(m, i, j)) + sol := first nullSpace transpose map(infValue, + mhat)$MatrixCategoryFunctions2(RF, Vector RF, Vector RF, + Matrix RF, Q, Vector Q, Vector Q, Matrix Q) + (pr := kmin(m, sol)) case "failed" => return ans + qsetelt_!(ans, pr.pos, + +/[Q2RF(qelt(sol, i)) * rfmonom(repOrder(m, i - ii) - pr.km) + * qelt(ans, i) for i in minIndex sol .. maxIndex sol]) + + integral? : (%,UP) -> Boolean + integral?(f:$, p:UP) == + (r:=retractIfCan(p)@Union(F,"failed")) case F => integral?(f,r::F) + (integralCoordinates(f).den exquo p) case "failed" + + differentiate : (%,(UP -> UP)) -> % + differentiate(f:$, d:UP -> UP) == + differentiate(f, x +-> differentiate(x, d)$RF) + +*) + +\end{chunk} + \begin{chunk}{FFCAT.dotabb} "FFCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=FFCAT"]; "FFCAT" -> "MONOGEN" \end{chunk} + \begin{chunk}{FFCAT.dotfull} "FunctionFieldCategory(a:UFD,b:UPOLYC(a),c:UPOLYC(Fraction(b)))" [color=lightblue,href="bookvol10.2.pdf#nameddest=FFCAT"]; @@ -78670,6 +91211,7 @@ FunctionFieldCategory(F, UP, UPUP): Category == Definition where -> "MonogenicAlgebra(a:FRAC(UPOLYC(UFD)),b:UPOLYC(FRAC(UPOLYC(UFD))))" \end{chunk} + \begin{chunk}{FFCAT.dotpic} digraph pic { fontsize=10; @@ -78707,6 +91249,7 @@ digraph pic { } \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagehead{PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory}{PACEXTC} \pagepic{ps/v102pseudoalgebraicclosureofalgextofrationalnumbercategory.ps}{PACEXTC}{0.50} @@ -78810,6 +91353,7 @@ digraph pic { )spool )lisp (bye) \end{chunk} + \begin{chunk}{PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory.help} ==================================================================== PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory examples @@ -79101,6 +91645,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory:Category == Impl where Join(PseudoAlgebraicClosureOfRationalNumberCategory,_ RetractableTo(Q),ExtensionField(Q)) \end{chunk} + \begin{chunk}{PACEXTC.dotabb} "PACEXTC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACEXTC"]; "PACEXTC" -> "PACRATC" @@ -79108,6 +91653,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory:Category == Impl where "PACEXTC" -> "XF" \end{chunk} + \begin{chunk}{PACEXTC.dotfull} "PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACEXTC"]; @@ -79136,6 +91682,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory:Category == Impl where [color=lightblue,href="bookvol10.2.pdf#nameddest=XF"]; \end{chunk} + \begin{chunk}{PACEXTC.dotpic} digraph pic { fontsize=10; @@ -93136,6 +105683,143 @@ Note that this code is not included in the generated catdef.spad file. 0 26 2 0 19 0 0 47 1 0 29 0 34)))))) (QUOTE |lookupComplete|))) \end{chunk} + +\chapter{The Proofs} +\begin{chunk}{coq} +Module Categories +\getchunk{COQ BASTYPE} +\getchunk{COQ ELEMFUN} +\getchunk{COQ HYPCAT} +\getchunk{COQ IEVALAB} +\getchunk{COQ ATJACID} +\getchunk{COQ ATLUNIT} +\getchunk{COQ ATMULVA} +\getchunk{COQ ATNZDIV} +\getchunk{COQ ATNULSQ} +\getchunk{COQ ATPOSET} +\getchunk{COQ RADCAT} +\getchunk{COQ RETRACT} +\getchunk{COQ ATRUNIT} +\getchunk{COQ TRIGCAT} +\getchunk{COQ AGG} +\getchunk{COQ ELTAGG} +\getchunk{COQ EVALAB} +\getchunk{COQ FRETRCT} +\getchunk{COQ LOGIC} +\getchunk{COQ SETCAT} +\getchunk{COQ TRANFUN} +\getchunk{COQ ABELSG} +\getchunk{COQ FINITE} +\getchunk{COQ GRMOD} +\getchunk{COQ HOAGG} +\getchunk{COQ MONAD} +\getchunk{COQ ORDSET} +\getchunk{COQ RRCC} +\getchunk{COQ SGROUP} +\getchunk{COQ ABELMON} +\getchunk{COQ BGAGG} +\getchunk{COQ CLAGG} +\getchunk{COQ DVARCAT} +\getchunk{COQ ES} +\getchunk{COQ GRALG} +\getchunk{COQ IXAGG} +\getchunk{COQ MONADWU} +\getchunk{COQ MONOID} +\getchunk{COQ RCAGG} +\getchunk{COQ ARR2CAT} +\getchunk{COQ BRAGG} +\getchunk{COQ DIOPS} +\getchunk{COQ GROUP} +\getchunk{COQ LNAGG} +\getchunk{COQ MATCAT} +\getchunk{COQ OASGP} +\getchunk{COQ ORDMON} +\getchunk{COQ PSETCAT} +\getchunk{COQ SETAGG} +\getchunk{COQ URAGG} +\getchunk{COQ ABELGRP} +\getchunk{COQ BTCAT} +\getchunk{COQ DIAGG} +\getchunk{COQ ELAGG} +\getchunk{COQ FLAGG} +\getchunk{COQ STAGG} +\getchunk{COQ TSETCAT} +\getchunk{COQ FDIVCAT} +\getchunk{COQ FSAGG} +\getchunk{COQ KDAGG} +\getchunk{COQ LZSTAGG} +\getchunk{COQ LSAGG} +\getchunk{COQ NARNG} +\getchunk{COQ A1AGG} +\getchunk{COQ RSETCAT} +\getchunk{COQ RMODULE} +\getchunk{COQ RNG} +\getchunk{COQ BMODULE} +\getchunk{COQ BTAGG} +\getchunk{COQ NASRING} +\getchunk{COQ OAMONS} +\getchunk{COQ RING} +\getchunk{COQ SRAGG} +\getchunk{COQ TBAGG} +\getchunk{COQ VECTCAT} +\getchunk{COQ DIFRING} +\getchunk{COQ ENTIRER} +\getchunk{COQ LALG} +\getchunk{COQ MODULE} +\getchunk{COQ ORDRING} +\getchunk{COQ PDRING} +\getchunk{COQ RMATCAT} +\getchunk{COQ OREPCAT} +\getchunk{COQ ALGEBRA} +\getchunk{COQ DIFEXT} +\getchunk{COQ LIECAT} +\getchunk{COQ LODOCAT} +\getchunk{COQ NAALG} +\getchunk{COQ VSPACE} +\getchunk{COQ DIRPCAT} +\getchunk{COQ DIVRING} +\getchunk{COQ FINAALG} +\getchunk{COQ INTDOM} +\getchunk{COQ OC} +\getchunk{COQ QUATCAT} +\getchunk{COQ SMATCAT} +\getchunk{COQ AMR} +\getchunk{COQ FRNAALG} +\getchunk{COQ GCDDOM} +\getchunk{COQ FAMR} +\getchunk{COQ PSCAT} +\getchunk{COQ UFD} +\getchunk{COQ EUCDOM} +\getchunk{COQ PFECAT} +\getchunk{COQ UPSCAT} +\getchunk{COQ FIELD} +\getchunk{COQ INS} +\getchunk{COQ POLYCAT} +\getchunk{COQ UTSCAT} +\getchunk{COQ ACF} +\getchunk{COQ DPOLCAT} +\getchunk{COQ FPC} +\getchunk{COQ FINRALG} +\getchunk{COQ FS} +\getchunk{COQ QFCAT} +\getchunk{COQ RCFIELD} +\getchunk{COQ RNS} +\getchunk{COQ RPOLCAT} +\getchunk{COQ UPOLYC} +\getchunk{COQ ACFS} +\getchunk{COQ XF} +\getchunk{COQ FFIELDC} +\getchunk{COQ FPS} +\getchunk{COQ FRAMALG} +\getchunk{COQ ULSCCAT} +\getchunk{COQ UPXSCCA} +\getchunk{COQ FAXF} +\getchunk{COQ MONOGEN} +\getchunk{COQ COMPCAT} +\getchunk{COQ FFCAT} +End Categories +\end{chunk} + \chapter{Chunk collections} \begin{chunk}{algebra} \getchunk{category ABELGRP AbelianGroup} diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 7a036f9..661d0b4 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -18,9 +18,7 @@ domain, or package. An ellipse means that the name refers to something in the bootstrap set. Thus, \includegraphics[scale=0.85]{ps/v103colorchart.ps} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%\pagehead{Domain}{ABB} -%\pagepic{ps/v103domain.ps}{ABB}{1.00} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter A} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -115,12 +113,21 @@ AffinePlane(K):Exports == Implementation where \end{chunk} + +\begin{chunk}{COQ AFFPL} +(* domain AFFPL *) +(* +*) + +\end{chunk} + \begin{chunk}{AFFPL.dotabb} "AFFPL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFPL"]; "AFFSP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFSP"]; "AFFPL" -> "AFFSP" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain AFFPLPS AffinePlaneOverPseudoAlgebraicClosureOfFiniteField} @@ -218,12 +225,21 @@ AffinePlaneOverPseudoAlgebraicClosureOfFiniteField(K):Exports == Impl where Impl ==> AffinePlane(KK) \end{chunk} + +\begin{chunk}{COQ AFFPLPS} +(* domain AFFPLPS *) +(* +*) + +\end{chunk} + \begin{chunk}{AFFPLPS.dotabb} "AFFPLPS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFPLPS"]; "AFFPL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFPL"]; "AFFPLPS" -> "AFFPL" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain AFFSP AffineSpace} @@ -408,6 +424,123 @@ AffineSpace(dim,K):Exports == Implementation where ptt \end{chunk} + +\begin{chunk}{COQ AFFSP} +(* domain AFFSP *) +(* + + AffineSpace(dim: NonNegativeInteger,K: Field) + + Rep:= List(K) + + origin : () -> % + origin == + new(dim,0$K)$List(K) + + coerce : % -> OutputForm + coerce(pt:%):OutputForm == + dd:OutputForm:= ":" :: OutputForm + llout:List(OutputForm):=[ hconcat(dd, a::OutputForm) for a in rest pt] + lout:= cons( (first pt)::OutputForm , llout) + out:= hconcat lout + oo:=paren(out) + ee:OutputForm:= degree(pt) :: OutputForm + oo**ee + + definingField : % -> K + definingField(pt) == + K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ + maxTower(pt@Rep) + 1$K + + degree : % -> PositiveInteger + degree(pt) == + K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ + extDegree definingField pt + 1 + + coerce : % -> List(K) + coerce(pt:%):List(K) == + pt@Rep + + affinePoint : List(K) -> % + affinePoint(pt:LIST(K)) == + pt :: % + + list : % -> List(K) + list(ptt) == + ptt@Rep + + pointValue : % -> List(K) + pointValue(ptt) == + ptt@Rep + + conjugate : % -> % + conjugate(p,e) == + lp:Rep:=p + pc:List(K):=[c**e for c in lp] + affinePoint(pc) + + rational? : (%,NonNegativeInteger) -> Boolean + rational?(p,n) == + p = conjugate(p,n) + + rational? : % -> Boolean + rational?(p) == + rational?(p,characteristic()$K) + + removeConjugate : List(%) -> List(%) + removeConjugate(l) == + removeConjugate(l,characteristic()$K) + + removeConjugate : (List(%),NonNegativeInteger) -> List(%) + removeConjugate(l:LIST(%),n:NNI):LIST(%) == + if K has FiniteFieldCategory then + allconj:LIST(%):=empty() + conjrem:LIST(%):=empty() + for p in l repeat + if ^member?(p,allconj) then + conjrem:=cons(p,conjrem) + allconj:=concat(allconj,orbit(p,n)) + conjrem + else + error "The field is not finite" + + conjugate : % -> % + conjugate(p) == + conjugate(p,characteristic()$K) + + orbit : % -> List(%) + orbit(p) == + orbit(p,characteristic()$K) + + orbit : (%,NonNegativeInteger) -> List(%) + orbit(p,e)== + if K has FiniteFieldCategory then + l:LIST(%):=[p] + np:%:=conjugate(p,e) + flag:=^(np=p)::Boolean + while flag repeat + l:=concat(np,l) + np:=conjugate(np,e) + flag:=not (np=p)::Boolean + l + else + error "Cannot compute the conjugate" + + ?=? : (%,%) -> Boolean + aa:% = bb:% == + aa =$Rep bb + + coerce : List(K) -> % + coerce(pt:LIST(K)) == + ^(dim=#pt) => error "Le point n'a pas la bonne dimension" + ptt:%:= pt + ptt +*) + +\end{chunk} + \begin{chunk}{AFFSP.dotabb} "AFFSP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFSP"]; "PACPERC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"]; @@ -416,6 +549,7 @@ AffineSpace(dim,K):Exports == Implementation where "AFFSP" -> "PACPERC" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ALGSC AlgebraGivenByStructuralConstants} @@ -2662,12 +2796,393 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ true \end{chunk} + +\begin{chunk}{COQ ALGSC} +(* domain ALGSC *) +(* +AlgebraGivenByStructuralConstants(R: Field, + n: PositiveInteger, + ls: List(Symbol), + gamma: Vector(Matrix(R))) + + DirectProduct(n,R) add + + Rep := DirectProduct(n,R) + + x,y : % + dp : DirectProduct(n,R) + v : V R + + recip : % -> Union(%,"failed") + recip(x) == + recip(x)$FiniteRankNonAssociativeAlgebra_&(%,R) + + ?*? : (SquareMatrix(n,R),%) -> % + (m:SquareMatrix(n,R))*(x:%) == + apply((m :: Matrix R),x) + + coerce : Vector(R) -> % + coerce v == + directProduct(v) :: % + + structuralConstants : () -> Vector(Matrix(R)) + structuralConstants() == + gamma + + coordinates : % -> Vector(R) + coordinates(x) == + vector(entries(x :: Rep)$Rep)$Vector(R) + + er1:="coordinates: first argument is not in linear span of second argument" + + coordinates : (%,Vector(%)) -> Vector(R) + coordinates(x,b) == + --not (maxIndex b = n) => + -- error("coordinates: your 'basis' has not the right length") + m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger + transitionMatrix : Matrix R := new(n,m,0$R)$Matrix(R) + for i in 1..m repeat + setColumn_!(transitionMatrix,i,coordinates(b.i)) + res : REC := solve(transitionMatrix,coordinates(x))$LSMP + if (not every?(zero?$R,first res.basis)) then + error("coordinates: warning your 'basis' is linearly dependent") + (res.particular case "failed") => error(er1) + (res.particular) :: (Vector R) + + basis : () -> Vector(%) + basis() == + [unitVector(i::PositiveInteger)::% for i in 1..n] + + someBasis : () -> Vector(%) + someBasis() == + basis()$% + + rank : () -> PositiveInteger + rank() == + n + + ?.? : (%,Integer) -> R + elt(x,i) == + elt(x:Rep,i)$Rep + + coerce : % -> OutputForm + coerce(x:%):OutputForm == + zero?(x::Rep)$Rep => (0$R) :: OutputForm + le : List OutputForm := nil + for i in 1..n repeat + coef : R := elt(x::Rep,i) + not zero?(coef)$R => + ((coef) = 1)$R => + -- sy : OutputForm := elt(ls,i)$(List Symbol) :: OutputForm + le := cons(elt(ls,i)$(List Symbol) :: OutputForm, le) + le := cons(coef :: OutputForm * elt(ls,i)$(List Symbol)_ + :: OutputForm, le) + reduce("+",le) + + ?*? : (%,%) -> % + x * y == + v : Vector R := new(n,0) + for k in 1..n repeat + h : R := 0 + for i in 1..n repeat + for j in 1..n repeat + h := h +$R elt(x,i) *$R elt(y,j) *$R elt(gamma.k,i,j ) + v.k := h + directProduct v + + er2:="algebra satisfies 2*associator(a,b,b)=0 = 2*associator(a,a,b)=0" + + alternative? : () -> Boolean + alternative?() == + for i in 1..n repeat + -- expression for check of left alternative is symmetric in i and j: + -- expression for check of right alternative is symmetric in j and k: + for j in 1..i-1 repeat + for k in j..n repeat + -- right check + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res - _ + (elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_ + (elt(gamma.l,i,j)*elt(gamma.r,l,k) + elt(gamma.l,i,k)*_ + elt(gamma.r,l,j) ) + not zero? res => + messagePrint("algebra is not right alternative")$OutputForm + return false + for j in i..n repeat + for k in 1..j-1 repeat + -- left check + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res + _ + (elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_ + (elt(gamma.l,j,k)*elt(gamma.r,i,l) + elt(gamma.l,i,k)*_ + elt(gamma.r,j,l) ) + not (zero? res) => + messagePrint("algebra is not left alternative")$OutputForm + return false + + for k in j..n repeat + -- left check + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res + _ + (elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_ + (elt(gamma.l,j,k)*elt(gamma.r,i,l) + elt(gamma.l,i,k)*_ + elt(gamma.r,j,l) ) + not (zero? res) => + messagePrint("algebra is not left alternative")$OutputForm + return false + -- right check + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res - _ + (elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_ + (elt(gamma.l,i,j)*elt(gamma.r,l,k) + elt(gamma.l,i,k)*_ + elt(gamma.r,l,j) ) + not (zero? res) => + messagePrint("algebra is not right alternative")$OutputForm + return false + + messagePrint(er2)$OutputForm + true + + associative? : () -> Boolean + associative?() == + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res + elt(gamma.l,i,j)*elt(gamma.r,l,k)-_ + elt(gamma.l,j,k)*elt(gamma.r,i,l) + not (zero? res) => + messagePrint("algebra is not associative")$OutputForm + return false + messagePrint("algebra is associative")$OutputForm + true + + antiAssociative? : () -> Boolean + antiAssociative?() == + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res + elt(gamma.l,i,j)*elt(gamma.r,l,k)+_ + elt(gamma.l,j,k)*elt(gamma.r,i,l) + not (zero? res) => + messagePrint("algebra is not anti-associative")$OutputForm + return false + messagePrint("algebra is anti-associative")$OutputForm + true + + commutative? : () -> Boolean + commutative?() == + for i in 1..n repeat + for j in (i+1)..n repeat + for k in 1..n repeat + not ( elt(gamma.k,i,j)=elt(gamma.k,j,i) ) => + messagePrint("algebra is not commutative")$OutputForm + return false + messagePrint("algebra is commutative")$OutputForm + true + + antiCommutative? : () -> Boolean + antiCommutative?() == + for i in 1..n repeat + for j in i..n repeat + for k in 1..n repeat + not zero? (i=j => elt(gamma.k,i,i); _ + elt(gamma.k,i,j)+elt(gamma.k,j,i) ) => + messagePrint("algebra is not anti-commutative")$OutputForm + return false + messagePrint("algebra is anti-commutative")$OutputForm + true + + leftAlternative? : () -> Boolean + leftAlternative?() == + for i in 1..n repeat + -- expression is symmetric in i and j: + for j in i..n repeat + for k in 1..n repeat + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res+(elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_ + (elt(gamma.l,j,k)*elt(gamma.r,i,l) + _ + elt(gamma.l,i,k)*elt(gamma.r,j,l) ) + not (zero? res) => + messagePrint("algebra is not left alternative")$OutputForm + return false + messagePrint("algebra is left alternative")$OutputForm + true + + rightAlternative? : () -> Boolean + rightAlternative?() == + for i in 1..n repeat + for j in 1..n repeat + -- expression is symmetric in j and k: + for k in j..n repeat + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res-(elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_ + (elt(gamma.l,i,j)*elt(gamma.r,l,k) + _ + elt(gamma.l,i,k)*elt(gamma.r,l,j) ) + not (zero? res) => + messagePrint("algebra is not right alternative")$OutputForm + return false + messagePrint("algebra is right alternative")$OutputForm + true + + flexible? : () -> Boolean + flexible?() == + for i in 1..n repeat + for j in 1..n repeat + -- expression is symmetric in i and k: + for k in i..n repeat + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res + elt(gamma.l,i,j)*elt(gamma.r,l,k)-_ + elt(gamma.l,j,k)*elt(gamma.r,i,l)+_ + elt(gamma.l,k,j)*elt(gamma.r,l,i)-_ + elt(gamma.l,j,i)*elt(gamma.r,k,l) + not (zero? res) => + messagePrint("algebra is not flexible")$OutputForm + return false + messagePrint("algebra is flexible")$OutputForm + true + + lieAdmissible? : () -> Boolean + lieAdmissible?() == + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for r in 1..n repeat + res := 0$R + for l in 1..n repeat + res := res_ + + (elt(gamma.l,i,j)-elt(gamma.l,j,i))*_ + (elt(gamma.r,l,k)-elt(gamma.r,k,l)) _ + + (elt(gamma.l,j,k)-elt(gamma.l,k,j))*_ + (elt(gamma.r,l,i)-elt(gamma.r,i,l)) _ + + (elt(gamma.l,k,i)-elt(gamma.l,i,k))*_ + (elt(gamma.r,l,j)-elt(gamma.r,j,l)) + not (zero? res) => + messagePrint("algebra is not Lie admissible")$OutputForm + return false + messagePrint("algebra is Lie admissible")$OutputForm + true + + er3:="this algebra is not Jordan admissible, _ + as 2 is not invertible in the ground ring" + + jordanAdmissible? : () -> Boolean + jordanAdmissible?() == + recip(2 * 1$R) case "failed" => + messagePrint(er3)$OutputForm + false + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for w in 1..n repeat + for t in 1..n repeat + res := 0$R + for l in 1..n repeat + for r in 1..n repeat + res := res_ + + (elt(gamma.l,i,j)+elt(gamma.l,j,i))_ + * (elt(gamma.r,w,k)+elt(gamma.r,k,w))_ + * (elt(gamma.t,l,r)+elt(gamma.t,r,l))_ + - (elt(gamma.r,w,k)+elt(gamma.r,k,w))_ + * (elt(gamma.l,j,r)+elt(gamma.l,r,j))_ + * (elt(gamma.t,i,l)+elt(gamma.t,l,i))_ + + (elt(gamma.l,w,j)+elt(gamma.l,j,w))_ + * (elt(gamma.r,k,i)+elt(gamma.r,i,k))_ + * (elt(gamma.t,l,r)+elt(gamma.t,r,l))_ + - (elt(gamma.r,k,i)+elt(gamma.r,k,i))_ + * (elt(gamma.l,j,r)+elt(gamma.l,r,j))_ + * (elt(gamma.t,w,l)+elt(gamma.t,l,w))_ + + (elt(gamma.l,k,j)+elt(gamma.l,j,k))_ + * (elt(gamma.r,i,w)+elt(gamma.r,w,i))_ + * (elt(gamma.t,l,r)+elt(gamma.t,r,l))_ + - (elt(gamma.r,i,w)+elt(gamma.r,w,i))_ + * (elt(gamma.l,j,r)+elt(gamma.l,r,j))_ + * (elt(gamma.t,k,l)+elt(gamma.t,l,k)) + not (zero? res) => + messagePrint("algebra is not Jordan admissible")$OutputForm + return false + messagePrint("algebra is Jordan admissible")$OutputForm + true + + er4:="this is not a Jordan algebra, _ + as 2 is not invertible in the ground ring" + + jordanAlgebra? : () -> Boolean + jordanAlgebra?() == + recip(2 * 1$R) case "failed" => + messagePrint(er4)$OutputForm + false + not commutative?() => + messagePrint("this is not a Jordan algebra")$OutputForm + false + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for l in 1..n repeat + for t in 1..n repeat + res := 0$R + for r in 1..n repeat + for s in 1..n repeat + res := res + _ + elt(gamma.r,i,j)*elt(gamma.s,l,k)*elt(gamma.t,r,s) - _ + elt(gamma.r,l,k)*elt(gamma.s,j,r)*elt(gamma.t,i,s) + _ + elt(gamma.r,l,j)*elt(gamma.s,k,k)*elt(gamma.t,r,s) - _ + elt(gamma.r,k,i)*elt(gamma.s,j,r)*elt(gamma.t,l,s) + _ + elt(gamma.r,k,j)*elt(gamma.s,i,k)*elt(gamma.t,r,s) - _ + elt(gamma.r,i,l)*elt(gamma.s,j,r)*elt(gamma.t,k,s) + not zero? res => + messagePrint("this is not a Jordan algebra")$OutputForm + return false + messagePrint("this is a Jordan algebra")$OutputForm + true + + jacobiIdentity? : () -> Boolean + jacobiIdentity?() == + for i in 1..n repeat + for j in 1..n repeat + for k in 1..n repeat + for r in 1..n repeat + res := 0$R + for s in 1..n repeat + res := res + elt(gamma.r,i,j)*elt(gamma.s,j,k) +_ + elt(gamma.r,j,k)*elt(gamma.s,k,i) +_ + elt(gamma.r,k,i)*elt(gamma.s,i,j) + not zero? res => + messagePrint("Jacobi identity does not hold")$OutputForm + return false + messagePrint("Jacobi identity holds")$OutputForm + true + +*) + +\end{chunk} + \begin{chunk}{ALGSC.dotabb} "ALGSC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALGSC"] "FRNAALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRNAALG"] "ALGSC" -> "FRNAALG" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ALGFF AlgebraicFunctionField} @@ -3195,12 +3710,175 @@ AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Implementation where not ground? gcd(retract(discriminant())@UP, p) \end{chunk} + +\begin{chunk}{COQ ALGFF} +(* domain ALGFF *) +(* + SAE add + + import ChangeOfVariable(F, UP, UPUP) + import InnerCommonDenominator(UP, RF, Vector UP, Vector RF) + import MatrixCommonDenominator(UP, RF) + import UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP, UP2) + + + brandNew?:Reference(Boolean) := ref true + + infBr?:Reference(Boolean) := ref true + + discPoly:Reference(RF) := ref 0 + + n := degree modulus + + n1 := (n - 1)::N + + ibasis:Matrix(RF) := zero(n, n) + + invibasis:Matrix(RF) := copy ibasis + + infbasis:Matrix(RF) := copy ibasis + + invinfbasis:Matrix(RF):= copy ibasis + + branchPointAtInfinity? : () -> Boolean + branchPointAtInfinity?() == + (INIT; infBr?()) + + discriminant : () -> Fraction(UP) + discriminant() == + (INIT; discPoly()) + + integralBasis : () -> Vector(%) + integralBasis() == + (INIT; vect ibasis) + + integralBasisAtInfinity : () -> Vector(%) + integralBasisAtInfinity() == + (INIT; vect infbasis) + + integralMatrix : () -> Matrix(Fraction(UP)) + integralMatrix() == + (INIT; ibasis) + + inverseIntegralMatrix : () -> Matrix(Fraction(UP)) + inverseIntegralMatrix() == + (INIT; invibasis) + + integralMatrixAtInfinity : () -> Matrix(Fraction(UP)) + integralMatrixAtInfinity() == + (INIT; infbasis) + + branchPoint? : F -> Boolean + branchPoint?(a:F) == + zero?((retract(discriminant())@UP) a) + + definingPolynomial : () -> UPUP + definingPolynomial() == + modulus + + inverseIntegralMatrixAtInfinity : () -> Matrix(Fraction(UP)) + inverseIntegralMatrixAtInfinity() == + (INIT; invinfbasis) + + vect : Matrix RF -> Vector $ + vect m == + [represents row(m, i) for i in minRowIndex m .. maxRowIndex m] + + integralCoordinates : % -> Record(num: Vector(UP),den: UP) + integralCoordinates f == + splitDenominator(coordinates(f) * inverseIntegralMatrix()) + + knownInfBasis : NonNegativeInteger -> Void + knownInfBasis d == + if deref brandNew? then + alpha := [monomial(1, d * i)$UP :: RF for i in 0..n1]$Vector(RF) + ib := diagonalMatrix + [inv qelt(alpha, i) for i in minIndex alpha .. maxIndex alpha] + invib := diagonalMatrix alpha + for i in minRowIndex ib .. maxRowIndex ib repeat + for j in minColIndex ib .. maxColIndex ib repeat + infbasis(i, j) := qelt(ib, i, j) + invinfbasis(i, j) := invib(i, j) + void + + getInfBasis: () -> Void + getInfBasis() == + x := inv(monomial(1, 1)$UP :: RF) + invmod := map(s +-> s(x), modulus) + r := mkIntegral invmod + degree(r.poly) ^= n => error "Should not happen" + ninvmod:UP2 := map(s +-> retract(s)@UP, r.poly) + alpha := [(r.coef ** i) x for i in 0..n1]$Vector(RF) + invalpha := [inv qelt(alpha, i) + for i in minIndex alpha .. maxIndex alpha]$Vector(RF) + invib := integralBasis()$FunctionFieldIntegralBasis(UP, UP2, + SimpleAlgebraicExtension(UP, UP2, ninvmod)) + for i in minRowIndex ibasis .. maxRowIndex ibasis repeat + for j in minColIndex ibasis .. maxColIndex ibasis repeat + infbasis(i, j) := ((invib.basis)(i,j) / invib.basisDen) x + invinfbasis(i, j) := ((invib.basisInv) (i, j)) x + ib2 := infbasis * diagonalMatrix alpha + invib2 := diagonalMatrix(invalpha) * invinfbasis + for i in minRowIndex ib2 .. maxRowIndex ib2 repeat + for j in minColIndex ibasis .. maxColIndex ibasis repeat + infbasis(i, j) := qelt(ib2, i, j) + invinfbasis(i, j) := invib2(i, j) + void + + startUp : Boolean -> Void + startUp b == + brandNew?() := b + nmod:UP2 := map(retract, modulus) + ib := integralBasis()$FunctionFieldIntegralBasis(UP, UP2, + SimpleAlgebraicExtension(UP, UP2, nmod)) + for i in minRowIndex ibasis .. maxRowIndex ibasis repeat + for j in minColIndex ibasis .. maxColIndex ibasis repeat + qsetelt_!(ibasis, i, j, (ib.basis)(i, j) / ib.basisDen) + invibasis(i, j) := ((ib.basisInv) (i, j))::RF + if zero?(infbasis(minRowIndex infbasis, minColIndex infbasis)) + then getInfBasis() + ib2 := coordinates normalizeAtInfinity vect ibasis + invib2 := inverse(ib2)::Matrix(RF) + for i in minRowIndex ib2 .. maxRowIndex ib2 repeat + for j in minColIndex ib2 .. maxColIndex ib2 repeat + ibasis(i, j) := qelt(ib2, i, j) + invibasis(i, j) := invib2(i, j) + dsc := resultant(modulus, differentiate modulus) + dsc0 := dsc * determinant(infbasis) ** 2 + degree(numer dsc0) > degree(denom dsc0) =>error "Shouldn't happen" + infBr?() := degree(numer dsc0) < degree(denom dsc0) + dsc := dsc * determinant(ibasis) ** 2 + discPoly() := primitivePart(numer dsc) / denom(dsc) + void + + integralDerivationMatrix : (UP -> UP) -> Record(num: Matrix(UP),den: UP) + integralDerivationMatrix d == + w := integralBasis() + splitDenominator(coordinates([differentiate(w.i, d) + for i in minIndex w .. maxIndex w]$Vector($)) + * inverseIntegralMatrix()) + + integralRepresents : (Vector(UP),UP) -> % + integralRepresents(v, d) == + represents(coordinates(represents(v, d)) * integralMatrix()) + + branchPoint? : UP -> Boolean + branchPoint?(p:UP) == + INIT + (r:=retractIfCan(p)@Union(F,"failed")) case F =>branchPoint?(r::F) + not ground? gcd(retract(discriminant())@UP, p) + +*) + +\end{chunk} + \begin{chunk}{ALGFF.dotabb} "ALGFF" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALGFF"] "FFCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FFCAT"] "ALGFF" -> "FFCAT" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain AN AlgebraicNumber} @@ -3942,12 +4620,38 @@ AlgebraicNumber(): Exports == Implementation where trueEqual((a-b)::Rep,0::Rep) \end{chunk} + +\begin{chunk}{COQ AN} +(* domain AN *) +(* + InnerAlgebraicNumber add + + Rep:=InnerAlgebraicNumber + a,b:% + + zero? : % -> Boolean + zero? a == + trueEqual(a::Rep,0::Rep) + + one? : % -> Boolean + one? a == + trueEqual(a::Rep,1::Rep) + + ?=? : (%,%) -> Boolean + a=b == + trueEqual((a-b)::Rep,0::Rep) + +*) + +\end{chunk} + \begin{chunk}{AN.dotabb} "AN" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AN"] "ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"] "AN" -> "ACF" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ANON AnonymousFunction} @@ -4013,6 +4717,19 @@ AnonymousFunction():SetCategory == add x pretend OutputForm \end{chunk} + +\begin{chunk}{COQ ANON} +(* domain ANON *) +(* + + coerce : % -> OutputForm + coerce(x:%):OutputForm == + x pretend OutputForm + +*) + +\end{chunk} + \begin{chunk}{ANON.dotabb} "ANON" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ANON"] "BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"] @@ -4021,6 +4738,7 @@ AnonymousFunction():SetCategory == add "ANON" -> "KOERCE" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ANTISYM AntiSymm} @@ -4859,12 +5577,165 @@ AntiSymm(R:Ring, lVar:List Symbol): Exports == Implementation where reduce(_+,[makeTerm(t.coef,t.base) for t in (a @ Rep)])$L(O) \end{chunk} + +\begin{chunk}{COQ ANTISYM} +(* domain ANTISYM *) +(* +FMR add + + Rep := L Term + x,y : EAB + a,b : % + r : R + m : I + + dim := #lVar + + 1 : () -> % + 1 == + [[ Nul(dim)$EAB, 1$R ]] + + coefficient : (%,%) -> R + coefficient(a,u) == + not null u.rest => error "2nd argument must be a basis element" + x := u.first.base + for t in a repeat + if t.base = x then return t.coef + if t.base < x then return 0 + 0 + + retractable? : % -> Boolean + retractable?(a) == + null a or (a.first.k = Nul(dim)) + + retractIfCan : % -> Union(R,"failed") + retractIfCan(a):Union(R,"failed") == + null a => 0$R + a.first.k = Nul(dim) => leadingCoefficient a + "failed" + + retract : % -> R + retract(a):R == + null a => 0$R + leadingCoefficient a + + homogeneous? : % -> Boolean + homogeneous? a == + null a => true + siz := _+/exponents(a.first.base) + for ta in reductum a repeat + _+/exponents(ta.base) ^= siz => return false + true + + degree : % -> NonNegativeInteger + degree a == + null a => 0$NNI + homogeneous? a => (_+/exponents(a.first.base)) :: NNI + error "not a homogeneous element" + + zo : (I,I) -> L I + zo(p,q) == + p = 0 => [1,q] + q = 0 => [1,1] + [0,0] + + getsgn : (EAB,EAB) -> I + getsgn(x,y) == + sgn:I := 0 + xx:L I := exponents x + yy:L I := exponents y + for i in 1 .. (dim-1) repeat + xx := rest xx + sgn := sgn + (_+/xx)*yy.i + sgn rem 2 = 0 => 1 + -1 + + Nalpha: (EAB,EAB) -> L I + Nalpha(x,y) == + i:I := 1 + dum2:L I := [0 for i in 1..dim] + for j in 1..dim repeat + dum:=zo((exponents x).j,(exponents y).j) + (i:= i*dum.1) = 0 => leave + dum2.j := dum.2 + i = 0 => cons(i, dum2) + cons(getsgn(x,y), dum2) + + ?*? : (%,%) -> % + a * b == + null a => 0 + null b => 0 + ((null a.rest) and (a.first.k = Nul(dim))) => a.first.c * b + ((null b.rest) and (b.first.k = Nul(dim))) => b.first.c * a + z:% := 0 + for tb in b repeat + for ta in a repeat + stuff:=Nalpha(ta.base,tb.base) + r:=first(stuff)*ta.coef*tb.coef + if r ^= 0 then z := z + [[rest(stuff)::EAB, r]] + z + + coerce : R -> % + coerce(r):% == + r = 0 => 0 + [ [Nul(dim), r] ] + + coerce : Integer -> % + coerce(m):% == + m = 0 => 0 + [ [Nul(dim), m::R] ] + + characteristic : () -> NonNegativeInteger + characteristic() == + characteristic()$R + + generator : NonNegativeInteger -> % + generator(j) == + -- j < 1 or j > dim => error "your subscript is out of range" + -- error will be generated by dum.j if out of range + dum:L I := [0 for i in 1..dim] + dum.j:=1 + [[dum::EAB, 1::R]] + + exp : List(Integer) -> % + exp(li:(L I)) == + [[li::EAB, 1]] + + leadingBasisTerm : % -> % + leadingBasisTerm a == + [[a.first.k, 1]] + + displayList:EAB -> O + displayList(x):O == + le: L I := exponents(x)$EAB + reduce(_*,[(lVar.i)::O for i in 1..dim | ((le.i) = 1)])$L(O) + + makeTerm:(R,EAB) -> O + makeTerm(r,x) == + -- we know that r ^= 0 + x = Nul(dim)$EAB => r::O + (r = 1) => displayList(x) + r::O * displayList(x) + + coerce : % -> OutputForm + coerce(a):O == + zero? a => 0$I::O + null rest(a @ Rep) => + t := first(a @ Rep) + makeTerm(t.coef,t.base) + reduce(_+,[makeTerm(t.coef,t.base) for t in (a @ Rep)])$L(O) + +*) + +\end{chunk} + \begin{chunk}{ANTISYM.dotabb} "ANTISYM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ANTISYM"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ANTISYM" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ANY Any} @@ -5226,12 +6097,71 @@ Any(): SetCategory with error "function any must have a domain as first argument" \end{chunk} + +\begin{chunk}{COQ ANY} +(* domain ANY *) +(* + + Rep := Record(dm: SExpression, ob: None) + + printTypeInOutputP:Reference(Boolean) := ref false + + obj : % -> None + obj x == + x.ob + + dom : % -> SExpression + dom x == + x.dm + + domainOf : % -> OutputForm + domainOf x == + x.dm pretend OutputForm + + ?=? : (%,%) -> Boolean + x = y == + (x.dm = y.dm) and EQUAL(x.ob, y.ob)$Lisp + + objectOf : % -> OutputForm + objectOf(x : %) : OutputForm == + spad2BootCoerce(x.ob, x.dm, + list("OutputForm"::Symbol)$List(Symbol))$Lisp + + showTypeInOutput : Boolean -> String + showTypeInOutput(b : Boolean) : String == + printTypeInOutputP := ref b + b=> "Type of object will be displayed in output of a member of Any" + "Type of object will not be displayed in output of a member of Any" + + coerce : % -> OutputForm + coerce(x):OutputForm == + obj1 : OutputForm := objectOf x + not deref printTypeInOutputP => obj1 + dom1 := + p:Symbol := prefix2String(devaluate(x.dm)$Lisp)$Lisp + atom?(p pretend SExpression) => list(p)$List(Symbol) + list(p)$Symbol + hconcat cons(obj1, + cons(":"::OutputForm, [a::OutputForm for a in dom1])) + + any : (SExpression,None) -> % + any(domain, object) == + (isValidType(domain)$Lisp)@Boolean => [domain, object] + domain := devaluate(domain)$Lisp + (isValidType(domain)$Lisp)@Boolean => [domain, object] + error "function any must have a domain as first argument" + +*) + +\end{chunk} + \begin{chunk}{ANY.dotabb} "ANY" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ANY"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ANY" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASTACK ArrayStack} @@ -6583,40 +7513,129 @@ ArrayStack(S:SetCategory): StackAggregate(S) with -- system operations # s == _#(s)$Rep + + s = t == s =$Rep t + + copy s == copy(s)$Rep + + coerce(d):OutputForm == + empty? d => empty()$(List S) ::OutputForm + [(d.i::OutputForm) for i in 0..#d-1] ::OutputForm + + -- stack operations + + depth s == # s + + empty? s == empty?(s)$Rep + + extract_! s == pop_! s + + insert_!(e,s) == (push_!(e,s);s) + + push_!(e,s) == (concat(e,s); e) + + pop_! s == + if empty? s then error "empty stack" + r := s.0 + delete_!(s,0) + r + + top s == if empty? s then error "empty stack" else s.0 + + arrayStack l == construct(l)$Rep + + empty() == new(0,0 pretend S) + + parts s == [s.i for i in 0..#s-1]::List(S) + + map(f,s) == construct [f(s.i) for i in 0..#s-1] + + map!(f,s) == ( for i in 0..#s-1 repeat qsetelt!(s,i,f(s.i)) ; s ) + + inspect(s) == + if empty? s then error "empty stack" + qelt(s,0) + +\end{chunk} + +\begin{chunk}{COQ ASTACK} +(* domain ASTACK *) +(* + Rep := IndexedFlexibleArray(S,0) + + -- system operations + #? : % -> NonNegativeInteger + # s == _#(s)$Rep + + ?=? : (%,%) -> Boolean s = t == s =$Rep t + + copy : % -> % copy s == copy(s)$Rep + + coerce : % -> OutputForm coerce(d):OutputForm == empty? d => empty()$(List S) ::OutputForm [(d.i::OutputForm) for i in 0..#d-1] ::OutputForm -- stack operations + + depth : % -> NonNegativeInteger depth s == # s + + empty? : % -> Boolean empty? s == empty?(s)$Rep + + extract! : % -> S extract_! s == pop_! s + + insert! : (S,%) -> % insert_!(e,s) == (push_!(e,s);s) + + push! : (S,%) -> S push_!(e,s) == (concat(e,s); e) + + pop! : % -> S pop_! s == if empty? s then error "empty stack" r := s.0 delete_!(s,0) r + + top : % -> S top s == if empty? s then error "empty stack" else s.0 + + arrayStack : List(S) -> % arrayStack l == construct(l)$Rep + + empty : () -> % empty() == new(0,0 pretend S) + + parts : % -> List(S) parts s == [s.i for i in 0..#s-1]::List(S) + + map : ((S -> S),%) -> % map(f,s) == construct [f(s.i) for i in 0..#s-1] + + map! : ((S -> S),%) -> % map!(f,s) == ( for i in 0..#s-1 repeat qsetelt!(s,i,f(s.i)) ; s ) + + inspect : % -> S inspect(s) == if empty? s then error "empty stack" qelt(s,0) +*) + \end{chunk} + \begin{chunk}{ASTACK.dotabb} "ASTACK" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASTACK"] "A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"] "ASTACK" -> "A1AGG" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP1 Asp1} @@ -6727,76 +7746,185 @@ Asp1(name): Exports == Implementation where -- Build Symbol Table for Rep syms : SYMTAB := empty()$SYMTAB + + declare!(X,fortranReal()$FT,syms)$SYMTAB + + real : FST := "real"::FST + + Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms) + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + coerce(u:FEXPR(['X],[],MachineFloat)):$ == + coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +\end{chunk} + +\begin{chunk}{COQ ASP1} +(* domain ASP1 *) +(* + + -- Build Symbol Table for Rep + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal()$FT,syms)$SYMTAB + real : FST := "real"::FST Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms) + retract : Fraction(Polynomial(Integer)) -> % retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed") retractIfCan(u:FRAC POLY INT):Union($,"failed") == foo : Union(FEXPR(['X],[],MachineFloat),"failed") foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) foo case "failed" => "failed" foo::FEXPR(['X],[],MachineFloat)::$ + retract : Fraction(Polynomial(Float)) -> % retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed") retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == foo : Union(FEXPR(['X],[],MachineFloat),"failed") foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) foo case "failed" => "failed" foo::FEXPR(['X],[],MachineFloat)::$ + retract : Expression(Float) -> % retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan : Expression(Float) -> Union(%,"failed") retractIfCan(u:EXPR FLOAT):Union($,"failed") == foo : Union(FEXPR(['X],[],MachineFloat),"failed") foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) foo case "failed" => "failed" foo::FEXPR(['X],[],MachineFloat)::$ + retract : Expression(Integer) -> % retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan : Expression(Integer) -> Union(%,"failed") retractIfCan(u:EXPR INT):Union($,"failed") == foo : Union(FEXPR(['X],[],MachineFloat),"failed") foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) foo case "failed" => "failed" foo::FEXPR(['X],[],MachineFloat)::$ + retract : Polynomial(Float) -> % retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan : Polynomial(Float) -> Union(%,"failed") retractIfCan(u:POLY FLOAT):Union($,"failed") == foo : Union(FEXPR(['X],[],MachineFloat),"failed") foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) foo case "failed" => "failed" foo::FEXPR(['X],[],MachineFloat)::$ + retract : Polynomial(Integer) -> % retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + + retractIfCan : Polynomial(Integer) -> Union(%,"failed") retractIfCan(u:POLY INT):Union($,"failed") == foo : Union(FEXPR(['X],[],MachineFloat),"failed") foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) foo case "failed" => "failed" foo::FEXPR(['X],[],MachineFloat)::$ + coerce: FortranExpression([construct,QUOTEX],[construct],MachineFloat) -> % coerce(u:FEXPR(['X],[],MachineFloat)):$ == coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep + coerce : List(FortranCode) -> % coerce(c:List FortranCode):$ == coerce(c)$Rep + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % coerce(r:RSFC):$ == coerce(r)$Rep + coerce : FortranCode -> % coerce(c:FortranCode):$ == coerce(c)$Rep + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u)$Rep + outputAsFortran : % -> Void outputAsFortran(u):Void == p := checkPrecision()$NAGLinkSupportPackage outputAsFortran(u)$Rep p => restorePrecision()$NAGLinkSupportPackage +*) + \end{chunk} + \begin{chunk}{ASP1.dotabb} "ASP1" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP1"] "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] "ASP1" -> "PFECAT" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP10 Asp10} @@ -6916,13 +8044,21 @@ Asp10(name): Exports == Implementation where Implementation ==> add real : FST := "real"::FST + syms : SYMTAB := empty()$SYMTAB + declare!(P,fortranReal()$FT,syms)$SYMTAB + declare!(Q,fortranReal()$FT,syms)$SYMTAB + declare!(DQDL,fortranReal()$FT,syms)$SYMTAB + declare!(X,fortranReal()$FT,syms)$SYMTAB + declare!(ELAM,fortranReal()$FT,syms)$SYMTAB + declare!(JINT,fortranInteger()$FT,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), [P,Q,DQDL,X,ELAM,JINT],syms) @@ -6940,7 +8076,8 @@ Asp10(name): Exports == Implementation where v::$ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ @@ -7006,12 +8143,142 @@ Asp10(name): Exports == Implementation where p => restorePrecision()$NAGLinkSupportPackage \end{chunk} + +\begin{chunk}{COQ ASP10} +(* domain ASP10 *) +(* + + real : FST := "real"::FST + + syms : SYMTAB := empty()$SYMTAB + + declare!(P,fortranReal()$FT,syms)$SYMTAB + + declare!(Q,fortranReal()$FT,syms)$SYMTAB + + declare!(DQDL,fortranReal()$FT,syms)$SYMTAB + + declare!(X,fortranReal()$FT,syms)$SYMTAB + + declare!(ELAM,fortranReal()$FT,syms)$SYMTAB + + declare!(JINT,fortranInteger()$FT,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), + [P,Q,DQDL,X,ELAM,JINT],syms) + + retract : Vector(Fraction(Polynomial(Integer))) -> % + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed") + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Fraction(Polynomial(Float))) -> % + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed") + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Expression(Integer)) -> % + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed") + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Expression(Float)) -> % + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan : Vector(Expression(Float)) -> Union(%,"failed") + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Polynomial(Integer)) -> % + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed") + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Polynomial(Float)) -> % + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed") + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + coerce : FortranCode -> % + coerce(c:FortranCode):% == coerce(c)$Rep + + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % + coerce(r:RSFC):% == coerce(r)$Rep + + coerce : List(FortranCode) -> % + coerce(c:List FortranCode):% == coerce(c)$Rep + + -- To help the poor old compiler! + localAssign : (s:Symbol,u:Expression MFLOAT) -> FortranCode + localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == + assign(s,u)$FortranCode + + coerce : + Vector(FortranExpression([construct,QUOTEJINT,QUOTEX,QUOTEELAM], + [construct],MachineFloat)) -> % + coerce(u:Vector FEXPR):% == + import Vector FEXPR + not (#u = 3) => error "Incorrect Dimension For Vector" + ([localAssign(P,elt(u,1)::Expression MFLOAT),_ + localAssign(Q,elt(u,2)::Expression MFLOAT),_ + localAssign(DQDL,elt(u,3)::Expression MFLOAT),_ + returns()$FortranCode ]$List(FortranCode))::Rep + + coerce : % -> OutputForm + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +*) + +\end{chunk} + \begin{chunk}{ASP10.dotabb} "ASP10" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP10"] "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] "ASP10" -> "PFECAT" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP12 Asp12} @@ -7116,32 +8383,86 @@ Asp12(name): Exports == Implementation where import Switch real : FST := "real"::FST + syms : SYMTAB := empty()$SYMTAB + declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB + declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB + declare!(ELAM,fortranReal()$FT,syms)$SYMTAB + fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT + declare!(FINFO,fType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms) -- eqn : O := (I::O)=(1@Integer::EXI::O) code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U), printStatement(["_"Output from Monit_""::O])), - printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK! + printStatement([MAXIT::O,IFLAG::O,ELAM::O,_ + subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), returns()]$List(FortranCode))::Rep coerce(u:%):OutputForm == coerce(u)$Rep outputAsFortran(u:%):Void == outputAsFortran(u)$Rep + outputAsFortran():Void == outputAsFortran(code)$Rep \end{chunk} + +\begin{chunk}{COQ ASP12} +(* domain ASP12 *) +(* + + import FC + import Switch + + real : FST := "real"::FST + + syms : SYMTAB := empty()$SYMTAB + + declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB + + declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB + + declare!(ELAM,fortranReal()$FT,syms)$SYMTAB + + fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT + + declare!(FINFO,fType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms) + + -- eqn : O := (I::O)=(1@Integer::EXI::O) + code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U), + printStatement(["_"Output from Monit_""::O])), + printStatement([MAXIT::O,IFLAG::O,ELAM::O,_ + subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), + returns()]$List(FortranCode))::Rep + + coerce : % -> OutputForm + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u:%):Void == outputAsFortran(u)$Rep + + outputAsFortran : () -> Void + outputAsFortran():Void == outputAsFortran(code)$Rep + +*) + +\end{chunk} + \begin{chunk}{ASP12.dotabb} "ASP12" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP12"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ASP12" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP19 Asp19} @@ -7454,16 +8775,27 @@ Asp19(name): Exports == Implementation where Implementation ==> add real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(M,fortranInteger()$FT,syms)$SYMTAB + declare!(N,fortranInteger()$FT,syms)$SYMTAB + declare!(LJC,fortranInteger()$FT,syms)$SYMTAB + xcType : FT := construct(real,[N],false)$FT + declare!(XC,xcType,syms)$SYMTAB + fveccType : FT := construct(real,[M],false)$FT + declare!(FVECC,fveccType,syms)$SYMTAB + fjaccType : FT := construct(real,[LJC,N],false)$FT + declare!(FJACC,fjaccType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms) coerce(c:List FC):$ == coerce(c)$Rep @@ -7496,7 +8828,7 @@ Asp19(name): Exports == Implementation where seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT)) s1 : SegmentBinding POLY INT := equation(I@S,seg1) s2 : SegmentBinding POLY INT := equation(J@S,seg2) - as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT) + as : FC:= assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT) clear : FC := forLoop(s1,forLoop(s2,as)) j:Integer x:S := XC::S @@ -7512,7 +8844,7 @@ Asp19(name): Exports == Implementation where for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) p:= reverse(p) jac:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) c1:FC := localAssign2(FVECC,u) c2:FC := localAssign1(FJACC,jac) [clear,c1,c2,returns()]$List(FC)::$ @@ -7524,68 +8856,235 @@ Asp19(name): Exports == Implementation where outputAsFortran(u)$Rep p => restorePrecision()$NAGLinkSupportPackage + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +\end{chunk} + +\begin{chunk}{COQ ASP19} +(* domain ASP19 *) +(* + + real : FSTU := ["real"::FST]$FSTU + + syms : SYMTAB := empty()$SYMTAB + + declare!(M,fortranInteger()$FT,syms)$SYMTAB + + declare!(N,fortranInteger()$FT,syms)$SYMTAB + + declare!(LJC,fortranInteger()$FT,syms)$SYMTAB + + xcType : FT := construct(real,[N],false)$FT + + declare!(XC,xcType,syms)$SYMTAB + + fveccType : FT := construct(real,[M],false)$FT + + declare!(FVECC,fveccType,syms)$SYMTAB + + fjaccType : FT := construct(real,[LJC,N],false)$FT + + declare!(FJACC,fjaccType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms) + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + -- Take a symbol, pull of the script and turn it into an integer!! + o2int : S -> Integer + o2int(u:S):Integer == + o : OutputForm := first elt(scripts(u)$S,sub) + o pretend Integer + + -- To help the poor old compiler! + fexpr2expr : FEXPR -> EXPR MFLOAT + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign1 : (S, Matrix FEXPR) -> FC + localAssign1(s:S,j:Matrix FEXPR):FC == + j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + localAssign2 : (S, VEC FEXPR) -> FC + localAssign2(s:S,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + coerce : Vector(FortranExpression([construct], + [construct,QUOTEXC],MachineFloat)) -> % + coerce(u:VEC FEXPR):$ == + -- First zero the Jacobian matrix in case we miss some derivatives which + -- are zero. + import POLY INT + seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT)) + seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT)) + s1 : SegmentBinding POLY INT := equation(I@S,seg1) + s2 : SegmentBinding POLY INT := equation(J@S,seg2) + as : FC:= assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT) + clear : FC := forLoop(s1,forLoop(s2,as)) + j:Integer + x:S := XC::S + pu:List(S) := [] + -- Work out which variables appear in the expressions + for e in entries(u) repeat + pu := setUnion(pu,variables(e)$FEXPR) + scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) + -- This should be the maximum XC_n which occurs (there may be others + -- which don't): + n:Integer := reduce(max,scriptList)$List(Integer) + p:List(S) := [] + for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) + p:= reverse(p) + jac:Matrix(FEXPR) := _ + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + c1:FC := localAssign2(FVECC,u) + c2:FC := localAssign1(FJACC,jac) + [clear,c1,c2,returns()]$List(FC)::$ + + coerce : % -> OutputForm + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + retract : Vector(Fraction(Polynomial(Integer))) -> % retract(u:VEC FRAC POLY INT):$ == v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) v::$ + retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed") retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Fraction(Polynomial(Float))) -> % retract(u:VEC FRAC POLY FLOAT):$ == v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) v::$ + retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed") retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Expression(Integer)) -> % retract(u:VEC EXPR INT):$ == v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) v::$ + retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed") retractIfCan(u:VEC EXPR INT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Expression(Float)) -> % retract(u:VEC EXPR FLOAT):$ == v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) v::$ + retractIfCan : Vector(Expression(Float)) -> Union(%,"failed") retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Polynomial(Integer)) -> % retract(u:VEC POLY INT):$ == v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) v::$ + retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed") retractIfCan(u:VEC POLY INT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Polynomial(Float)) -> % retract(u:VEC POLY FLOAT):$ == v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) v::$ + retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed") retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ +*) + \end{chunk} + \begin{chunk}{ASP19.dotabb} "ASP19" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP19"] "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] "ASP19" -> "FS" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP20 Asp20} @@ -7728,16 +9227,27 @@ Asp20(name): Exports == Implementation where Implementation ==> add real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(NROWH,fortranInteger(),syms)$SYMTAB + declare!(NCOLH,fortranInteger(),syms)$SYMTAB + declare!(JTHCOL,fortranInteger(),syms)$SYMTAB + hessType : FT := construct(real,[NROWH,NCOLH],false)$FT + declare!(HESS,hessType,syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(HX,xType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms) @@ -7824,12 +9334,151 @@ Asp20(name): Exports == Implementation where p => restorePrecision()$NAGLinkSupportPackage \end{chunk} + +\begin{chunk}{COQ ASP20} +(* domain ASP20 *) +(* + + real : UFST := ["real"::FST]$UFST + + syms : SYMTAB := empty() + + declare!(N,fortranInteger(),syms)$SYMTAB + + declare!(NROWH,fortranInteger(),syms)$SYMTAB + + declare!(NCOLH,fortranInteger(),syms)$SYMTAB + + declare!(JTHCOL,fortranInteger(),syms)$SYMTAB + + hessType : FT := construct(real,[NROWH,NCOLH],false)$FT + + declare!(HESS,hessType,syms)$SYMTAB + + xType : FT := construct(real,[N],false)$FT + + declare!(X,xType,syms)$SYMTAB + + declare!(HX,xType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST, + [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms) + + coerce : List(FortranCode) -> % + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce : FortranCode -> % + coerce(c:FortranCode):$ == coerce(c)$Rep + + -- To help the poor old compiler! + fexpr2expr : FEXPR -> EXPR MFLOAT + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign : (Symbol, VEC FEXPR) -> FortranCode + localAssign(s:Symbol,j:VEC FEXPR):FortranCode == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FortranCode + + coerce : Matrix(FortranExpression([construct], + [construct,QUOTEX,QUOTEHESS], + MachineFloat)) -> % + coerce(u:MAT FEXPR):$ == + j:Integer + x:Symbol := X::Symbol + n := nrows(u)::PI + p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n] + prod:VEC FEXPR := u*p + ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$ + + retract : Matrix(Fraction(Polynomial(Integer))) -> % + retract(u:MAT FRAC POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2a + v::$ + + retractIfCan : Matrix(Fraction(Polynomial(Integer))) -> Union(%,"failed") + retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract : Matrix(Fraction(Polynomial(Float))) -> % + retract(u:MAT FRAC POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2b + v::$ + + retractIfCan : Matrix(Fraction(Polynomial(Float))) -> Union(%,"failed") + retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract : Matrix(Expression(Integer)) -> % + retract(u:MAT EXPR INT):$ == + v : MAT FEXPR := map(retract,u)$MF2e + v::$ + + retractIfCan : Matrix(Expression(Integer)) -> Union(%,"failed") + retractIfCan(u:MAT EXPR INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract : Matrix(Expression(Float)) -> % + retract(u:MAT EXPR FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2f + v::$ + + retractIfCan : Matrix(Expression(Float)) -> Union(%,"failed") + retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract : Matrix(Polynomial(Integer)) -> % + retract(u:MAT POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2c + v::$ + + retractIfCan : Matrix(Polynomial(Integer)) -> Union(%,"failed") + retractIfCan(u:MAT POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract : Matrix(Polynomial(Float)) -> % + retract(u:MAT POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2d + v::$ + + retractIfCan : Matrix(Polynomial(Float)) -> Union(%,"failed") + retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + coerce : % -> OutputForm + coerce(u:$):O == coerce(u)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +*) + +\end{chunk} + \begin{chunk}{ASP20.dotabb} "ASP20" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP20"] "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] "ASP20" -> "FS" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP24 Asp24} @@ -7950,80 +9599,199 @@ Asp24(name): Exports == Implementation where Implementation ==> add + real : FSTU := ["real"::FST]$FSTU + + syms : SYMTAB := empty() + + declare!(N,fortranInteger(),syms)$SYMTAB + + xcType : FT := construct(real,[N::Symbol],false)$FT + + declare!(XC,xcType,syms)$SYMTAB + + declare!(FC,fortranReal(),syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms) + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:FEXPR):$ == + coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +\end{chunk} + +\begin{chunk}{COQ ASP24} +(* domain ASP24 *) +(* +FortranFunctionCategory with real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty() + declare!(N,fortranInteger(),syms)$SYMTAB + xcType : FT := construct(real,[N::Symbol],false)$FT + declare!(XC,xcType,syms)$SYMTAB + declare!(FC,fortranReal(),syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms) + coerce : List(FortranCode) -> % coerce(c:List FortranCode):$ == coerce(c)$Rep + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % coerce(r:RSFC):$ == coerce(r)$Rep + coerce : FortranCode -> % coerce(c:FortranCode):$ == coerce(c)$Rep + coerce : FortranExpression([construct], + [construct,QUOTEXC],MachineFloat) -> % coerce(u:FEXPR):$ == coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep + retract : Fraction(Polynomial(Integer)) -> % retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed") retractIfCan(u:FRAC POLY INT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR foo case "failed" => "failed" (foo::FEXPR)::$ + retract : Fraction(Polynomial(Float)) -> % retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed") retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR foo case "failed" => "failed" (foo::FEXPR)::$ + retract : Expression(Float) -> % retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Expression(Float) -> Union(%,"failed") retractIfCan(u:EXPR FLOAT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR foo case "failed" => "failed" (foo::FEXPR)::$ + retract : Expression(Integer) -> % retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Expression(Integer) -> Union(%,"failed") retractIfCan(u:EXPR INT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR foo case "failed" => "failed" (foo::FEXPR)::$ + retract : Polynomial(Float) -> % retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Polynomial(Float) -> Union(%,"failed") retractIfCan(u:POLY FLOAT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR foo case "failed" => "failed" (foo::FEXPR)::$ + retract : Polynomial(Integer) -> % retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Polynomial(Integer) -> Union(%,"failed") retractIfCan(u:POLY INT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR foo case "failed" => "failed" (foo::FEXPR)::$ + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u)$Rep + outputAsFortran : % -> Void outputAsFortran(u):Void == p := checkPrecision()$NAGLinkSupportPackage outputAsFortran(u)$Rep p => restorePrecision()$NAGLinkSupportPackage +*) + \end{chunk} + \begin{chunk}{ASP24.dotabb} "ASP24" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP24"] "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"] "ASP24" -> "PFECAT" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP27 Asp27} @@ -8132,33 +9900,111 @@ Asp27(name): Exports == Implementation where MAT ==> Matrix MFLOAT ==> MachineFloat - - Exports == FortranMatrixCategory Implementation == add + real : UFST := ["real"::FST]$UFST + + integer : UFST := ["integer"::FST]$UFST + + syms : SYMTAB := empty()$SYMTAB + + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + + declare!(N,fortranInteger(),syms)$SYMTAB + + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + + zType : FT := construct(real,[N],false)$FT + + declare!(Z,zType,syms)$SYMTAB + + declare!(W,zType,syms)$SYMTAB + + rType : FT := construct(real,[LRWORK],false)$FT + + declare!(RWORK,rType,syms)$SYMTAB + + iType : FT := construct(integer,[LIWORK],false)$FT + + declare!(IWORK,iType,syms)$SYMTAB + + Rep := FortranProgram(name,real, + [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) + + -- To help the poor old compiler! + localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) + + coerce (u:MAT MFLOAT):$ == + Ws: Symbol := W + Zs: Symbol := Z + code : List FC + l:EXPR MFLOAT := "+"/ _ + [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_ + for j in 1..nrows(u)::PI])_ + *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI] + c := assign(name,l)$FC + code := [c,returns()]$List(FC) + code::$ + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +\end{chunk} + +\begin{chunk}{COQ ASP27} +(* domain ASP27 *) +(* real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + zType : FT := construct(real,[N],false)$FT + declare!(Z,zType,syms)$SYMTAB + declare!(W,zType,syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(integer,[LIWORK],false)$FT + declare!(IWORK,iType,syms)$SYMTAB + Rep := FortranProgram(name,real, [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) -- To help the poor old compiler! + localCoerce : Symbol -> EXPR(MFLOAT) localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) + coerce : Matrix(MachineFloat) -> % coerce (u:MAT MFLOAT):$ == Ws: Symbol := W Zs: Symbol := Z @@ -8171,26 +10017,35 @@ Asp27(name): Exports == Implementation where code := [c,returns()]$List(FC) code::$ + coerce : List(FortranCode) -> % coerce(c:List FortranCode):$ == coerce(c)$Rep + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % coerce(r:RSFC):$ == coerce(r)$Rep + coerce : FortranCode -> % coerce(c:FortranCode):$ == coerce(c)$Rep + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u)$Rep + outputAsFortran : % -> Void outputAsFortran(u):Void == p := checkPrecision()$NAGLinkSupportPackage outputAsFortran(u)$Rep p => restorePrecision()$NAGLinkSupportPackage +*) + \end{chunk} + \begin{chunk}{ASP27.dotabb} "ASP27" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP27"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ASP27" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP28 Asp28} @@ -8535,26 +10390,101 @@ Asp28(name): Exports == Implementation where Implementation == add + real : UFST := ["real"::FST]$UFST + + syms : SYMTAB := empty() + + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + + declare!(N,fortranInteger(),syms)$SYMTAB + + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + + xType : FT := construct(real,[N],false)$FT + + declare!(Z,xType,syms)$SYMTAB + + declare!(W,xType,syms)$SYMTAB + + rType : FT := construct(real,[LRWORK],false)$FT + + declare!(RWORK,rType,syms)$SYMTAB + + iType : FT := construct(real,[LIWORK],false)$FT + + declare!(IWORK,rType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST, + [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) + + -- To help the poor old compiler! + localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) + + coerce (u:MAT MFLOAT):$ == + Zs: Symbol := Z + code : List FC + r: List EXPR MFLOAT + r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_ + for i in 1..ncols(u)$MAT(MFLOAT)::PI]_ + for j in 1..nrows(u)$MAT(MFLOAT)::PI] + code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC) + code::$ + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +\end{chunk} + +\begin{chunk}{COQ ASP28} +(* domain ASP28 *) +(* real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(Z,xType,syms)$SYMTAB + declare!(W,xType,syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(real,[LIWORK],false)$FT + declare!(IWORK,rType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) -- To help the poor old compiler! + localCoerce : Symbol -> EXPR(MFLOAT) localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) + coerce : Matrix(MachineFloat) -> % coerce (u:MAT MFLOAT):$ == Zs: Symbol := Z code : List FC @@ -8565,26 +10495,35 @@ Asp28(name): Exports == Implementation where code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC) code::$ + coerce : FortranCode -> % coerce(c:FortranCode):$ == coerce(c)$Rep + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % coerce(r:RSFC):$ == coerce(r)$Rep + coerce : List(FortranCode) -> % coerce(c:List FortranCode):$ == coerce(c)$Rep + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u)$Rep + outputAsFortran : % -> Void outputAsFortran(u):Void == p := checkPrecision()$NAGLinkSupportPackage outputAsFortran(u)$Rep p => restorePrecision()$NAGLinkSupportPackage +*) + \end{chunk} + \begin{chunk}{ASP28.dotabb} "ASP28" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP28"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ASP28" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP29 Asp29} @@ -8690,16 +10629,27 @@ Asp29(name): Exports == Implementation where import SYMTAB real : FSTU := ["real"::FST]$FSTU + integer : FSTU := ["integer"::FST]$FSTU + syms : SYMTAB := empty() + declare!(ISTATE,fortranInteger(),syms) + declare!(NEXTIT,fortranInteger(),syms) + declare!(NEVALS,fortranInteger(),syms) + declare!(NVECS,fortranInteger(),syms) + declare!(K,fortranInteger(),syms) + kType : FT := construct(real,[K],false)$FT + declare!(F,kType,syms) + declare!(D,kType,syms) + Rep := FortranProgram(name,["void"]$FSTU, [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms) @@ -8710,12 +10660,58 @@ Asp29(name): Exports == Implementation where outputAsFortran(coerce(code)@Rep)$Rep \end{chunk} + +\begin{chunk}{COQ ASP29} +(* domain ASP29 *) +(* + + import FST + import FT + import FC + import SYMTAB + + real : FSTU := ["real"::FST]$FSTU + + integer : FSTU := ["integer"::FST]$FSTU + + syms : SYMTAB := empty() + + declare!(ISTATE,fortranInteger(),syms) + + declare!(NEXTIT,fortranInteger(),syms) + + declare!(NEVALS,fortranInteger(),syms) + + declare!(NVECS,fortranInteger(),syms) + + declare!(K,fortranInteger(),syms) + + kType : FT := construct(real,[K],false)$FT + + declare!(F,kType,syms) + + declare!(D,kType,syms) + + Rep := FortranProgram(name,["void"]$FSTU, + [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms) + + outputAsFortran : () -> Void + outputAsFortran():Void == + callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)") + code : List FC := [callOne,returns()]$List(FC) + outputAsFortran(coerce(code)@Rep)$Rep + +*) + +\end{chunk} + \begin{chunk}{ASP29.dotabb} "ASP29" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP29"] "FORTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FORTCAT"] "ASP29" -> "FORTCAT" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP30 Asp30} @@ -8879,22 +10875,39 @@ Asp30(name): Exports == Implementation where import Switch real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(MODE,fortranInteger()$FT,syms)$SYMTAB + declare!(M,fortranInteger()$FT,syms)$SYMTAB + declare!(N,fortranInteger()$FT,syms)$SYMTAB + declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB + declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + yType : FT := construct(real,[M],false)$FT + declare!(Y,yType,syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(integer,[LIWORK],false)$FT + declare!(IWORK,iType,syms)$SYMTAB + declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) @@ -8929,12 +10942,99 @@ Asp30(name): Exports == Implementation where p => restorePrecision()$NAGLinkSupportPackage \end{chunk} + +\begin{chunk}{COQ ASP30} +(* domain ASP30 *) +(* + + import FC + import FT + import Switch + + real : UFST := ["real"::FST]$UFST + + integer : UFST := ["integer"::FST]$UFST + + syms : SYMTAB := empty()$SYMTAB + + declare!(MODE,fortranInteger()$FT,syms)$SYMTAB + + declare!(M,fortranInteger()$FT,syms)$SYMTAB + + declare!(N,fortranInteger()$FT,syms)$SYMTAB + + declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB + + declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB + + xType : FT := construct(real,[N],false)$FT + + declare!(X,xType,syms)$SYMTAB + + yType : FT := construct(real,[M],false)$FT + + declare!(Y,yType,syms)$SYMTAB + + rType : FT := construct(real,[LRWORK],false)$FT + + declare!(RWORK,rType,syms)$SYMTAB + + iType : FT := construct(integer,[LIWORK],false)$FT + + declare!(IWORK,iType,syms)$SYMTAB + + declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST, + [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) + + coerce : Matrix(MachineFloat) -> % + coerce(a:MAT MFLOAT):$ == + locals : SYMTAB := empty() + numRows := nrows(a) :: Polynomial Integer + numCols := ncols(a) :: Polynomial Integer + declare!(A,[real,[numRows,numCols],false]$FT,locals) + declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals) + ptA:UEXPR := [("MODE"::S)::EXI] + ptB:UEXPR := [1::EXI] + ptC:UEXPR := [2::EXI] + sw1 : Switch := EQ(ptA,ptB)$Switch + sw2 : Switch := EQ(ptA,ptC)$Switch + callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)") + callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)") + c : FC := cond(sw1,callOne,cond(sw2,callTwo)) + code : List FC := [assign(A,a),c,returns()] + ([locals,code]$RSFC)::$ + + coerce : List(FortranCode) -> % + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce : FortranCode -> % + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce : % -> OutputForm + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +*) + +\end{chunk} + \begin{chunk}{ASP30.dotabb} "ASP30" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP30"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ASP30" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP31 Asp31} @@ -9063,8 +11163,6 @@ Asp31(name): Exports == Implementation where MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - - Exports ==> FortranVectorFunctionCategory with coerce : VEC FEXPR -> $ ++coerce(f) takes objects from the appropriate instantiation of @@ -9072,21 +11170,137 @@ Asp31(name): Exports == Implementation where Implementation ==> add + real : UFST := ["real"::FST]$UFST + + syms : SYMTAB := empty() + + declare!(X,fortranReal(),syms)$SYMTAB + + yType : FT := construct(real,["*"::Symbol],false)$FT + + declare!(Y,yType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms) + + -- To help the poor old compiler! + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign(s:Symbol,j:MAT FEXPR):FC == + j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + makeXList(n:Integer):List(Symbol) == + j:Integer + y:Symbol := Y::Symbol + p:List(Symbol) := [] + for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p) + p:= reverse(p) + + coerce(u:VEC FEXPR):$ == + dimension := #u::Polynomial Integer + locals : SYMTAB := empty() + declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB + n:Integer := maxIndex(u)$VEC(FEXPR) + p:List(Symbol) := makeXList(n) + jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ + Symbol,FEXPR ,VEC FEXPR,List(Symbol)) + code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC) + ([locals,code]$RSFC)::$ + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + coerce(u:$):O == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +\end{chunk} + +\begin{chunk}{COQ ASP31} +(* domain ASP31 *) +(* real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(X,fortranReal(),syms)$SYMTAB + yType : FT := construct(real,["*"::Symbol],false)$FT + declare!(Y,yType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms) -- To help the poor old compiler! fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + localAssign : (Symbol, MAT FEXPR) -> FC localAssign(s:Symbol,j:MAT FEXPR):FC == j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 assign(s,j')$FC + makeXList : Integer -> List(Symbol) makeXList(n:Integer):List(Symbol) == j:Integer y:Symbol := Y::Symbol @@ -9094,6 +11308,8 @@ Asp31(name): Exports == Implementation where for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p) p:= reverse(p) + coerce : Vector(FortranExpression([construct,QUOTEX], + [construct,QUOTEY],MachineFloat)) -> % coerce(u:VEC FEXPR):$ == dimension := #u::Polynomial Integer locals : SYMTAB := empty() @@ -9105,80 +11321,102 @@ Asp31(name): Exports == Implementation where code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC) ([locals,code]$RSFC)::$ + retract : Vector(Fraction(Polynomial(Integer))) -> % retract(u:VEC FRAC POLY INT):$ == v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) v::$ + retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed") retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Fraction(Polynomial(Float))) -> % retract(u:VEC FRAC POLY FLOAT):$ == v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) v::$ + retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed") retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Expression(Integer)) -> % retract(u:VEC EXPR INT):$ == v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) v::$ + retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed") retractIfCan(u:VEC EXPR INT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Expression(Float)) -> % retract(u:VEC EXPR FLOAT):$ == v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) v::$ + retractIfCan : Vector(Expression(Float)) -> Union(%,"failed") retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Polynomial(Integer)) -> % retract(u:VEC POLY INT):$ == v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) v::$ + retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed") retractIfCan(u:VEC POLY INT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + retract : Vector(Polynomial(Float)) -> % retract(u:VEC POLY FLOAT):$ == v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) v::$ + retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed") retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ + coerce : List(FortranCode) -> % coerce(c:List FC):$ == coerce(c)$Rep + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % coerce(r:RSFC):$ == coerce(r)$Rep + coerce : FortranCode -> % coerce(c:FC):$ == coerce(c)$Rep + coerce : % -> OutputForm coerce(u:$):O == coerce(u)$Rep + outputAsFortran : % -> Void outputAsFortran(u):Void == p := checkPrecision()$NAGLinkSupportPackage outputAsFortran(u)$Rep p => restorePrecision()$NAGLinkSupportPackage +*) + \end{chunk} + \begin{chunk}{ASP31.dotabb} "ASP31" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP31"] "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] "ASP31" -> "FS" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP33 Asp33} @@ -9268,27 +11506,66 @@ Asp33(name): Exports == Implementation where Implementation ==> add real : UFST := ["real"::FST]$UFST + + syms : SYMTAB := empty() + + declare!(JINT,fortranInteger(),syms)$SYMTAB + + declare!(X,fortranReal(),syms)$SYMTAB + + vType : FT := construct(real,["3"::Symbol],false)$FT + + declare!(V,vType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms) + + outputAsFortran():Void == + outputAsFortran( (returns()$FortranCode)::Rep )$Rep + + outputAsFortran(u):Void == outputAsFortran(u)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + +\end{chunk} + +\begin{chunk}{COQ ASP33} +(* domain ASP33 *) +(* + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(JINT,fortranInteger(),syms)$SYMTAB + declare!(X,fortranReal(),syms)$SYMTAB + vType : FT := construct(real,["3"::Symbol],false)$FT + declare!(V,vType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms) + outputAsFortran : () -> Void outputAsFortran():Void == outputAsFortran( (returns()$FortranCode)::Rep )$Rep + outputAsFortran : % -> Void outputAsFortran(u):Void == outputAsFortran(u)$Rep + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u)$Rep +*) + \end{chunk} + \begin{chunk}{ASP33.dotabb} "ASP33" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP33"] "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"] "ASP33" -> "ALIST" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP34 Asp34} @@ -9405,19 +11682,33 @@ Asp34(name): Exports == Implementation where Implementation == add real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(Y,xType,syms)$SYMTAB + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(integer,[LIWORK],false)$FT + declare!(IWORK,iType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) @@ -9453,6 +11744,84 @@ Asp34(name): Exports == Implementation where p => restorePrecision()$NAGLinkSupportPackage \end{chunk} + +\begin{chunk}{COQ ASP34} +(* domain ASP34 *) +(* + + real : UFST := ["real"::FST]$UFST + + integer : UFST := ["integer"::FST]$UFST + + syms : SYMTAB := empty()$SYMTAB + + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + + declare!(N,fortranInteger(),syms)$SYMTAB + + xType : FT := construct(real,[N],false)$FT + + declare!(X,xType,syms)$SYMTAB + + declare!(Y,xType,syms)$SYMTAB + + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + + rType : FT := construct(real,[LRWORK],false)$FT + + declare!(RWORK,rType,syms)$SYMTAB + + iType : FT := construct(integer,[LIWORK],false)$FT + + declare!(IWORK,iType,syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST, + [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) + + -- To help the poor old compiler + localAssign : (Symbol,EXI) -> FC + localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC + + coerce : Matrix(MachineFloat) -> % + coerce(u:Matrix MachineFloat):$ == + dimension := nrows(u) ::Polynomial Integer + locals : SYMTAB := empty()$SYMTAB + declare!(I,fortranInteger(),syms)$SYMTAB + declare!(J,fortranInteger(),syms)$SYMTAB + declare!(W1,[real,[dimension],false]$FT,locals)$SYMTAB + declare!(W2,[real,[dimension],false]$FT,locals)$SYMTAB + declare!(MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB + assign1 : FC := localAssign(IFLAG@Symbol,(-1)@EXI) + call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC + assign2 : FC := localAssign(IFLAG::Symbol,-(IFLAG@Symbol::EXI)) + assign3 : FC := assign(MS,u)$FC + code : List FC := [assign1,assign3,call,assign2,returns()]$List(FC) + ([locals,code]$RSFC)::$ + + coerce : List(FortranCode) -> % + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce : FortranCode -> % + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce : % -> OutputForm + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +*) + +\end{chunk} + \begin{chunk}{ASP34.dotabb} "ASP34" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP34"] "FIELD" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FIELD"] @@ -9461,6 +11830,7 @@ Asp34(name): Exports == Implementation where "ASP34" -> "RADCAT" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP35 Asp35} @@ -9597,7 +11967,7 @@ Asp35(name): Exports == Implementation where MFLOAT ==> MachineFloat FEXPR ==> FortranExpression([],['X],MFLOAT) MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) + EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) SWU ==> Union(I:Expression Integer,F:Expression Float, CF:Expression Complex Float,switch:Switch) @@ -9609,15 +11979,25 @@ Asp35(name): Exports == Implementation where Implementation ==> add real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(FVEC,xType,syms)$SYMTAB + declare!(LDFJAC,fortranInteger(),syms)$SYMTAB + jType : FT := construct(real,[LDFJAC,N],false)$FT + declare!(FJAC,jType,syms)$SYMTAB + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms) coerce(u:$):OutputForm == coerce(u)$Rep @@ -9673,7 +12053,8 @@ Asp35(name): Exports == Implementation where v::$ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) v case "failed" => "failed" (v::VEC FEXPR)::$ @@ -9714,12 +12095,160 @@ Asp35(name): Exports == Implementation where (v::VEC FEXPR)::$ \end{chunk} + +\begin{chunk}{COQ ASP35} +(* domain ASP35 *) +(* + real : UFST := ["real"::FST]$UFST + + syms : SYMTAB := empty()$SYMTAB + + declare!(N,fortranInteger(),syms)$SYMTAB + + xType : FT := construct(real,[N],false)$FT + + declare!(X,xType,syms)$SYMTAB + + declare!(FVEC,xType,syms)$SYMTAB + + declare!(LDFJAC,fortranInteger(),syms)$SYMTAB + + jType : FT := construct(real,[LDFJAC,N],false)$FT + + declare!(FJAC,jType,syms)$SYMTAB + + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + + Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms) + + coerce : % -> OutputForm + coerce(u:$):OutputForm == coerce(u)$Rep + + makeXList : Integer -> List(Symbol) + makeXList(n:Integer):List(Symbol) == + x:Symbol := X::Symbol + [subscript(x,[j::OutputForm])$Symbol for j in 1..n] + + fexpr2expr : FEXPR -> EXPR MFLOAT + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign1 : (Symbol,MAT FEXPR) -> FC + localAssign1(s:Symbol,j:MAT FEXPR):FC == + j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + localAssign2 : (Symbol,VEC FEXPR) -> FC + localAssign2(s:Symbol,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + coerce : Vector(FortranExpression([construct], + [construct,QUOTEX],MachineFloat)) -> % + coerce(u:VEC FEXPR):$ == + n:Integer := maxIndex(u) + p:List(Symbol) := makeXList(n) + jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ + Symbol,FEXPR,VEC FEXPR,List(Symbol)) + assf:FC := localAssign2(FVEC,u) + assj:FC := localAssign1(FJAC,jac) + iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU + sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU) + sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU) + cond(sw1,assf,cond(sw2,assj)$FC)$FC::$ + + coerce : List(FortranCode) -> % + coerce(c:List FC):$ == coerce(c)$Rep + + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce : FortranCode -> % + coerce(c:FC):$ == coerce(c)$Rep + + outputAsFortran : % -> Void + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract : Vector(Fraction(Polynomial(Integer))) -> % + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed") + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Fraction(Polynomial(Float))) -> % + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed") + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=_ + map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Expression(Integer)) -> % + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed") + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Expression(Float)) -> % + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan : Vector(Expression(Float)) -> Union(%,"failed") + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Polynomial(Integer)) -> % + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed") + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract : Vector(Polynomial(Float)) -> % + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed") + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +*) + +\end{chunk} + \begin{chunk}{ASP35.dotabb} "ASP35" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP35"] "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"] "ASP35" -> "FS" \end{chunk} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain ASP4 Asp4} @@ -9832,13 +12361,19 @@ Asp4(name): Exports == Implementation where Implementation ==> add real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(NDIM,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[NDIM],false)$FT + declare!(X,xType,syms)$SYMTAB + Rep := FortranProgram(name,real,[NDIM,X],syms) retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY INT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR @@ -9846,6 +12381,7 @@ Asp4(name): Exports == Implementation where foo::FEXPR::$ retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR @@ -9853,6 +12389,7 @@ Asp4(name): Exports == Implementation where foo::FEXPR::$ retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR FLOAT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR @@ -9860,6 +12397,7 @@ Asp4(name): Exports == Implementation where foo::FEXPR::$ retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR INT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR @@ -9867,6 +12405,7 @@ Asp4(name): Exports == Implementation where foo::FEXPR::$ retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY FLOAT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR @@ -9874,6 +12413,7 @@ Asp4(name): Exports == Implementation where foo::FEXPR::$ retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY INT):Union($,"failed") == foo : Union(FEXPR,"failed") foo := retractIfCan(u)$FEXPR @@ -9897,12 +12437,117 @@ Asp4(name): Exports == Implementation where p => restorePrecision()$NAGLinkSupportPackage \end{chunk} + +\begin{chunk}{COQ ASP4} +(* domain ASP4 *) +(* + + real : FSTU := ["real"::FST]$FSTU + + syms : SYMTAB := empty()$SYMTAB + + declare!(NDIM,fortranInteger(),syms)$SYMTAB + + xType : FT := construct(real,[NDIM],false)$FT + + declare!(X,xType,syms)$SYMTAB + + Rep := FortranProgram(name,real,[NDIM,X],syms) + + retract : Fraction(Polynomial(Integer)) -> % + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed") + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract : Fraction(Polynomial(Float)) -> % + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed") + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract : Expression(Float) -> % + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Expression(Float) -> Union(%,"failed") + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract : Expression(Integer) -> % + retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Expression(Integer) -> Union(%,"failed") + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract : Polynomial(Float) -> % + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + + retractIfCan : Polynomial(Float) -> Union(%,"failed") + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract : Polynomial(Integer) -> % + retract(u:POLY INT):$ ==