truncreg.ado

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

*! version 1.4.2  17mar2005
program define truncreg, eclass byable(onecall)
	if _by() {
		local BY `"by `_byvars'`_byrc0':"'
	}
	`BY' _vce_parserun truncreg, jkopts(eclass) : `0'
	if "`s(exit)'" != "" {
		exit
	}

	version 7, missing

	if replay() {
		if "`e(cmd)'" != "truncreg" { error 301 } 
		if _by() { error 190 }
		Replay `0'
         }
	else {
		`BY' Estimate `0'
	}
	mac drop TRUNCREG_*
end

program define Estimate, eclass byable(recall)
	syntax [varlist(ts) ] [aweight fweight pweight] [if] [in]  /*
		 */ [, LL(string) UL(string) /*
		 */ noCONstant noLOg OFFset(varname numeric)/*
		 */ Marginal   AT(string) noSKIP SCore(string) /*
		 */  Robust CLuster(varname) Level(passthru) * ]
	if _by() {
		_byoptnotallowed score() `"`score'"'
	}
	mlopts mlopts, `options'
        if "`cluster'"~="" {
		 local clopt "cluster(`cluster')"
        }
	if ("`marginal'"=="") & (`"`at'"' ~= "") {
		local marginal "marginal"
        }			
	if ("`marginal'"!="") {
		if ("`ll'" != "") {
			cap confirm number `ll'
			if _rc {
				dis as err  /*
		*/ "limits are variables, cannot calculate marginal effects"
				exit 198
			}
		}
		if ("`ul'" != "") {
			cap confirm number `ul'
			if _rc {
				dis as err  /*
		*/ "limits are variables, cannot calculate marginal effects"
				exit 198
			}
		}
	}
	if "`offset'" != "" { local offopt "offset(`offset')" }
	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 
			local n 
		}
		tokenize `score' 
		if "`2'" == "" | "`3'" != "" {
			di as err /* 
			*/ "number of variables in score() option must be 2"
			exit 198
		}
		confirm new var `1'
		confirm new var `2'
		local scopt "score(`score')" 
	}
	if "`skip'" != "" {
                if "`robust'" != "" {
			di as txt /*
*/ "(options skip and robust inappropriate together -- skip ignored)"

	*/ "model LR test inappropriate with robust covariance estimates"
                        local skip
                }
                if "`constant'" != "" {
			di as txt /* 
*/ "(options skip and noconstant inappropriate together -- skip ignored)"
                        local skip
                }
        }
	if "`log'" != "" {
		local showlog	qui
	}
	else local showlog noi	 
                                 
	tokenize `varlist'
	local lhs "`1'"
	tsunab lhs : `lhs'
	mac shift
	local rhs "`*'"

	if "`constant'" != "" & `"`rhs'"' == "" {
di as err "independent variables required with noconstant option"
		exit 100
	}
					  /* define estimation sample */
	quietly {
	        marksample touse	
		markout `touse' `lhs' `rhs' `cluster' `wvar' `offset', strok
		count if `touse'==1
		scalar N_b= r(N)
					/* case 1, left truncated */ 
		if "`ll'" ~= "" {
		        replace `touse' = 0 if `lhs' <= `ll'
			capture confirm number `ll'
			if  _rc != 0 {
				replace `touse' = 0 if `ll'>=.
			}
			global TRUNCREG_a "`ll'"
			global TRUNCREG_flag 1
                }
					/* case -1, right truncated */
		if "`ul'" ~= "" {
			replace `touse' = 0 if `lhs' >= `ul'
			capture confirm number `ul'
			if _rc != 0 {
				replace `touse' = 0 if `ul'>= .
			}
			global TRUNCREG_b "`ul'"
			global TRUNCREG_flag -1
                }
					/* case 0, between        */
		if ("`ul'" ~="") & ("`ll'"~="") {
			global TRUNCREG_flag 0
                }
					/* case 2, regression     */
		if ("`ul'"=="") & ("`ll'"=="") {
			global TRUNCREG_flag 2
		}
		count if `touse'==1
		scalar N_a=r(N)
	 } 
                                          /* handle weights          */
         if "`weight'"~= "" {
	        tempvar wvar
	        qui gen double `wvar' `exp' if `touse' 
	        local weight "[`weight'`exp']"
                } 
	 _rmcoll `rhs' `weight' if `touse'
	 local rhs `r(varlist)'
	 di as txt "(note: " N_b - N_a " obs. truncated)"
                                 	/* get initial values       */
         if "`weight'" ~= "" {
         	qui reg `lhs' `rhs' `weight' if `touse', `constant'
         }
	 else 	qui reg `lhs' `rhs' if `touse', `constant'
	 tempname b0 c0
	 mat `b0'=e(b), e(rmse)
	 mat `c0' = `b0'[1,colsof(`b0')-1..colsof(`b0')]
	 local lhsn : subinstr local lhs "." "_"
					/* call ml model            */
	 if "`skip'" == "noskip" {
				/* constant only model */
	 	`showlog' di
         	`showlog' di as txt "Fitting constant-only model:"
	 	local continu continue
	 	`showlog' ml model lf trunc_ll (`lhsn':`lhs'=, `offopt') /*
		*/ /sigma `weight' if `touse', search(off) /*
		*/ `robust' `clopt' nooutput max miss /*
		*/ init(`c0',copy) 
	 }
	`showlog' di
        `showlog' di as txt "Fitting full model:"
	 ml model lf trunc_ll (`lhs'=`rhs', `constant' `offopt') /*
		 */ /sigma    /*
		 */ `weight' if `touse', max miss init(`b0', copy) `continu' /*
		 */ search(off) nopreserve `mlopts' `log'  `scopt'/* 
		 */ `robust' `clopt' title("Truncated regression" )
	 tempname b
	 mat `b' = get(_b)
	 est scalar N_bf=N_b
	 est scalar sigma =`b'[1,colsof(`b')]
         est local cmd "truncreg"
	 est local predict "truncr_p"
	 est local k
	 est local k_eq
	 est local k_dv
	 if $TRUNCREG_flag == 1 {
		est local llopt $TRUNCREG_a
         }
	 if $TRUNCREG_flag == -1 {
		est local ulopt $TRUNCREG_b
         }
	 if $TRUNCREG_flag == 0 {
		est local llopt $TRUNCREG_a
		est local ulopt $TRUNCREG_b
         }
		/* get mean matrix and check for dummies  */

	 if `"`rhs'"' == "" { 
		Replay, `level'	`marginal'
		exit
	 }
		
	 tempname A M dum
	 qui mat ac `A'= `rhs' `weight' if `touse',   /*
	  	*/ noc means(`M')

	 matrix `dum' = `M'    /* preserve stripe info */
	 local i 0
	 foreach v of varlist `rhs' {
		local ++i
		capture assert `v' == 0 | `v' == 1 if `touse'
		matrix `dum'[1,`i'] = (_rc==0)
	 }
	 est mat dummy `dum'
	 est mat means `M'
	 if `"`at'"' ~= "" {
		Replay, `level' `marginal' at(`at')
	 }
	 else {
	 	Replay, `level' `marginal' 
	 }
