/*  pathsas.txt   */

**********************************************************************
*                                                                    *
*     PATHSAS 1.0                                                    *
*     Program for Analysis of Path Coefficients Using SAS            *
*     C.S. Cramer, T.C. Wehner and S.B. Donaghy                      *
*     November 18, 1997                                              *
*                                                                    *
**********************************************************************


**********************************************************************
*                                                                    *
*     pathsas.sas                                                    *
*     a PATHSAS macro for calulating path coefficients               *
*                                                                    *
*********************************************************************;

%macro analyze(data=, out=);
data data1; set &data;
proc standard data=data1 mean=0 std=1 out=_sdata2;
      by &bylist;
      var &indep &dep0 &dep;
proc reg data=_sdata2 noprint
      outest=_estdep(drop=_model_  _type_  _rmse_  intercep);
      by &bylist;
      model &dep0=&indep;

%if &dep ne %then %do;
proc reg data=_sdata2 noprint
   outest=estindep(drop=_model_  _type_  _rmse_  intercep);
   by &bylist;
   model &dep=&dep0;

data _estind2; set estindep end=eof;
   by &bylist;
   array _r  regc1-regc&nodep;
   retain   regc1-regc&nodep;
  * if first.&bylast then _i_=0;
   _i_+1;
   _r=&dep0;
   if eof then output;
   drop &dep0 &dep _depvar_;
   run;
   %end;

proc corr data=data1  outp=_corr  noprint;
   by &bylist;
   var &indep;
   run;
data _corr; set _corr;
   if _type_='CORR';
   drop _type_;
   run;

data _estdep; set _estdep;
   array _reg &indep;
   array _r2  reg1-reg&noind;
   do over _reg;
     _r2=_reg;
     end;
   drop &indep;
   run;

data _tog;
   if _n_=1 then set _estdep;
   set _corr;
   by &bylist;
   array _dir  &indep;
   array _corr &indep;
   array _r2   reg1-reg&noind;
   _n+1;
   &dep0=0;
   do over _dir;
      if _n=_i_ then _dir= _r2;
         else _dir=_r2*corr;
       &dep0 + _dir;
       end;
   drop _n;
 *  keep &bylist--_name_ &indep  &dep0 _depvar_;
   drop reg1-reg&noind ;
   format &indep &dep0 5.2;
   run;

data _tog2; set _tog;
 *  drop &indep;
   drop _depvar_;

%if &dep ne %then %do;
data _tog2;
   if _n_=1 then set _estind2;
   set _tog;
   by &bylist;
   array _r regc1-regc&nodep;
   array _t &dep;
   do over _r;
      _t=&dep0 * _r;
      end;

   format &dep &dep0 5.2;
   format regc1-regc&nodep 5.2;
   drop regc1-regc&nodep;
*   drop &indep;
   drop _depvar_;
   run;
   %end;

data &out; set _tog2;
   rename _name_= indep;
   run;
%mend analyze;

%macro pathsas(data,indep,dep0,dep,bylist,printreg,printout,corrind,
       corrdep,boot,random=1234501,samples=1000);
    /*
      Parameters to macro are:
      data =name of dataset to analyse
      indep=list of independent variables
      dep0=primary dependent variable - for total correlation
      dep=secondary dependent variables - for total correlation
      bylist=by variable list
      printreg=print regression? ( value is either yes or no)
      printout=print results(direct,indirect effects)?
               (value is either yes or no)
      corrind =print corr. coeff. for independent variables?
               (value is either yes or no)
      corrdep =print corr. coeff. for dependent variables?
               (value is either yes or no)
      boot    =compute bootstrap conf. intervals for total corr.
               variables?
               (value is either yes or no)
      random  =random seed for bootstrap macro
               default seed is 12345
      samples =no. of resamples to do for bootstrap macro
               default should be at least 1000 for 90% confidence
               and greater than 1000 for higher conf. value or if BC
               method is specified.
    */

