dm output 'clear';
dm log 'clear';	

/****************************************************************************/
/*	PREVOD KORELACNI MATICE NA POZITIVNE DEFINITNI							*/
/*														Ing. Zdenka Vesela	*/
/*														14.11.2006			*/
/****************************************************************************/

/******************************* ZADANI MAKER *******************************/
%LET a=21;	  /*... zadani rozmeru matice (pocet korelovanych vlastnosti ...*/
%LET max=1000000;  /*... maximalni pocet iteraci						 ...*/
/************** ZADANI ADRESARE A NAZVU UKLADANE KORELACNI MATICE ***********/
filename pdcor 'c:/zet/disertace/data/pdcor';

proc iml;
/*********************** ZADANI KORELACNI MATICE ****************************/
r={
1	0.3	0.15	0.15	0.1	-0.17	-0.1	-0.7	-0.7	-0.5	0.1104	
0.07	0.0663	0.0379	0.0606	0.05267	0.0606	0.05358	0.0608	0.055 0.0613,
0.3	1	0.33	0.29	0.28	-0.9	-0.14	-0.4	-0.5	-0.3	0.3014
0.101	0.102	0.092	0.0736	0.0719	0.0693	0.0569	0.0596	0.0521 0.0676,
0.15	0.33	1	0.7	0.63	-0.4	-0.9	-0.18	-0.15	-0.1	0.4248
0.1543	0.1462	0.1885	0.1178	0.1314	0.1007	0.0923	0.0867	0.0729	0.095,
0.15	0.29	0.7	1	0.72	-0.5	-0.4	-0.15	-0.18	-0.14	0.387
0.1889	0.1713	0.2385	0.1446	0.1526	0.1196	0.1109	0.104	0.0858 0.1171,
0.1	0.28	0.63	0.72	1	-0.4	-0.5	-0.14	-0.13	-0.18 0.8126
0.1864	0.1714	0.2409	0.1423	0.1546	0.1163	0.1081	0.104	0.0858 0.1171,
-0.17	-0.9	-0.4	-0.5	-0.4	1	0.3	0.15	0.13	0.08 -0.0832	
0.0133	-0.0042	0.0185	0.0029	0.0011	0.0023	0.0006 0.0026 -0.0002 -0.0005,
-0.1	-0.14	-0.9	-0.4	-0.5	0.3	1	0.29	0.17	0.03 -0.08324
-0.012	-0.0077	0.0072	-0.0038	0.003 -0.0014 -0.0052 -0.0076 -0.0005 -0.0015,
-0.7	-0.4	-0.18	-0.15	-0.14	0.15	0.29	1	0.81 0.45 -0.079
0.0458	0.0464	0.076	0.053	0.0596	0.0426	0.0459	0.0394	0.0411 0.0444,
-0.7	-0.5	-0.15	-0.18	-0.13	0.13	0.17	0.81 1 0.62 -0.0755	
0.0556	0.0561	0.0878	0.0562	0.0646	0.0404	0.0434	0.0358	0.0359 0.0438,
-0.5	-0.3	-0.1	-0.14	-0.18	0.08	0.03	0.45	0.62 1 -0.2962
0.0483	0.0457	0.051	0.02165	0.0168	0.018	0.0138	0.0114	0.0161	0.014,
0.1104	0.3014	0.4248	0.387	0.8126 -0.0832 -0.08324 -0.079 -0.0755 -0.2962	
1	0.1181	0.1111	0.1587	0.0897 0.1024 0.0716 0.0669 0.0631 0.05208 0.0769,
0.07	0.101	0.1543	0.1889	0.1864	0.0133	-0.012	0.0458	0.0556	0.0483
0.1181 1 0.7017	0.7242	0.2687	0.2778	0.2508	0.1981	0.1734 0.08661 0.2363,
0.0663	0.102	0.1462	0.1713	0.1714	-0.0042	-0.0077	0.0464	0.0561	0.0457
0.1111 0.7017 1	0.4632	0.5629	0.5613	0.5857	0.5454	0.5379	0.3937 0.5101,
0.0379	0.092	0.1885	0.2385	0.2409	0.0185	0.0072	0.076	0.0878	0.051
0.1587	0.7242	0.4632	1	0.5264	0.5088 0.4407 0.3809 0.4108 0.3704 0.4319,
0.0606	0.0736	0.1178	0.1446	0.1423	0.0029	-0.0038	0.053	0.0562 0.02165
0.0897 0.2687 0.5629 0.5264	1	0.9649	0.9202	0.95	0.9516	0.9066 0.9301,
0.05267	0.0719	0.1314	0.1526	0.1546	0.0011	0.003	0.0596	0.0646 0.0168
0.1024	0.2778	0.5613	0.5088	0.9649	1 0.8898 0.8745	0.8873	0.8299 0.8677,
0.0606	0.0693	0.1007	0.1196	0.1163	0.0023	-0.0014	0.0426	0.0404	0.018
0.0716	0.2508	0.5857	0.4407	0.9202	0.8898	1 0.9154 0.951 0.9215 0.9235,
0.05358	0.0569	0.0923	0.1109	0.1081	0.0006	-0.0052	0.0459	0.0434	0.0138
0.0669	0.1981	0.5454	0.3809	0.95	0.8745	0.9154 1 0.9803 0.9495 0.9562,
0.0608	0.0596	0.0867	0.104	0.104	0.0026	-0.0076	0.0394	0.0358	0.0114
0.0631	0.1734	0.5379	0.4108	0.9516	0.8873	0.951 0.9803 1 0.9751 0.9556,
0.055	0.0521	0.0729	0.0858	0.0858	-0.0002	-0.0005	0.0411	0.0359	0.0161
0.05208	0.08661	0.3937	0.3704	0.9066	0.8299	0.9215 0.9495 0.9751 1 0.9626,
0.0613	0.0676	0.095	0.1171	0.1171	-0.0005	-0.0015	0.0444	0.0438	0.014
0.0769	0.2363	0.5101	0.4319	0.9301	0.8677	0.9235 0.9562 0.9556 0.9626 1
};
/*********************** ZADANI MATICE S POCTY ZVIRAT************************/
p={
175531	175531	77128	80146	31248	26449	26449	26449 26449 8004 2355
5424	5424	5424	5424	5424	5424	5424	5424	5424	5424,
175531	175531	77128	80146	31248	26449	26449	26449 26449	8004 2355
5424	5425	5425	5425	5425	5425	5425	5425	5425	5425,
77128	77128	78215	80146	31248	26449	26449	26449 15168	5829 2355
4907	4907	4907	4907	4907	4907	4907	4907	4907	4907,
80146	80146	80146	80643	22737	16147	16147	16147 16147	5468 2355
5279	5279	5279	5279	5279	5279	5279	5279	5279	5279,
31248	31248	31248	22737	31535	10761	10761	10761 10761	4084 2355
3557	3557	3557	3557	3557	3557	3557	3557	3557	3557,
26449	26449	26449	16147	10761	62315	62315	62315	62315	18823
2355	557	557	557	557	557	557	557	557	557	557,
26449	26449	26449	16147	10761	62315	62315	62315	62315	18823
2355	557	557	557	557	557	557	557	557	557	557,
26449	26449	26449	16147	10761	62315	62315	62315	62315	18823
2355	557	557	557	557	557	557	557	557	557	557,
26449	26449	15168	16147	10761	62315	62315	62315	62315	18823
2355	557	557	557	557	557	557	557	557	557	557,
8004	8004	5829	5468	4084	18823	18823	18823	18823	19019
2355	81	81	81	81	81	81	81	81	81	81,
2355	2355	2355	2355	2355	2355	2355	2355 2355 2355 2355
2355	2355	2355	2355	2355	2355	2355	2355	2355	2355,
5424	5424	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424,
5424	5425	4907	5279	3557	557	557	557	557	81	2355	5424	
5424	5424	5424	5424	5424	5424	5424	5424	5424
};
/****************************************************************************/
/*... 1. Vypocet matice vlastnich vekturu (eigenvectors) U
	a diagonalni matice vlastnich hodnotnu (eigenvalues) D
	korelacni matice R										...*/
