Az irreducibilitás vizsgálata

Bevezetés

A Mathematica segítségével nagyon jól meg tudjuk vizsgálni egy polinom viselkedését. Meg tudjuk határozni például Az együtthatóit, megkereshetjük a gyökeit, a minimumát és maximumát. Egyszerű parancsokkal megadható egy polinomnak a foka, együtthatóinak listája, kibonthatunk egy szorzatként felírt polinomot, össze tudjuk gyűjteni az együtthatóit, meghatározhatjuk, hogy milyen változói vannak, ki tudjuk számolni két polinom rezultánsát, faktorizálhatunk, meg tudjuk határozni két polinom legnagyobb közös osztóját, legkisebb közös többszörösét és így tovább. A polinomkkal kapcsolatos parancsokat megtalálhatjuk a következő helyen:

Hyperlink["poly","paclet:guide/PolynomialAlgebra"]

Azonban elég kevés dolog áll rendelkezésünkre, hogy eldönthessük egy egész együtthatós polinomról, hogy reducibilis vagy irreducibilis. Természetesen nem áll rendelkezésünkre olyan állítás, ami szükséges és elégséges feltétele az irreducibilitásnak, de sok olyan tétel és állítás létezik, aminek a segítségével bizonyos polinomokról el lehet dönteni, hogy irreducibilisek. A következőkben pedig ezekkel a tételekkel fogunk foglalkozni.

Schönemann - Eisenstein kritérium

Ez a kritérium valószínűleg mindenki számára ismert, de azért elevenítsük fel. Tehát ha adott egy f(x)=(∑_(i=0)^n) (Subscript[a, i])(x^i)egész együtthatós polinom és létezik olyan p prím, hogy p∤(Subscript[a, n]), p∣(Subscript[a, i]) minden i∈{0,1,...,n-1} , de (p^2)∤(Subscript[a, 0]), akkor f irreducibilis. 
Először is el tudjuk dönteni egy adott polinomról, hogy egy adott prímre teljesül-e rá a kritérium:

f1[x_]:=(x^3)+6358(x^2)-10285x+1122
Eisenstein[A_,p_]:=And[PolynomialQ[A,x],PrimeQ[p],Mod[Reverse[CoefficientList[A,x]],p][[1]]≠0 ,Plus@@Table[Mod[Reverse[CoefficientList[A,x]],p][[i]],{i,2,Exponent[A,x]+1}]==0 ,Mod[Reverse[CoefficientList[A,x]],p^2][[Exponent[A,x]+1]]≠0]
Eisenstein[f1[x],11]
Eisenstein[f1[x],3]

Emellett megkereshetjük egy adott aés bközött azon prímet illetve prímeket, melyekre teljesül a kritérium.

