asmprobit.ado

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

		exit 198
	}

	tokenize `technique'

	local d1 d1
	local vce0 
	local tech `technique'
	if "`2'" == "" {
		if "`1'" == "" {
			local tech bfgs
			local technique bfgs
		}
		if "`vce'" == "native" {
			if ("`tech'" == "nr")	local vce oim
			else if ("`tech'" == "bhhh") local vce opg
		}
		local vce0 = "`vce'"
		if "`tech'" == "bhhh" {
			local initbhhh = 0
			/* must trick -ml- and let the likelihood evaluator compute the */
			/* outer product gradient approximation to the negative Hessian */
			local d1 d2
			local tech nr

			/* detect if a extra call to ml is needed to get the desired vce */
			if "`vce'"=="oim" {
				local tech2 nr
				local vce2  oim
				local d21   d1
			}
			else { // "`vce'"=="opg" | "`vce'"=="native"
				local vce oim
				local vce0 opg
			} 
			else local vce0 opg
		}
		else if "`vce'" == "opg" {
			/* detect if a extra call to ml is needed to get the desired vce */
			local tech2 nr
			local vce2  oim
			local d21   d2
		}
		if `initbhhh' > 0 {
			if ("`tech'" == "nr") local techmeth Newton-Raphson
			else local techmeth = upper("`technique'")
		}
	}
	else {
		local initbhhh = 0
		local i = 0
		while "``++i''" != "" {
			if "``i''" == "bhhh" {
				di as error "{p}technique(`technique') is invalid; " ///
				 "use the initbhhh({it:#}) option{p_end}"
				exit 184
			}
		}
		local tech2 nr
		if "`vce'"=="" | "`vce'"=="oim" {
			local vce2  oim
			local d21   d1
			local vce0  oim 
		}
		else {
			local vce2  oim
			local d21   d2
			local vce0  opg
		}
	}
	sreturn local technique `"`technique'"'
	sreturn local tech `"`tech'"'
	sreturn local d1 "`d1'"
	sreturn local vce0 "`vce0'"
	sreturn local vce "`vce'"
	sreturn local tech2 "`tech2'"
	sreturn local vce2 "`vce2'"
	sreturn local d21 "`d21'"
	sreturn	local initbhhh = `initbhhh'
	sreturn local techmeth "`techmeth'"
end

program GetModel, rclass
	syntax varlist(max=1) [if] [fw pw iw],	///
		alternatives(varname) 		///
		altname(string)			///
		ibase(integer) [		///
		case(varname)			///
		attribs(varlist) 		///
		noconstant			///
		casevars(varlist) 		///
		constraints(numlist) ]

	tempname from caselvls b ind
	local np = 0
	local const = ("`constant'" == "")
	local nccf : word count `casevars'
	local nacf : word count `attribs'

	 _labels2names `alternatives', stub(_alt_) noint
	local alteqs `"`s(names)'"'
	local nalt = `s(n_cat)'

	local ncoef = 0

	if `nacf' > 0 {
		local altmodel `"(`altname':`varlist'="'
		foreach attrib of local attribs {
			local cfnms `"`cfnms' `altname':`attrib'"'
			local altmodel `"`altmodel' `attrib'"'
			local `++ncoef'
		}
		local altmodel `"`altmodel',nocons)"'
	}
	if `const' | `nccf'>0 {
		local k = 0

		forvalues i=1/`nalt' {
			if (`i'==`ibase') continue

               		local ai : word `i' of `alteqs'
			local `++k'
			if (`k'==1 & `nacf'==0)	local casemodels `"`casemodels' (`ai':`varlist'="'
			else local casemodels `"`casemodels' (`ai':"'

			if `nccf' > 0 {
				foreach cv of local casevars {
					local cfnms `"`cfnms' `ai':`cv'"'
					local casemodels `"`casemodels' `cv'"'
					local `++ncoef'
				}
			}
			if `const' {
				local cfnms `"`cfnms' `ai':_cons"'
				local casemodels `"`casemodels')"'
				local `++ncoef'
			}
			else local casemodels `"`casemodels',nocons)"'
		}
	}
	return local ncoef = `ncoef'
	return local altmodel `"`altmodel'"'
	return local casemodels `"`casemodels'"'
	return local alteqs `"`alteqs'"'
	return local ncasecf = `nccf'+`const'
	return local const = `const'
	return local rcfnms `"`cfnms'"'
