**********************************************;
options nonumber NOCENTER ls=182
        MPRINT MTRACE SYMBOLGEN NONUMBER NODATE MISSING=' ';
**********************************************;

**********************************************;
%MACRO ALPHA;
******************************************************************;
*   Hays, R. D. & Wang, E.  (1992, April).  Multitrait
*     Scaling Program:  MULTI.  Proceedings of the Seventeenth
*     Annual SAS Users Group International Conference, 1151-1156.
******************************************************************;
PROC CORR DATA=ALPHA1 NOPRINT NOMISS COV OUTP=CORROUT;
VAR
 &&ITEMS&i           ;
TITLE1 'ALPHA INTERNAL CONSISTENCY RELIABILITY';
TITLE2 " &&nscal&i" ;
RUN;
**********************************************;
DATA ALPHA;
 SET CORROUT;
**********************************************;
ARRAY STOT (I)
 &&ITEMS&i        ;
**********************************************;
RETAIN TOT SDTOT VAR SDSUM;
**********************************************;
KK=&&nit&i;
**********************************************;
IF _N_=1 THEN DO;
 TOT=0;SDTOT=0;VAR=0;SDSUM=0;
END;
**********************************************;
IF _N_<=KK THEN DO;
 DO I=1 TO KK;
  TOT=STOT+TOT;
  IF I=_N_ THEN VAR=STOT+VAR;
  END;
END;
**********************************************;
IF _N_=(KK+2) THEN DO;
 DO I=1 TO KK;
  SDSUM=STOT+SDSUM;
 END;
END;
**********************************************;
IF _N_>(KK+3) THEN DO;
 DO I=1 TO KK;
  SDTOT=STOT+SDTOT;
  END;
END;
**********************************************;
IF _N_=((2*KK)+3) THEN DO;
 COV=TOT-VAR;
 ALPHA=(KK*COV)/((KK-1)*TOT);
 RII=COV/((KK-1)*VAR);
 SCOV=SDTOT-KK;
 SALPHA=(KK*SCOV)/((KK-1)*SDTOT);
 SRII=SCOV/((KK-1)*KK);
 SCOTT=COV/((SDSUM*SDSUM)-VAR);
OUTPUT;
END;
RENAME KK=K;
**********************************************;
PROC PRINT NOOBS;
 VAR ALPHA SALPHA RII SRII SCOTT K;
RUN;
%MEND ALPHA;

*******************************************;
* saved as map.sas
*******************************************;
%MACRO MULTI(DATA=,
items1 =,
items2 =,
items3 =,
items4 =,
items5 =,
items6 =,
items7 =,
items8 =,
items9 =,
items10=,
items11=,
items12=,
items13=,
items14=,
items15=,
items16=,
items17=,
items18=,
items19=,
nit1=,NIT2=,NIT3=,NIT4=,NIT5=,
NIT6=,NIT7=,NIT8=,NIT9=,
NIT10=,NIT11=,NIT12=,
NIT13=,NIT14=,NIT15=,
NIT16=,NIT17=,NIT18=,
NIT19=,
nSCAL1 =,
nSCAL2 =,
nSCAL3 =,
nSCAL4 =,
nSCAL5 =,
nSCAL6 =,
nSCAL7 =,
nSCAL8 =,
nSCAL9 =,
nSCAL10=,
nSCAL11=,
nSCAL12=,
nSCAL13=,
nSCAL14=,
nSCAL15=,
nSCAL16=,
nSCAL17=,
nSCAL18=,
nSCAL19=,
NSCALES=,BOZO=);
*******************************************;
DATA ALPHA;
SET &DATA;
********************************;
count=0;
do i=1 to 19;
  n=symget('nit'||left(i));
  count=count + n ;
end;
call symput('k',left(put(count,2.)));
********************************;
%let scales=;
%do i=1 %to &nscales;
%let scales = &scales &&nscal&i ;
%end;
********************************;
********************************;
%let items =;
%do i=1 %to 19;
%let items  = &items  &&items&i ;
%end;

ARRAY NO (I) &ITEMS &SCALES;
KEEP=1;
DO OVER NO;
 IF NO<=.Z THEN KEEP=0;
END;
*****************************************;
DATA ALPHA1;
 SET ALPHA;