EisensteinPrime[A_,a_,b_]:=Select[Range[a,b,1],PrimeQ][[Flatten[Position[Eisenstein[A,#]&/@Select[Range[a,b,1],PrimeQ],True]]]]
EisensteinPrime[f1[x],1,100]

A polinomok irreducibilitására az is igaz, hogy f(x) irreducibilis ⇔ f(x+a) irreducibilis valamilyen a∈(SuperPlus[ℤ])-ra. Ezért ha f(x)-re nem működik a Schönemann-Eisenstein kritérium, akkor megvizsgálhatjuk f eltoltjait is. Létezik egy algoritmus, ami azt mondja, hogy elég azokat az p-ket megvizsgálni, amelyek osztják fés f' rezultánsának abszolútértékét és minden ilyen p-re elég azokat az f(x+a) eltoltakat, melyre a∈{0,1,…,p-1  }. Vagyis például a következő polinomnál az alábbi prímeket kell megvizsálni:

f2[x_]:=(x^4)+2 x-1
FactorInteger[Abs[Resultant[f2[x],D[f2[x],x],x]]][[All,1]]

Newton - poligon

A Newton - poligon előállítása

Vegyünk egy egész együtthatós f(x)=(∑_(i=0)^n) (Subscript[A, i])(x^i) polinomot és egy p prímet. Írjunk fel minden (Subscript[A, i])=(Subscript[a, i])(p^(Subscript[α, i])), ahol p∤(Subscript[a, i]). Ezután ábrázoljuk az (i,(Subscript[α, i])) párokat, és a kapott pontok konvex burkának vegyük az (Subscript[A, 0])(Subscript[A, n]) szakasz alatti részét. Így megkapjuk egy polinom p-re vonatkozó Newton-poligonját.

f3[x_]:=24 (x^6)+44 (x^5)-7 (x^4)+64 (x^3)-8 (x^2)+26 x+96
NewtonPontok[A_,p_]:=If[PolynomialQ[A,x],Cases[Table[{i,IntegerExponent[Reverse[CoefficientList[A,x]],p][[i+1]]},{i,0,Length[CoefficientList[A,x]]-1}],{_,_Integer}]]
meredekseg[{{a_,b_},{c_,d_}}]:=(d-b)/(c-a)
MaxMer[A_,p_]:=Max[Map[meredekseg,Flatten[Table[{NewtonPontok[A,p][[i]],NewtonPontok[A,p][[i+j]]},{i,1,Length[NewtonPontok[A,p]]-1},{j,1,Length[NewtonPontok[A,p]]-i}],1]]]
seged1[A_,p_,k_]:=First[Flatten[Position[Join[Table[MaxMer[A,p]+1,{i,1,k}],Map[meredekseg,Table[{NewtonPontok[A,p][[k]],NewtonPontok[A,p][[j]]},{j,k+1,Length[NewtonPontok[A,p]]}]]],Min[Join[Table[MaxMer[A,p]+1,{i,1,k-1}],Map[meredekseg,Table[{NewtonPontok[A,p][[k]],NewtonPontok[A,p][[j]]},{j,k+1,Length[NewtonPontok[A,p]]}]]]]]]]
seged2[A_,p_]:=NestWhileList[seged1[A,p,#]&,1,#≠Length[NewtonPontok[A,p]]&]
NewtonPolygonPontok[A_,p_]:=NewtonPontok[A,p][[seged2[A,p]]]
NewtonPolygon[A_,p_]:=Show[Graphics[{Red,AbsolutePointSize[8],Point[Complement[NewtonPontok[A,p],NewtonPolygonPontok[A,p]]]},Axes->True,AxesOrigin->{0,0}],Graphics[ListLinePlot[NewtonPolygonPontok[A,p],Mesh->Full,MeshStyle->Directive[AbsolutePointSize[8],Green],PlotStyle->Directive[Blue,Thick],AxesOrigin->{0,0}]]]

NewtonPolygon[f3[x],2]

Irreducibilitásvizsgálat Newton - poligonnal

Dumas - tétele kimondja, hogy két polinom szorzatának a Newton - poligonja előállítható úgy, hogy összefésüljük a két polinom Newton poligonjának szakaszait a meredekségük alapján. Például:

f4[x_]:=(x^2)+x+6
f5[x_]:=12 (x^2)-5x+24
{NewtonPolygon[f4[x],2],NewtonPolygon[f5[x],2],NewtonPolygon[f4[x] f5[x],2]}

Ennek a tételnek a következménye, hogy ha egy polinom Newton - poligonja csak egy szakaszból áll, és ezen a szakaszon nincs egész koordinátájú pont, akkor a polinom irreducibilis. A Schönemann - Eisenstein kritérium a Newton - poligon módszerének egy egyszerű következménye, hiszen ha felrajzoljuk egy olyan polinom Newton - poligonját, amire igaz a kritérium, akkor egy szakaszt kapunk, aminek a kezdőpontja (0,0) és a végpontja (n,1), és ezen a szakaszon nincs egész koordinátájú pont. A következő polinom pont olyan, amire a Schönemann-Eisenstein kritérium nem működik, viszont a Newton-poligonjával megállapítható, hogy irreducibilis.

f6[x_]:=(x^3)-6 (x^2)+56 x-20
NewtonIrreducibility[A_,p_]:=And[Length[NewtonPolygonPontok[A,p]]==2,Length[Select[NewtonPolygonPontok[A,p][[1,2]]+meredekseg[NewtonPolygonPontok[A,p]]*Range[0,Exponent[A,x]],IntegerQ]]==2]

Eisenstein[f6[x],2]
NewtonIrreducibility[f6[x],2]

Gyöktesztelés

Legyen adva egy f egész együtthatós polinom melynek a főegyütthatója 1és f(0)≠0.Ekkor ha f-nekpontosan egy gyöke van a komplex egységkörön kívül, akkor f irreducibilis.

f7[x_]:=x^5+5*x^4-x^3+4
gyokteszt[A_]:=And[Count[Floor[Abs[(Solve[A==0]//N)[[All,1,2]]]],0]==Exponent[A,x]-1,(A/.{x->0})≠0]

gyokteszt[f7[x]]

Domináns együtthatójú polinomok

Most is legyen adva egy f(x)=(∑_(i=0)^n) (Subscript[a, i])(x^i) egész együtthatós polinom melynek a főegyütthatója 1és f(0)≠0.  Ekkor a következő három kritériumot állapíthatjuk meg.
Ha  | (Subscript[a, 1])| > 1 + | (Subscript[a, i]) |+⋯+| (Subscript[a, i ])|, akkor firreducibilis.
Ha | (Subscript[a, 1])| ≥ 1 + | (Subscript[a, i]) |+⋯+| (Subscript[a, i ])| és f(±1)≠1, akkor firreducibilis.
Ha  (Subscript[a, 1]) ≤  (Subscript[a, 2]) ≤ ⋯ ≤ (Subscript[a, n]) <  0, akkor firreducibilis,
Ezeket a kritériumokat Perron-kritériomuknak nevezzük.

f8[x_]:=(x^6)+10 (x^5)-5 x +2
f9[x_]:=(x^4)-5 (x^3)+(x^2)-2 x+1
f10[x_]:=(x^3)-7(x^2)-5 x -4
Perron1[A_]:=And[Abs[Reverse[CoefficientList[A,x]][[2]]]> Plus@@Drop[Abs[Reverse[CoefficientList[A,x]]],{2}],(A/.{x->0})≠0&&CoefficientList[A,x][[-1]]==1]
Perron2[A_]:=And[Abs[Reverse[CoefficientList[A,x]][[2]]]== Plus@@Drop[Abs[Reverse[CoefficientList[A,x]]],{2}] && (A/.{x->1})≠1 , (A/.{x->-1})≠1 &&(A/.{x->0})≠0&&CoefficientList[A,x][[-1]]==1]
Perron3[A_]:=And[And@@Negative[Drop[CoefficientList[A,x],{-1}]],Abs[Reverse[Drop[CoefficientList[A,x],{-1}]]]==Sort[Abs[Reverse[Drop[CoefficientList[A,x],{-1}]]],Greater]]

Perron1[f8[x]]
Perron2[f9[x]]
Perron3[f10[x]]

Még egy állítást szeretnék ebben a fejezetben megemlíteni, mégpedig az első Perron - kritériumhoz nagyon hasonlót. Ez azt mondja, hogy vegyünk egy, az előzőeknek megfelelő polinomot. Ha a polinom konstans tagjának abszolútértéke egy p prím, és (p-1) nagyobb, mint a többi együttható abszolútértékének összege, akkor firreducibilis.

f11[x_]:=(x^3)+2 (x^2)-10 x+17
PrimeConstant[A_]:=And[PrimeQ[Abs[(A/.{x->0})]]&& CoefficientList[A,x][[-1]]==1, Abs[(A/.{x->0})]>Plus@@Abs[Drop[CoefficientList[A,x],{1}]]]

PrimeConstant[f11[x]]

Irreducibilitásvizsgálat helyettesítési értékekkel

A következőkben még három állítást szeretnénk bemutatni. Az elsőt leginkább azért, mert magyar vonatkozású, a másodikat és harmadikat pedig azért, mert gyakorlatban elég jól használható. Az első a Pólya-tétel, ami azt mondja, ha fegy egész együtthatós polinom és a foka n, akkor ha létezik n különböző egész, hogy | f((Subscript[a, i])) |<m!/(2^(-m)), ahol m=[((n+1)/2)], akkor firreducibilis.
A másik tétel arról szól, hogyha létezik (2n+1) vagy (n+5) különböző egész, hogy | f((Subscript[a, i])) | prím, akkor f irreducibilis, a harmadik pedig azt mondja ki, hogy ha | f(10) | prím és 0≤ (Subscript[a, i]) ≤ (10^15)(Subscript[a, n]), akkor f irreucibilis. Az első kis program segítségével megkeressük egy a és b között, hogy a függvény ezeken a helyeken hány prím értéket vesz fel. A második program a harmadik állítás tesztelését végzi, míg a harmadik a Pólya-tételt.

f12[x_]:=(x^3)+3 x-1
f13[x_]:=(x^2)+2 x+7
Prime1[A_,a_,b_]:=If[Exponent[A,x]<5,Count[Table[PrimeQ[Abs[A/.{x->i}]],{i,a,b}],True]>2*Exponent[A,x]+1,Count[Table[PrimeQ[Abs[A/.{x->i}]],{i,a,b}],True]>Exponent[A,x]+5]
Prime2[A_]:=PrimeQ[A/.{x->10}]&& Select[CoefficientList[A,x],#>10^15*CoefficientList[A,x][[-1]]&]=={}
Pólya[A_,a_,b_]:=Module[{m=Floor[(Exponent[A,x]+1)/2]},Length[Select[Abs[A/.seged2/@Complement[Range[a,b],Solve[A==0,x][[All,1,2]]]],#<m!/2^m&]]>Exponent[A,x]]

Prime1[f12[x],-10,10]
Prime2[f13[x]]

Végül pedig adunk egy összetett programot, ami az itt bemutatott kritériumok mindegyikét megvizsgálja egy általunk beállított polinomra :

Manipulate[Column[{
Labeled["A polinom:",Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}],Right],
Labeled[If[Eisenstein[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}],p],Framed[True,RoundingRadius->10],False],"Eisenstein:",Left],
Labeled[If[EisensteinPrime[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}],a,b]≠{},Framed[True,RoundingRadius->10],False],"EisensteinPrime:",Left],
Labeled[If[NewtonIrreducibility[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}],p],Framed[True,RoundingRadius->10],False],"Newton:",Left],
Labeled[If[gyokteszt[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}]],Framed[True,RoundingRadius->10],False],"Gyokteszt:",Left],
Labeled[If[Perron1[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}]],Framed[True,RoundingRadius->10],False],"Perron1:",Left],
Labeled[If[Perron2[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}]],Framed[True,RoundingRadius->10],False],"Perron2:",Left],
Labeled[If[Perron3[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}]],Framed[True,RoundingRadius->10],False],"Perron3:",Left],
Labeled[If[PrimeConstant[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}]],Framed[True,RoundingRadius->10],False],"PrimeConstant:",Left],
Labeled[If[Prime1[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}],a,b],Framed[True,RoundingRadius->10],False],"Prime1:",Left],
Labeled[If[Prime2[Sum[x^i Take[{(Subscript[c, 0]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4]),(Subscript[c, 5]),(Subscript[c, 6]),(Subscript[c, 7]),(Subscript[c, 8]),(Subscript[c, 9]),(Subscript[c, 10])},(n+1)][[i+1]],{i,0,n}]],Framed[True,RoundingRadius->10],False],"Prime2:",Left]
}],
"deg f:",
{{n,3,"n"},1,15,1,Appearance->"Labeled", ImageSize-> Tiny},
Delimiter,
"interval_min:",
{{a,1,"a"},-100,100,1,Appearance->"Labeled", ImageSize-> Tiny},
"interval_max:",
{{b,10,"b"},a,100,1,Appearance->"Labeled", ImageSize-> Tiny},
"prime:",
{{p,2,"p"},2,31,1,Appearance->"Labeled", ImageSize-> Tiny},
Delimiter,
"coefficients of polynomial:",
{{(Subscript[c, 0]),1,"(Subscript[c, 0])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 1]),1,"(Subscript[c, 1])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 2]),2,"(Subscript[c, 2])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 3]),3,"(Subscript[c, 3])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 4]),0,"(Subscript[c, 4])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 5]),0,"(Subscript[c, 5])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 6]),0,"(Subscript[c, 6])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 7]),0,"(Subscript[c, 7])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 8]),0,"(Subscript[c, 8])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
{{(Subscript[c, 9]),0,"(Subscript[c, 9])"},-50,50,1,Appearance->"Labeled", ImageSize-> Tiny},
ControlPlacement-> Left,Alignment->Left]