Mathematica 教學 How to find determinant of large matrix efficiently

temp1=15;
A=N@Table[Tan[m+2n]+Cot[m+2n]z,{m,1,temp1},{n,1,temp1}];

myminors[mymatrix_?MatrixQ]:=Block[{dim},
dim=Length@mymatrix;
{If[OddQ[#],1,-1]*mymatrix[[1,#]],
mymatrix[[All,Drop[Range[dim],{#}]]][[2;;-1]]}&/@Range[dim]];

dist[list1_,list2_List]:=Insert[#,list1,1]&/@list2

(* 降階到11x11的minor後代Mathematica的Det *)

anstemp1=Nest[Flatten[ParallelMap[dist[#[[1;;-2]],myminors[#[[-1]]]]&,#],1]&,
myminors[A],temp1-12];

ans=Total[ParallelTable[
Times@@Flatten[anstemp1[[i]][[1;;-2]]]*
Det[anstemp1[[i]][[-1]]],{i,Length@anstemp1}]

Det[A/.z->1]-ans/.z->1

Det[A/.z->1]-ans/.z->1

(* 上面的程式在anstemp1所產生的項數共15*14*13*12=32760，所以顯然是很沒效率。*)
(* 但如果就上述的矩陣改以下列方式計算，那速度快很多。*)

temp=15;
AA=Table[Tan[m+2n]//N,{m,1,temp},{n,1,temp}];
BB=Table[Cot[m+2n]//N,{m,1,temp},{n,1,temp}];
A=Table[Tan[m+2n]+Cot[m+2n]z//N,{m,1,temp},{n,1,temp}];

ans1=AbsoluteTiming[Det[AA]*Det[(IdentityMatrix[temp]+z*Inverse[AA].BB)]]
ans2=AbsoluteTiming@Det[AA+z*BB]
ans3=AbsoluteTiming@Det[A]

{ans1[[2]]/.z->#,ans2[[2]]/.z->#,ans3[[2]]/.z->#}&/@Range[0.1,1,0.1]

(* Nobody knows what the reason is... *)

Tags: Mathematica 教學, Teaching

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見