asmprobit.ado

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

	if $MPROBIT_NCASECOEF>0 & "`pseudo'"!="" {
		/* check that we will be able to generate scores */
		/*  after estimation				 */
		CheckMemoryForRobust
	}

	if "`tech2'"=="" & `reparam' {
		local tech2 nr
		local vce2  oim
		if ("`vce'"=="opg") local d21 d2
		else local d21 d1
	}
	if "`tech2'" != "" {
		local waldopt2 waldtest(`wald')
		local waldopt waldtest(0)
	}
	else {
		if ("`vce'"!="") local vceopt  vce(`vce')
		local waldopt waldtest(`wald')
	}
	if ("`constraints'" != "") local conopt constraints(`constraints')

	local converged = 0
	local rc = 0
	if `initbhhh' > 0 {
		if "`log'" == "" {
			di _n in smcl in gr "(setting optimization to BHHH)"
			if ("`techmeth'" != "") local log1 log
		}
		/* `onercp'!=0, we use d2 and nr but the algorithm is actually 	*/
		/*  bhhh technique and opg for negative hessian 		*/
		ml model d2 asmprobit_lf `altmodel' `casemodels' `thetas' `iff'  ///
			`wtopt', technique(nr) collinear nopreserve `conopt' 	 ///
			noscvars `critopt' `seaopt' `initopt' nooutput `trace'   ///
			iterate(`initbhhh') `log' nowarning max 

		matrix `b' = e(b)
		scalar `ic' = e(ic)
		matrix `ilog' = e(ilog)
		local initopt init(`b')
		local seaopt search(off)
		local converged = e(converged)
		local rc = e(rc)
		if `converged' & "`tech2'"=="" {
			local tech2 nr
			local vce2  oim
			if ("`vce'"=="opg") local d21 d2
			else local d21 d1
			local waldopt2 waldtest(`wald')
		}
	}
	if `converged' == 0 {
		if "`debug'" != "" {
			global MPROBIT_TRACE = 0

			ml model d1debug asmprobit_lf `altmodel' `casemodels' `thetas' `iff' ///
				`wtopt', nopreserve collinear `initopt' noscvars gradient    ///
				showstep trace max search(off) `trace' `log' 
		}
		else {
			if ("`log1'" != "") di _n in smcl in gr "(switching optimization to " ///
				"`techmeth')"
			/* let -ml- approximate the negative hessian (unless tech=bhhh) */
			ml model `d1' asmprobit_lf `altmodel' `casemodels' `thetas' `iff' ///
				`wtopt', technique(`tech') nopreserve collinear `conopt'  ///
				`initopt' `seaopt' noscvars `vceopt' `robopt' `iterate'   ///
				`mlopts' `critopt' `waldopt' nooutput max `trace' `log'

			matrix `b' = e(b)
			scalar `ic' = e(ic)
			matrix `ilog' = e(ilog)
		}

		local converged = e(converged)
		local rc = e(rc)
	}
	if "`tech2'" != "" {
		if `reparam' {
			/* put parameter estimates into desired metric */
			if ("`log'" == "") di _n in gr "Reparameterizing to " ///
				"correlation metric and refining estimates" 

			Reparameterize "`b'" `"`rcfnms'"' "`order0'"

			local thetas = `"`r(thetas)'"'
			global MPROBIT_CHOLESKY = 0
			local iteropt `iterate'
		}
		else {
			local iteropt iterate(0)
			local qui qui 
		}
		`qui' ml model `d21' asmprobit_lf `altmodel' `casemodels' `thetas' `wtopt' ///
			`iff', technique(`tech2') vce(`vce2') collinear `conopt' init(`b') ///
			nopreserve `mlopts' `critopt' `waldopt2' search(off) nooutput      ///
			noscvars max nowarning `iteropt' `log'
		if `reparam' & e(converged)==0 {
			di in gr "Note: reparameterization failed"
		} 
		else {
			ereturn scalar converged = `converged'
			ereturn scalar rc = `rc'
		}
	}
	if "`pseudo'" != "" {
		tempname V b g negH lnf
		global ML_y1 = "`choice'"
		scalar `lnf' = 0
		matrix `V' = e(V)
		matrix `b' = e(b)

		asmprobit_lf 3 "`b'" "`lnf'" "`g'" "`negH'"  
		/* temporary varaibles for covariance scores */
		if `nattrib' > 0 {
			/* dummy names for coefficients */
			foreach  scr of global MPROBIT_ASCRS {
				local robnms `"`robnms' `scr':_cons"'
			}
		}
		if $MPROBIT_NCASECOEF > 0 {
			/* dummy names for coefficients */
			foreach  scr of global MPROBIT_CSCRS {
				local robnms `"`robnms' `scr':_cons"'
			}
			local i = 0
			local `cscrs' `"$MPROBIT_CSCRS"'
			forvalues j = 1/`nalt' {
				if (`j' == `ibase') continue
				if `i' == 0 {
					local i = $MPROBIT_NCASECOEF
					continue
				}
				foreach scr of global MPROBIT_CSCRS {
					tempvar c`++i'
					local robnms `"`robnms' `c`i'':_cons"'
					local cscrs `"`cscrs' `c`i''"'
					qui gen double `c`i'' = `scr' if `altern'==`j'
					qui replace `scr' = 0 if `altern' == `j'
					qui by `case': replace `c`i'' = sum(`c`i'')
					qui by `case': replace `c`i'' = `c`i''[_N]
				}
			} 
			foreach scr of global MPROBIT_CSCRS {
				qui replace `scr' = 0 if `altern'==`ibase'
				qui by `case': replace `scr' = sum(`scr')
				qui by `case': replace `scr' = `scr'[_N]
			}
		}
		if `ncov' > 0 {
			/* dummy names for coefficients */
			foreach  scr of global MPROBIT_VSCRS {
				local robnms `"`robnms' `scr':_cons"'
			}
		}
		matrix colnames `V' = `robnms'
		matrix rownames `V' = `robnms'
		_robust $MPROBIT_ASCRS `cscrs' $MPROBIT_VSCRS `iff' [`weight'`exp'], ///
			`clopt2' variance(`V')

		local nms : colfullnames `b'
		matrix rownames `V' = `nms'
		matrix colnames `V' = `nms'

		local nc = r(N_clust)
		ereturn repost b=`b' V=`V' 
		ereturn local chi2
		ereturn local p
		if "`cluster'" != "" {
			ereturn scalar N_clust = `nc'
			ereturn scalar df_r = `nc' - 1
			ereturn local clustvar "`cluster'"
		}
		if `nattrib'>0 | $MPROBIT_NCASECOEF>0 {
			if `nattrib' > 0 {
				qui test [`alternatives']
				local accum a
			}
			if $MPROBIT_NCASECOEF-$MPROBIT_CONST > 0 {
				forvalues i=1/`nalt' {
					if (`i' == `ibase') continue
					local eq : word `i' of $MPROBIT_ALTEQS
					qui test [`eq'], `accum'
					local accum a
				}
			}
			ereturn scalar df_m = r(df)
			local dfr = `nattrib'+($MPROBIT_NCASECOEF-$MPROBIT_CONST)*(`nalt'-1)
			if "`cluster'" != "" {
				ereturn local chi2type
				if (r(df)==`dfr') ereturn scalar F = r(F)
				else ereturn scalar F = .
			}
			else {
				if (r(df)==`dfr') ereturn scalar chi2 = r(chi2)
				else ereturn scalar chi2 = .
			}
			if (r(df)==`dfr') ereturn scalar p = r(p)
		}
		ereturn local vcetype "Robust"
	}
	else if "`vce0'" == "opg" {
		ereturn local vcetype "OPG"
		ereturn local ml_method "d1"
	}

	tempname varstr varfix
	matrix `varstr' = vecdiag(`corstr')
	matrix `varfix' = vecdiag(`corfix')
	forvalues i=`nalt'(-1)1 {
		matrix `corstr'[`i',`i'] = .
		matrix `corfix'[`i',`i'] = .
		if ("`altlevels'"!="") local alt`i' = `altlevels'[`i',1]
		else local alt`i' = `i'
		if ("`altlabels'"!="") local alt`i' : label `altlabels' `alt`i''

		ereturn local alt`i' `"`alt`i''"'
	}
	local names : rownames `corstr'
	matrix colnames `varstr' = `names'
	matrix colnames `varfix' = `names'
	ereturn matrix corpattern = `corstr'
	ereturn matrix stdpattern = `varstr'
	ereturn matrix corfixed = `corfix'
	ereturn matrix stdfixed = `varfix'

	AlternStats `case' `altern' `choice' `wtoptinit', nalt(`nalt') altlevels(`altlevels')
	tempname stats
	matrix `stats' = r(stats)
	ereturn matrix stats = `stats'

	ereturn scalar N_case = e(N)
	if "`weight'" == "fweight" {
		tempvar fw 
		qui gen `fw' `exp'
		qui summarize `fw' 
		ereturn scalar N = r(sum) 
	}
	else ereturn scalar N = _N
	ereturn scalar alt_min = `casestat'[1,1]
	ereturn scalar alt_avg = `casestat'[2,1]
	ereturn scalar alt_max = `casestat'[3,1]
	ereturn scalar cholesky = `cholesky'
	ereturn scalar fullcov = `fullcov'
	ereturn scalar k_indvars = `nattrib'
	ereturn scalar k_ind2vars = $MPROBIT_NCASECOEF-$MPROBIT_CONST 
	ereturn scalar const = $MPROBIT_CONST
	ereturn scalar k_alt = `nalt'
	ereturn scalar i_base = `ibase'
	ereturn scalar i_scale = `iscale'

	if `nalt' > 2 {
		ereturn scalar mc_points = `intpoints'
		ereturn scalar mc_antithetics = `antithetics'
		if (`imeth'!=3) ereturn scalar mc_burn = `intburn'
	}
	ereturn scalar k_rho = `ncor'
	ereturn scalar k_sigma = `nvar'

	ereturn local indvars  `"`:list retok attribs'"'
	ereturn local ind2vars `"`casevars'"'
	if ($MPROBIT_NCASECOEF > 0) ereturn local alteqs `"$MPROBIT_ALTEQS"'
	ereturn local altvar  `"`alternatives'"'
	ereturn local casevar  `"`case'"'

	if `nalt' > 2 {
		if (`imeth'==1) ereturn local mc_method "Halton"
		else if (`imeth'==2) ereturn local mc_method "Hammersley"
		else {
			ereturn local mc_method "uniform random"
			ereturn local mc_seed `"$MPROBIT_SEED"'
		}
	}
	if ("`correlation'" == "indep")	ereturn local correlation "independent"
	else if ("`correlation'" == "exch") ereturn local correlation "exchangeable"
	else if ("`correlation'" == "unstruct")	ereturn local correlation "unstructured"
	else if ("`cormattype'" == "pattern") ereturn local correlation "pattern matrix"
	else ereturn local correlation "fixed parameter matrix"

	if ("`stddev'" == "heter") ereturn local stddev "heteroskedastic"
	else if ("`stddev'" == "homo") ereturn local stddev "homoskedastic"
	else if ("`varmattype'" == "pattern") ereturn local stddev "pattern matrix"
	else ereturn local stddev "fixed parameter matrix"

	ereturn scalar ic = `ic'
	ereturn matrix ilog = `ilog'

	ereturn local k_dv 

	ereturn local title  "Alternative-specific multinomial probit"
	ereturn local predict asmprobit_p
	ereturn local estat_cmd asmprobit_estat
	ereturn local cmd2 asmprobit
	ereturn local cmd asmprobit

	restore
	ereturn repost, esample(`touse')

	Replay, `diopts'
end

program Replay
	syntax [, Level(cilevel)]

	local ncov = e(k_rho)+e(k_sigma)
	local ncasecf : word count `"`e(ind2vars)'"'
	local const = `e(const)' != 0
	local ncasecf = `ncasecf' + `const'

	local noheader noheader 
	local crtype = upper(substr(`"`e(crittype)'"',1,1)) + ///
		substr(`"`e(crittype)'"',2,.)
	di _n in gr `"`e(title)'"' _col(48) "Number of obs" _col(67) "= " in ye ///
	 %10.0g e(N)
	di in gr `"Case variable: `=abbrev("`e(casevar)'",24)'"' _col(48) 	///
	 "Number of cases" _col(67) "= " in ye %10.0g e(N_case) _n
	local altvar `=abbrev("`e(altvar)'",17)'
	di in gr `"Alternative variable: `altvar'"' _col(48) 			///
	 "Alts per case: min = " in ye %10.0g e(alt_min) _n _col(63) in gr 	///
	 "avg = " in ye %10.1f e(alt_avg) _n _col(63) in gr "max = " 		///
	 in ye %10.0g e(alt_max)
	local lencr = length("`e(crittype)'")
	if ("`e(mc_method)'" != "") {
		local sk = `lencr'-length("`e(mc_method)'") - 8
		di in smcl in gr "Integration sequence:" _skip(`sk') "`e(mc_method)'" 
		local sk = `lencr'-21
		local intpoints `""Integration points:" _skip(`sk') in ye %15.0g `=e(mc_points)'"'
	}
	else local intpoints _n

	if "`e(chi2type)'" == "Wald" {
		local stat chi2
        	local cfmt=cond(e(chi2)<1e+7,"%10.2f","%10.3e")
       		if e(chi2) >= . {
			local h help j_robustsingular:
			di in gr `intpoints' in gr _col(51) ///
			 "{`h'Wald chi2(`e(df_m)'){col 67}= }" in ye `cfmt' e(chi2)
       		}
        	else {
			di in gr `intpoints' in gr _col(51) 			    ///
			 "`e(chi2type)' chi2(" in ye "`e(df_m)'" in gr ")" _col(67) ///
			 "= " in ye `cfmt' e(chi2)
       		}
	}
	else {
		/* F statistic from test after _robust */
		local stat F
		local cfmt=cond(e(F)<1e+7,"%10.2f","%10.3e")
		if e(F) < . {
			di in gr `intpoints' in gr _col(51) 			///
			 "F(" in ye %3.0f e(df_m) in gr "," in ye %6.0f e(df_r) ///
			 in gr ")" _col(67) "= " in ye `cfmt' e(F)
		}
		else {
			local dfm = e(df_m)
			local dfr = e(df_r)
			local h help j_robustsingular:

			di in gr `intpoints' in gr _col(51) ///
			 "{`h'F( `dfm', `dfr')}" _col(67) "{`h'=          .}"
		}
	}
	di in gr "`crtype' = " in ye %10.0g e(ll) _col(51) in gr "Prob > `stat'" ///
	 _col(67) "= "  in ye %10.4f e(p) _n

	local neq : word count `e(alteqs)' 

	local coleq : coleq e(b)
	local coleq : list uniq coleq
	_choice_table, begin level(`level')
	if e(k_indvars) {
		_choice_table `e(altvar)', equation level(`level')
	}
	forvalues i=1/`neq' {
		local altid : word `i' of `e(alteqs)'
		if `i' == e(i_base) {
			_choice_table `altid', comment("  (base alternative)")
		}
		else {
			_choice_table `altid', equation level(`level')
		}
	}

	if `ncov' > 0 {
		Replay1 `level'
		
		_get_diparmopts, bottom execute
	}
	local i = `e(i_base)'
	if (wordcount("`e(alt`i')'") > 1) local base `""`=abbrev(`"`e(alt`i')'"',17)'""'
	else local base `"`=abbrev(`"`e(alt`i')'"',17)'"'
        di in gr `"{p}(`altvar'=`base' is the alternative normalizing location){p_end}"'
	if (`e(i_scale)' < .) {
		local i = `e(i_scale)'
		if (wordcount("`e(alt`i')'") > 1) local scale `""`=abbrev(`"`e(alt`i')'"',17)'""'
		else local scale `"`=abbrev(`"`e(alt`i')'"',17)'"'
	        di in gr `"{p}(`altvar'=`scale' is the alternative normalizing scale){p_end}"'
	}
	ml_footnote
end

program Replay1
	args level

	local nalt = e(k_alt)
	if `e(cholesky)' {
		local rii lnl
		local labii l
		local rij l
	}
	else {
		local rii lnsigma
		local labii sigma
		local rij atanhr
	}
	if e(k_sigma) > 0 {
		if !e(fullcov) {
			forvalues i = 1/`e(k_sigma)' {
				_diparm lnsigmaP`i', level(`level')
			}
		}
		else {
			forvalues i = 1/`nalt' {
				if (el(e(stdpattern),1,`i') >= .) continue
	
				if e(cholesky) local ii `i'_`i'
				else local ii `i'
	
				_diparm `rii'`ii', level(`level')
			}
		}
		if (e(k_rho)>0 | `e(cholesky)'==0) ///
			_get_diparmopts, diparmopts(diparm(__sep__)) execute
	}
	if e(k_rho) > 0 {
		if !e(fullcov) {
			forvalues i=1/`e(k_rho)' {
				_diparm atanhrP`i', level(`level')
			}
		}
		else {
			forvalues j=1/`nalt' {
				local j1 = `j'+1
				forvalues i=`j1'/`nalt' {
					if e(fullcov) local ij `i'_`j'
					else local ij = el(e(corpattern),`i',`j')
					if (el(e(corpattern),`i',`j') >= .) continue
	
					_diparm `rij'`ij', level(`level')
				}
			}
		}
		if (`e(cholesky)'==0) ///
			_get_diparmopts, diparmopts(diparm(__sep__)) execute
	}
	if (e(cholesky) != 0) exit
	if !e(fullcov) local P P
	if e(k_sigma) > 0 {
		forvalues i = 1/`nalt' {
			if (el(e(stdpattern),1,`i') >= .) {
				if (`i'==e(i_base)) local cmnt "(base alternative)"
				else if (`i'==e(i_scale)) local cmnt "(scale alternative)"
				else local cmnt "(fixed)"

				_choice_table sigma`i', ///
					value(`=el(e(stdfixed),1,`i')') ///
					comment("  `cmnt'") nosep
			}
			else {
				if e(fullcov) local ii `i'
				else local ii = el(e(stdpattern),1,`i')
	
				_diparm lnsigma`P'`ii', ///
				level(`level') exp label(sigma`i')
			}
		}
	}
	if e(k_rho) > 0 {
		if (e(k_sigma) > 0) ///
			_get_diparmopts, diparmopts(diparm(__sep__)) execute
		forvalues j=1/`nalt' {
			local j1 = `j'+1
			forvalues i=`j1'/`nalt' {
				if e(fullcov) local ij `i'_`j'
				else local ij = el(e(corpattern),`i',`j')

				if (el(e(corpattern),`i',`j') >= .) {
					if `i'== e(i_base)|`j' == e(i_base) {
						if (el(e(corfixed),`i',`j')==0) ///
							continue
						else local cmnt "(base alternative)"
					}
		    			else local cmnt "(fixed)"

					_choice_table rho`i'_`j', 	      ///
					    value(`=el(e(corfixed),`i',`j')') ///
					    comment("  `cmnt'") nosep
				}
				else {
					_diparm atanhr`P'`ij', level(`level') ///
						function(tanh(@)) 	      ///
						derivative((1-tanh(@)^2))     ///
						label(rho`i'_`j')
				}
			}
		}
	}
end

program PostError
	syntax , [SCore(string)]
 
	if "`score'"!="" {
		di as error "option scores() not allowed"
		exit 198
	}
end
  
program ParseTech, sclass
	args technique initbhhh vce

	if "`vce'"!="" & "`vce'"!="oim" & "`vce'"!="opg" & "`vce'"!="native" {
		di as error "{p}vce must be either oim, opg, robust, bootstrap, " ///
		 "or jackknife{p_end}"
		exit 198
	}
	if "`initbhhh'"!="" & `initbhhh'<0 {
		di as error "initbhhh must be greater than 0"