/usr/share/axiom-20170501/src/algebra/AFALGRES.spad is in axiom-source 20170501-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | )abbrev package AFALGRES AffineAlgebraicSetComputeWithResultant
++ Author: Gaetan Hache
++ Date Created: 17 nov 1992
++ Date Last Updated: May 2010 by Tim Daly
++ Description:
++ The following is part of the PAFF package
AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt) :
SIG == CODE where
K : Field
symb: List(Symbol)
OV ==> OrderedVariableList(symb)
E : DirectProductCategory(#symb,NonNegativeInteger)
PolyRing : PolynomialCategory(K,E,OV)
ProjPt : ProjectiveSpaceCategory(K)
PCS : LocalPowerSeriesCategory(K)
SUP ==> SparseUnivariatePolynomial
UPUP ==> SUP(SUP(K))
NNI ==> NonNegativeInteger
RFP ==> RootsFindingPackage
SIG ==> with
affineSingularPoints : PolyRing -> _
Union(List(ProjPt),"failed","Infinite",Integer)
affineSingularPoints : UPUP -> _
Union(List(ProjPt),"failed","Infinite",Integer)
affineAlgSetLocal : List UPUP -> _
Union(List(ProjPt),"failed","Infinite",Integer)
affineAlgSet : List PolyRing -> _
Union(List ProjPt ,"failed","Infinite",Integer)
polyRing2UPUP : PolyRing -> UPUP
allPairsAmong : List UPUP -> List List UPUP
affineRationalPoints : (PolyRing, PositiveInteger) -> _
Union(List(ProjPt),"failed","Infinite",Integer)
CODE ==> add
import ProjPt
evAtcoef: (UPUP,K) -> SUP(K)
evAtcoef(pol,a)==
zero?(pol) => 0
dd:= degree pol
lc:= leadingCoefficient pol
monomial( lc(a), dd )$SUP(K) + evAtcoef( reductum(pol), a )
polyRing2UPUP(pol)==
zero?(pol) => 0
dd:= degree pol
lc:= leadingCoefficient pol
pp:= parts dd
monomial(monomial(lc,pp.1)$SUP(K),pp.2)$UPUP+polyRing2UPUP(reductum(pol))
if K has FiniteFieldCategory then
affineRationalPoints(crv:PolyRing,extdegree:PositiveInteger) ==
listPtsIdl:List(ProjPt):= empty()
x:= monomial(1,directProduct(vector([1,0,0])$Vector(NNI)))$PolyRing
y:= monomial(1,directProduct(vector([0,1,0])$Vector(NNI)))$PolyRing
if K has PseudoAlgebraicClosureOfFiniteFieldCategory then
setTower!(1$K)$K
q:= size()$K
px:= x**(q**extdegree) - x
py:= y**(q**extdegree) - y
rpts:= affineAlgSet([crv,px,py])
-- si les 3 tests qui suivent ne sont pas la,
-- alors ca ne compile pas !!! ???
rpts case "failed" => _
error "case failed: From affineRationalPoints in AFALGRES"
rpts case "Infinite" => _
error "case infinite: From affineRationalPoints in AFALGRES"
rpts case Integer => _
error "case Integer: From affineRationalPoints in AFALGRES"
rpts case List(ProjPt) => rpts
error "case unknown: From affineRationalPoints in AFALGRES"
allPairsAmong(lp)==
#lp = 2 => [lp]
rlp:=rest lp
subL:= allPairsAmong rlp
pol:=first lp
frontL:= [[pol,p] for p in rlp]
concat( frontL , subL )
affineSingularPoints(pol:PolyRing)==
affineSingularPoints( polyRing2UPUP pol )
affineSingularPoints(pol:UPUP)==
ground? pol => "failed"
lc := coefficients pol
lcb := [ ground?( c )$SUP(K) for c in lc ]
reduce("and" , lcb) => "failed"
dy:=differentiate(pol)
dx:=map(differentiate$SUP(K),pol)
affineAlgSetLocal( [ pol, dy, dx ] )
resultantL: List UPUP -> SUP(K)
resultantL(lp)==
g:=first lp
h:= last lp
resultant(g,h)
affineAlgSet(lpol:List PolyRing)==
affineAlgSetLocal( [ polyRing2UPUP pol for pol in lpol ] )
affineAlgSetLocal(lpol:List UPUP)==
listPtsIdl:List(ProjPt)
allP:= allPairsAmong lpol
beforGcd:List SUP(K) := [resultantL(lp) for lp in allP]
polyZeroX:SUP(K):=gcd beforGcd
zero? polyZeroX => "failed"
listZeroY:List(K):=empty()
listZeroX:List(K):=empty()
recOfZerosX:=distinguishedRootsOf(polyZeroX,1$K)$RFP(K)
degExtX:=recOfZerosX.extDegree
listZeroX:List K := recOfZerosX.zeros
listOfExtDeg:List(Integer):=empty()
listOfExtDeg:=cons(degExtX,listOfExtDeg)
lpolEval:List SUP(K)
for a in listZeroX repeat
lpolEval := [ evAtcoef(p,a) for p in lpol ]
recOfZerosOfIdeal:=distinguishedCommonRootsOf( lpolEval ,a)$RFP(K)
listZeroY:= recOfZerosOfIdeal.zeros
listOfExtDeg:=cons(recOfZerosOfIdeal.extDegree,listOfExtDeg)
listPtsIdl:=
concat( [projectivePoint([a,b,1]) for b in listZeroY] ,listPtsIdl)
degExt:=lcm listOfExtDeg
zero?(degExt) =>
print(("AFALGRES:Infinite number of points")::OutputForm)
"Infinite"
^one?(degExt) =>
print(("AFALGRES:You need an extension of degree")::OutputForm)
print(degExt::OutputForm)
degExt
listPtsIdl
|