heckman.ado

是一个经济学管理应用软件 很难找的 但是经济学学生又必须用到

*! version 2.8.6  31jan2005
program define heckman, eclass byable(onecall) prop(svyb svyj svyr ml_score)
	if _by() {
		local BY `"by `_byvars'`_byrc0':"'
	}
	`BY' _vce_parserun heckman : `0'
	if "`s(exit)'" != "" {
		exit
	}

	version 6.0, missing

	if replay() {
		if "`e(cmd)'" != "heckman" { error 301 }
		if _by() { error 190 }
		if "`e(method)'" == "two-step" {
			Display2 `0'
		}
		else    Display `0'
		exit
	}

	if _caller() < 6.0 {
		if _by() { error 190 }
		local vers = string(_caller())
		version 5, missing
	}
	`BY' Estimate `0'
end

program define Estimate, eclass byable(recall)
	version 6, missing	/* do not delete */
	if _caller() < 6.0 { 
		Parse50 `0' 
		local rhometh 0
	}
	else {
					/* Allow = after depvar */

		gettoken dep 0 : 0 , parse(" =,[")
		tsunab dep: `dep'
		local tsnm = cond( match("`dep'", "*.*"),		/*
				*/ substr("`dep'",			/*
				*/        (index("`dep'",".")+1),.),	/*
				*/ "`dep'")
		confirm variable `tsnm'
		local depn : subinstr local dep "." "_"
		gettoken equals rest : 0 , parse(" =")
		if "`equals'" == "=" { local 0 `"`rest'"' }

					/* Primary syntax */
		syntax [varlist(default=none ts)] [if] [in] [pw fw iw aw] /*
			*/ , SELect(string)    [ BRACKET CLuster(varname) /*
			*/ noCOEF  noConstant FIRst FROM(string) 	  /*
			*/ FROM0(string) Level(cilevel) noHEADer 	  /*
			*/ noLOg Mills(string) MLMethod(string) 	  /*
			*/ MLOpts(string) NShazard(string) 		  /*
			*/ OFFset(varname numeric) Robust		  /*
			*/ RHOForce RHOLimited RHOSigma RHOTrunc 	  /*
			*/ SCore(string) noSKIP TECHnique(string) TWOstep /*
			*/ CRITTYPE(passthru) * ]

		if _by() {
			_byoptnotallowed score() `"`score'"'
			_byoptnotallowed nshazard() `"`nshazar'"'
			_byoptnotallowed mills() "`mills'"'
		}

					/* Set up command options. */

					/* method for rho outside -1,1 */
		local ct : word count `rhotrunc' `rholimited' `rhosigmafix' /*
			*/ `rhoforce'
		if `ct' > 1 {
			di in red "options rhotrunc, rhoforce, rholimited" /*
				*/ ", and rhosigma, are mutually exclusive"
			exit 198
		}
		if "`rhoforce'" != "" {
			local rhometh 0
		}
		else if "`rhotrunc'" != "" {
			local rhometh 1
		}
		else if "`rholimited'" != "" {
			local rhometh 3
		}
		else {				/* rhosigma is default */
			local rhometh 2		
			local rhosigm "rhosigma"
		}

		if "`score'" != "" { 
			local n : word count `score'
			if `n'==1 & substr("`score'",-1,1)=="*" { 
				local score = /*
				*/ substr("`score'",1,length("`score'")-1)
				local score `score'1 `score'2 `score'3 `score'4
				local n
			}
		}

		if "`nshazard'" != "" & "`mills'" != "" {
			di in blu /*
			*/ "note: options nshazard() and mills() are synonyms;"
			di in blu /*
			*/ "      using nshazard() and ignoring mills()"
		}

		if "`nshazard'" != "" { local mills `nshazard' }

		local ind `varlist'

		local if0 `if'          /* Required with second -syntax- */
		local in0 `in'
		local option0 `options'
		local nc `constan'
		local off `offset'
		if "`offset'" != "" { local offopt "offset(`offset')" }

		local wtype `weight'
		local wtexp `"`exp'"'
		if "`weight'" != "" { local wgt `"[`weight'`exp']"' }

		if "`weight'" == "pweight" | "`cluster'" != "" { 
			local robust robust
		}
		if "`cluster'" != "" { local clusopt "cluster(`cluster')" }
		if "`skip'" != "" {
			if "`robust'" != "" {
di in blue "model LR test inappropriate with robust covariance estimates"
				local skip
			}
			if "`constan'" != "" {
di in blue "model LR test inappropriate with noconstant option"
				local skip
			}
			if "`ind'" == "" {
di in blue "model LR test inappropriate with constant-only model"
				local skip
			}
			if "`twostep'" != "" {
di in blue "model LR test inappropriate for two-step model"
				local skip
			}
			if "`skip'" == "" {
				di in blue "    performing Wald test instead"
			}
		}

		if "`log'" == "" {
			local showlog noisily
		} 
		else    local showlog quietly

		if "`mlmethod'" == "" { local mlmetho d2 }
		if "`mlmethod'" == "d0" {
			if "`techniq'" == "" {
				local techniq "technique(nr)"
			}
			else	local techniq "technique(`techniq')"
		}
		else if "`techniq'" != "" {
di in blue "note: technique() only allowed with mlmethod(d0); option ignored"
			local techniq
		}

		if "`mills'" != "" { confirm new var `mills' }

					/* Setup temporary scorevars */
		if "`score'" != "" {
			local numscr : word count `score'
			if `numscr' != 4 {
di in red "number of variables in score() option must be 4"
				exit 198
			}
			confirm new var `score'
			tempvar sc1 sc2 sc3 sc4
			local scoreml "score(`sc1' `sc2' `sc3' `sc4')"
		}

				/* Process selection equation */

					/* Set up selection depvar */

		tokenize `"`select'"', parse(" =")
		if "`1'" == "=" { local 1 " " }
		if "`2'" == "=" { 
			capture tsunab 1 : `1' 
			local seldep `1'
			local seldepn : subinstr local seldep "." "_"
			local 1 " " 
			local 2 " " 
		}

		local 0 `*'
		syntax varlist(default=none ts) [, noConstant   /*
			*/ OFFset(varname numeric) ]
		local selind `varlist'

					/* Set up selection eq options. */
		local selnc `constan'
		local seloff `offset'
		if "`seloff'" != "" { local seloffo "offset(`offset')" }

				/* End process selection equation */
	}

					/* Parse ML options */
	mlopts stdopts, `option0'
	local cns `s(constraints)'

					/* Ensure valid selection eqn */
	if "`selnc'" != "" & "`selind'" == "" { 
		noi di in red "no variables specified for selection"
		exit 198
	}
					/* Ensure valid main eqn */
	if "`nc'" != "" & "`ind'" == "" { 
noi di in red "must specify variables or allow constant for primary equation"
		exit 198
	}

					/* Set observed/selected variable. */
	if "`seldep'" == "" { 
		tempname seldep
		qui gen byte `seldep' =  `dep' < . 
		local selname select
	}
	else  local selname `seldepn'

					/* Define sample.
					 * Best left here w/ Parse50 */
	tempvar touse rtouse
	mark `touse' `if0' `in0' `wgt'
	markout `touse' `seldep' `selind' `seloff' `cluster', strok

	qui gen byte `rtouse' = `touse'
	markout `rtouse' `dep' `ind' `off'
	qui replace `touse' = 0  if `seldep' & !`rtouse'

					/* Remove collinearity */
	_rmcoll `selind' if `touse', `selnc'
	local selind "`r(varlist)'"
	_rmdcoll `dep' `ind' if `touse' & `seldep', `nc'
	local ind "`r(varlist)'"

					/* Check selection condition */
	qui sum `seldep' if `touse'
	if `r(N)' == `r(sum)' {
