*! version 1.0.5  8/15/95
*! An enhanced version of Stata's HREG. In addition to doing all that
*! HREG does, HREG2SLS applies Huber/White corrections to Two-Stage
*! Least-Squares Estimates. This is Version 5 of HREG2SLS, dated 8/15/95.
*! It is based on Version 3.04 of HREG (dated 01/18/94).  Authors are
*! Mead Over and Dean Joliffe of the World Bank and Andrew Foster of the
*! University of Pennsylvania.  We wish to thank James Hardin of
*! Stata Corp. for his assistance.

program define hreg2sls
        version 4.0
        if "`1'"=="" | substr("`1'",1,1)=="," {  /* Just replay previous results. */
                if ("$S_E_cmd"!="hreg2sls") { error 301 }
                local options "Level(integer $S_level)"
                parse "`*'"
        }
        else {
                parse "`*'", parse(" ,")
                                        /* Parse out varlists */
                capture noisily doparse `*'

                                        /* Perform new estimation. */
                local varlist "req ex"
                local in "opt"
                local if "opt"
                local options "Group(string) Level(integer $S_level) *"
                local weight "fweight aweight pweight iweight"

                                        /* Check for syntax errors. */
                parse "`*'"

                local varlist "$S_dv$S_ind"
                local iv      "$S_ivl"

                tempvar  yr ys touse
                tempname xxzz zz zx zxc gm gmi xhi

                mark `touse' [`weight'`exp'] `if' `in'
                markout `touse' `varlist' `group' `iv'
                if ("`group'"!="") {
                        sort `group'
                        local grs "group(`group')"
                }
                if ("`exp'"!="") {
                        local wt "[aw`exp']"
                }

                preserve
                cap assert `touse'
                if _rc {
                        qui keep if `touse'
                }
                                /* Perform OLS in preparation for _huber. */
                if "`iv'" == "" {
                        qui reg `varlist' `wt', `options'
                        qui predict `yr' , resid
                }
                                /* Perform 2SLS in preparation for _huber. */
                else {
                        local ivsign "(2SLS)"
                        local zv `iv'
                        parse "`varlist'", parse(" ")
                        local yv `1'
                        macro shift
                        local xv "`*'"

                                /* First perform 2SLS. */
                        qui reg `yv' `xv' ( `iv' ) `wt', `options'

                                /* And save residuals. */
                        qui predict `yr' , resid

                        local nx: word count `xv'
                        local nz: word count `zv'
                        local nx1=`nx'+1
                        local nc=`nx'+`nz'+1

                        mat accum `xxzz'= `xv' `zv'
                        mat `xxzz'=`xxzz'/_N
                        mat `zz'=`xxzz'[`nx1'...,`nx1'...]
                        mat `zz'=syminv(`zz')
                        mat `zx'=`xxzz'[`nx1'...,1..`nx']
                        mat `zxc'=`xxzz'[`nx1'...,`nc']
                        mat `zx'=`zx'~`zxc'

                                /* Re-estimate the coefficients of the
                                   1st stage regressions. */
                        mat `gm'=`zz'*`zx'

                                /* This loop replaces each independent variable
                                   by its predicted value from its own first
                                   stage regression.  This temporarily changes
                                   the data.  However, the preserve command
                                   above guarantees that the original data will
                                   be restored when this program terminates.*/
                        qui   while "`1'"~="" {
                                mat `gmi'=`gm'[.,"`1'"]
                                mat `gmi'=`gmi''
                                capture drop `xhi'
                                mat score `xhi'=`gmi'
                                recast float `1'
                                replace `1'=`xhi'
                                macro shift
                        }
                                /* Replay regress command to retrieve
                                   _result's. */
                        qui reg
                }
                if _result(1)==0 | _result(1)==. { error 2000 }
                local nobs=_result(1)
                local mdf=_result(3)
                local tdf=_result(5)
                local r2=_result(7)
                local ar2=_result(8)
                local rmse=_result(9)
                qui gen byte `ys' = 1
                qui _huber `yr' `ys', `grs' level(`level'), [`weight'`exp']

                                /* Do White/Huber correction. */
                global S_E_cmd  "hreg2sls"
                global S_E_grs  "`grs'"
                global S_E_dv   "`1'"
                global S_E_depv "`1'"
                global S_E_nobs `nobs'
                global S_E_tdf  `tdf'
                global S_E_mdf  `mdf'
                global S_E_r2   `r2'
                global S_E_ar2  `ar2'
                global S_E_rmse `rmse'
        }
        if "$S_E_grs"=="" { local addline "_n" }
        #delimit ;
        di _n in gr "Regression with Huber standard errors " "`ivsign'"
                _col(53) "Number of obs    =" in yel %8.0f $S_E_nobs _n
                _col(53) in gre "R-square         ="
                in yel %8.4f $S_E_r2 _n
                _col(53) in gr "Adj R-square     ="
                in yel %8.4f $S_E_ar2 _n
                _col(53) in gr "Root MSE         ="
                in yel %8.0g $S_E_rmse `addline'  ;
        #delimit cr
                                /* Replay the _huber results previously
                                   calculated. */
        _huber, level(`level') $S_E_grs
end

program define doparse
        unabbrev "`1'"
        global S_dv "$S_1"
        mac shift 1

        global S_ivl
        global S_ind
        IfEndTrm "`1'"
        while $S_1==0 {
                if substr("`1'",1,1)=="(" {
                        local list
                        while substr("`1'",-1,1)!=")" {
                                if "`1'"=="" {
                                        di in red "varlist invalid"
                                        exit 198
                                }
                                local list "`list' `1'"
                                mac shift
                        }
                        local list "`list' `1'"
                        unabbrev `list'
                        global S_ivl "$S_1"
                }
                else {
                        unabbrev `1'
                        global S_ind "$S_ind $S_1"
                }

                mac shift
                IfEndTrm "`1'"
        }
end

program define IfEndTrm
        global S_1 1
        if "`1'"=="," | "`1'"=="in" | "`1'"=="if" | "`1'"=="" { exit }
        if substr("`1'",1,1)=="[" { exit }
        global S_1 0
end