N/A
Posts: 0

CTA SAS macro

I am very new to SAS and I have an input matrix and an macro but I am getting results .
My input matrix is:
%CTA-SAS2(SAMPMAT1 =

1

0.564 1

0.531 0.496 1

0.466 0.436 0.449 1

0.460 0.429 0.662 0.582 1,

N = 134, vars = 5, nesttest = 0, pchor = 0, lisrel = 0, mplus = 0, lowdiag=1);

My huge macro:

%macro cta(N=, vars=, nesttest=0, pchor=0, lisrel=0, mplus=0, SAMPMAT1=,lowdiag=1);

*................... Macro Functions ...........................*;
%macro _resid(a,b,c,d);
residual = S(&a,&b)*S(&c,&d)-S(&a,&c)*S(&b,&d);

/* asymptotic variance */
AVAR = (1/&N) *
(S(&d,&b)*S(&d,&b)*S(&a,&a)*S(&c,&c) +
S(&a,&c)*S(&a,&c)*S(&d,&d)*S(&b,&b) +
S(&d,&c)*S(&d,&c)*S(&a,&a)*S(&b,&b) +
S(&a,&b)*S(&a,&b)*S(&d,&d)*S(&c,&c) +
2 *(S(&d,&b)*S(&a,&c)*S(&a,&d)*S(&b,&c) -
S(&d,&b)*S(&d,&c)*S(&a,&a)*S(&b,&c) -
S(&d,&b)*S(&a,&b)*S(&a,&d)*S(&c,&c) -
S(&a,&c)*S(&d,&c)*S(&d,&a)*S(&b,&b) -
S(&a,&c)*S(&a,&b)*S(&d,&d)*S(&b,&c) +
S(&d,&c)*S(&a,&b)*S(&a,&d)*S(&b,&c))+
2 *((S(&d,&b)*S(&a,&c)-S(&a,&b)*S(&d,&c))**2));

/* t-value */
tvalue = residual/sqrt(avar);

%mend _resid;

%macro _switch (first,second);
temp = &first;
&first = &second;
&second= temp;
%mend _switch;

*................... Data Input ................................*;
/* count # of variables */
data _null_;
array varname (*) &vars;
call symput('k',left(dim(varname))); /* &k = # vars */
call symput('m',left(dim(varname)**2)); /* &m = &k*&k */
run;

%let nt = %eval(&k*(&k-1)*(&k-2)*(&k-3)/8); /* # of tetrads*/

%if &data ne %str() %then %do;
/* compute covariance matrix */
/* exclude missing cases */
proc corr data=&data nomiss nocorr cov out=covout noprint;
var &vars;
data matx; set covout;
if _type_ = 'N' then do;
maxn = max(of &vars);
call symput('n',maxn); /* &n = # obs */
end;
if _type_ = 'COV';
keep &vars;
proc print data=matx noobs;
var &vars;
title2 'Covariance Matrix Computed from Input Data';
data matx1rec; set matx;
retain s1 - s&m;
array v (*) &vars;
array s (&k,&k);
do i = 1 to &k;
s(_n_,i) = v(i);
end;
if _n_ = &k then output;
%end;

%else %do;
/* read covariance or correlation matrix */
data matx1rec;
%let lowtri = %eval((&k + 1)*(&k)/2);
array t(&lowtri) _temporary_ (&cmatrix);
array s(&k,&k);
do i = 1 to &k;
do j = 1 to i;
p + 1;
s(i,j) = t(p);
s(j,i) = t(p);
end;
end;
data matx; set matx1rec;
array v (*) &vars;
array s(&k,&k);
do i = 1 to &k;
do j = 1 to &k;
v(j) = s(i,j);
end;
keep &vars;
output;
end;
proc print data=matx noobs;
var &vars;
title2 'Covariance/Correlation Matrix Read from Input Matrix';
%end;

%if %upcase(&AC) = DFAC %then %do;
/* convert variables to deviation scores */
proc means noprint mean data=&data;
var &vars;
output out=meanout mean(&vars)=mean1 - mean&k;
data meanout; set meanout;
match=1;
keep mean1 - mean&k match;
data &data; set &data; match=1;
data ctrdata;
merge &data meanout; by match;
array x (&k) &vars;
array mean (&k);
do i = 1 to &k;
x(i) = x(i) - mean(i);
end;
keep match &vars;
%end;

array s (&k,&k);

/* generate all tetrads equations */
a=1; b=2; c=3; d=3;
do until (a > &k-3);
do until (b > &k-2);
do until (c > &k-1);
do until (d = &k);
d=d+1;

cov1 = a * 1000 + b; cov2 = c * 1000 + d;
cov3 = a * 1000 + c; cov4 = b * 1000 + d;
%_resid(a,b,c,d);
id+1;
output;

