nl_7.ado

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

*! version 1.5.3  16may2005
program define nl_7, eclass byable(recall) sort
	version 7, missing
	local options "Level(cilevel)"
	if "`1'"=="" | substr("`1'",1,1)=="," { 
		if "`e(cmd)'"!="nl" { error 301 } 
		if _by() { error 190 }
		syntax [, `options']
		NLout `level'
		exit
	}
	gettoken func 0 : 0
	syntax varlist [if] [in] [aw fw] [, /*
		*/ DELta(real 4e-7) EPS(real 0) Init(string) 		/*
		*/ ITerate(integer 0) LEAve LNlsq(real 1e20) noLOg 	/*
		*/ TRace noDisp `options' robust cluster(varname) hc2 hc3 * ]

	/* In case someone with version 9 calls me with robust VCE, get out */
	if "`robust'" != "" {
		di as txt "robust " as error "not allowed"
		exit 198
	}
	if "`cluster'" != "" {
		di as txt "cluster() " as error "not allowed"
		exit 198
	}
	if "`hc2'" != "" {
		di as txt "hc2 " as error "not allowed"
		exit 198
	}
	if "`hc3'" != "" {
		di as txt "hc3 " as error "not allowed"
		exit 198
	}
	
	tokenize `varlist'
	local yname "`1'"
	mac shift 
	local fargs "`*'"

	marksample touse

	local version : di "version " string(_caller()) ", missing:"

	tempname mnlnwt sumwt meany vary gm2 old_ssr ssr f sstot 

/*
	Obtain information on parameters (returned in S_1)
*/

	/* Following is for version control */
	if "`func'" == "exp2" | "`func'" == "exp2a" | "`func'" == "exp3" | /*
		*/ "`func'" == "log4" | "`func'" == "log3" | /*
		*/ "`func'" == "gom4" | "`func'" == "gom3" {
		local func "`func'_7"
	}

	* The following is a phony set up of an estimation result for 
	* nl`func' on the query call:
	tempvar cpy
	tempname b v 
	mat `b' = (1)
	mat `v' = (0)
	mat rownames `v' = c1
	qui gen byte `cpy' = `touse'
	est post `b' `v', esample(`cpy')

	est local cmd
	est local depvar `"`yname'"'
	est local wtype `"`weight'"'
	est local wexp `"`exp'"'

	/* Double saves in case nl`func' is version 5 */
	global S_E_cmd
	global S_E_depv "`e(depvar)'"
	global S_E_if "if `touse'"
	global S_E_wgt "`e(wtype)'"
	global S_E_exp "`e(wexp)'"


	/* where nl`func' returns its results after query */
	global S_1 /* parameters */
	global S_2 /* title */
	global S_3 /* title 2 */

	/* call nl`func' */
	if _caller() < 7 { 
		local iffor6 "if `touse'"
	}
	capture noi qui `version' nl`func' ? `fargs' `iffor6' , `options'
	local iffor6
	local rc = _rc
	est clear
	if `rc' { 
		di in red "nl`func' refused query, rc=" `rc'
		exit `rc'
	}
	if "$S_2"=="" { 
		local title "(`func')"
	}
	else	local title "$S_2"
	local title2 "$S_3"
	local params "$S_1"

	local np : word count `params'
	if `np' == 0 { 
		di in red "no parameters returned by nl`func'"
		exit 198
	}

	if "`leave'" ~= "" { /* confirm `params' are not currently variables */
		confirm new var `params'
	}

/*
	Parse the init() option
*/
	if "`init'"!="" {
		tokenize `"`init'"', parse(" =,")
		while "`1'"!="" { 
			if "`1'" == "," { mac shift }
			capture confirm number `3'
			if _rc | ("`2'" != "=") {
				di in red "option init() invalid"
				exit 198
			}
			global `1' `3'
			mac shift 3
		}
	}

/*
	setup so that `1', `2', ..., contain the names of the parameters
*/
	tokenize `"`params'"'

/*
		`func' holds the name of the user program that calculates the
		non-linear function value, returning it in argument 1 (S_1).
		A non-zero return code from `func' is trapped, causing nl
		to abort with that return code.

		But nl can be made to exit more gracefully.  If the global 
		macro T_nlferr is specified, then an error in nl\`func' will
		display the message contained in T_nlferr and exit with 498.
		
*/
	local funcerr "error #\`rc' occurred in program nl\`func'"
