***********************************************************************
* WHITE performs White's (1980) test for general heteroskedasticity
*
*  (or, more properly, White's Test Which Has Power Against Alternatives
*   That Affect the Consitency of the Least Squares Covariance Matrix)
*
*
* PROCEDURE WHITE resids start end
* # <suppl. card>
*
*
* RESIDS: the residual series from a regression
* The supplemental card should list all the regressors from the original
*    regression (do NOT, however, include a constant on the list --
*    the test requires one anyway)
*
* OPTIONS
*    PRINT/[NOPRINT]      Print the auxiliary regression results
*    [CROSS]/NOCROSS      Include/Exclude the cross products of
*                           the regressors
*    [LINEAR]/NOLINEAR    Include/Exclude the original regressors
*    LAGS/[NOLAGS]        If you include lags in the regression
*                           and suppl. card, use the LAGS option:
*                           this is due to a problem with getting
*                           the name of a series which is in the
*                           form series{1 to X}.  When I find a
*                           workaround, I shall fix this.
*
* The latter CROSS & LINEAR options are included because as the number of
*    regressors increases, the number of terms in auxiliary regression
*    used to calculated the test statistic can grow very large,
*    possibly exceeding the number of observations.  If this is a problem
*    one might eliminate the linear (nonsquared & noncross-product) terms
*    first.  For k regressors in the original regression, the number of
*    regressors in the auxiliary regression is k+k(k+1)/2
*
*
* References:
*   White, H. 1980: "A Heteroskedasticity-Consistent Covariance
*     Matrix and a Direct Test for Heteroskedasticity"
*     Econometrica, Vol 48: 817-838.
*
* Written 3/95 by
*
*    Norman J. Morin
*    Department of Economics
*    University of California, San Diego
*    nmorin@weber.ucsd.edu
***********************************************************************

PROCEDURE WHITE resids start end

TYPE SERIES resids
TYPE INTEGER start end

OPTION SWITCH  CROSS  1
OPTION SWITCH  LINEAR 1
OPTION SWITCH  PRINT  0
OPTION SWITCH  LAGS   0


LOCAL INDEX        vlist reglist whitedex
LOCAL INTEGER      startl endl neqn ii jj deter nb nr start2 end2 nres
LOCAL SERIES       residssq
LOCAL LABEL        rlabel
LOCAL VECT[series] varlist regvec
LOCAL VECT[labels] vlabel vlabel2
LOCAL RECT         lev
LOCAL REAL         CSTAT

ENTER(varying) reglist

DISP
DISP
DISP "Performing White's Test for Heteroskedasticity on" %Label(resids)
IF CROSS.eq.0.and.linear.eq.1
  DISP '  using the regressors and their squares'
ELSE IF CROSS.eq.1.and.linear.eq.1
  DISP '  using the regressors, their squares, and non-redundant cross-products'
ELSE IF CROSS.eq.1.and.linear.eq.0
  DISP '  using the squared regressors and non-redundant cross-products'
ELSE IF CROSS.eq.0.and.linear.eq.0
  DISP '  using the squared regressors'
DISP



INQUIRE(series=resids) start2>>start end2>>end
IF %defined(start)
   COMPUTE startl = start
ELSE
   COMPUTE startl = start2
IF %defined(end)
   COMPUTE endl = end
ELSE
   COMPUTE endl = end2

MAKE(trans) lev startl endl
# reglist

compute neqn = %rows(lev)

DIM vlabel(neqn)
IF LAGS.eq.0 {
   DO ii = 1,neqn
      COMPUTE vlabel(ii) = %label([series] reglist(ii))
   END DO
   }
ELSE {
   DO ii = 1,neqn
      COMPUTE vlabel(ii) = 'Var#' + ii
   END DO
  }

DIM regvec(neqn)
DO ii = 1,neqn
  SET regvec(ii) startl endl = 0.
  DO jj = startl,endl
    COMPUTE regvec(ii)(jj) = lev(ii,jj-startl+1)
  END DO
END DO

DO jj = 1,neqn
   LABELS regvec(jj) ; #vlabel(jj)
END DO

DIM whitedex(0)

ENTER(varying) whitedex
#whitedex constant

IF LINEAR.eq.1 {
  DO ii = 1,neqn
    ENTER(varying) whitedex
    #whitedex regvec(ii)
  END DO
  }

IF CROSS.eq.0 {
  COMPUTE nres = (linear+1)*neqn
  DIM varlist(neqn) vlabel2(neqn)
  }
ELSE {
  COMPUTE n2 = neqn*(neqn+1)/2
  COMPUTE nres = linear*neqn + n2
  DIM varlist(n2) vlabel2(neqn*n2)
  }


  DO ii = 1,neqn
    DO jj = 1,neqn
      IF ii.eq.jj {
        SET varlist(ii) startl endl = regvec(ii)**2
        COMPUTE vlabel2(ii) = vlabel(ii) + '^2'
        LABELS varlist(ii) ; # vlabel2(ii)
        ENTER(varying) whitedex
        #whitedex varlist(ii)
        }
    END DO
  END DO

IF CROSS.eq.1 {
  COMPUTE count = neqn+1
  DO jj = 1,neqn
    DO ii = 1,neqn
      IF ii.gt.jj {
        SET varlist(count) startl endl = regvec(ii)*regvec(jj)
        COMPUTE vlabel2(count) = vlabel(jj)+'*'+vlabel(ii)
        LABELS varlist(count) ; # vlabel2(count)
        ENTER(varying) whitedex
        #whitedex varlist(count)
        COMPUTE count = count+1
        }
    END DO
  END DO
   }

SET residssq startl endl = resids**2
COMPUTE rlabel = %Label(resids) + '^2'
LABELS residssq ; #rlabel

LINREG(print=print) residssq startl endl
#whitedex

COMPUTE CSTAT = %nobs*%rsquared
CDF(noprint) CHISQR CSTAT nres

DISP
DISP 'The test statistic is distributed as Chi-Squared(' @-1 nres @-1 ')'
DISP '    under the null hypothesis of homoskedasticity'
DISP
DISP '    Test Statistic: '  ####.##### %CDSTAT
DISP '    Significance:   '  ####.##### %SIGNIF
DISP
do jj = 1,%cols(varlist)
  CLEAR whitedex(jj)
end do

END



