preserve set printback=off set decimal=dot *--------------------------------------------------------------------------- * kanonika1 * Program za simultanu kanonicku korelacijsku analizu * * * Verzija 1.0. * * Kanonicka korelacijska analiza implementirana je u skladu sa * metodama koje su predlozili Hotelling (1935; 1936) i Cooley * and Lohnes (1971); testiranje znacajnosti kanonickih korelacija * izvedeno je postupkom koga je predlozio Bartlett (1941). * * * * Ovaj program je revizija programa kanonika, napisanog u SS jeziku * (Momirovic, Dobric, Bosnar i Prot, 1984). * * kanonika se aktivira na sledeci nacin: * INCLUDE 'kanonika1.SPS'. * kanonika SET1=imena varijabli/SET2=imena varijabli/INC=zeljena znacajnost/. * Odredba INC je opciona. Ukoliko se izostavi podrazumeva se statisticka * znacajnost na nivou 0.01. * * Napomena: Makro je manje robustan od regularnih SPSS komandi * Provera regularnosti sintakse je vrlo stroga, tako da se apsolutno * treba pridrzavati zadate sintakse. *--------------------------------------------------------------------------- define kanonika(set1=!charend('/') /set2=!charend('/') /inc=!default(.01) !charend('/')) preserve set printback=off mxloop=100 mprint off *--------------------------------------------------------------------------- * Cuvanje originalnog fajla *--------------------------------------------------------------------------- save outfile='cc_tmp1.sav' *--------------------------------------------------------------------------- * Kreiranje korelacione matrice. *--------------------------------------------------------------------------- set results off corr variables=!set1 !set2 /missing=listwise/matrix out(*) set decimal=dot set results listing printback off mprint off *--------------------------------------------------------------------------- * Kreiranje korelacionih submatrica *--------------------------------------------------------------------------- matrix get r /variables=!set1/missing=omit/file=* compute p1=ncol(r) get r /file=* /names=varname/missing=omit/variables=!set1 !set2 compute p2=ncol(r)-p1 compute nx1=varname(1:p1) compute nv=p1+p2 compute nx2=varname((p1+1):nv) compute rr=r(4:(nv+3),1:nv) compute ns=r(3,1) compute r11=rr(1:p1,1:p1) compute r22=rr((p1+1):nv,(p1+1):nv) compute r12=rr(1:p1,(p1+1):nv) compute r21=t(r12) release r release nv release rr release varname *--------------------------------------------------------------------------- * Stampanje korelacija *--------------------------------------------------------------------------- compute num={"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","75","76","77","78","79","80","81", "82","83","84","85","86","87","88","89","90","91","92","93","94","95", "96","97","98","99","100"} print r11 /format "f8.3"/title 'Interkorelacije levog skupa varijabli' /rnames=nx1 /cnames=nx1 print r22 /format "f8.3"/title 'Interkorelacije desnog skupa varijabli' /rnames=nx2 /cnames=nx2 print r12 /format "f8.3" /title 'Kroskorelacije levog i desnog skupa varijabli' /rnames=nx1 /cnames=nx2 print /title 'REZULTATI KANONICKE KORELACIJSKE ANALIZE:' /space 2 *--------------------------------------------------------------------------- * r1 and r2 su matrice dobijene dekompozicijom Cholesk-og * matrica interkorelacija *--------------------------------------------------------------------------- compute r1=chol(r11) compute r2=chol(r22) *--------------------------------------------------------------------------- * r1inv and r2inv su inverzi r1 i r2 *--------------------------------------------------------------------------- compute r1inv=inv(r1) compute r2inv=inv(r2) release r1 release r2 *--------------------------------------------------------------------------- * Izracunavanje omega matrice *--------------------------------------------------------------------------- do if (p1 le p2) compute omega=t(r1inv)*r12*r2inv else compute omega=t(r2inv)*t(r12)*r1inv end if *--------------------------------------------------------------------------- * Singularna dekompozicija matrice omega *--------------------------------------------------------------------------- call svd(omega,u,lambda,v) compute dlam=diag(lambda) release omega release lambda *---------------------------------------------------------------------------- * Konstrukcije struktura za ispis rezultata analize prepokrivanja *---------------------------------------------------------------------------- compute c1={"CV1-1","CV1-2","CV1-3","CV1-4","CV1-5","CV1-6","CV1-7", "CV1-8","CV1-9","CV1-10","CV1-11","CV1-12","CV1-13","CV1-14","CV1-15", "CV1-16","CV1-17","CV1-18","CV1-19","CV1-20","CV1-21","CV1-22","CV1-23", "CV1-24","CV1-25","CV1-26","CV1-27","CV1-28","CV1-29","CV1-30","CV1-31", "CV1-32","CV1-33","CV1-34","CV1-35","CV1-36","CV1-37","CV1-38","CV1-39", "CV1-40","CV1-41","CV1-42","CV1-43","CV1-44","CV1-45","CV1-46","CV1-47", "CV1-48","CV1-49","CV1-50","CV1-51","CV1-52","CV1-53","CV1-54","CV1-55", "CV1-56","CV1-57","CV1-58","CV1-59","CV1-60","CV1-61","CV1-62","CV1-63", "CV1-64","CV1-65","CV1-66","CV1-67","CV1-68","CV1-69","CV1-70","CV1-71", "CV1-72","CV1-73","CV1-74","CV1-75","CV1-76","CV1-77","CV1-78","CV1-79", "CV1-80","CV1-81","CV1-82","CV1-83","CV1-84","CV1-85","CV1-86","CV1-87", "CV1-88","CV1-89","CV1-90","CV1-91","CV1-92","CV1-93","CV1-94","CV1-95", "CV1-96","CV1-97","CV1-98","CV1-99","CV1-100"} compute c2={"CV2-1","CV2-2","CV2-3","CV2-4","CV2-5","CV2-6","CV2-7", "CV2-8","CV2-9","CV2-10","CV2-11","CV2-12","CV2-13","CV2-14","CV2-15", "CV2-16","CV2-17","CV2-18","CV2-19","CV2-20","CV2-21","CV2-22","CV2-23", "CV2-24","CV2-25","CV2-26","CV2-27","CV2-28","CV2-29","CV2-30","CV2-31", "CV2-32","CV2-33","CV2-34","CV2-35","CV2-36","CV2-37","CV2-38","CV2-39", "CV2-40","CV2-41","CV2-42","CV2-43","CV2-44","CV2-45","CV2-46","CV2-47", "CV2-48","CV2-49","CV2-50","CV2-51","CV2-52","CV2-53","CV2-54","CV2-55", "CV2-56","CV2-57","CV2-58","CV2-59","CV2-60","CV2-61","CV2-62","CV2-63", "CV2-64","CV2-65","CV2-66","CV2-67","CV2-68","CV2-69","CV2-70","CV2-71", "CV2-72","CV2-73","CV2-74","CV2-75","CV2-76","CV2-77","CV2-78","CV2-79", "CV2-80","CV2-81","CV2-82","CV2-83","CV2-84","CV2-85","CV2-86","CV2-87", "CV2-88","CV2-89","CV2-90","CV2-91","CV2-92","CV2-93","CV2-94","CV2-95", "CV2-96","CV2-97","CV2-98","CV2-99","CV2-100"} *--------------------------------------------------------------------------- * Kanonicke korelacije i testiranje njihove znacajnosti *--------------------------------------------------------------------------- compute eign=(1 &/ (1-dlam &**2)) - 1 compute wlam=1 &/ (1+eign) compute n=nrow(wlam) compute wilk=wlam compute df=wlam compute sig=wlam compute bart2=wlam compute tem=1 loop #l=1 to n + compute tem=tem*wlam(n-#l+1) + compute df(n-#l+1)=(p1-n+#l)*(p2-n+#l) + compute dof=df(n-#l+1) + compute bart2(n-#l+1)=-(ns-(p1+p2+3)/2)*ln(tem) + compute chi=bart2(n-#l+1) + compute sig(n-#l+1)=1-chicdf(chi,dof) + compute wilk(n-#l+1)=tem end loop compute test={dlam,wilk,bart2,df,sig} print test /format "f10.3" /title 'Koeficijenti kanonickih korelacija i njihova znacajnost:' /space 2/rnames=num /cnames={"Rho","Lambda","Hi2","df","sig"} release eign release wlam release wilk release df release bart2 release tem release test release dof release chi release dlam *------------------------------------------------------------------------- * Zadrzavanje znacajnih kanonickih korelacija *------------------------------------------------------------------------- compute cifra=make(n,1,0) compute inc=!inc loop s=1 to n do if sig(s,1) < inc + compute cifra(s,1)=1 end if end loop compute znac=csum(cifra) release sig release cifra do if znac > 0 *--------------------------------------------------------------------------- * Izracunavanje i stampanje kanonickih koeficijenata levog skupa varijabli *--------------------------------------------------------------------------- do if (p1 le p2) compute a=r1inv*u else compute a=r1inv*v end if do if (p2 lt p1) compute a=a(:,1:p2) end if compute aznac=a(:,1:znac) print aznac/format "f8.3" /title 'Kanonicki koeficijenti levog skupa varijabli' /space 2/rnames=nx1/cnames=num release r1inv *--------------------------------------------------------------------------- * Izracunavanje i stampanje kanonickih koeficijenata desnog skupa varijabli *--------------------------------------------------------------------------- do if (p1 le p2) compute b=r2inv*v else compute b=r2inv*u end if do if (p1 le p2) compute b=b(:,1:p1) end if compute bznac=b(:,1:znac) print bznac/format "f8.3" /title 'Kanonicki koeficijenti desnog skupa varijabli' /space 2/rnames=nx2/cnames=num release r2inv release v release u *--------------------------------------------------------------------------- * Izracunavanje i stampanje struktura kanonickih faktora levog * skupa varijabli *--------------------------------------------------------------------------- compute tem1=r11*a compute tem1z=tem1(:,1:znac) print tem1z /format "f8.3" /title 'Kanonicki faktori levog skupa varijabli' /space 2/rnames=nx1/cnames=num release tem1 *--------------------------------------------------------------------------- * Izracunavanje i stampanje struktura kanonickih faktora desnog * skupa varijabli *--------------------------------------------------------------------------- compute tem2=r22*b compute tem2z=tem2(:,1:znac) print tem2z /format "f8.3" /title 'Kanonicki faktori desnog skupa varijabli' /space 2/rnames=nx2/cnames=num release tem2 *--------------------------------------------------------------------------- * Izracunavanje i stampanje kanonickih kros-faktoralevog skupa varijabli *--------------------------------------------------------------------------- compute tem12=r12*b compute tem12z=tem12(:,1:znac) print tem12z /format "f8.3" /title 'Kanonicki kros-faktori levog skupa varijabli' /space 2/rnames=nx1/cnames=num release tem12 release b *--------------------------------------------------------------------------- * Izracunavanje i stampanje kanonickih kros-faktora desnog skupa varijabli *--------------------------------------------------------------------------- compute tem21=t(r12)*a compute tem21z=tem21(:,1:znac) print tem21z /format "f8.3" /title 'Kanonicki kros-faktori desnog skupa varijabli' /space 2/rnames=nx2/cnames=num release tem21 release a *---------------------------------------------------------------------------- * Relativne varijanse, indeksi prepokrivanja i mere generalizabilnosti * levog skupa varijabli *---------------------------------------------------------------------------- compute f1=cssq(tem1z)/p1 compute f1=t(f1) compute jedanc=make(znac,1,1) compute alpha1=(p1/(p1-1))*(jedanc-jedanc&/t(cssq(tem1z))) compute cs3=cssq(tem12z)/p1 compute cs3=t(cs3) release tem12z *--------------------------------------------------------------------------- * Relativne varijanse, indeksi prepokrivanja i mere generalizabilnosti * desnog skupa varijabli *--------------------------------------------------------------------------- compute f2=cssq(tem2z)/p2 compute f2=t(f2) compute alpha2=(p2/(p2-1))*(jedanc-jedanc&/t(cssq(tem2z))) compute cs4=cssq(tem21z)/p2 compute cs4=t(cs4) release tem21z release jedanc *--------------------------------------------------------------------------- * Stampanje rezultata analize prepokrivanja *--------------------------------------------------------------------------- print /title 'ANALIZA PREPOKRIVANJA:' /space 2 compute test1={f1, cs3}. print test1/format "f15.3" /title 'Analiza prepokrivanja levog skupa' /space 2/rnames=c1 /cnames= {"Var.","Prepok."} compute test2={f2, cs4 }. print test2/format "f15.3" /title 'Analiza prepokrivanja desnog skupa' /space 2/rnames=c2 /cnames= {"Var.","Prepok."} release f1 release f2 release cs3 release cs4 release alpha1 release alpha2 release test1 release test2 else . print/title 'Nisu izdvojene statisticki znacajne kanonicke korelacije' end if *--------------------------------------------------------------------------- * Singularna dekompozicija matrice r12 *--------------------------------------------------------------------------- call svd(r12,x1,lambda1,x2) *--------------------------------------------------------------------------- * Zadrzavaju se singularne vrednosti matrice r12 koje su vece od * aritmeticke sredine svih njenih singularnih vrednosti *--------------------------------------------------------------------------- compute dlam1=diag(lambda1) compute suma1=csum(dlam1) compute suma=suma1/n compute cifra1=make(n,1,0) loop s=1 to n do if dlam1(s,1) >= suma . compute cifra1(s,1)=1 end if end loop compute znacq=csum(cifra1) compute x1z=x1(:,1:znacq) compute x2z=x2(:,1:znacq) release dlam1 release x1 release x2 release lambda1 release cifra1 release suma release suma1 *--------------------------------------------------------------------------- * Izracunavanje i stampanje kvazikanonickih koeficijenata, sklopa, strukture, * interkorelacija zadrzanih kvazikanonickih faktora i testiranje i stampanje * njihove znacajnosti *--------------------------------------------------------------------------- compute c=t(x1z)*r12*x2z compute mm1=t(x1z)*r11*x1z compute mm2=t(x2z)*r22*x2z do if znacq > 1 compute d1=diag(mm1) compute d2=diag(mm2) compute d1=sqrt(d1) compute d1=1&/d1 compute d1=mdiag(d1) compute d2=sqrt(d2) compute d2=1&/d2 compute d2=mdiag(d2) compute m1=d1*mm1*d1 compute m2=d2*mm2*d2 compute invm1=inv(m1) compute invm2=inv(m2) compute c=diag(c) compute c=mdiag(c) compute f1=r11*x1z*d1 compute f2=r22*x2z*d2 compute a1=f1*invm1 compute a2=f2*invm2 compute ro=d1*c*d2 compute ro=diag(ro) compute ro2=ro&*ro compute f12=r12*x2z*d2 compute f21=r21*x1z*d1 compute df1=1 compute df2=ns-2 compute ftest1=make(znacq,1,1) compute ftest2=ftest1 compute sig1=ftest1 loop s=1 to znacq . compute ftest1(s,1)=ro2(s,1)*((ns-2)/(1-ro2(s,1))) . compute ftest2=ftest1(s,1) . compute sig1(s,1)=1-fcdf(ftest2,df1,df2) end loop compute lav={ro,ro2,ftest1,sig1} print lav/format "f8.3" /title 'Kvazikanonicke korelacije i testovi znacajnosti'/space=2 /rnames=num/cnames={"ro","ro2","f-test","sig"} print x1z/format "f7.3" /title 'Kvazikanonicki koeficijenti levog skupa varijabli' /rnames=nx1/cnames=num print a1/format "f7.3" /title 'Sklop levog skupa varijabli' /rnames=nx1/cnames=num print m1/format "f7.3" /title 'Interkorelacije levog skupa kvazikanonickih faktora' /rnames=num/cnames=num print f1/format "f7.3" /title 'Struktura levog skupa varijabli kvazikanonickih faktora' /rnames=nx1/cnames=num print f12/format "f7.3" /title 'Kros-struktura levog skupa' /rnames=nx1/cnames=num print x2z/format "f7.3" /title 'Kvazikanonicki koeficijenti desnog skupa varijabli' /rnames=nx2/cnames=num print a2/format "f7.3" /title 'Sklop desnog skupa varijabli' /rnames=nx2/cnames=num print m2/format "f7.3" /title 'Interkorelacije desnog skupa kvazikanonickih faktora' /rnames=num/cnames=num print f2/format "f7.3" /title 'Struktura desnog skupa varijabli kvazikanonickih faktora' /rnames=nx2/cnames=num print f21/format "f7.3" /title 'Kros-struktura desnog skupa' /rnames=nx2/cnames=num release invm1 release invm2 release m1 release m2 release c release a1 release a2 release ftest1 release ftest2 *--------------------------------------------------------------------------- * Relativne varijanse, indeksi prepokrivanja i mere generalizabilnosti * levog skupa varijabli *--------------------------------------------------------------------------- compute jedan=make(znacq,1,1) compute red1=cssq(f1)/p1 compute red1=t(red1) compute red3=cssq(f12)/p1 compute red3=t(red3) compute beta1=(p1/(p1-1))*(jedan-jedan&/t(cssq(f1))) *--------------------------------------------------------------------------- * Relativne varijanse, indeksi prepokrivanja i mere generalizabilnosti * desnog skupa varijabli *--------------------------------------------------------------------------- compute red2=cssq(f2)/p2 compute red2=t(red2) compute red4=cssq(f21)/p2 compute red4=t(red4) compute beta2=(p2/(p2-1))*(jedan-jedan&/t(cssq(f2))) *---------------------------------------------------------------------------- * Stampanje rezultata analize redundanci. *--------------------------------------------------------------------------- print /title 'ANALIZA PREPOKRIVANJA:' /space 2 compute test1={red1,red3,beta1}. print test1/format "f15.3" /title 'Analiza prepokrivanja levog skupa' /space 2/rnames=c1 /cnames= {"Varijansa","prepokrivanje","generalizabilnost"} compute test2={red2,red4,beta2} print test2/format "f15.3" /title 'Analiza prepokrivanja desnog skupa' /space 2/rnames=c2 /cnames= {"Varijansa","prepokrivanje","generalizabilnost"} else compute d1=sqrt(mm1) compute d2=sqrt(mm2) compute d1=1/d1 compute d2=1/d2 compute f1=r11*x1z*d1 compute f2=r22*x2z*d2 compute f12=r12*x2z*d2 compute f21=r21*x1z*d1 compute ro=d1*c*d2 compute ro2=ro*ro compute df2=ns-2 compute df1=1 compute ftest=ro2*(df2/(1-ro2)) compute sig1=1-fcdf(ftest,1,df2) compute lav={ro,ro2,ftest,df1,df2,sig1} end if end matrix *--------------------------------------------------------------------------- * Pozivanje i restrukturiranje originalnog fajla *--------------------------------------------------------------------------- get file='cc_tmp1.sav' restore !enddefine. restore