%local  word printr;
%global noind nodep noby bylast;

  /*  create noind macro variable                               */
  /*  noind is the number of independent variables in &indep    */
  %let noind=0;
  %if &indep ne %then %do;
      %let word=%scan(&indep,1);
      %do %while (&word ne );
          %let noind=%eval(&noind+1);
          %let word=%scan(&indep,&noind+1);
          %end;
      %end;

  /*  create nodep macro variable                           */
  /*  nodep is the number of dependent variables in &dep    */
  %let nodep=0;
  %if &dep ne %then %do;
      %let word=%scan(&dep,1);
      %do %while (&word ne );
          %let nodep=%eval(&nodep+1);
          %let word=%scan(&dep,&nodep+1);
          %end;
      %end;

  /*  create noby  macro variable                            */
  /*  noby is the number of by variables in &bylist          */
  /*  - also creates &by1 &by2 &by3 etc. for the FREQ proc.  */
  /*    to determine the no. of levels for BY variable values*/
  /*  - also creates &bylast(last variable in BY list        */

  %let noby=0;
  %if &bylist ne %then %do;
      %let word=%scan(&bylist,1);
      %do %while (&word ne );
          %let noby=%eval(&noby+1);
          %let by&noby=%scan(&bylist,&noby);
          %let word=%scan(&bylist,&noby+1);
          %end;
      %let bylast=%scan(&bylist,&noby);
      %end;

  /*   create printr macro variable                          */
  /*   printr has a blank value or the value NOPRINT         */
  /*   specifies whether to print regression output or not   */
   %if %upcase(&printreg)=YES %then %let printr=;
      %else %let printr=noprint;

  /*   create new variable _DUMMY if no &bylist is specified */
  %if &bylist eq %then %do;
      %let bylist=_dummy;
      %let noby=%eval(1);
      %let by&noby=%scan(&bylist,&noby);
      %let bylast=%scan(&bylist,&noby);
      %end;

data _data1; set &data;
   %if &bylist eq _dummy %then _dummy=1;;      /* creates _DUMMY */
                                               /* needs 2 ;      */
   keep &bylist &dep0 &dep &indep;
   run;

proc sort data=_data1;
   by &bylist;
proc standard data=_data1 mean=0 std=1 out=_sdata2;
      by &bylist;
      var &indep &dep0 &dep;
   run;

proc reg data=_sdata2  &printr
      outsscp=_sscp(keep=&bylist intercep _type_)
      outest=_estdep(drop=_model_  _type_  _rmse_  intercep);
      by &bylist;
      model &dep0=&indep;
   run;

   /*
   _type_='N' is the number of obs in the dataset;
   nobs, number of obs., is created
   needed for checking that there are enough obs.
   if not, the reg. coeffients are biased, and need to set to
   missing
   */
data _sscp; set _sscp;
   if _type_='N';
   rename intercep=nobs;
   drop _type_;

/*   if no. of obs. is <= the no. of indep. variables, then
     set the regression coeffients to missing           */
data _estdep; merge _sscp _estdep;
   by &bylist;
   array _v &indep;
   _look='no ';
   if nobs<=&noind then do;
      _look='yes';
      do over _v;
         _v=.;
         end;
      end;
   run;

proc print data=_estdep;
   where _look='yes';
   var &bylist nobs;
title3
'The following identification levels do not have enough obs. for
 analysis';
title4 '   and the regression coeffients were set to missing      ';
   run;
title3 ' ' ;

   /*  if no &dep (secondary variables) then skip this part      */
%if &dep ne %then %do;
proc reg data=_sdata2  noprint
   outest=estindep(drop=_model_  _type_  _rmse_  intercep);
   by &bylist;
   model &dep=&dep0;
   run;
   %if %upcase(&printreg)=YES %then
       %str(title3 'Regression coefficients';
            proc print data=estindep(drop=&dep););

data _estind2; set estindep;
   by &bylist;
   array _r  regc1-regc&nodep;
   retain   regc1-regc&nodep;
   if first.&bylast then _i_=0;
   _i_+1;
   _r=&dep0;
   if last.&bylast then do;
      output;
      do over _r;
         _r=.;
         end;
      end;
   drop &dep0 &dep _depvar_;
   run;
   %end;

proc corr data=_data1  outp=_corr  noprint;
   by &bylist;
   var &indep;
   run;
data _corr; set _corr;
   if _type_='CORR';
   drop _type_;
   run;

/*  print corr for indep var. ?  */
title3 'Correlation coefficients for Independent variables';
%if %upcase(&corrind)=YES %then %do;
   %if &bylist eq _dummy %then
       %str(proc print data=_corr(drop=&bylist); format &indep 5.2;
            run;);
   %else %str(proc print data=_corr; format &indep 5.2; run;);
   %end;