IF KEEP=1;
*****************************************;
PROC CORR DATA=ALPHA1 NOPRINT OUTP=CORROUT;
VAR
 &ITEMS &SCALES;WITH &ITEMS;
RUN;
**********************************************;
DATA ALPHA;
 SET CORROUT;
**********************************************;
ARRAY ITEMSD (II)  &ITEMS;
ARRAY ISD (II)     BOZO1-BOZO200;
ARRAY NIT(nscale) NITEM1-NITEM19;
ARRAY SCALESD  (I) S1-S19;
ARRAY CORSCALE (I) &SCALES;
RETAIN SCALESD ISD II WHERE NSCALE NCASES;
**********************************************;
 array item{19} nitem1  nitem2  nitem3  nitem4  nitem5  nitem6  nitem7 nitem8
                nitem9  nitem10 nitem11 nitem12 nitem13 nitem14 nitem15
		nitem16 nitem17 nitem18 nitem19 ;
  do i=1 to 19;
   item{i}=symget('nit'||left(i));
  end;
**********************************************;
IF _N_=2 THEN DO I=1 TO &NSCALES;
 SCALESD=CORSCALE;
END;
**********************************************;
IF _N_=2 THEN DO II=1 TO &K;
 ISD=ITEMSD;
END;
**********************************************;
IF _N_=3 THEN DO II=1 TO 1;
 NCASES=ITEMSD;
 END;
**********************************************;
IF _N_=3 THEN II=1;
**********************************************;
IF _N_>3 THEN DO;
IF _N_=4 THEN NSCALE=1;
IF _N_=4 THEN WHERE=1;
IF WHERE<=NIT THEN WHERE=WHERE+1;
**********************************************;
DO I=1 TO &NSCALES;
IF I=NSCALE THEN DO;
DENO=(SCALESD*SCALESD+ISD*ISD)-(2*CORSCALE*SCALESD*ISD);
DENOM=sqrt(DENO);
CORSCAL=(CORSCALE*SCALESD)-ISD;
CORSCALE=CORSCAL/DENOM;
END;
END;
OUTPUT;
II=II+1;
 IF WHERE=NIT+1 THEN DO;
  NSCALE=NSCALE+1;
  WHERE=1;
 END;
END;
**********************************************;
PROC MEANS DATA=ALPHA NOPRINT;
 VAR NCASES;
OUTPUT OUT=ONE MEAN=SAMPSIZE;
TITLE1 'MULTI -- MULTITRAIT SCALING PROGRAM';
TITLE2 'NUMBER OF CASES IN ANALYSIS';
RUN;
**********************************************;
DATA;
 SET ONE(KEEP=SAMPSIZE);
SEOFCORR=1/SQRT(SAMPSIZE);
PROC PRINT NOOBS;RUN;
**********************************************;
data a;
length s1  s2  s3  s4  s5  s6  s7  s8  s9  s10
       s11 s12 s13 s14 s15 s16 s17 s18 s19 $ 1;
SET ALPHA(KEEP=_NAME_ &SCALES NITEM1-NITEM19 );
 
IF _N_<=&K;
RENAME _NAME_=ITEM;

*****************************************************;
array s{19} $ s1 s2  s3  s4  s5  s6  s7  s8  s9  s10
	      s11 s12 s13 s14 s15 s16 s17 s18 s19;
array t{19} nitem1  nitem2  nitem3  nitem4  nitem5  nitem6  nitem7 nitem8
             nitem9  nitem10 nitem11 nitem12 nitem13 nitem14 nitem15
	     nitem16 nitem17 nitem18 nitem19 ;
nt=0;
do i=1 to 19;
ot=nt;
nt=ot + t{i};
if ot<  _N_ <= nt then s{i}='*' ;
end;
*****************************************************;
%let put=@2 item $8. +2;
%do i=1 %to &nscales;
%let put= &put &&nscal&i 4.2  s&i $ 1. +4 ;
%end;

data _null_;
set a  end=endfile;
file print notitles header=hd;
put  &put;
RETURN;
hd:
put / @1 'MULTITRAIT MULTITEM CORRELATION MATRIX ' ;

PUT //
 @2  'item '
