ml_check.ado

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

	SetVal
	local val `r(val)'

	di _n in smcl in gr "{hline 62}" " begin execution"
	capture noisily $ML_eval `val'
	di in smcl in gr "{hline 64}" " end execution"
	local rc = _rc
	if `rc'==0 {
		exit
	}
	if `rc'==1 {
		exit `rc'
	}
	di _n in gr "This time " in ye "$ML_user" in gr /*
	*/ " returned error " in ye "`rc'" in gr "."


	di in gr _n "Here is a trace of the execution:"
	di in smcl in gr "{hline 78}"
	capture noisily {
		qui ml trace on
		capture noisily $ML_eval `val'
		local rc2 = _rc
		di in smcl in gr "{hline 78}"
		qui ml trace off
	}
	if _rc { exit _rc }
	if `rc2'==0 {
		di in ye "$ML_user" in gr " worked this time!"
	}
	else if `rc2'!=`rc' {
		di in ye "$ML_user" in gr " returned error " in ye "`rc2'" /*
		*/ in gr " this time!"
		di in gr "(It returned error " in ye "`rc'" in gr " last time.)"
	}
	di in gr "Fix " in ye "$ML_user" in gr "."
	exit `rc'
end


program define SetVal, rclass
	if "$ML_meth"=="lf" | "$ML_meth"=="d0" {
		return local val "0"
		exit
	}
	if "$ML_meth"=="d1" | "$ML_meth"=="d1debug" {
		return local val "1"
		exit
	}
	return local val "2"
end

program define Failed
	if `"`1'"'=="" {
		di in red _col(10) "FAILED."
		exit
	}
	di in red _col(10) "FAILED; " in ye "$ML_user" /*
		*/ in gr " returned error `1'."
	exit
end

program define Passed
	di in gr _col(10) "Passed."
end

program define Break
	if _rc==1 {
		exit 1
	}
end

program define Trace /* call_type [rc] */
	di in gr _n "Here is a trace of its execution:"
	di in smcl in gr "{hline 78}"
	capture noisily {
		qui ml trace on
		capture noisily $ML_eval `1'
		local rc2 = _rc
		di in smcl in gr "{hline 78}"
		qui ml trace off
	}
	if _rc { exit _rc }
	if "`2'" != "" {
		if `rc2'==0 {
			di in ye "$ML_user" in gr " worked this time!"
			di in gr "Probably something is unintialized."
		}
		else if `rc2'!=`2' {
			di in ye "$ML_user" in gr " returned error " /*
			*/ in ye "`rc2'" in gr " this time!"
			di in gr "(It returned error " in ye "`2'" /*
			*/ in gr " last time.)"
		}
		di in gr "Fix " in ye "$ML_user" in gr "."
	}
end

program define CheckF
	capture scalar list $ML_f
	if _rc==0 { exit }
	Break
	Failed
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " did not issue an error, " /*
		*/ "but it also did not set the" _n /*
		*/ _col(10) "$ML_crtyp scalar."
	exit 111
end

program define CheckG
	Gexists
	Gright
end

program define Gexists
	capture local junk = $ML_g[1,1]
	if _rc==0 { exit }
	Break
	Failed
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " did not issue an error, " /*
		*/ "but it also did not set the" _n /*
		*/ _col(10) "gradient vector."
	exit 111
end

program define Gright
	if rowsof(matrix($ML_g))==1 & colsof(matrix($ML_g))==$ML_k {
		exit
	}
	Failed
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " returned a gradient vector that was " in ye /*
		*/ rowsof(matrix($ML_g)) " x " colsof(matrix($ML_g)) /*
		*/ in gr ", not " in ye "1 x $ML_k" in gr "."
	exit 503
end

program define CheckV
	Vexists
	Vright
	Vsym
end

program define Vexists
	capture local junk = $ML_V[1,1]
	if _rc==0 { exit }
	Break
	Failed
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " did not issue an error, " /*
		*/ "but it also did not set the" _n /*
		*/ _col(10) "Hessian matrix."
	exit 111
end

program define Vright
	if rowsof(matrix($ML_V))==$ML_k & colsof(matrix($ML_V))==$ML_k {
		exit
	}
	Failed
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " returned a Hessian matrix that was " in ye /*
		*/ rowsof(matrix($ML_V)) " x " colsof(matrix($ML_V)) /*
		*/ in gr ", not " in ye "$ML_k x $ML_k" in gr "."
	exit 503
end