/*  print corr for dep var. ?  */
%if %upcase(&corrdep)=YES and &nodep>0 %then %do;
   title3 'Correlation coefficients for dependent variables';
   proc corr data=_data1  outp=_corrdep  noprint;
      by &bylist;
      var &dep0 &dep;
   data _corrdep; set _corrdep;
      if _type_='CORR';
      drop _type_;
   %if &bylist eq _dummy %then %str(
             proc print data=_corrdep(drop=&bylist);
                format &dep0 &dep 5.2;
                run;);
      %else %str(
             proc print data=_corrdep;
                format &dep0 &dep 5.2;
                run;);
   title3 ' ';
   %end;

data _estdep; set _estdep;
   array _reg &indep;
   array _r2  reg1-reg&noind;
   do over _reg;
     _r2=_reg;
     end;
   drop &indep;
   run;

/*   get direct and indirect effects         */
data _tog;
   merge _corr _estdep;
   by &bylist;
   array _dir  &indep;
   array _corr &indep;
   array _r2   reg1-reg&noind;
   if first.&bylast then do;
      _totc=0;
      _n=0;
      end;
   _n+1;
   &dep0=.;
   do over _dir;
      if _n=_i_ then _dir= _r2;
         else _dir=_r2*_corr;
       &dep0 + _dir;
       end;
   drop _n;
   keep &bylist--_name_ &indep  &dep0 _depvar_ nobs;
   format &indep &dep0 5.2;
   run;

data _tog2; set _tog;
   drop _depvar_;

   /*  skip if &dep (secondary variables) do not exist     */
   /*  computes total corr. for secondary variables        */
%if &dep ne %then %do;
data _tog2; merge _tog _estind2; by &bylist;
   array _r regc1-regc&nodep;
   array _t &dep;
   do over _r;
      _t=&dep0 * _r;
      end;
   format &dep &dep0 5.2;
   format regc1-regc&nodep 5.2;
   drop regc1-regc&nodep;
   drop _depvar_;
   run;
   %end;

title3 'Direct Effects, Indirect Effects and Total Correlations';
%if %upcase(&printout)=YES %then %do;
%if &bylist eq _dummy %then %str(proc print data=_tog2(drop=&bylist);
                                  run;);
       %else %str(proc print data=_tog2; run;);
   %end;
title3 ' ';

%if %upcase(&boot)=YES %then %do;
    * %inc 'jackboot.sas';
      proc freq data=_data1;
      tables
           %do i=1 %to &noby;
               &&by&i
               %if &i lt &noby %then *;
               %end;
         / noprint out=_levels;
         run;

      data _null_;
         if 0 then set _levels nobs=total;
         call symput('nlevel',left(put(total,8.)));
         stop;
         run;

      data _out; delete; run;

         %do i=1 %to &nlevel;
             title3 "&i";
             data _one; set _levels;
                  if _n_=&i;
                  drop count percent;
                  run;
             data _sub;
                  merge _data1 _one(in=yes);
                  by &bylist;
                  if yes;

             %boot(data=_sub, samples=&samples,id=indep, chart=0, 
                   print=0,
                   random=&random,stat=&dep0 &dep);
             %bootci(bc, id=indep, print=0 , stat=&dep0 &dep);
                run;

             data _ci;
                set bootci;
             data _ci;
                 if _n_=1 then set _one;
                 set _ci(keep=indep name value alcl aucl confid
                         method n);
                 method=scan(method,2);
                 if not(alcl<=value<=aucl) then check='*';
                    else check=' ';
                 if (alcl<-1) or (aucl>1)  then check='*';
             data _out; set _out _ci;
                run;
                %end;
      title3 'Bootstrap 95% confidence intervals - using BC method';
      title4 "Random Seed= &random";
      title5 "Number of Resamples=&samples";
      proc print data= _out  label split='*';
         %if &bylist eq _dummy %then %str(var indep name alcl value
                                          aucl ;);
             %else %str(var &bylist indep name alcl value aucl  ;);
         label indep='Independent*Variables';
         format alcl aucl 6.2;
         run;
      title3 ' ';
      %end;

proc datasets library=work memtype=data;
  delete
   _CI
   _CORR
   _CORRDEP
   _DATA1
   _ESTDEP
   ESTINDEP
   _ESTIND2
   _LEVELS
   _ONE
   _SDATA2
   _SSCP
   _SUB
   _TOG
   _TOG2
   ;
   run;
   quit;

%mend pathsas;