di in red "Dependent variable never censored due to selection: "
di in red "model would simplify to OLS regression"
		/* regress `dep' `ind' `wgt' if `touse' */
		exit 498
	}

					/* Fetch initial values */
	if "`twostep'" == "" {
					/* Constant only model */
		if "`skip'" != "" & "`from0'" == "" {
			tempname b0
			GetIval "`dep'" "" "`nc'" "`selind'" "`selnc'" `b0' /*
				*/ "`wgt'" "`wtype'" "`wtexp'" `touse'      /*
				*/ `seldep' "`off'" "`seloffo'" "`rhometh'"
			local from0 "`b0', copy"
		}
					/* Full model.
					 * Starting values and comparison LL */
		tempname b regll prbll
		GetIval "`dep'" "`ind'" "`nc'" "`selind'" "`selnc'" /*
			*/ `b' "`wgt'" "`wtype'" "`wtexp'"          /*
			*/ `touse' `seldep' "`off'" "`seloffo'"     /*
			*/ "`rhometh'" "`twostep'" "`first'"
		scalar `regll' = r(regll)
		scalar `prbll' = r(prbll)
		if "`from'" == "" { local from "`b', copy" }
	}
	else {
		if `"`stdopts'"' != "" {
			// mlopts are not allowed with -twostep-
			local 0 `", `stdopts'"'
			syntax [, NOOPTION ]
			error 198		// [sic]
		}
					/* Do heckman's two-step procedure */

		if "`off'`seloff'`robust'`score'`cluster'`wgt'" != "" {
			di in red "weights, offset(), robust, score(), and cluster()"
			di in red "      not allowed with the two-step option"
			exit 198
		}
		GetIval "`dep'" "`ind'" "`nc'" "`selind'" "`selnc'" "`b'"    /*
			*/ "" "" "" "`touse'" "`seldep'" "`off'" "`seloffo'" /*
			*/ "`rhometh'" "`twostep'" "`first'" "`mills'"
		Display2 , level(`level')
		if substr("`seldep'",1,2) != "__" {
			est local depvar `dep' `seldep'
		}
		else    est local depvar `dep'
		est local rhometh `rhotrunc'`rhosigmafix'`rhoforce'`rholimited'
		est local method "two-step" 
		est repost, esample(`touse')
		est local cmd "heckman"
		exit					/* EXIT */
	}

	if "`skip'" == "noskip" & "`cns'" == "" {
					/* Fit constant only model */
		`showlog' di
		`showlog' di in green "Fitting constant-only model:"
		ml model `mlmetho' heck_d2                             /*
			*/ (`depn':  `dep' = , `nc' `offopt')          /*
			*/ (select: `seldep' = `selind', `selnc' `seloffo') /*
			*/ /athrho  /lnsigma 	                       /*
			*/ if `touse' `wgt', wald(0)                   /*
			*/ collinear missing max nooutput nopreserve   /*
			*/ init(`from0') search(off) `log' `stdopts'   /*
			*/ `mlopts' `techniq' `bracket' `robust' `crittyp'
		local continu "continue"
		`showlog' di
		`showlog' di in green "Fitting full model:"
	}

					/* Fit full model */
	ml model `mlmetho' heck_d2					/*
	*/ (`depn':   `dep' = `ind', `nc' `offopt')			/*
	*/ (`selname':   `seldep' = `selind', `selnc' `seloffo')	/*
	*/ /athrho /lnsigma						/*
	*/ if `touse' `wgt',						/*
	*/ collinear missing max nooutput nopreserve			/*
	*/ title(Heckman selection model)				/*
	*/ `scoreml' `robust' `clusopt'					/*
	*/ init(`from') search(off) `continu' `log' `stdopts'		/*
	*/ `mlopts' `techniq' `bracket' `crittyp'			/*
	*/ diparm(athrho, tanh label("rho"))				/*
	*/ diparm(lnsigma, exp label("sigma"))				/*
	*/ diparm(athrho lnsigma,					/*
	*/   func(exp(@2)*(exp(@1)-exp(-@1))/(exp(@1)+exp(-@1)) )	/*
	*/   der( exp(@2)*(1-((exp(@1)-exp(-@1))/(exp(@1)+exp(-@1)))^2)	/*
	*/     exp(@2)*(exp(@1)-exp(-@1))/(exp(@1)+exp(-@1)) )		/*
	*/   label("lambda"))						/*
	*/
	ml_s_e
	Reparm

					/* Get Mills' ratio if requested */
	if "`mills'" != "" {
		qui _predict double `mills', eq(#2), if `touse'
		qui replace `mills' = normd(`mills') / normprob(`mills')
		label var `mills' "nonselection hazard"
	}

					/* Handle scores if requested */
	if "`score'" != "" {
		tokenize `score'
		local i 1
		while "``i''" != "" {
			rename `sc`i'' ``i''
			local i = `i' + 1
		}
		est local scorevars `score' 
	}

	tokenize `e(depvar)'
	if substr("`2'", 1, 2) == "__" { est local depvar `1' }
	if "`robust'" != "" {
		est local chi2_ct "Wald"
		qui test [athrho]_b[_cons] = 0
		est scalar chi2_c = r(chi2)
	}
	else {
		est local chi2_ct "LR"
		est scalar chi2_c = 2 * (e(ll) - `regll' - `prbll')
	}
	est scalar p_c = chiprob(1, e(chi2_c))
	if "`wtype'" == "fweight" {
		tempname sumwt
		qui gen double `sumwt'`wtexp'  if `touse' & !`seldep'
		qui replace `sumwt' = sum(`sumwt')
		est scalar N_cens = `sumwt'[_N]
	}
	else {
		qui count if `seldep' == 0 & `touse'
		est scalar N_cens = r(N)
	}
	est scalar k_aux = 2
	est local title2 "(regression model with sample selection)"
	est local method "ml"
	est local predict "heckma_p"
	est local mills `mills' 
	est local cmd "heckman"
	global S_E_cmd "heckman"

	Display , level(`level') `coef' `header'
end


program define Display
	syntax [, Level(cilevel) noCOEF noHEADer ]

	if "`coef'" == "" {
		if "`header'" == ""  { _crcshdr }
		ml display , noheader level(`level') nofootnote

		if "`e(vcetype)'" != "Robust" { 
			local testtyp LR
		}
		else    local testtyp Wald
		di in gr  "`testtyp' test of indep. eqns. (rho = 0):" /*
			*/ _col(38) "chi2(" in ye "1" in gr ") = "   /*
			*/ in ye %8.2f e(chi2_c) 		     /*