program define Vsym
	tempname Vinv
	capture matrix `Vinv' = syminv($ML_V)
	if _rc == 0 { exit }
	Break
	local rc = _rc
	if _rc == 505 {
		di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " returned a Hessian matrix that was not symmetric."
		exit 505
	}
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " returned an invalid Hessian matrix"
	noisily matrix `Vinv' = syminv($ML_V)
	exit `rc'
end

program define EqualF /* <f0_scalar> */
	CheckF
	if scalar(`1') == scalar($ML_f) { exit }
	Failed
	di in ye _col(10) "$ML_user" in gr " returned LnL = " /*
	*/ in ye %10.0g scalar($ML_f) in gr " this time," _n /*
	*/ _col(28) "lnL = " in ye %10.0g scalar(`1') in gr " last time," _n /*
	*/ _col(21) "difference = " %10.0g scalar($ML_f-`1')
	di in gr _col(10) "The coefficient vectors were the same."
	exit 9
end

program define EqualG /* <g0_vector> */
	CheckG
	if matrix(mreldif($ML_g,`1'))==0 { exit }
	Failed
	di in ye _col(10) "$ML_user" in gr /*
	*/ " returned a different gradient vector this time;"
	di in gr _col(10) "mreldif(this time, last time) = " /*
	*/ in ye %10.0g matrix(mreldif($ML_g,`1'))
	di in gr _col(10) "The coefficient vectors were the same."
	exit 9
end

program define EqualV /* <v0_matrix> */
	CheckV
	if matrix(mreldif($ML_V,`1'))==0 { exit }
	Failed
	di in ye _col(10) "$ML_user" in gr /*
	*/ " returned a different Hessian matrix this time;"
	di in gr _col(10) "mreldif(this time, last time) = " /*
	*/ in ye %10.0g matrix(mreldif($ML_V,`1'))
	di in gr _col(10) "The coefficient vectors were the same."
	exit 9
end

program define CheckB
	capture local junk = $ML_b[1,1]
	if _rc==0 { exit }
	Break
	Failed
	di in ye _col(10) in ye "$ML_user" in gr /*
		*/ " did not issue an error, " /*
		*/ "but it dropped the input" _n /*
		*/ _col(10) "coefficient vector."
	exit 111
end

program define EqualB /* <b0 vector> */
	CheckB
	if matrix(mreldif($ML_b,`1')) == 0 { exit }
	Failed
	di in ye _col(10) "$ML_user" in gr /*
	*/ " changed the coefficient vector." _n /*
	*/ _col(10) "Your program must not change this input value."
	exit 9
end

program define NotRel
	di in gr _col(10) "test not relevant for method " /*
	*/ in ye "$ML_meth" in gr "."
end

program define GetFeas2
	di in smcl in gr _n "{hline 78}"
	#delimit ;
	di in gr
"Searching for alternate values for the coefficient vector to verify that"
_n in ye "$ML_user" in gr
" returns different results when fed a different coefficient vector:" ;
	#delimit cr
	di _n in gr "Searching..."
	ml_searc, trace restart
	di _n in smcl in gr "continuing with tests..." _n "{hline 78}"
end

program define NoteqF /* b0 f0 g0 V0 */
	local b0 "`1'"
	local f0 "`2'"
	if scalar(`f0')!=scalar($ML_f) { exit }
	Failed
	di in gr _col(10) /*
*/ "Two different coefficient vectors resulted in equal $ML_crtyp" /*
*/ _n _col(10) "values of " in ye %10.0g scalar($ML_f) in gr "."
	NotProof
	TwoParm `b0'
	exit 9
end

program define NoteqG /* b0 f0 g0 V0 */
	local b0 "`1'"
	local g0 "`3'"
	if mreldif(matrix(`g0'),matrix($ML_g)) { exit }
	Failed
	di in gr _col(10) /*
	*/ "Two different coefficient vectors resulted in equal gradient" /*
	*/ " vectors."
	NotProof
	TwoParm `b0'
	di _n in gr "Gradient vector:"
	mat list $ML_g, nohead noblank
	exit 9
end

program define NoteqV /* b0 f0 g0 V0 */
	local b0 "`1'"
	local V0 "`4'"
	if mreldif(matrix(`V0'),matrix($ML_V)) { exit }
	Failed
	di in gr _col(10) /*
	*/ "Two different coefficient vectors resulted in equal Hessians."
	NotProof
	TwoParm `b0'
	di _n in gr "Negative Hessian matrix:"
	mat list $ML_V, nohead noblank
	exit 9
end

program define NotProof
	di in gr _col(10) /*
	*/ "This does not prove there is a problem, but it suggests it."
end

program define TwoParm /* b0 */
	local b0 "`1'"
	tempname t
	mat `t' = nullmat($ML_b) \ `b0'
	di _n in gr "two coefficient vectors:"
	mat list `t', nohead noblank
end


/* the following is included to verify method lf evaluators do not
   corrupt b
*/

program define ML_elf /* <nothing> */
	local i 1
	while `i' <= $ML_n {
		tempname x`i' y`i'
		qui mat score double `x`i'' = $ML_b if $ML_samp, eq(#`i')
		if "${ML_xo`i'}" != "" {
			qui replace `x`i'' = `x`i'' + ${ML_xo`i'}
		}
		else if "${ML_xe`i'}" != "" {
			qui replace `x`i'' = `x`i'' + ln(${ML_xe`i'})
		}
		qui gen double `y`i'' = `x`i''
		local list `list' `x`i''
		local i = `i' + 1
	}
	tempvar lnf
	qui gen double `lnf' = .
	version 7
	$ML_vers $ML_user `lnf' `list'
	version 6
	local i 1
	while `i' <= $ML_n {
		capture assert `x`i''==`y`i''
		if _rc {
			Failed
			di in ye _col(10) "$ML_user" in gr " changed an"/*
			*/ " input variable (arguments 2, 3,...)." /*
			*/ _n _col(10) "It must not do that."
			exit 9
		}
		local i = `i' + 1
	}
end

exit