1+1

2×2 Jacobi Iteration: Exact Zeros

As we discussed before it is possible to use similarity rotations to introduce pairs of zeros into a matrix

J2[{i_,j_},θ_,m_] := SparseArray[{
{i,i}->Cos[θ],
{j,j}->Cos[θ],
{i,j}->-Sin[θ],
{j,i}->Sin[θ],
Band[{1,1}]->1.0
},
{m,m}]

m= 5;
A=RandomReal[{-1,1},{m,m}];
A= A + Transpose[A];
{i,j}={2,4};
θ= 0.5 ArcTan[ 2 ((A[[i,j]])/(A[[j,j]]-A[[i,i]]))]
JTemp=J2[{i,j},θ,m];
MatrixForm[JTemp.A.Transpose[JTemp]]

A sweep is a pass throught the matrix reducing all the off diagonals.  Lets make a decent sized test matrix and see how we could organizze a sweep.

m= 100;
A=RandomReal[{-1,1},{m,m}];
A= A + Transpose[A];

Repeated sweeps : fixed order.

Here are repeated sweeps through the matrix in a fixed order.

AA=A;
NSweep=12;
Data=Table[
Do[
θ= 0.5 ArcTan[ 2 ((AA[[i,j]])/(AA[[j,j]]-AA[[i,i]]))];
JTemp=J2[{i,j},θ,m];
AA=JTemp.AA.Transpose[JTemp],
{i,1,m,1},
{j,i+1,m}
];
{n*(m-1)*m/2,((Norm[LowerTriangularize[AA,-1],"Frobenius"])/(Norm[AA,"Frobenius"]))},
{n,NSweep}];
ListLogPlot[Data,
FrameLabel->{"J Comps","Frobenius OffDiagona Fraction"},
GridLines->Automatic,
PlotStyle->{PointSize[0.03],Blue},
Frame->True,
PlotLabel->"Jacobi Fixed Order"]
Sort[Diagonal[AA],Abs[#1]>Abs[#2]&]
Eigenvalues[A]

Repeated row comps : Partial Max

Here are repeated passes through the matrix reducing the maximum in each column

AA=A;
NPartialSweep=120;
Data=Table[
Do[
AbsCol =Abs[AA[[All,i]]];
AbsCol[[i]]=0.0;
j=Position[AbsCol,Max[AbsCol],1][[1,1]];
θ= 0.5 ArcTan[ 2 ((AA[[i,j]])/(AA[[j,j]]-AA[[i,i]]))];
JTemp=J2[{i,j},θ,m];
AA=JTemp.AA.Transpose[JTemp],
{i,1,m,1}
];
{n*m,((Norm[LowerTriangularize[AA,-1],"Frobenius"])/(Norm[AA,"Frobenius"]))},
{n,NPartialSweep}];
ListLogPlot[Data,
FrameLabel->{"J Comps","Frobenius OffDiagonal Fraction"},
GridLines->Automatic,
Frame->True,
PlotLabel->"Jacobi Col Max Search"]
Sort[Diagonal[AA],Abs[#1]>Abs[#2]&]
Eigenvalues[A]

Repeated comps : Full Max

Here are repeated runs reducing the maximum of diagonal each time

AA=A;
NOps=12000;
Data=Table[
TempMat=Abs[AA];
Do[TempMat[[k,k]]=0.0,{k,1,m}];
{i,j}=Position[TempMat,Max[TempMat]][[1]];
θ= 0.5 ArcTan[ 2 ((AA[[i,j]])/(AA[[j,j]]-AA[[i,i]]))];
JTemp=J2[{i,j},θ,m];
AA=JTemp.AA.Transpose[JTemp];
{n,((Norm[LowerTriangularize[AA,-1],"Frobenius"])/(Norm[AA,"Frobenius"]))},
{n,NOps}];
ListLogPlot[Data,
FrameLabel->{"J Ops","Frobenius OffDiagonal Fraction"},
GridLines->Automatic,
Frame->True,
PlotLabel->"Jacobi Max Search"]
Sort[Diagonal[AA],Abs[#1]>Abs[#2]&]
Eigenvalues[A]

MatrixPlot[AA]

ListPlot3D[Log[Abs[AA]]]

m