end

program InitMProbit, rclass
	syntax varlist(max=1) [if] [fw pw iw],	///
		case(varname)			///
		alternatives(varname) 		///
		ibase(integer) 			///
		coefnames(string)[		///
		attribs(varlist) 		///
		noCONSTant			///
		casevars(varlist) 		///
		cmat(string) ]

	tempname from b 
	local const = ("`constant'" == "")
	local nccf : word count `casevars'
	local nacf : word count `attribs'

	 _labels2names `alternatives', stub(_alt_) noint
	local altlabels `"`s(names)'"'
	local nalt = `s(n_cat)'
		
	if `nacf' == 0 {
		if (`const'==0) local noconst noconstant
		/* must generate mlogit coefficient names in case it drops variables due */
		/* to collinearity */
		tempvar resp 
		tempname lab
		qui gen `resp' = `alternatives'
		forvalues i=1/`nalt' {
               		local ai : word `i' of `altlabels'

			label define `lab' `i' `ai', add
			if (`i'==`ibase') continue

			if `nccf' > 0 {
				foreach cv of local casevars {
					local initcf `"`initcf' `ai':`cv'"'
				} 
			}
			if (`const') local initcf `"`initcf' `ai':_cons"'
		}
		label values `resp' `lab'
		if (`const'==0) local noconst noconst
		if "`cmat'" != "" {
			local n: word count `initcf'
			matrix colnames `cmat' = `initcf' c`++n'
			local copt constraints(`cmat')
		}
		cap qui mlogit `resp' `casevars' [`weight'`exp'] `if', `noconst' ///
			ltol(0.0001) tol(0.001) base(`ibase') `copt' iterate(50)

		local rc = _rc
		if `rc' == 503 {
			/* constraints on collinear variables */
			cap qui mlogit `resp' `casevars' [`weight'`exp'] `if', `noconst' ///
				ltol(0.0001) tol(0.001) base(`ibase')  iterate(50)
		}
		else if `rc' > 0 {
			di as error "initial estimates failed"
			error `rc' 
		}
		matrix `b' = e(b)
	}
	else {
		/* must generate clogit coefficient names in case it drops variables due */
		/* to collinearity */
		foreach attrib of local attribs {
			local initcf `"`initcf' `varlist':`attrib'"'
		}
		if `const' | `nccf'>0 {
			forvalues i=1/`nalt' {
				if (`i'==`ibase') continue

				tempvar a`i'
				gen byte `a`i'' = (`alternatives'==`i')
				if `nccf' > 0 {
					foreach cv of local casevars {
						tempvar `cv'`ai'
						gen double ``cv'`ai'' = `a`i''*`cv'
						local csvars `"`csvars' ``cv'`ai''"'
						local initcf `"`initcf' `varlist':``cv'`ai''"'
					} 
				}
				if `const' {
					local csvars `"`csvars' `a`i''"'
					local initcf `"`initcf' `varlist':`a`i''"'
				}
			}
		}
		if "`cmat'" != "" {
			local n: word count `initcf'
			matrix colnames `cmat' = `initcf' c`++n'
			local copt constraints(`cmat')
		}
		cap qui clogit `varlist' `attribs' `csvars' [`weight'`exp'], group(`case') ///
			ltol(0.0001) tol(0.001) nrtol(0.01) `copt' iterate(50)  

		local rc = _rc
		if `rc' == 503 {
			/* constraints on collinear variables */
			qui clogit `varlist' `attribs' `csvars' [`weight'`exp'], group(`case') ///
			   ltol(0.0001) tol(0.001) nrtol(0.01) iterate(50)  
		}
		else if `rc' > 0 {
			di as error "initial estimates failed"
			error `rc' 
		}
		matrix `b' = e(b)
	}
	if (e(converged)==0) di in gr "Note: computation of initial estimates failed"
	local ncoef : word count `coefnames'
	if colsof(`b') < `ncoef' {
		di in gr "{p 0 7}Note: two or more of the variables are collinear; " ///
	 	 "convergence may not be achieved"

		matrix `from' = J(1,`ncoef',0)
		local ndrop = 0
		forvalues i=1/`ncoef' {
			local icf : word `i' of `initcf'
			local k = colnumb(`b',`"`icf'"')
			
			if (`k'<.)  matrix `from'[1,`i'] = `b'[1,`k']
		}
	}
	else matrix `from' = `b'

	matrix colnames `from' = `coefnames' 
	return matrix from = `from'
end


program MatrixName, rclass
	cap syntax namelist(min=1 max=2), type(string) 

	if _rc > 0 {
		di as error "correlation() or stddev() incorrectly specified"
		exit 198
	}

	gettoken spec name : namelist

	local lspec = length("`spec'")
	if "`spec'" == substr("pattern",1,max(3,`lspec')) {
		return local matspec pattern
	}
	else if "`spec'" == substr("fixed",1,max(3,`lspec')) {
		return local matspec fixed
	}
	else if "`type'" == "correlation" {
		di as error "{p}correlation() must specify either independent, " ///
		 "exchangeable, unstructured (default), or a matrix "            ///
		 "specifying the correlation pattern or fixed parameters{p_end}" 
		exit 198
	}
	else {
		di as error "{p}stddev() must specify either heteroskedastic, "  ///
		 "homoskedastic, or a matrix specifying the standard deviation " ///
		 "pattern or fixed parameters{p_end}"
		exit 198
	}
	if "`name'" == "" {
		di as error "{p}a matrix name must follow the matrix specification " ///
		 "`spec' in `type'(){p_end}"
		exit 198
	}
	if _rc != 0 {
		di as error "syntax error specifying `type'()"
		exit _rc
	}
	cap qui confirm matrix `name'
	if _rc != 0 {
		di as error "matrix `name' specified in `type'() does not exist"
		exit 111
	}
	return local name `name'
end

program VParStripe, rclass
	args cholesky

	local nvcf = 0
	if $MPROBIT_FULLCOV {
		if `cholesky' {
			local rii lnl
			local rij l
		}
		else {
			local rii lnsigma
			local rij atanhr
		}
		forvalues j=1/$MPROBIT_NALT {
			local aj = $MPROBIT_CORSTRUCT[`j',`j']
			if `aj' < . {
				if (`cholesky') local jj `j'_`j'
				else local jj `j'
				local thetas `"`thetas' /`rii'`jj'"'
				local cfnms `"`cfnms' `rii'`jj':_cons"'
				local `++nvcf'
			}
		}
		forvalues j=1/$MPROBIT_NALT {
			local j1 = `j'+1
			forvalues i=`j1'/$MPROBIT_NALT {
				local ai = $MPROBIT_CORSTRUCT[`i',`j']
				if `ai' < . {
					local thetas1 `"`thetas1' /`rij'`i'_`j'"'
					local cfnms1 `"`cfnms1' `rij'`i'_`j':_cons"'
					local `++nvcf'
				}
			}
		}
	}
	else {
		forvalues j=1/$MPROBIT_NVAR {
			local thetas `"`thetas' /lnsigmaP`j'"'
			local cfnms `"`cfnms' lnsigmaP`j':_cons"'
		}
		forvalues i=1/$MPROBIT_NCOR {
			local thetas1 `"`thetas1' /atanhrP`i'"'
			local cfnms1 `"`cfnms1' atanhrP`i':_cons"'
		}
		local nvcf = $MPROBIT_NVAR+$MPROBIT_NCOR
	}
	if `"`thetas1'"' != "" {
		local thetas `"`thetas' `thetas1'"'
		local cfnms `"`cfnms' `cfnms1'"'
	}
	return local nvcf `nvcf'
	return local thetas `"`thetas'"'
	return local vcfnms `"`cfnms'"'
