ml_max.ado

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

*! version 7.2.13  27jun2005
program define ml_max, eclass
	local vv : display "version " string(_caller()) ":"
	version 6 
	#delimit ;
	syntax [, Bounds(string) noCLEAR GRADient noHEADer HESSian
	          ITERate(string) GTOLerance(real -1)
		  Level(cilevel) noLOg noOUTput noWARNing
		  LTOLerance(real 1e-7)
		  NONRTOLerance NRTOLerance(real 1e-5) SHOWNRtolerance
		  Repeat(integer 0) SEArch(string) SCore(string) SHOWSTEP 
		  TOLerance(real 1e-6) TRace noVCE MAXFEAS(passthru) 
		  ITERONLY1 * ] ;
	#delimit cr
	_get_eformopts , eformopts(`options') soptions allowed(__all__)
	local options `s(options)'
	local eform `s(eform)'
				/* MAXFEAS (undocumented) is maximum number
				   of random attempts for infeasible starting
				   values in ml_searc, search(on)
				*/
	if "`score'"!="" {
		if `"$ML_score"'=="" {
			di in red /*
			*/ "method $ML_meth does not allow score() option"
			exit 198
		}
		if "$ML_pres"!="" {		/* we are preserved */
			#delimit ;
			di in red
"May not specify score() option unless" _n
"     a)  estimation subsample is the entire data in memory, or" _n
"     b)  you specify nopreserve option on -ml model- statement (meaning" _n
"         your evaluation program explicitly restricts itself to obs." _n
"         for which $" "ML_samp==1." ;
			#delimit cr
			exit 198
		}
		if "$ML_nosc" != "" {
			opts_exclusive "score() noscore"
		}
		if "$ML_vscr" == "" {
			local numscr $ML_n
		}
		else	local numscr $ML_k
		local n : word count `score'
		if `n'==1 {
			if substr("`score'",-1,1)=="*" {
				local nam = /*
				*/ substr("`score'",1,length("`score'")-1)
				local score
				local i 1
				while `i' <= `numscr' {
					local score `score' `nam'`i'
					local i = `i' + 1
				}
				local nam
				local n : word count `score'
			}
		}
		if !(`n' == $ML_n | ("$ML_vscr" == "1" & `n' == $ML_k)) {
			di in red /*
*/ "score() requires you specify `numscr' new variable names in this case"
			exit 198
		}
		confirm new var `score'
		local n
	}

	global ML_svsc
	if "`score'"=="" & ("$ML_vce"=="robust" | "$ML_vce2"=="OPG") {
		global ML_svsc *
		local i 1
		if "$ML_vscr" == "" {
			local numscr $ML_n
		}
		else	local numscr $ML_k
		while `i' <= `numscr' {
			tempvar new
			local score `score' `new'
			local i = `i' + 1
		}
		local i
		local new
	}

/* assure adequate storage for scores */

	if "`score'" != "" & "$ML_mksc" == "" {
		local scr_ct : word count `score'
		local i 1
		while `i' <= `scr_ct' + 8 {
			capture {
				tempname scv`i'
				local sctvs `sctvs' `scv`i''
				gen double `scv`i''  = . in 1
				local scv`i'
			}
			if _rc {
				di in red "insufficient memory for score "  /*
					*/ "variables"
				exit 950
			}
			local i = `i' + 1
		}
		drop `sctvs'
		local sctvs
		local scr_ct
	}


/*
	Standard options are:
		$ML_trace	0 (nolog), 1 (log), 2 (trace), 3 (showstep),
		                4 (trace showstep)
		$ML_dider	0 (neither), 1 (gradient only),
				2 (hessian only), 3 (gradient and hessian)
		$ML_tol		coefficient tolerance
		$ML_ltol	log-likelihood (criterion) tolerance
		$ML_gtol	relative gradient_k/(1+Beta_k)  tolerance
		$ML_iter	max number of iterations
*/

	SetTrace, `log' `trace' `gradien' `hessian' `showste'
	if `toleran'<0 {
		di in red "tolerance(`toleran') must be >= 0"
		exit 198
	}
	if `ltolera'<0 {
		di in red "ltolerance(`ltolera') must be >= 0"
		exit 198
	}
	if `gtolera'==-1 {
		local gtolera
	}
	else if `gtolera'<0 {
		di in red "gtolerance(`gtolera') must be >= 0"
		exit 198
	}
	if "`nonrtolerance'" != "" {
		opts_exclusive "`nonrtolerance' `shownrtolerance'"
		local nrtoler
	}
	else if `nrtolerance'<0 {
		di in red "nrtolerance(`nrtolerance') must be >= 0"
		exit 198
	}
	if "`iterate'"!="" {
		confirm integer number `iterate'
		if `iterate'<0 {
			di in red "iterate(`iterate') must be >= 0"
			exit 198
		}
		global ML_rc 0
	}
	else {
		local iterate `c(maxiter)'
		global ML_rc 430
	}
	
	global ML_conv 0
	global ML_iton1 = "`iteronly1'" != ""

	global ML_tol `toleran'
	global ML_ltol `ltolera'
	global ML_gtol `gtolera'
	global ML_nrtol `nrtolerance'
	global ML_nrsho `shownrtolerance'
	global ML_iter `iterate'
	global ML_ic 0
	mat ML_log = J(1,20,0)

	global ML_swa
	if "$ML_svy2" != "" {
		// Adjust weights for poststratification
		_svyset get poststrata
		if "`r(poststrata)'" != "" {
			local posts posts(`r(poststrata)')
			local postw postw(`r(postweight)')
			tempvar wgt wgt2
			if "$ML_sw" != "" {
				local wt [iw=$ML_sw]
			}
			svygen post double `wgt2' `wt' if $ML_samp, ///
				`posts' `postw'
			quietly gen double `wgt' = `wgt2'
			quietly replace `wgt' = 0 if $ML_wo == 0
			global ML_swa `wgt2'
			global ML_w `wgt'
		}
	}

/* Check if sufficient space for final evaluation program */

	if "$ML_evalf"!="" {
		$ML_evalf -1
	}

/* Do optimization. */

	if `iterate' {
		if $ML_trace {
			di
		}
		if "`search'"=="on" | "`search'"=="quietly" ///
		 | "`search'"=="" | "`search'" == "norescale" {
			if "`search'"=="quietly" | $ML_trace == 0 {
				local sopts "nolog"
			}
			else if $ML_trace > 1 {
				local sopts "trace"
			}
			if "`search'" == "norescale" {
				local sopts "`sopts' norescale"
			}

			ml_searc `bounds', repeat(`repeat') `sopts' `maxfeas'
		}
		else if "`search'"!="off" {
			di in red "search(`search') invalid"
			exit 198
		}
		$ML_opt, `options' `warning' /* call optimizer */
	}
	else Iter0, `warning' `vce'

/* Call optional final evaluation program. */


	if "$ML_evalf"!="" {
		$ML_evalf 2
		if $ML_C {
			mat $ML_V = $ML_CT'*$ML_V*$ML_CT
		}
		if "$ML_noinf" == "" {
			capture mat $ML_V = syminv($ML_V)
			if _rc {
				di in red "Hessian has become unstable or " /*
					*/ "asymmetric (M1)"
				exit _rc
			}
		}
		if $ML_C {
			mat $ML_V = $ML_CT*$ML_V*$ML_CT'
		}
	}
/* Compute scores. */

	if "`score'"!="" {
		$ML_score `score'
	}

	if "$ML_vce2" == "OPG" & "$ML_meth" != "rdu0" {
		qui count if $ML_samp
		mat $ML_V = I($ML_k)
		_cpmatnm $ML_b, square($ML_V)
		qui _robust `score' [iw=$ML_w] if $ML_samp,	///
			variance($ML_V) minus(0)
		if $ML_C {
			mat $ML_V = $ML_CT'*$ML_V*$ML_CT
		}
		if "$ML_noinf" == "" {
			capture mat $ML_V = syminv($ML_V)
			if _rc {
				di in red "Hessian has become unstable or " /*
					*/ "asymmetric (M1)"
				exit _rc
			}
		}
		if $ML_C {
			mat $ML_V = $ML_CT*$ML_V*$ML_CT'
		}
	}
	else	_cpmatnm $ML_b, square($ML_V)

	if $ML_yn==1 {
		local depname depname($ML_y)
	}

	tempvar esvar
	qui gen byte `esvar' = $ML_samp
	est post $ML_b $ML_V $ML_CC, `depname' obs($ML_N) esample(`esvar')
	est scalar rc = max($ML_rc,0)
	est scalar ll = scalar($ML_f)
	if `iterate' | "`warning'" == "" {
		est scalar converged = $ML_conv
	}
	else	est scalar converged = 1

	est local wtype `"$ML_wtyp"'
	est local wexp  `"$ML_wexp"'

	if "$ML_tnqk" != "" {
		version 8: ereturn local tech_steps `"$ML_tnqk"'
	}
	version 8: ereturn local technique `"$ML_tnql"'
	est local crittype `"$ML_crtyp"'

	tempname v1	iv1		/* vce of the model */
	mat `v1' = e(V)
	mat `iv1' = syminv(`v1')
	global ML_rank = colsof(`v1') - diag0cnt(`iv1')
	est scalar rank = $ML_rank 		/* return rank(V) */	

	if "$ML_ll_0"!="" {
		if "$ML_rank0" != "" {			/* continue option */
			est scalar rank0 = $ML_rank0
			est scalar df_m = $ML_rank - $ML_rank0
		} 
		else est scalar df_m = $ML_k - $ML_k0
		est scalar ll_0 = $ML_ll_0
		est scalar chi2 = 2*(e(ll)-e(ll_0))
		est scalar p = chiprob(e(df_m), e(chi2))
	}
	est local chi2type "LR"
	est scalar k    = $ML_k
	est scalar k_eq = $ML_n
	est scalar k_dv = $ML_yn


	est local user		`"$ML_ouser"'
	est local ml_method	`"$ML_meth"'
	if `"$ML_meth"' == "lf" {
		tempname ml_tn ml_hn
		matrix `ml_tn' = J(1,$ML_n,0)
		matrix `ml_hn' = J(1,$ML_n,0)
		forval i = 1/$ML_n {
			matrix `ml_tn'[1,`i'] = ${ML_tn`i'}
			matrix `ml_hn'[1,`i'] = ${ML_hn`i'}
		}
		est matrix ml_tn `ml_tn'
		est matrix ml_hn `ml_hn'
	}
	else if inlist(`"$ML_meth"',"d0","d1debug","d2debug") {
		est matrix ml_d0_s = ML_d0_S
	}
	est local cnt0 $ML_cnt0
	est local cnt1 $ML_cnt1
	est local cnt2 $ML_cnt2
	est local cnt_ $ML_cnt_
	${ML_svsc}est local scorevars `score'

	est local depvar $ML_y
	est matrix ilog ML_log
	est matrix gradient $ML_g
	est scalar ic = $ML_ic-1 /* starts at 1 */
	est scalar N = $ML_N
	est local title `"$ML_title"'
	est local opt "ml"
	local i 1
	while `i' <= $ML_n {
		if "${ML_xo`i'}" != "" {
			est local offset`i' `"${ML_xo`i'}"'
		}
		else if "${ML_xe`i'}" != "" {
			est local offset`i' `"ln(${ML_xe`i'})"'
		}
		local i = `i'+1
	}


	if "`clear'"!="" {
		mat $ML_b = get(_b)
		mat $ML_V = get(VCE)
	}