/*
		If lnlsq(k) is specified y and yhat are effectively (though
		not computationally) transformed to g*ln(y-k) and g*ln(yhat-k)
		where g = geometric_mean(y-k).
*/
	local logtsf 0
	if `lnlsq' < .999e20 { local logtsf 1 }
/*
		iterate is the max iterations allowed.
		eps and tau control parameter convergence, see Gallant p 28.
		delta is a proportional increment for calculating derivatives,
		appropriately modified for very small parameter values.
*/
	local iterate = cond(`iterate'<=0, 10000, `iterate')
	local eps = cond(`eps'<=0, 1e-5, `eps')
	local tau 1e-3

/*
		Set up y-variate (YVAR)
*/
	tempvar YVAR Z tmp dbeta 	/* dbeta for est hold */
	qui gen double `Z' = 0 		/* vlw, double */

/*
	YVAR will contain missing for all unused observations (as will touse)
*/
	qui gen double `YVAR' = `yname' if `touse'

	scalar `mnlnwt' = 0 /* mean log normalized weights */
	qui if `"`exp'"' != "" { 
		tempvar s
		gen double `s' `exp' if `touse'		/* vlw, double */
		sum `s', meanonly 
		noi di in gr "(sum of wgt is " r(N)*r(mean) ")"
		replace `s' = ln(`s'/r(mean))
		sum `s', meanonly
		scalar `mnlnwt' = r(mean)
		drop `s'
		local exp "[`weight'`exp']"
	}
	else {
		qui count if `touse'
		di in gr "(obs = " r(N) ")"
	}
	if "`log'"=="" { di }

	if `logtsf' {
		capture assert (`YVAR'-`lnlsq')>0 if `touse'
		if _rc {
			di in red /*
 */ "nonpositive value(s) among `yname'-`lnlsq', cannot log transform"
			exit 482
		} 
		qui replace `YVAR' = ln(`YVAR'-`lnlsq') if `touse'
	}
	qui count if `touse'
	if r(N) < `np' {
		di in red "cannot have fewer observations than parameters"
		exit 2001
	}
	qui sum `YVAR' `exp' if `touse'
	if r(min) == r(max) {
		di in red "`yname' has zero variance"
		exit 498
	}
	local nobs = round(r(N),1)
	scalar `sumwt' = r(sum_w)
	scalar `meany' = r(mean)
	scalar `vary' = r(Var)
/*
		Initialisations.

		Set up derivative vectors.
*/
	capture noi qui {		/* to handle dropping derivs	*/
		local j 1
		while `j' <= `np' {
			* name is ``j''
			tempvar J`j'
			local Jnames "`Jnames' `J`j''"
			gen double `J`j'' = . 
			local j = `j'+1
		}
		tempvar RESID YHAT YHATi
		gen double `YHAT' = .
		gen double `YHATi' = .
		capture noi qui `version' nl`func' `YHAT' `fargs' , `options'
		if _rc {
			local rc = _rc
			if "$T_nlferr" != "" {
				noi di
				noi di in red "$T_nlferr"
				exit 498
			}
			else {
				noisily di in red "`funcerr'"
			}	
			exit 196
		}
		capture assert `YHAT'<. if `touse'
		if _rc { 
			noi di in red /*
	*/ "starting values invalid or some RHS variables have missing values"
			exit 480
		}
/*
		If a (shifted) log transformation is used, the y-data are
		scaled by g = geom mean(y-k) to make the residual deviances
		comparable between untransformed and log transformed data.
		This is done by scaling the residual and model sums of squares
		and variances by gm2 = g^2.
*/
		if `logtsf' {
			gen double `RESID'=`YVAR'-ln(`YHAT'-`lnlsq') if `touse'
			scalar `gm2' = exp(2*`meany')
			local scaled "(scaled) "
		}
		else {
			gen double `RESID' = `YVAR'-`YHAT' if `touse'
			scalar `gm2' = 1
			local scaled ""
		}
		reg `RESID' `Z' `exp' if `touse', nocons
		scalar `old_ssr' = e(rss)*`gm2'
/*
		Iterative (Gauss-Newton) loop
			old_pj left as local since globals used for betas
*/
		local done 0	/* finished (cnvrgd or out of iters) */
		local its 0	/* current iteration count */
		tempname hest	/* for holding estimation results */
		while ~`done' {
			* Calc partial deriv of func w.r.t. parameters:
			if "`log'" == "" {
				noi di in gr /*
				*/ "Iteration " `its' ":" _c
				if "`trace'"!="" { noi di }
			}
			local j 1
			while `j' <= `np' {
				* name is ``j''
				* value is ${``j''}
				local old_pj = ${``j''}
				if "`trace'" != "" {
					noi di in gr _col(12) "``j'' = " /*
					*/ in ye %9.0g `old_pj'
				}
				local incr = `delta'*(abs(`old_pj')+`delta')
				global ``j'' = `old_pj'+`incr'
				cap `version' nl`func' `YHATi' `fargs' , /*
					*/ `options'
				if _rc {
					local rc = _rc
					if "$T_nlferr" != "" {
						noi di
						noi di in red "$T_nlferr"
						exit 498
					}
					else {
						noi di in red "`funcerr'"
					}	
					exit 196
				}
				cap assert `YHATi'<. if `touse'
				if _rc { 
					noi di in red /*