CTA SAS macro

deleted_user — Wed, 03 Jun 2009 04:42:16 GMT

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);
title1 'Confirmatory Tetrad Analysis';

*................... Macro Functions ...........................*;
%macro _resid(a,b,c,d);
/* tetrad residual */
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);

tetrad = compress('t('||&a||','||&b||','||&c||','||&d||')');
%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;

*................... Tetrad Construction .......................*;
data tetrad; set matx1rec;
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;
var id tetrad residual tvalue;
title2 'List of Tetrads';

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

*................... Model Implied Vanishing Tetrads ...........*;
data mivt;
set tetrad;
/* 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 */

/* sort tetrads */
%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;
title2 'sorted tetrads';
%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;

*................... Remove Redundant Tetrads ..................*;
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;
merge tetrad (keep = id tetrad residual)
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;
var id tetrad residual;
title2 'List of Nonredundant Tetrads';

*................... Covariances in Tetrads ....................*;
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;

/* read data */
use matx;
read all into s var _all_;
close matx;

use cta;
read all into nrvt var {cov1 cov2 cov3 cov4};
read all into covs
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;

Re: CTA SAS macro

LinusH — Wed, 03 Jun 2009 08:55:26 GMT

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

CTA SAS macro

deleted_user — Fri, 05 Jun 2009 06:57:46 GMT

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.

Link to the macro :
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

Re: CTA SAS macro

LinusH — Fri, 05 Jun 2009 15:24:24 GMT

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

Re: CTA SAS macro

Cynthia_sas — Sat, 06 Jun 2009 21:12:21 GMT

Hi:
Possibly reading the documentation, written by the author and published at this UNC site might help:

http://www.unc.edu/~johnhipp/CTANEST1_documentation.doc
http://www.unc.edu/~dbauer/manuscripts/hipp-bauer-bollen-SEM-2005.pdf

cynthia

Re: CTA SAS macro

JLUbussiness — Fri, 06 Oct 2017 05:54:07 GMT

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

topic CTA SAS macro in SAS Programming

CTA SAS macro

Re: CTA SAS macro

CTA SAS macro

Re: CTA SAS macro

Re: CTA SAS macro

Re: CTA SAS macro