end

program Reparameterize, rclass
	args b cfnms order T

	tempname R
	matrix `R' = I($MPROBIT_NALT)

	/* cholesky factored covariance */
	local rc = 0
	forvalues j=1/$MPROBIT_NALT {
		local aj = $MPROBIT_CORSTRUCT[`j',`j']
		if `aj' < . {
			local k = colnumb("`b'","lnl`j'_`j':") 
			if `k' >= . {
				di as error "could not find coefficient associated " ///
				 "with parameter lnl`j'_`j':_cons"
				local rc = 497
				continue, break
			}
			matrix `R'[`j',`j'] = exp(`b'[1,`k']) 
		}
		local j1 = `j'+1
		forvalues i=`j1'/$MPROBIT_NALT {
			local ai = $MPROBIT_CORSTRUCT[`i',`j']
			if (`ai' >=.) continue

			local k =  colnumb("`b'","l`i'_`j':")
			if `k' >= . {
				local rc = 497
				di as error "could not find coefficient associated " ///
				 "with parameter l`i'_`j':_cons"
				continue, break
			}
			matrix `R'[`i',`j'] = `b'[1,`k']
		}
		if (`rc'>0) continue, break
	}
	if (`rc'>0) exit `rc'
	matrix `R' = `R'*`R''
	local reorder = 0
	local j = 0 
	while `++j'<$MPROBIT_NALT & !`reorder' {
		local reorder = (`order'[`j',1] != $MPROBIT_ORDER[`j',1])
	}
	if `reorder' {
		/* put variance-covariances back into the original alternative 	*/
		/*  order before permuting for base and scale alternatives	*/
		local names : rownames $MPROBIT_CORSTRUCT
		matrix rownames `R' = `names'

		PivotMat "$MPROBIT_CORSTRUCT" "`order'" 0 
		PivotMat "$MPROBIT_CORFIXED" "`order'" 0
		PivotMat "`R'" "`order'" 0
		global MPROBIT_ORDER `order'
	}
	local kv = 0
	local kc = 0

	local k : word count `cfnms'
	forvalues j=1/$MPROBIT_NALT {
		local aj = $MPROBIT_CORSTRUCT[`j',`j']
		if `aj' < . {
			matrix $MPROBIT_CORSTRUCT[`j',`j'] = `++kv'
			matrix `b'[1,`++k'] = log(sqrt(`R'[`j',`j']))
			local cfnms `"`cfnms' lnsigma`j':_cons"'
			local thetas `"`thetas' /lnsigma`j'"'
		}
	}
	forvalues j=1/$MPROBIT_NALT {
		local j1 = `j'+1
		forvalues i=`j1'/$MPROBIT_NALT {
			local ai = $MPROBIT_CORSTRUCT[`i',`j']
			if (`ai' >=.) continue

			matrix `b'[1,`++k'] = atanh(`R'[`i',`j']/sqrt(`R'[`i',`i']*`R'[`j',`j']))

			matrix $MPROBIT_CORSTRUCT[`i',`j'] = `++kc'
			matrix $MPROBIT_CORSTRUCT[`j',`i'] = `kc'
			local cfnms `"`cfnms' atanhr`i'_`j':_cons"'
			local thetas `"`thetas' /atanhr`i'_`j'"'
		}
	}
	if `reorder' {
		GenTmat "$MPROBIT_NVAR" "$MPROBIT_NCOR" "$MPROBIT_CORSTRUCT" 
		matrix $MPROBIT_TMAT = r(T)
	}
	matrix colnames `b' = `cfnms' 
	return local thetas `"`thetas'"' 
