Jacobi Rotations

Jacobi2x2[{i_,j_},angle_,m_]:=SparseArray[
{{i,i}->Cos[angle],
{j,j}->Cos[angle],
{i,j}->-Sin[angle],
{j,i}->Sin[angle],
Band[{1,1}]->1.0},
{m,m}]
MatrixForm[Jacobi2x2[{1,4}, x,5]]

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

Largest Entry in Matrix

ZeroBiggestEntry[A_] := Module[
{m=Length[A],MaxVal,i,j,angle,LowerA,Jacobi},
LowerA=LowerTriangularize[Abs[A],-1];
MaxVal=Max[LowerA];
{{i,j}}=Position[LowerA,MaxVal];
angle=0.5 ArcTan[((2A[[i,j]])/((A[[j,j]]-A[[i,i]])))];
Jacobi=Jacobi2x2[{i,j},angle,m];
Jacobi.A.Transpose[Jacobi]
]

m=11;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A];
LowerA=LowerTriangularize[Abs[A],-1];
NumberofRuns=5;
Data=Table[
A=ZeroBiggestEntry[A];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n,Difference},
{n,1,m*10}];

MatrixForm[A]
Sort[Diagonal[A]]
Sort[Eigenvalues[A]]

ListLogPlot[Data,
PlotRange->{10^-6,1}
]

Largest Entry in Row

ZeroBiggestEntryInRow[A_] := Module[
{m=Length[A],MaxVal,j,i,angle,LowerA,Jacobi, OurRow, NewA=A},
For[i=2,i≤m,i++,
LowerA=LowerTriangularize[Abs[NewA],-1];
OurRow=Abs[LowerA[[i]]];
MaxVal=Max[OurRow];
j=Position[OurRow,MaxVal][[1,1]];
angle=0.5 ArcTan[((2NewA[[i,j]])/((NewA[[j,j]]-NewA[[i,i]])))];
Jacobi=Jacobi2x2[{i,j},angle,m];
NewA =Jacobi.NewA.Transpose[Jacobi]];
NewA
]

m=11;
i=1;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A]; (*Make symmetric matrix*)
OurRow=Abs[A[[i]]]; (*Choose row*)
MaxVal=Max[OurRow](*Find maximum value in the row we chose*)
Position[OurRow,MaxVal] [[1,1]](*Find this maximum entry's position*)

Data1=Table[
A=ZeroBiggestEntryInRow[A];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n*m,Difference},
{n,1,30}];

ListLogPlot[Data1]

ListLogPlot[{Data,Data1}]

Largest K Entries in Matrix

FindMaxInVec[x_]:= Position[x,Max[x]][[1,1]] ;(* Finds the position in the vector x of the max *)
FindBiggestPositions[A_,k_]:=Module[
{LowerA,BigElementRows,Entries,i},
 LowerA=LowerTriangularize[Abs[A],-1]; (* Make a lower triangular matrix because it is symmetric *)
BigElementRows=Ordering[LowerA,k, Max[#1]>Max[#2]&]; (* Gives the rows in order of their largets elements *)
Entries = Table[ FindMaxInVec[ LowerA[[BigElementRows[[i]]]]],{i,1, k}] ;
Table[{BigElementRows[[i]],Entries[[i]]}, {i,1,k}] (*Gives an ordered pair of the positions of the largest entries*)
]

ZeroKBiggestEntries[A_,k_] := Module[
{ATemp=A,m=Length[A],Positions, i, j, q,angle,Jacobi},

Positions=FindBiggestPositions[A,k];(* Find the {i,j} values to zero *)
Do[
{i,j}=Positions[[q]];
angle=0.5 ArcTan[((2ATemp[[i,j]])/(ATemp[[j,j]]-ATemp[[i,i]]))];
Jacobi=Jacobi2x2[{i,j},angle,m];
ATemp=Jacobi.ATemp.Transpose[Jacobi],
{q,1,k}
]; (*This applies the Jacobi for the k entries we are zeroing*)
ATemp
]

Different Ks

Clear[Data]
m=11;
NIter=123;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A]; (* Make symmetric matrix *)
AHold=A; (*"Holds" A so that the same matrix is used each time*)

k = 1;
Data[k]=Table[
A=ZeroKBiggestEntries[A,k];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter}];