end

program define Replay
	syntax [, Level(cilevel) Marginal AT(string)]
	if ("`marginal'" =="") & (`"`at'"' ~= "") {
		local marginal "marginal"
	}
	local flag cond("`e(ulopt)'"=="", 1, -1) 
	if `flag'== -1 {
		local flag cond("`e(llopt)'"=="", -1,0)	
	}
	else local flag cond("`e(llopt)'"=="", 2, 1)
	cap confirm var `e(llopt)'
	if _rc {
		local llopt: display %10.0g `e(llopt)'
	}
	else local llopt: display %10s "`e(llopt)'" 
	cap confirm var `e(ulopt)'
	if _rc {
		local ulopt: display %10.0g `e(ulopt)'
	}
	else local ulopt: display %10s "`e(ulopt)'" 

	local crtype = upper(substr(`"`e(crittype)'"',1,1)) + /*
	*/ substr(`"`e(crittype)'"',2,.)
	local crlen = length(`"`crtype'"')
	local crlow = `crlen' - length("Limit:")

	if `e(df_m)' == 0 & "`marginal'" == "marginal" {
		local marginal
		local zwarn 1
	}

	if !missing(e(df_r)) {
		local model _col(57) as txt "F(" ///
			as res %3.0f e(df_m) as txt "," ///
			as res %6.0f e(df_r) as txt ")" _col(71) ///
			"=" as res %7.2f e(F)
		local pvalue _col(57) as txt "Prob > F" _col(71) ///
			"=" as res %7.4f Ftail(e(df_m),e(df_r),e(F))
	}
	else {
		if "`e(chi2type)'" == "" {
			local chitype Wald
		}
		else	local chitype `e(chi2type)'
		local model _col(57) as txt `"`chitype' chi2("' ///
			as res e(df_m) as txt ")" _col(71) ///
			"=" as res %7.2f e(chi2)
		local pvalue _col(57) as txt "Prob > chi2" _col(71) ///
			"=" as res %7.4f chiprob(e(df_m),e(chi2))
	}

	if "`marginal'" =="" {
		di _n as txt `"Truncated regression"'   
		if `flag' == 1 {
			di as txt "Limit:" /*
			*/ as txt %`crlow's "lower" " = " /*
			*/ as res "`llopt'" /*
			*/ as txt _col(57) `"Number of obs ="' /*
			*/ as res %7.0f e(N)
			di as txt %`crlen's "upper" " = " /*
			*/ as res "      +inf" `model'
        	}
		if `flag' == -1 {
			di as txt "Limit:" /*
			*/ as txt %`crlow's "lower" " = " /*