Mathematica 教學：Factor analysis with Varimax rotation

varimax[data_]:=Block[{AA,BB,CC,DD,nn,uu,XX,YY,vdata,angle,Tr,temp,vlist},
{nn,uu}=Dimensions[data];
vdata=Map[Normalize,data];
Do[
angle=Arg[nn* Total[Thread[Complex[
vdata[[All,iter[[1]]]],vdata[[All,iter[[2]]]]]]^4]
-Total[Thread[Complex[
vdata[[All,iter[[1]]]],vdata[[All,iter[[2]]]]]]^2]^2]/4;
Tr={{Cos[angle],-Sin[angle]},{Sin[angle],Cos[angle]}};
vdata[[All,iter]]= vdata[[All,iter]].Tr,
{iter,Flatten[Subsets[Range[uu],{2}]&/@Range[25],1]}
];
vdata*(Norm[#]&/@data)];


myfactor[data_]:=Block[{label,fadata,mypca,loadings,nf,rotatedloadings,
rotatedfactor,ncfa,proddata},
label=data[[1]];
fadata=data[[2;;-1]];
mypca=Eigensystem[Correlation@fadata];
nf=Length[Select[mypca[[1]],#>=1&]];
loadings=Transpose[mypca[[1,#]]^0.5*mypca[[2,#]]&/@Range[nf]];
rotatedloadings=varimax[loadings];
loadings=Flatten@{#,rotatedloadings[[#]],"",""}&/@Range[Length@loadings];
rotatedfactor=Table[Select[loadings,
(Abs[#[[i]]]==Max[Map[Abs,#[[2;;1+nf]]]])&],{i,2,nf+1}];
(rotatedfactor[[#,1,nf+2]]=mypca[[1,#]];
rotatedfactor[[#,1,nf+3]]=PercentForm[
Accumulate[mypca[[1]]][[#]]/Total[mypca[[1]]]];)&/@Range[nf];

Print["\n探索性因素分析\n"];

Print[TableForm[
Flatten[Table[Flatten@{StringReplace[label[[#[[1]]]]," "->""],
#[[2;;-1]]}&/@rotatedfactor[[i]],{i,nf}],1],
TableHeadings->{None, 
Flatten@{"題項","因素"<>ToString[#]&/@Range[nf],"特徵根","解釋百分比"}}]];
ncfa=Length/@rotatedfactor;
proddata=data[[All,Flatten[#[[All,1]]&/@rotatedfactor]]][[2;;-1]];

Print["\n驗證性因素分析\n"];

Print@thesisnoworrycfa[
proddata,ncfa,ToExpression["X"<>ToString[#]]&/@Range[nf]];
];

myfactorcheck[data_]:=Block[{label,fadata,mypca,loadings,nf,
rotatedloadings,rotatedfactor,ncfa,proddata,check,checkfactornum},
label=data[[1]];
fadata=data[[2;;-1]];
mypca=Eigensystem[Correlation@fadata];
nf=Length[Select[mypca[[1]],#>=1&]];
loadings=Transpose[mypca[[1,#]]^0.5*mypca[[2,#]]&/@Range[nf]];
rotatedloadings=varimax[loadings];
loadings=Flatten@{#,rotatedloadings[[#]],"",""}&/@Range[Length@loadings];
rotatedfactor=Table[Select[loadings,(Abs[#[[i]]]==Max[Map[Abs,#[[2;;1+nf]]]])&],{i,2,nf+1}];

rotatedfactor=Table[Insert[i,Length[rotatedfactor[[#]]],-1],
{i,rotatedfactor[[#]]}]&/@Range[Length[rotatedfactor]];

check[list_,j_]:=Block[{temp=list},
If[Abs[temp[[1+j]]]<0 .45="" actor="" nf="" temp="">ToString[j];
temp[[3+nf]]="因素負荷過低",temp[[2+nf]]="Factor "<>ToString[j];
temp[[3+nf]]=temp[[3+nf]]];temp];
 

check=Flatten[Select[#,#[[-2]]=="因素負荷過低"||#[[-1]]<=2&]&/@Table[
Map[check[#,i]&,rotatedfactor[[i]]],{i,nf}],1];
Print@TableForm@check;

data[[All,Complement[Range[Dimensions[data][[2]]],check[[All,1]]]]]
];

test=Import["test.xlsx"][[1]][[All,8;;29]];
semmethod="ML";
myfactor[NestWhile[myfactorcheck,test,UnsameQ,2]]

Tags:

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