/*
http://support.sas.com/onlinedoc/913/getDoc/en/statug.hlp/factor_sect22.htm
http://support.sas.com/ctx/samples/index.jsp?sid=512
*/

/*place a SAS macro somewhere in your PC*/
%include "C:\temp\sample00512_1_polychor.sas";


data raschdata;
input 
ID $ 1-10
Q01 11 Q02 12 Q03 13 Q04 14 Q05 15 Q06 16 Q07 17  Q08 18  Q09 19 Q10 20
Q11 21 Q12 22 Q13 23 Q14 24 Q15 25 Q16 26 Q17 27 Q18 28;
cards ;
Richard M 111111100000000000                                                                        
Tracie  F 111111111100000000                                                                        
Walter  M 111111111001000000                                                                        
Blaise  M 111100101000000000                                                                        
Ron     M 111111111100000000                                                                        
William M 111111111100000000                                                                        
Susan   F 111111111111101000                                                                        
Linda   F 111111111100000000                                                                        
Kim     F 111111111100000000                                                                        
Carol   F 111111111110000000                                                                        
Pete    M 111011111000000000                                                                        
Brenda  F 111110101100000000                                                                        
Mike    M 111110011111000000                                                                        
Zula    F 111111111110000000                                                                        
Frank   M 111111111111100000                                                                        
Dorothy F 111111111010000000                                                                        
Rod     M 111101111100000000                                                                        
Britton F 111111111100100000                                                                        
Janet   F 111111111000000000                                                                        
David   M 111111111100100000                                                                        
Thomas  M 111111111110100000                                                                        
Betty   F 111111111111000000                                                                        
Bert    M 111111111100110000                                                                        
Rick    M 111111111110100110                                                                        
Don     M 111011000000000000                                                                        
Barbara F 111111111100000000                                                                        
Adam    M 111111100000000000                                                                        
Audrey  F 111111111010000000                                                                        
Anne    F 111111001110010000                                                                        
Lisa    F 111111111000000000                                                                        
James   M 111111111100000000                                                                        
Joe     M 111111111110000000                                                                        
Martha  F 111100100100000000                                                                        
Elsie   F 111111111101010000                                                                        
Helen   F 111000000000000000   
;
run;

data raschdata2;
set raschdata;
xxx=.;
drop ID;
run;

%let abc=&syslast;
data _null_;set &abc end=end;
array test (*) _numeric_;  array allmiss (3000) $ (3000*'true');
  length list $ 5000;  do i=1 to dim(test);    if test(i) ne . then allmiss(i)='false';
  end;  if end=1 then   do i= 1 to dim(test);
    if allmiss(i) ='true' then list=trim(list)||' '||trim(vname(test(i)));
  end;  call symput('mlist',list);
run;
data &abc ;  set &abc ; drop &mlist;run;
PROC SQL NOPRINT;                                     
  SELECT TRIM(NAME)                
  INTO :VARLIST SEPARATED BY ' '                      
  FROM DICTIONARY.COLUMNS                             
  WHERE LIBNAME EQ "WORK" AND MEMNAME EQ "RASCHDATA2"          
  ORDER BY VARNUM;                                    
QUIT;                                                 


proc means data=raschdata2 ;
output out=meanresult;
var &varlist;
run;

data meanresult2;
set meanresult;
if _stat_="STD";
array kazu _numeric_ ;
do over kazu;
if kazu=0 then kazu=.;
end;
xxx=.;
run;
%let abc=&syslast;
data _null_;set &abc end=end;
array test (*) _numeric_;  array allmiss (3000) $ (3000*'true');
  length list $ 5000;  do i=1 to dim(test);    if test(i) ne . then allmiss(i)='false';
  end;  if end=1 then   do i= 1 to dim(test);
    if allmiss(i) ='true' then list=trim(list)||' '||trim(vname(test(i)));
  end;  call symput('mlist',list);
run;
data &abc ;  set &abc ; drop &mlist _freq_ _stat_;run;

PROC SQL NOPRINT;                                     
  SELECT TRIM(NAME)                
  INTO :VARLIST SEPARATED BY ' '                      
  FROM DICTIONARY.COLUMNS                             
  WHERE LIBNAME EQ "WORK" AND MEMNAME EQ "MEANRESULT2"          
  ORDER BY VARNUM;                                    
QUIT;            

%polychor(data=raschdata,var=&varlist,maxiter=200,out=result);

/*just to get the name first*/
data result2;
retain _name_;
set result;
run;

PROC EXPORT DATA= result2  OUTFILE= "C:\temp\matrix.xls" 
DBMS=EXCEL2000 REPLACE;
RUN;


%let name_of_doc=C:\temp\tetra_result.txt;
option NOCENTER;
PROC PRINTTO PRINT="&name_of_doc" new;
RUN;
options formdlim=' '; 

data one (type=corr);
set result2;
run;

proc factor data=one
method=prinit 
        n      = 2
        rotate = v
        scree;
*where _type_="CORR";
var &varlist2
;
run;


proc factor data=one
method=prin priors=smc
n      = 5
rotate = v
scree;
var 
&varlist2
;
run;

PROC PRINTTO PRINT=PRINT;
run;
quit;

x "notepad &name_of_doc";