do i=1 to &max by 1;
call eigen(b,u,r);
d=diag(b);
d1=d;
if d[&a,&a]>0 then do;
	create r from r;
	append from r;		/*... Vytvoreni souboru s korelacni matici ...*/
	print r;
	print i;
	r=j(1,1,0);
	d=j(1,1,0);
	p=j(1,1,0);
	u=j(1,1,0);
	a=root(r); /*... Kontrola správnosti ...*/
end;
do j=1 to &a by 1;
	if d1[j,j]<0.0001 then do;
	d1[j,j]=0.0002;
	end;
end;
trd=trace(d);
trd1=trace(d1);
trdd1=trd/trd1;
dd=j(&a,&a,0);
do j=1 to &a by 1;
	dd[j,j]=d1[j,j]*trdd1;
end;
w=j(&a);
do j=1 to &a by 1;
	do k=1 to &a by 1;
		w[j,k]=1/p[j,k];
	end;
end;
/*... Vypocet nove korelacni matice ...*/
r1=r-(r-(u*dd*u`))#w;
r2=j(&a);
do j=1 to &a by 1;
	do k=1 to &a by 1;
		r2[j,k]=r1[j,k]/sqrt(r1[j,j]*r1[k,k]);
	end;
end;
r=r2;
end;

data pdcor; set r; file pdcor; 
	put col1 col2 col3 col4 col5 col6 col7 col8 col9 col10
	 col11 col12 col13 col14 col15 col16 col17 col18 col19 col20
	 col21;
	 /*... Polde potreby doplnit nebo umazat sloupce ...*/
run;
quit;