ml_5.ado

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

	while (!`conv' & `iter'<`iterate') {
		if (int(`style'/2) & $S_mlsag!=1) {
			/* change Nash's epsilon for derivative calculation */
			global S_mlag = $S_mlag * $S_mlsag
			global S_mlsag = 1
		}
		scalar `add' = 0
		scalar `multipl' = 1
		local   unprod 0
		scalar `bad' = 0 
		mx_marq `i2' `h' `add' `multipl' `bad'
		if (`bad'>0) {
			di in bl "(nonconcave function encountered)"
		}
		local ok 0
		scalar `fbase' = `f`base''
		while (!`ok') {
			matrix `step`try'' = `d`base'' * `i2'
			matrix `b`try'' = `step`try'' + `b`base''
			`method' `b`try'' `f`try'' `d`try'' `hh' , fast(0)
			scalar `ftry'  = `f`try''
			if (`fbase'-`FUZZ'*abs(`fbase')>`ftry' & !`conv') {
				if (`unprod'==0) { 
					di in bl "(unproductive step attempted)"
					local unprod 1
				}
				if (mod(`style',2)==1) { local myfast 1 }
				scalar `bad' = 1
				mx_marq `i2' `h' `add' `multipl' `bad'
			}
			else 	local ok 1
		}
		scalar `ratio' = 1
		local ok 0
		while (!`ok') {
			mat `b`next'' = `step`try'' + `b`try''
			`method' `b`next'' `f`next'' `d`next'' `hh' , fast(0)
			if (`f`next''>`f`try'') {
				scalar `f`try'' = `f`next''
				mat `step`try'' = `b`try''-`b`base''
				mat `b`try'' = `b`next''
			}
			else 	local ok 1 
		}

		/* if the lf values are a, b, and c, 
		   2A = c - 2b + a, B = c - b */

		scalar `ratio' = (2*`f`try''-0.5*`f`next''-1.5*`f`base'')/ /*
				*/ (2*`f`try''-`f`next''-`f`base'')
		if `ratio'<=0 | `ratio'>=2 {
			scalar `ratio' = 1
		}
		mat `step`try'' = `step`try''*`ratio'
		mat `b`try'' = `step`try'' + `b`base''
		if ("`trace'"!="") { mat list `b`try'', nohead nonames noblank }
		/* dont calculate derivatives you dont think you will use */
		`method' `b`try'' `f`try'' `d`try'' `h' , fast(`myfast')
		local myfast 2
/*
		if (`fbase'<=`ftry' & `fbase'>=`ftry'-`ltolera') {
*/
		if abs(`ftry'-`fbase')<`ltolera' {
			local conv 1
			mat `b' = `b`try'' /* Save successful iteration */
		}
		local iter = `iter' + 1
		mat S_mlbest = `b`try''
		di in gr "Iteration " `iter' ":  `fcnlabe' = " in ye %10.0g `f`try''
		local next `base'
		local base `try'
		local try = mod(`base'+1,3)
	}
	if (!`conv') {
		mat `b' = `b`base''
	}
	if (`iterate'>0) { `method' `b' `f' `d0' `h' , fast(2) }
	cap mat `v' = syminv(`h')
	mat rownames `v' = `mycn'
	mat roweq `v' = `mycen'
	mat colnames `v' = `mycn'
	mat coleq `v' = `mycen'
	`method' `b0' `f0' `d0' `h' , lastit
	global S_mlfS
end


*  mx_out:  version 1.0.1  07/17/93
program define mx_out
	version 3.1, missing
	parse "`*'", parse(" ,")
	local cmd `1'
	mac shift
	local options "*"
	parse "`*'"
	if ("`cmd'"!="$S_E_cmd") { error 301 }
	di
	di in gr "$S_E_ttl" _col(53) "Number of obs    =" in yel %8.0f $S_E_nobs
	di _col(53) in gre "Model chi2(" in ye "$S_E_mdf" in gr ")" /*
		*/ _col(70) "=" in yel %8.2f $S_E_chi2
	di _col(53) in gre "Prob > chi2      =" in yel %8.4f chiprob($S_E_mdf,$S_E_chi2)
	di in gre "Log Likelihood =" in yel %15.7f $S_E_ll _c
	if ("$S_E_pr2"!="") { 
		di _col(22) in gr "Pseudo R2        =" /*
			*/ in yel %8.4f $S_E_pr2 _c 
	}
	di _n

	matrix mlout, `options'
end


*  mx_parm:  version 1.0.1  07/17/93
program define mx_parm
	version 3.1, missing
	local vn : colnames(`1')
	local ntok = colnumb(`1',"_cons")
	if (`ntok' < .) {
		local ntok = `ntok' - 1
		tempname d
		mat `d' = `1'[1,1..`ntok']
		global S_1 : colnames(`d')
		global S_2
	}
	else {
		global S_1 : colnames(`1')
		global S_2 nocons
	}
end


*  mx_post:  version 1.0.3  07/17/93
program define mx_post, eclass
	version 3.1, missing
	parse "`*'", parse(" ,")
	local cmd `1'
	mac shift
	local options "LF0(string) PR2 OBs(string) TItle(string) DOF(string)"
	parse "`*'"
	local k : word count $S_mldepn
	if (`k'==1) { local depn "depn($S_mldepn)" }
	if ("`obs'"=="") {
		qui summ $S_mlwgt
		local obs = _result(1)*_result(3)
		if (abs(`obs'-round(`obs',1))<.01) { 
			local obs = round(`obs',1) 
		}
	}
	local tdf .
	if ("`dof'"!="") {
		local tdf `dof'
		local dof(`dof')
	}
	mat post $S_mlmb $S_mlmv $S_mlmc, `depn' `dof' obs(`obs')
	global S_E_tdf `tdf'
capture est scalar df_r = $S_E_tdf
	global S_E_ttl "`title'"
est local title "$S_E_ttl"
	global S_E_depv "$S_mldepn"

	est local depvar $S_E_depv


	global S_E_nobs "`obs'"
capture est scalar N = $S_E_nobs
	if "`lf0'"=="i0" {
		local lf0 "$S_ll0"
	}
	if "`lf0'"!="" {
		global S_E_chi2 = 2 * (scalar($S_mlsf) - `lf0')
	}
	else	global S_E_chi2 .
capture est scalar chi2 = $S_E_chi2
	global S_E_mdf $S_mlmdf
capture est scalar df_m = $S_E_mdf
	global S_E_ll  = scalar($S_mlsf)
capture est scalar ll = $S_E_ll
	global S_E_ll0 = $S_ll0
capture est scalar ll_0 = $S_E_ll0
	if ("`pr2'"!="" & "`lf0'"!="") { 
		global S_E_pr2 = (scalar($S_mlsf) - `lf0')/abs(`lf0') 
	}
	else global S_E_pr2
capture est scalar r2_p = $S_E_pr2
	capture matrix drop S_mlbest
	capture scalar drop $S_mlsf
	global S_E_cmd "`cmd'"
est local cmd "$S_E_cmd"
	ml_5 begin
end


*  mx_q:  verson 1.0.0  06/27/93
program define mx_q
	version 3.1, missing

	di in gr "user-written function:" _col(30) _c
	if "$S_mlfunc"=="" { 
		di in gr "<unknown>"
	}
	else	di in ye "$S_mlfunc"

	di in gr "optimization method:" _col(30) _c
	if "$S_mlmeth"=="mx_lf" { di in ye "lf" }
	else if "$S_mlmeth"=="mx_d0" { di in ye "deriv0" }
	else if "$S_mlmeth"=="mx_d1" { di in ye "deriv1" }
	else if "$S_mlmeth"=="mx_d2" { di in ye "deriv2" }
	else if "$S_mlmeth"=="" { di in gr "<unknown>" }
	else di in ye "$S_mlmeth"

	di in gr "equation names:" _col(30) _c
	if "$S_mleqn"=="" { di in gr "<unknown>" }
	else di in ye "$S_mleqn"

	di in gr "dependent variables:" _col(29) _c
	if "$S_mldepn"=="" { di in gr " <none>" } 
	else di in ye "$S_mldepn"

	di in gr "parameter vector:" _col(30) _c
	if "$S_mlmb"=="" { di in gr "<unknown>" }
	else di in ye "$S_mlmb"

	di in gr "sample-inclusion variable:" _col(30) _c
	if "$S_mlwgt"=="" { di in gr "<unknown>" }
	else di in ye "$S_mlwgt"
end


*  mx_rept:  version 1.0.2 7/19/93
program define mx_rept, eclass
	version 3.1, missing
	if "$S_E_cmd"=="inprogress" {
		mat mlout
		exit
	}
	tempname b f v
	mat `b' = S_mlbest
	global S_mlmb `b'
	mx_mx1 `f' `v' , iter(0)
	mat post `b' `v'
	global S_E_ttl "Unfinished maximization"
est local title "$S_E_ttl"
	global S_E_cmd "inprogress"
est local cmd "$S_E_cmd"
	global S_E_depv "$S_mldepn"
	est local depvar $S_E_depv

	qui summ $S_mlwgt
	local obs = _result(1)*_result(3)
	if (abs(`obs'-round(`obs',1))<.01) { local obs = round(`obs',1) }
	global S_E_nobs "`obs'"
capture est scalar N = $S_E_nobs
	global S_E_chi2 .
capture est scalar S_E_chi2 = .
	global S_E_mdf $S_mlmdf
capture est scalar df_m = $S_E_mdf
	global S_E_ll  = scalar(`f')
capture est scalar ll = $S_E_ll
	global S_E_pr2
capture est scalar r2_p = $S_E_pr2
	mat mlout
end


*  mx_samp:  version 1.0.4  18sep1996
program define mx_samp
	version 3.1, missing
	global S_mlwgt `1'
	capture drop $S_mlwgt
	confirm new var $S_mlwgt
	tempvar touse
	quietly gen byte `touse'=.
	mac shift

	local varlist "req ex"
	local if "opt"
	local in "opt"
	local weight "aweight fweight pweight iweight"
	local options "noAuto"
	parse "`touse' `*'"
	parse "`varlist'", parse(" ")
	mac shift
	local varlist "`*'"
	quietly {
		drop `touse'
		mark `touse' [`weight'`exp'] `if' `in'
		markout `touse' `varlist'
		if "`auto'"=="" {
			parse "$S_mleqn", parse(" ")
			while "`1'"!="" {
				eq ? `1'
				markout `touse' $S_1
				mac shift
			}
		}
		count if `touse'
		if _result(1)==0 { error 2000 } 
		if "`weight'"=="" {
			rename `touse' $S_mlwgt
			exit
		}
		gen double $S_mlwgt `exp'
		replace $S_mlwgt = 0 if !`touse'
		if "`weight'"=="aweight" {
			sum $S_mlwgt if $S_mlwgt>0
			replace $S_mlwgt = $S_mlwgt/_result(3)
		}
	}
end


*  version 1.0.2 07/17/93
program define mx_srch
	version 3.1, missing
	local options "Limits(string) Iterate(integer 5)"
	parse "`*'"
	if ("$S_mlmeth"!="mx_lf") {
		di in red /*
*/ "Search technique not suitable for this style of likelihood function"
		error 499
	}
	if "`limits'"=="" { 
		di in red "limits() required"
		exit 198
	}
	local b $S_mlmb     /* problem definition / starting values */
	local enames : coleq(`b')
	local vnames : colnames(`b')
	local i 1
	local neq 0
	local thiseq : word 1 of `enames'
	local lasteq "***"
	tempname bb thislf bestll
	while ("`thiseq'"!="") {
		if ("`thiseq'"!="`lasteq'") {
			local neq = `neq' + 1
			local eqlist "`eqlist' `thiseq'"
			tempname x`neq'
			mat `bb' = `b'[1,"`thiseq':"]
			mat score float `x`neq'' = `bb'
			local varlist "`varlist' `x`neq''"
			local lasteq `thiseq'
			local k 1
			local v1 : word 1 of `limits'
			local foundit 0
			while ("`v1'"!="" & !`foundit') {
				qui cap conf number `v1'
				if (!_rc) {
					local k = `k' + 1
					if ("`thiseq'"=="_") {
						local llimit "`llimit' `v1'"
						local v3 : word `k' of `limits'
						local ulimit "`ulimit' `v3'"
						local foundit 1
					}
				}
				else  {
					local k = `k' + 1
					local v2 : word `k' of `limits'
					local k = `k' + 1
					local v3 : word `k' of `limits'
					if ("`thiseq'"=="`v1'") {
						local llimit "`llimit' `v2'"
						local v3 : word `k' of `limits'
						local ulimit "`ulimit' `v3'"
						local foundit 1
					}
				}
				local k = `k' + 1
				local v1 : word `k' of `limits'
			}
			if (!`foundit') {
				local llimit "`llimit' ."
				local ulimit "`ulimit' ."
			}
		}
		local i = `i' + 1
		local thiseq : word `i' of `enames'
	}
	local nfound 0
	scalar `bestll' = -1e30
	tempname ff
	qui gen double `ff' = .
	while (`nfound'<`iterate') {
		local j 1
		local thisvec
		while (`j'<=`neq') {
			local ll : word `j' of `llimit'
			local ul : word `j' of `ulimit'
			if ("`ll'"!=".") {
				local totry = `ll' + (`ul'-`ll')*uniform()
				local thisvec "`thisvec' `totry'"
				qui replace `x`j'' = `totry'
			}
			else { local thisvec "`thisvec' ." }
			local j = `j' + 1
		}
		qui replace `ff' = .
		$S_mlfunc `ff' `varlist'
		qui cap assert `ff'< . | $S_mlwgt<=0
		if (_rc) {
			di "(infeasible value attempted; skipped)"
		}
		else {
			qui summ `ff' [aw=$S_mlwgt]
			scalar `thislf' = _result(2)*_result(3)
			local nfound = `nfound' + 1
			di in gr "search " `nfound' ":  Log Likelihood = " /*
				*/ in ye %10.0g `thislf'
			if (`thislf'>`bestll') {
				scalar `bestll' = `thislf'
				local pvec "`thisvec'"
			}
		}
	}
	local j 1
	while (`j'<=`neq') {
		local ll : word `j' of `pvec'
		if (`ll'< .) {
			local thiseq : word `j' of `eqlist'
			local pn = colnumb(matrix(`b'),"`thiseq':_cons")
			if (`pn'>=.) { error 198 }
			matrix `b'[1,`pn'] = `ll'
		}
		local j = `j' + 1
	}
end
exit

/*
ml_5.ado is a conglomeration of the following Stata 5 files:

	ml.ado
	mx_begin.ado
	mx_d0.ado
	mx_d1.ado
	mx_depn.ado
	mx_func.ado
	mx_lf.ado
	mx_marq.ado
	mx_meth.ado
	mx_model.ado
	mx_mx1.ado
	mx_out.ado
	mx_parm.ado
	mx_post.ado
	mx_q.ado
	mx_rept.ado
	mx_samp.ado
	mx_srch.ado
<end>