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
|
function [resn,g]=pfactors(pol,flag)
// Given polynomial pol returns in list resn polynomials of
// degree 1 or two which are the factors of pol.
// One has pol= g times product of entries of resn
// if flag=='c' unstable roots are reflected vs the imaginary axis
// if flag=='d' unstable roots are reflected vs unit circle
// Copyright INRIA
w=roots(pol);
n=size(w,'*');
if n==0 then resn=list();g=coeff(pol);return;end
co=coeff(pol);g=co(n+1);
resn=list();
[LHS,RHS]=argn(0);
if RHS==1 then flag=[];end
if flag==[] then RHS=1;end
if RHS==1 then
kk=1;k=1;
while %T
if abs(imag(w(kk)))<=%eps then
resn(k)=poly(w(kk),varn(pol));
kk=kk+1;k=k+1;
if kk>n then return;end
end
if abs(imag(w(kk)))>%eps then
resn(k)=real(poly([w(kk),w(kk+1)],varn(pol)));
kk=kk+2;k=k+1;
if kk>n then return;end
end
end
end //RHS=1
if RHS==2 then
kk=1;k=1;
if flag=='c' then
while %T
if abs(imag(w(kk)))<=%eps then
resn(k)=poly(-abs(w(kk)),varn(pol));
kk=kk+1;k=k+1;
if kk>n then return;end
end
if abs(imag(w(kk)))>%eps then
if real(w(kk))<0 then
resn(k)=real(poly([w(kk),w(kk+1)],varn(pol)));
else ;
resn(k)=real(poly([-w(kk),-w(kk+1)],varn(pol)));
end
kk=kk+2;k=k+1;
if kk>n then return;end
end
end
end //'c'
if flag=='d' then
while %T
wkk=w(kk);
if abs(imag(wkk))<=%eps then
[themin,which]=mini([abs(wkk),1/(abs(wkk))]);
if which==2 then g=-g*real(wkk);end
resn(k)=poly(sign(real(wkk))*themin,varn(pol));
kk=kk+1;k=k+1;
if kk>n then return;end
end
if abs(imag(wkk))>%eps then
if abs(wkk)<1 then
resn(k)=real(poly([wkk,w(kk+1)],varn(pol)));
else ;
// g=g*wkk*w(kk+1); w(kk+1)= conj(wkk)
g=g*abs(wkk)^2;
zp=[wkk,w(kk+1)];resn(k)=real(poly(ones(zp)./zp,varn(pol)));
end
kk=kk+2;k=k+1;
if kk>n then return;end
end
end
end //'d'
end //RHS=2
|