cov1 = a * 1000 + b; cov2 = c * 1000 + d;
cov3 = a * 1000 + d; cov4 = b * 1000 + c;
%_resid(a,b,d,c);
id+1;
output;

cov1 = a * 1000 + c; cov2 = b * 1000 + d;
cov3 = a * 1000 + d; cov4 = b * 1000 + c;
%_resid(a,c,d,b);
id+1;
output;

end;
c=c+1;
d=c;
end;
b=b+1;
c=b+1;
d=c;
end;
a=a+1;
b=a+1;
c=b+1;
d=c;
end;

proc print noobs;

/* Execution Control */
%if %upcase(&EXEC) ne PARTIAL %then %do;

*................... Model Implied Vanishing Tetrads ...........*;
data mivt;
/* select tetrads for test */
/* first keep then drop if both options specified */
%if &keept ne %str() %then %do;
array keeptd (&nt) _temporary_ (&keept);
do i = 1 to &nt;
if keeptd(i) = . then go to exit1;
if keeptd(i) = id then keeplist = 'keep';
end;
exit1:
if keeplist = 'keep';
%end;
%if &dropt ne %str() %then %do;
array droptd (&nt) _temporary_ (&dropt);
do i = 1 to &nt;
if droptd(i) = . then go to exit2;
if droptd(i) = id then droplist = 'drop';
end;
exit2:
if droplist = 'drop' then delete;
%end;

eq+1;
call symput('eqs',left(eq)); /* &eqs = # of vt */

%if &sort ne %str() %then %do;
data mivt; set mivt;
array sort(&eqs) _temporary_ (&sort);
do i = 1 to &eqs;
if sort(i) = . then do;
rank = &eqs + 1;
go to exit1;
end; else
if id = sort(i) then do;
rank = i;
go to exit1;
end;
end;
exit1:
proc sort; by rank;
proc print;
var id tetrad residual cov1 cov2 cov3 cov4;
%end;

/* Convert MIVT to single record */
data mivt1rec;
set mivt (keep = id tetrad residual cov1 cov2 cov3 cov4)
end = eof;
retain a1 - a&eqs
b1 - b&eqs
c1 - c&eqs
d1 - d&eqs
e1 - e&eqs 4.;

array a (*) a1 - a&eqs;
array b (*) b1 - b&eqs;
array c (*) c1 - c&eqs;
array d (*) d1 - d&eqs;
array e (*) e1 - e&eqs;

a(_n_) = cov1;
b(_n_) = cov2;
c(_n_) = cov3;
d(_n_) = cov4;
e(_n_) = id;

keep a1-a&eqs b1-b&eqs c1-c&eqs d1-d&eqs e1-e&eqs;
if eof then output;

data nrvt; set mivt1rec;
array a (*) a1 - a&eqs;
array b (*) b1 - b&eqs;
array c (*) c1 - c&eqs;
array d (*) d1 - d&eqs;
array e (*) e1 - e&eqs;
array nr (*) nr01 - nr&eqs;
array im (*) im01 - im&eqs;

do i = 1 to dim(nr);
if im(i) ne 1 then nr(i) = 1; /* NR VT */

/* check implied VTs from VT1 to VTi */
do p = 1 to i-1, i+1 to dim(nr);
if p < i or im(p) = 1 then do;
/* step 1: find 2 share covs */
cu1=a(i); cu2=b(i); cu3=c(i); cu4=d(i);
ps1=a(p); ps2=b(p); ps3=c(p); ps4=d(p);
array cu (*) cu1 cu2 cu3 cu4; /* current VT */
array ps (*) ps1 ps2 ps3 ps4; /* previous VT */
share = 0;
lhs = 0;
rhs = 0;
xhs = 0;

/* find shared covs from 2 tetrads */
do x = 1 to 4;
do y = 1 to 4;
if cu(x) = ps(y) then do;
share = share + 1;
if x <= 2 & y <= 2 then lhs = lhs + 1;
if x >= 3 & y >= 3 then rhs = rhs + 1;
if x <= 2 then xhs = xhs + 1;
end;

if share = 2 then do;
if lhs = 1 & rhs = 1 then do;
do x = 1 to 4;
do y = 1 to 4;
if cu(x) = ps(y) then do;
if x = 1 then cv1 = cu(2); else
if x = 2 then cv1 = cu(1); else
if x = 3 then cv4 = cu(4); else
if x = 4 then cv4 = cu(3);

