*! 1.2.0 (Sept 3, 1996) Jeroen Weesie (STB-33: sg60)
*        added -first- 
*        added check of formats, automatic addition of %
*        added display modes -zstb-, -ci- and -mean- support
*        added support for multiple dependent variables
*        specific support for regress,mvreg,mlogit
*        added -lv- 
*  1.1.0 (July 23, 1996) Jeroen Weesie
*        added option -eform-
*  1.0.0 (July 18, 1996) Jeroen Weesie

capt program drop diest
program define diest
    version 4.0
    if "$S_E_cmd"=="" { error 301 }

    local if "opt"
    local in "opt"        
    local weight "fweight aweight"
    #del ;
    local options "Sezp Ci Mean Tdf(str) Level(int $S_level) Eform(str) FIrst 
          lv fb(str) fse(str) fzt(str) fp(str) fci(str) fm(str) fsd(str)" ;
    #del cr    
    parse "`*'"

  * select display mode (sezp, ci, mean)

    if length("`sezp'`ci'`mean'") > 4 {
        di in re "at most one of options sezp, ci, mean permitted"
        exit 198
    }
    if "`ci'"~="" { local dimode "ci" }
    else if "`mean'"~="" { local dimode "mean" }
    else { local dimode "sezp" }  

  * process display formats

    checkfmt `fb' %9.0g
    local fb "$S_1"

    checkfmt `fse' %9.0g
    local fse "$S_1"

    checkfmt `fzt' %7.3f
    local fzt "$S_1"

    checkfmt `fp' %6.3f
    local fp "$S_1"

    checkfmt `fci' %9.0g
    local fci "$S_1"

    checkfmt `fm' %8.0g
    local fm "$S_1"

    checkfmt `fsd' %8.0g
    local fsd "$S_1"

    if `level' < 10 | `level' > 99 { 
        di in re "level must be between 10 and 99"
        exit 198
    }

  * scratch scalars/matrices

    tempname b V bi sei tzi pi lci hci step

  * get b/VCE from last estimates

    mat `b' = get(_b)                   /* estimates */
    mat `V' = get(VCE)                  /* covariance matrix */

    local bnames : colnames(`V')        /* parameter/variable name */ 
    local beq : coleq(`V')              /* equation names */
    local npar : word count `bnames'    /* #-parameters */

  * adaptations due to -inconsistencies- in Stata' internal handling of 
  * estimations commands. Note that I produce side-effects!

    if "$S_E_cmd"=="regress" {          /* save degrees of freedom */ 
        global S_E_tdf = _result(5)
    }    
    else if "$S_E_cmd"=="mlogit" {      /* format of b differs from rest */
        stackrow `b' `b'
    }    
    else if "$S_E_cmd"=="mvreg" {       /* names of dependent variables */
        global S_E_depv = "$S_E_elis"
    }    

  * significance/ci-intervals are based on t- or normal distributions  

    if "`tdf'"=="" { local tdf $S_E_tdf }     /* tdf set by est. command */

    if "`tdf'"=="" | "`tdf'"=="." {           /* normal */
        local tz "z" 
        if "`dimode'"=="ci" { scalar `step' = invnorm(0.5+`level'/200) }
    }
    else { 
        confirm number `tdf'                  /* t */
        local tz "t" 
        if "`dimode'"=="ci" { scalar `step' = invt(`tdf',`level'/100) }
    }       

  * dispay-mode mean: check if sample/weights were set by estimation command

    if "`dimode'"=="mean" {
        if "`if'"=="" & "`in'"=="" { 
            local if "$S_E_if"
            local in "$S_E_in" 
            if "`if'`in'"~="" {
                di in bl "summary stats based on sample `if' `in'"
            }
        }
        if "`weight'"=="" {
            local weight "$S_E_wght"
            local exp    "$S_E_exp"
            if "`weight'"~="" {
                di in bl "summary stats weighted [`weight'`exp']"
            }
        }
    }        

  * display header lines of table 

    di in gr _dup(78) "-"
    * loop over all dependent variables
    local nyvar: word count $S_E_depv    
    if `nyvar' > 0 {
        local i 1
        while `i' <= `nyvar' {    
            local yvar: word `i' of $S_E_depv
            divar `yvar' `lv'
            if `i' < `nyvar' { di }
            local i = `i'+1
       }
    }
    else di _col(42) in gr "|" _c

    * display column headers
    local etext "   Coef. "
    if "`eform'"=="_"  { 
        local etext "Exp Coeff"
    }    
    else if "`eform'"~="" {    
        local etext = substr("`eform'        ",1,9)
    } 

    if "`dimode'"=="sezp" { 
        di in gr " `etext'  Std. Err.     `tz'    P>|`tz'|" 
    }
    else if "`dimode'"=="mean" {
        di in gr " `etext'   P>|`tz'|    Mean   Std Dev" 
    }
    else if "`dimode'"=="ci" {         
        di in gr " `etext'   [`tz' " %2.0f `level' "% Conf. Interval]" 
    }

    di in gr _dup(41) "-" "+" _dup(36) "-"

  * display table of parameter estimates
        
    local i 1
    while `i' <= `npar' {

      * display equation names 

        if "`beq'"~="" {
            local eqname : word `i' of `beq'
            if "`eqname'"~="`eqold'" & "`eqname'" ~= "_" {
                if "`eqold'"~="" { 
                    di in gr _dup(78) "-" 
                    if "`first'"~="" { exit }    
                }
                di in ye "`eqname'" _col(42) in gr "|"
                local eqold "`eqname'"
            }
        }
      
      * display variable name/label
    
        local vname : word `i' of `bnames'
        divar `vname' `lv'

        scalar `bi'  = `b'[1,`i']
        scalar `sei' = sqrt(`V'[`i',`i'])

        if `sei'==0 { 
            di in ye " (dropped)"
        }
        else {

          * se/z/p-format or mean-format

            if "`dimode'"~="ci" {
                scalar `tzi' = `bi'/`sei'
                if "`tz'"=="z" {  scalar `pi' = 2-2*normprob(abs(`tzi')) } 
                else           {  scalar `pi' = tprob(`tdf',`tzi') }
                if "`eform'" ~= "" {
                    scalar `bi'  = exp(`bi')
                    scalar `sei' = `bi'*`sei'  /* se(transf) by linear. */
                }
          
                if "`dimode'"=="sezp" {
                    di in ye _col(2)  `fb'  `bi'   /*
                       */    _col(12) `fse' `sei'  /*
                       */    _col(22) `fzt' `tzi'  /*
                       */    _col(31) `fp'  `pi'
                }
                else {
                    confirm exist var `vname'
                    if ~_rc {        
                        capt qui summ `vname' `if' `in' [`weight'`exp']
                        di in ye _col(2) `fb' `bi' /*
                            */   _col(13) `fp' `pi' /*
                            */   _col(20) `fm' _result(3) /*
                            */   _col(29) `fsd' sqrt(_result(4))
                    }
                    else di in ye _col(2)  `fb'  `bi' /* 
                             */   _col(13) `fp'  `pi' 
                }    
            }

          * ci-format

            else {
                scalar `lci' = `bi' - `step'*`sei'    
                scalar `hci' = `bi' + `step'*`sei'    
                if "`eform'" ~= "" {
                    scalar `bi'  = exp(`bi')
                    scalar `lci' = exp(`lci')
                    scalar `hci' = exp(`hci')
                }                            
                di in ye _col(2)  `fb'  `bi'    /*
                   */    _col(15) `fci' `lci'   /*
                   */    _col(26) `fci' `hci' 
            }
        }
        local i=`i'+1
    }
    di in gr _dup(78) "-"
end        

* syntax: checkfmt %format 
* usage:  checks that %format is a valid numeric format, possibly after 
*         prepending a %. The valid display format is returned in S_1
program define checkfmt
    version 4.0
    if substr("`1'",1,1) ~= "%" { local 1 "%`1'" } 
    capture local difmt : display `1' 1    
    if _rc {
        di in re "invalid numeric %format `1'"
        exit 120
    }
    global S_1 `1'
end

* syntax: stackrow b bnew
* usage: bnew is the row-wise vectorization of b; bnew may overwrite b
program define stackrow
    version 4.0
    local b    `1'
    local bnew `2'
    tempname br bc
    local i 1
    while `i' <= rowsof(`b') {
       matrix `br' = `b'[`i',.]
       matrix `bc' = `bc' , `br'    
       local i= `i'+1
    }
    matrix `bnew' = `bc'
end

* syntax: divar vname lv
* usage: divars displays (varname varlabel) or (varlabel varname) 
program define divar
    version 4.0
    local vname `1'             /* variable name */
    local lv    `2'             /* if non-empty, label should come first */

    local vlabel                /* capture, to prevent error with _cons */
    capture local vlabel : var label `vname'

    if "`lv'"=="" {             /* varname varlabel */
        local ncol = 9-length("`vname'")
        di in gr _col(`ncol') "`vname'" in wh _col(10) "`vlabel'" /*
           */ in gr _col(42) "|" _c
    }
    else {                      /* varlabel varname */
        local ncol = 31-length("`vlabel'")
        di in wh _col(`ncol') "`vlabel'" in gr _col(32) "`vname'" /*
           */ in gr _col(42) "|" _c
   }
end
exit