end

program PivotMat, rclass
	args mat order renumber

	local nalt = rowsof(`order')
	tempname mat1 ip
	matrix `mat1' = J(`nalt',`nalt',.)
	matrix `ip' = J(`nalt',1,.)

	local levels : rownames `mat'

	forvalues i=1/`nalt' {
		local ci = `order'[`i',1]
		local olevels `"`olevels' `ci'"'

		local ci : word `i' of `levels'
		local j = 0
		local found = 0
		while `found'==0 & `j'<`nalt' {
			cap local found = (`ci' == `order'[`++j',1])
			if (_rc > 0) continue, break
		}
		if `found' == 0 {
			di as error "internal error pivoting matrix" 
			exit 113
		}
		matrix `ip'[`i',1] = `j'
		forvalues k=1/`nalt' {
			matrix `mat1'[`j',`k'] = `mat'[`i',`k']
		}
	}
	matrix `mat' = `mat1'
	forvalues i=1/`nalt' {
		local k = `ip'[`i',1]
		forvalues j=1/`nalt' {
			matrix `mat1'[`j',`k'] = `mat'[`j',`i']
		}
	}
	matrix `mat' = `mat1'
	matrix rownames `mat' = `olevels'
	matrix colnames `mat' = `olevels'
	
	if `renumber' {
		/* used for corpattern and corfixed matrices */
		local kd = 0
		local kl = 0
		forvalues j=1/`nalt' {
			if `mat'[`j',`j'] < . {
				matrix `mat'[`j',`j'] = `++kd'
			}
			local j1 = `j'+1
			forvalues i=`j1'/`nalt' {
				if `mat'[`i',`j'] < . {
					matrix `mat'[`i',`j'] = `++kl'
					matrix `mat'[`j',`i'] = `kl'
				}
			}
	
		}