if y = 1 then cv3 = ps(2); else
if y = 2 then cv3 = ps(1); else
if y = 3 then cv2 = ps(4); else
if y = 4 then cv2 = ps(3);
end;
end;
end;
end;
if lhs = 2 then do;
cv1 = cu(3);
cv2 = cu(4);
cv3 = ps(3);
cv4 = ps(4);
end;
if rhs = 2 then do;
cv1 = cu(1);
cv2 = cu(2);
cv3 = ps(1);
cv4 = ps(2);
end;
if lhs = 0 & rhs = 0 then do;
if xhs = 1 then do;
do x = 1 to 4;
do y = 1 to 4;
if cu(x) = ps(y) then do;
if x = 1 then cv1 = cu(2); else
if x = 2 then cv1 = cu(1); else
if x = 3 then cv3 = cu(4); else
if x = 4 then cv3 = cu(3);

if y = 1 then cv2 = ps(2); else
if y = 2 then cv2 = ps(1); else
if y = 3 then cv4 = ps(4); else
if y = 4 then cv4 = ps(3);
end;
end;
end;
end;
if xhs = 0 then do;
cv1 = cu(1);
cv2 = cu(2);
cv3 = ps(3);
cv4 = ps(4);
end;
if xhs = 2 then do;
cv1 = cu(3);
cv2 = cu(4);
cv3 = ps(1);
cv4 = ps(2);
end;
end;

end;
end;
end;

/* step 2: if 2 share covs is found, construct IM VT */
if share = 2 then do;
if cv1 > cv2 then do;
%_switch(cv1,cv2);
end;
if cv3 > cv4 then do;
%_switch(cv3,cv4);
end;

if cv1 > cv3 then do;
%_switch(cv1,cv3);
%_switch(cv2,cv4);
end;

/* step 3: compare 4 covs from i+1 to last */
do cp = i+1 to dim(nr);
count = 0;
cp1=a(cp); cp2=b(cp); cp3=c(cp); cp4=d(cp);
array cv (*) cv1 cv2 cv3 cv4;
array af (*) cp1 cp2 cp3 cp4;
do m = 1 to 4;
do n = 1 to 4;
if cv(m) = af(n) then count = count+1;
if count = 4 then do;
if im(cp) ne 1 then do s=i+1 to dim(nr);
if im(s) ne 1 then do;
%_switch(a(s),a(cp));
%_switch(b(s),b(cp));
%_switch(c(s),c(cp));
%_switch(d(s),d(cp));
%_switch(e(s),e(cp));
im(s)=1;
go to exit1;
end;
end;
end;
end;
end;
end;
end;
exit1:
end;
end;
end;

do i=1 to &eqs;
cov1 = a(i);
cov2 = b(i);
cov3 = c(i);
cov4 = d(i);
id = e(i);
nr_ = nr(i);
match= 1;
keep id match nr_ cov1 - cov4;
output;
end;
proc sort; by id;

data cta;
nrvt (keep = cov1 - cov4 id match nr_);
by id;
cov1b = mod(cov1,1000); cov1a = (cov1-cov1b)/1000;
cov2b = mod(cov2,1000); cov2a = (cov2-cov2b)/1000;
cov3b = mod(cov3,1000); cov3a = (cov3-cov3b)/1000;
cov4b = mod(cov4,1000); cov4a = (cov4-cov4b)/1000;
if nr_ = 1; /* keep only nonredundant VT */
nr+1;
call symput('nre',left(nr)); /* create macro variable &nre */

proc print noobs;

data covs;
set cta;
keep cov;
cov = cov1; output;
cov = cov2; output;
cov = cov3; output;
cov = cov4; output;
proc sort; by cov;

data nrc; /* nonredundant covariances */
set covs; by cov;
if first.cov;
cov_b = mod(cov,1000); cov_a = (cov-cov_b)/1000;
nc+1;
call symput('nrc',left(nc)); /* &nc = # cov */

*................... Distribution Free Estimator ...............*;
%if %upcase(&AC) = DFAC %then %do;
data nrc1rec;
set nrc;
retain ca1 - ca&nrc
cb1 - cb&nrc;
array ca (&nrc);
array cb (&nrc);
ca(_n_) = cov_a;
cb(_n_) = cov_b;
match = 1;
if _n_ = &nrc then output;
keep match ca1 - ca&nrc cb1 - cb&nrc;

data dfac; /* distribution free AC */
merge ctrdata nrc1rec; by match;
%let nac = %eval(&nrc **2); /* # AC elements */
array v (&k) &vars;
array ca (&nrc);
array cb (&nrc);
array efgh(&nrc,&nrc);
array cvab(&nrc);

do i = 1 to &nrc;
cvab(i) = v(ca(i))*v(cb(i));
do j = 1 to i;
efgh(i,j) = v(ca(i))*v(cb(i))*v(ca(j))*v(cb(j));
efgh(j,i) = efgh(i,j);
end;
end;
keep efgh1 - efgh&nac cvab1 - cvab&nrc;

proc means data=dfac noprint mean;
var efgh1 - efgh&nac cvab1 - cvab&nrc;
output out=meanout mean=;
data dfac2; set meanout;
array efgh(&nrc,&nrc);
array cvab(&nrc);
array dfac(&nrc);