k = 4;
A=AHold;
Data[k]=Table[
A=ZeroKBiggestEntries[A,k];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter}];

A=AHold;
k = 8;
Data[k]=Table[
A=ZeroKBiggestEntries[A,k];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter}];

A=AHold;
k = 10;
Data[k]=Table[
A=ZeroKBiggestEntries[A,k];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter}];

ListLogPlot[{Data[1],Data[4],Data[8],Data[10]},
PlotStyle->{Red,Blue, Purple, Black},
AxesLabel->{Iterations,"Difference"}
]

Red shows taking the biggest, zeroing, and then sweeping through.
Blue shows taking the 4 biggest, zeroing, and then sweeping through.
Purple shows taking the 8 biggest, zeroing, and then sweeping through.
Black shows taking the 10 (m-1) biggest, zeroing, and then sweeping through.

Results!

NIter=50;
m=20;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A]; (* Make symmetric matrix *)
AHold1=A;


Data=Table[
A=ZeroBiggestEntry[A];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n,Difference},
{n,1,m*NIter}];

A=AHold1;
Data1=Table[
A=ZeroBiggestEntryInRow[A];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n*m,Difference},
{n,1,NIter}];

A=AHold1;
Data2=Table[
A=ZeroKBiggestEntries[A,19];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter*m}];

A=AHold1;
Data3=Table[
A=ZeroKBiggestEntries[A,10];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter*m}];

A=AHold1;
Data4=Table[
A=ZeroKBiggestEntries[A,5];
Difference=1-((Norm[Diagonal[A]])/(Norm[A,"Frobenius"]));
{n k,Difference},
{n,1,NIter*m}];

ListLogPlot[{Data,Data1,Data2, Data3, Data4},
PlotStyle->{Red,Blue, Green, Orange, Purple},
AxesLabel->{Iterations,"Difference"}
]

Green finds the 19 biggest, zeros, and then sweeps through.
Red is the zero the largest entry, and then sweep through.
Orange finds the 10 biggest, zeros, and then sweeps through.
Blue finds the largest in a row, zeros, and then sweeps through.
Purple finds the 5 biggest, zeros, and then sweeps through.

Jen

Laregst entry in matrix.

m=12;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A];
TestMat=LowerTriangularize[Abs[A],-1];
MaxVal=Max[TestMat];
Position[TestMat,MaxVal]

Largest entry in a specified row!

m=12;
i=6;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A]; (*Make symmetric matrix*)
OurRow=Abs[A[[i]]]; (*Choose row*)
MaxVal=Max[OurRow](*Find maximum value in the row we chose*)
Position[OurRow,MaxVal] [[1,1]](*Find this maximum entry's position*)

Largest k entries in a specified row first.

m=12;
i=6;
k=3;
A= RandomReal[{-1,1}, {m,m}]
OurRow=Abs[A[[i]]]
OurBigs=Ordering[OurRow,-k]
OurRow[[OurBigs]]

Largest k entries in a matrix.

m=6;
A= RandomReal[{-1,1}, {m,m}];
A=A+Transpose[A]; (* Make Sym Matrix *)
TestMat=LowerTriangularize[Abs[A],-1]; (* Trash the top *)
k=4; (* we want 4 big things *)
BigElementRows=Ordering[TestMat,k, Max[#1]>Max[#2]&] (* Gives the rows in order of their largets elements *)
Clear[FindMaxInVec];
FindMaxInVec[x_]:= Position[x,Max[x]][[1,1]] ;(* Finds the position in the vector x of the max *)
Entries = Table[ FindMaxInVec[ TestMat[[BigElementRows[[i]]]]],{i,1, k}] (*Finds the entries corresponding to the positions listed above*)
Table[TestMat[[BigElementRows[[i]],Entries[[i]]]], {i,1,k}] (*Gives the largest entries in order*)