@12  "&nscal1"
@21  "&nscal2"
@30  "&nscal3"
@39  "&nscal4"
@48  "&nscal5"
@57  "&nscal6"
@66  "&nscal7"
@75  "&nscal8"
@84  "&nscal9"
@93  "&nscal10"
@102 "&nscal11"
@111 "&nscal12"
@120 "&nscal13"
@129 "&nscal14"
@138 "&nscal15"
@147 "&nscal16"
@156 "&nscal17"
@165 "&nscal18"
@174 "&nscal19"
/ ;
PROC CORR DATA=ALPHA1 NOPRINT OUTP=CORROUT;
VAR
 &SCALES;
RUN;
**********************************************;
DATA;
 SET CORROUT(KEEP=_NAME_ &SCALES);
IF _N_>3;
RENAME _NAME_=SCALE;
TITLE 'INTERCORRELATIONS AMONG SCALES';
PROC PRINT;
RUN;
***************************************************************;
PROC MEANS DATA=ALPHA1 MAXDEC=2 FW=10;
VAR
 &ITEMS &SCALES;
TITLE 'ITEM AND SCALE MEANS AND STANDARD DEVIATIONS';
RUN;
***************************************************************;
PROC UNIVARIATE DATA=ALPHA1 NOPRINT NORMAL;
 VAR
&SCALES;
OUTPUT OUT=ONE SKEWNESS=&SCALES;
TITLE 'SKEWNESS OF SCALE SCORES (unbounded)';
RUN;
**********************************************;
DATA;
 SET ONE;
PROC PRINT NOOBS;RUN;
**********************************************;
PROC UNIVARIATE DATA=ALPHA1 NOPRINT NORMAL;
 VAR
&SCALES;
OUTPUT OUT=ONE KURTOSIS=&SCALES;
TITLE 'KURTOSIS OF SCALE SCORES (-2 --> +infinity)';
RUN;
**********************************************;
DATA;
 SET ONE;
PROC PRINT NOOBS;RUN;
**********************************************;
PROC UNIVARIATE DATA=ALPHA1 NOPRINT NORMAL;
 VAR
&SCALES;
OUTPUT OUT=ONE NORMAL=&SCALES;
TITLE1 'NORMALITY OF SCALE SCORES';
TITLE2 'Shapiro-Wilk statistic if n <= 2000';
TITLE3 'Kolomogorov D statistic if n > 2000';
RUN;
**********************************************;
DATA;
 SET ONE;
PROC PRINT NOOBS;RUN;
**********************************************;
DATA;
SET ALPHA(KEEP=_NAME_ &ITEMS);
IF _N_<=&K;
RENAME _NAME_=ITEMS;
TITLE 'INTERCORRELATIONS AMONG ITEMS';
TITLE2 ' ';
TITLE3 ' ';
PROC PRINT;
%do i=1 %to &nscales;
%ALPHA;
%end;
***************************************************************;
%MEND MULTI;
***************************************************************;

DATA NEW;
INPUT
ID       1-2
ITEM1      4
ITEM2      5
ITEM3      6
ITEM4      7
ITEM5      8;
CARDS;
01 55354
02 45351
03 42254
04 35142
05 22121
;
run;
DATA NEW;
 SET NEW;
SCALE1=MEAN(ITEM1,ITEM2)*2;
SCALE2=MEAN(ITEM3,ITEM4,ITEM5)*3;
*******************************************;
run;
*******************************************;
%MULTI (DATA=NEW,items1=ITEM1 ITEM2,items2=ITEM3 ITEM4 ITEM5,
items3=,items4=,items5=,items6=,items7=,items8=,items9=,
items10=,items11=,items12=,items13=,items14=,items15=,
items16=,items17=,items18=,items19=,
NIT1=2,NIT2=3,NIT3=0,NIT4=0,NIT5=0,NIT6=0,NIT7=0,NIT8=0,NIT9=0,
NIT10=0,NIT11=0,NIT12=0,NIT13=0,NIT14=0,NIT15=0,NIT16=0,NIT17=0,
NIT18=0,NIT19=0,nscal1=scale1,nscal2=scale2,
nscal3=3,nscal4=4,nscal5=5,nscal6=6,nscal7=7,
nscal8=8,nscal9=9,nscal10=10,nscal11=11,nscal12=12,
nscal13=13,nscal14=14,nscal15=15,nscal16=16,nscal17=17,
nscal18=18,nscal19=19,nscales=2);