do i = 1 to &nrc;
do j = 1 to &nrc;
dfac(j) = efgh(i,j) - cvab(i)*cvab(j);
end;
keep dfac1 - dfac&nrc;
output;
end;
%end;

*................... Construct CTA Test ........................*;
proc iml;
start cta;

use matx;
read all into s var _all_;
close matx;

use cta;
read all into nrvt var {cov1 cov2 cov3 cov4};
var {cov1a cov1b cov2a cov2b cov3a cov3b cov4a cov4b};
read all into td var {residual};
close cta;

use nrc;
read all into nrc var {cov};
read all into nrcs var {cov_a cov_b};
close nrc;

/* construct derivative matrix: d */
d=j(&nrc,&nre,0);
do r=1 to &nrc;
do c=1 to &nre;
if nrc(|r,1|) = nrvt(|c,1|)
then d(|r,c|) = s(| covs(|c,3|),covs(|c,4|) |);
if nrc(|r,1|) = nrvt(|c,2|)
then d(|r,c|) = s(| covs(|c,1|),covs(|c,2|) |);
if nrc(|r,1|) = nrvt(|c,3|)
then d(|r,c|) = - s(| covs(|c,7|),covs(|c,8|) |);
if nrc(|r,1|) = nrvt(|c,4|)
then d(|r,c|) = - s(| covs(|c,5|),covs(|c,6|) |);
end;
end;

/* construct asymptotic cov matrix: ac */
%if %upcase(&AC) = DFAC %then %do;
/* distribution free AC */
use dfac2;
read all into ac var _all_;
close dfac2;
mtype = ' ';
%end;

%else %do;
/* normal distribution */
ac=j(&nrc,&nrc);
do i=1 to &nrc;
do j=1 to &nrc;
e=nrcs(|i,1|);
f=nrcs(|i,2|);
g=nrcs(|j,1|);
h=nrcs(|j,2|);
if diag(s) = i(&k) then do;
mtype = 'Matrix Used: Correlation Matrix';
ac(|i,j|)
=(1/2)
* (s(|e,f|)*s(|g,h|))
* (s(|e,g|)**2 + s(|e,h|)**2 + s(|f,g|)**2
+ s(|f,h|)**2)
+ s(|e,g|)*s(|f,h|) + s(|e,h|)*s(|f,g|)
- s(|e,f|)*(s(|f,g|)*s(|f,h|)+s(|e,g|)*s(|e,h|))
- s(|g,h|)*(s(|f,g|)*s(|e,g|)+s(|f,h|)*s(|e,h|));
end;
else do;
mtype = 'Matrix Used: Covariance Matrix ';
ac(|i,j|)=s(|e,g|)*s(|f,h|) + s(|e,h|)*s(|f,g|);
end;
end;
end;
%end;

dacd=d`*ac*d;

df=nrow(dacd);
chi=&n * td` * inv(dacd) * td;
prob=1-probchi(chi,df);

title2 'Test Results';
print 'Matrix Used for the Test';
print S;
print chi (|format=8.2|)
df (|format=8.0|)
prob(|format=8.4|);

finish;
run cta;

%end; /* end of &EXEC control */
%mend cta;
Super User
Posts: 5,824

Re: CTA SAS macro

There is a problem with line feeds in your post, which will make your code nearly impossible to understand. Even if I could, your question is too vague and the code too complex. Try to make your question more specified, and narrow down the code to more generic, and focused on your problem.

/Linus
Data never sleeps
N/A
Posts: 0

CTA SAS macro

I am trying to get output using Covariance matrix and the macro. The macro defined as
%macro cta(data=, cmatrix=, vars=, n=,
keept=, dropt=, sort=, exec=, ac=);
where as my input matrix has no mention of them.

http://www.cuhk.edu.hk/soc/ting/CTA-SAS2.MAC

And my input matrix :
%CTA-SAS2(SAMPMAT1 =
1

0.564 1

0.531 0.496 1

0.466 0.436 0.449 1

0.460 0.429 0.662 0.582 1,

N = 134, vars = 5, nesttest = 0, pchor = 0, lisrel = 0, mplus = 0, lowdiag=1); Message was edited by: Varsha
Super User
Posts: 5,824

Re: CTA SAS macro

This forum couldn't possible be the right place for getting help on how to use/modify an extensive macro like that.
If this is not a SAS Institute created macro, I suggest that you make contact with person who did.

/Linus
Data never sleeps
Frequent Learner
Posts: 1

Re: CTA SAS macro

Dear professor, could u give me the macro CTA-SAS? I m a doctoral student from China, cause the website they give are not connected. And this macro is very important to my research. Thanks
SAS Super FREQ
Posts: 9,253