asmprobit.ado

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

	}

end

program CopyVarStruct, rclass
	args corstr corfix varstr varmat vartype ibase ifixed 

	local levels : rownames `corstr'
	local nalt : word count `levels'

	if (rowsof(`varstr')==`nalt' & colsof(`varstr')==1) matrix `varstr' = `varstr''
	
	if rowsof(`varstr')!=1 | colsof(`varstr')!=`nalt' {
		di as error "matrix specified in stddev() must be 1 by `nalt'"
		exit 198
	}
	matrix colnames `varstr' = `levels'
	local nvar = 0
	if "`vartype'" == "pattern" {
		tempname v
		matrix `v' = J(`nalt',1,0) 
	}
	forvalues i=1/`nalt' {
		if "`vartype'" == "pattern" {
			if (`varstr'[1,`i'] == 0) matrix `varstr'[1,`i'] = .
			local k = `varstr'[1,`i'] 
			matrix `corstr'[`i',`i'] = `k'
			if `k' >= . {
				/* fixed to 1 */
				if (`ibase'>=. & `ifixed'!=`i') local ibase = `i'
				else if (`ifixed'>=. & `ibase'!=`i') local ifixed = `i'

				matrix `corfix'[`i',`i'] = 1
			}
			else {
				if `k'<1 | `k'>`nalt' {
					di as error "{p}variance parameters identified in " ///
					 "`varmat' must be consecutive starting from 1 "    ///
					 "and cannot exceed `nalt'{p_end}"
					error 417
				}
				matrix `v'[`k',1] = `v'[`k',1] + 1
				if (`k' > `nvar') local nvar = `k'
				/* free parameter */
				matrix `corfix'[`i',`i'] = .
			}
			
		}
		else { /* "`vartype'" == "fixed" */
			local val = `varstr'[1,`i']
			matrix `corfix'[`i',`i'] = `val'
			if `val' < . {
				if `val' <= 0.0 {
					di as error "{p}fixed standard deviation "    ///
					 "`varmat'[1,`i'] = " %10.0g `val' " is not " ///
					 "valid {p_end}"
					exit 411
				}
				/* fixed to a user specified constant */
				if (`ibase'>=. & `ifixed'!=`i') local ibase = `i'
				else if (`ifixed'>=. & `ibase'!=`i') local ifixed = `i'

				matrix `corstr'[`i',`i'] = .
			}
			else {
				/* free parameter, add to pattern matrix */
				matrix `corstr'[`i',`i'] = `++nvar'
			}
		}
	}
	if "`vartype'" == "pattern" {
		forvalues i=1/`nvar' {
			if `v'[`i',1] == 0 {
				di as error "{p}variance parameters identified in "  ///
				 "`varmat' must be consecutive starting from 1 and " ///
				 "cannot exceed `nalt'{p_end}"
				error 417
			}
		}
	}
	return local ibase `ibase'
	return local ifixed `ifixed'
	return local nvar `nvar'
end

program CorStruct, rclass
	args nalt correlation stddev ibase ifixed varmat vartype

	tempname corstr corfix order
	matrix `corstr' = J(`nalt',`nalt',.)
	matrix `corfix' = I(`nalt')
	
	matrix `order' = J(`nalt',1,1)
	local levels  "1"
	forvalues i=2/`nalt' { 
		matrix `order'[`i',1] = `i'
		local levels `"`levels' `i'"'
	}
	matrix rownames `corstr' = `levels'
	matrix colnames `corstr' = `levels'
	matrix rownames `corfix' = `levels'
	matrix colnames `corfix' = `levels'

	if `varmat' {
		tempname varstr 
		matrix `varstr' = `stddev'
		local varmat = "`stddev'"
		local stddev = "user" 

		CopyVarStruct "`corstr'" "`corfix'" "`varstr'" "`varmat'" "`vartype'" ///
			`ibase' `ifixed' 
		local ibase = `r(ibase)'
		local ifixed = `r(ifixed)'
		local nvar = `r(nvar)'

		if `ibase' >= . {
			di as error "{p}could not find an appropriate base alternative; " ///
			 "at least two standard deviations must be fixed, or use the "    ///
			 "basealternative() option{p_end}"
			exit 453
		}
		else if `ifixed' >= . {
			di in gr "{p 0 7}Note: could not find an appropriate scale " ///
			 "alternative; the model may not be scaled{p_end}"
		}
	}
	else {
		if `ibase' >= .  {
			loca ibase = 1
			if (`ibase' == `ifixed') local ibase = 2
		}
		if `ifixed' >= . {
			local ifixed = 1
			if (`ifixed' == `ibase') local ifixed = 2
		}
	}

	local alpha = 1
	local sigma = 1

	if "`correlation'" == "indep" {
		forvalues i=1/`nalt' {
			if (`i'==`ibase' | `i'==`ifixed') continue
			if "`stddev'" == "heter" {
				matrix `corstr'[`i',`i'] = `sigma'
				matrix `corfix'[`i',`i'] = .
				local sigma = `sigma'+1
			}
		}
		return local ncor = 0
		if ("`stddev'"=="user") return local nvar = `nvar'
		else return local nvar = `sigma'-1
	}
	else {
		local ibs = 0
		local ifx = 0
		forvalues j=1/`nalt' {
			if (`j'==`ibase') continue
			else if "`stddev'"=="heter" & `j'!=`ifixed' {
				matrix `corstr'[`j',`j'] = `sigma'
				matrix `corfix'[`j',`j'] = .
				local sigma = `sigma'+1
			}
			local i1 = `j'+1
			forvalues i=`i1'/`nalt' {
				if `i' != `ibase' { 
					matrix `corstr'[`i',`j'] = `alpha'
					matrix `corstr'[`j',`i'] = `alpha'
					matrix `corfix'[`i',`j'] = .
					matrix `corfix'[`j',`i'] = .
					if ("`correlation'"=="unstruct") local alpha = `alpha'+1
				}
			}
		}
		if ("`correlation'"=="unstruct") local alpha = `alpha'-1
		local sigma = `sigma'-1

		return local ncor = `alpha'
		if ("`stddev'"=="user") return local nvar = `nvar'
		else return local nvar = `sigma'
	}
	return matrix order = `order'
	return local ibase = `ibase'
	return local ifixed = `ifixed'	
	return matrix corstr = `corstr'
	return matrix corfix = `corfix'
end
	
program ValidateCorStruct, rclass
	args corstr nalt cormat vars ibase ifixed cortype bvarmat vartype

	if rowsof(`corstr')!=`nalt' | colsof(`corstr')!=`nalt' {
		di as error "matrix specified in correlation() must be " ///
		 "`nalt' by `nalt'"
		exit 198
	}
	tempname corfix order
	if "`cortype'" == "fixed" {
		matrix `corfix' = `corstr'
		matrix `corstr' = J(`nalt',`nalt',.)
	}
	else {
		matrix `corfix' = J(`nalt',`nalt',0)
	}
	matrix `order' = J(`nalt',1,1)
	matrix `corstr'[1,1] = .
	local levels "1"
	forvalues i=2/`nalt' {
		matrix `order'[`i',1] = `i'
		matrix `corstr'[`i',`i'] = .
		if `corstr'[`i',1] == 0 {
			matrix `corstr'[`i',1] = .
			matrix `corstr'[1,`i'] = .
		}
		local i1 = `i'+1
		forvalues j=`i1'/`nalt' {
			if `corstr'[`j',`i'] == 0 {
				matrix `corstr'[`j',`i'] = .
				matrix `corstr'[`i',`j'] = .
			}
		}
		local levels `"`levels' `i'"'
	}
	matrix rownames `corstr' = `levels'
	matrix colnames `corstr' = `levels'
	matrix rownames `corfix' = `levels'
	matrix colnames `corfix' = `levels'

	if `bvarmat' {
		tempname varstr 
		local varmat "`vars'"
		matrix `varstr' = `vars'
		local vars "user"

		CopyVarStruct "`corstr'" "`corfix'" "`varstr'" "`varmat'" "`vartype'" ///
			`ibase' `ifixed' 
		local nvar = `r(nvar)'
	}
	local ncor = 0
	if "`cortype'" == "pattern" {
		tempname r  
		local n = `nalt'*(`nalt'-1)/2
		matrix `r' = J(`n',1,0)
	}
	tempname nfree
	matrix `nfree' = J(1,`nalt',0)
	forvalues i=1/`nalt' {
		local j1 = `i'+1 
		forvalues j=`j1'/`nalt' {
			if "`cortype'"=="pattern" {
				local k = `corstr'[`j',`i']
				if  `k' < . {
					if `k'<1 | `k'>`n' {
						di as error "{p}correlation parameters identified " ///
						 "in `cormat' must be consecutive starting "   ///
						 "from 1 and cannot exceed `n'{p_end}"
						exit 417
					}
					matrix `r'[`k',1] = `r'[`k',1] + 1
					if  (`k' > `ncor') local ncor = `k'
					matrix `corfix'[`j',`i'] = .
					matrix `nfree'[1,`j'] = `nfree'[1,`j'] + 1
					matrix `nfree'[1,`i'] = `nfree'[1,`i'] + 1
				}
			}
			else {
				local val = `corfix'[`j',`i']
				if `val' < . {
					if `val'<-1 | `val'>1 {
						di as error "{p}fixed correlation identified in " ///
						 "`cormat' must be between -1 and 1 inclusive{p_end}"
						exit 417
					}
				}
				else {
					matrix `corstr'[`j',`i'] = `++ncor'
					matrix `nfree'[1,`j'] = `nfree'[1,`j'] + 1
					matrix `nfree'[1,`i'] = `nfree'[1,`i'] + 1
				}
			}
			/* ensure symmetric, lower triangular determines the content */
			matrix `corstr'[`i',`j'] = `corstr'[`j',`i'] 
			matrix `corfix'[`i',`j'] = `corfix'[`j',`i']
		}
	}
	if "`cortype'" == "pattern" {
		forvalues i=1/`ncor' {
			if `r'[`i',1] == 0 {
				di as error "{p}correlation parameters identified in " ///
				 "`cormat' must be consecutive starting from 1 and "   ///
				 "cannot exceed `n'{p_end}"
				error 417
			}
		}
	}
	/* try to find suitable base alternative */
	if `ibase' >= . {
		forvalues i=1/`nalt' {
			if `corstr'[`i',`i']>=. & `nfree'[1,`i']==0 {
				local ibase = `i'
				continue, break
			}
		}
		if `ibase' >= . {
			forvalues i=1/`nalt' {
				if `nfree'[1,`i'] == 0 {
					local ibase = `i'
					continue, break
				}
			}
		}
	}
	if `ibase' >= . {
		di as error "{p}could not find an appropriate base alternative; use the " ///
		 "basealternative() option{p_end}"
		exit 453
	}
	/* identify a suitable scale alternative */
	if `ifixed' == . {
		forvalues i=1/`nalt' {
			if `corstr'[`i',`i'] >= . {
				if `ibase' != `i' {
					local ifixed = `i'
					continue, break
				}
			}
		}
	}
	if `ifixed' >= . {
		di in gr "{p 0 7}Note: could not find an appropriate scale alternative; " /// 
		 "the model may not be scaled{p_end}"
	}
	else if !`bvarmat' {
		local nvar = 0
		if "`vars'" == "heter" {
			forvalues i=1/`nalt' {
				if `i'!=`ibase' & `i'!=`ifixed' {
					matrix `corstr'[`i',`i'] = `++nvar'
					matrix `corfix'[`i',`i'] = .
				}
				else {
					matrix `corstr'[`i',`i'] = .
					matrix `corfix'[`i',`i'] = 1
				}
			}
		}
		else { /* if "`vars'" == "homo" */
			forvalues i=1/`nalt' {
				matrix `corstr'[`i',`i'] = .
				matrix `corfix'[`i',`i'] = 1
			}
		}
	}
	
	return local ncor = `ncor'
	return local nvar = `nvar'
	return local stddev  "`vars'"
	return local ibase = `ibase'
	return local ifixed = `ifixed'
	return matrix corfix = `corfix'
	return matrix corstr = `corstr'
	return matrix order = `order'
end

program AlternativeIndex, rclass
	args  altlevels nalt altlabels level type

	local index = .
	if "`level'"!="" {
		if "`altlevels'" != "" {
			local i = 0
			while `++i'<=`nalt' & `index'>=. {
				local ialt = `altlevels'[`i',1]
				if (`"`level'"'==`"`ialt'"') local index = `i'
			}
		}
		if `index'>=. & "`altlabels'"!="" {
			local i = 0
			while `++i'<=`nalt' & `index'>=. {
				local labi : label `altlabels' `i'
				if (`"`level'"'==`"`labi'"') local index = `i'
			}
		}
		if "`type'"!="" & `index'>=. {
			di as error "{p}`type' `level' is not one of the alternatives; " ///
			 "use {help tabulate##|_new:tabulate} for a list of values{p_end}"
			exit 111
		}
	}
	return local index = `index'
end 

program GenTmat, rclass
	args nv nr corstr unstr

	tempname T
	local nc = `nv'+`nr'
	local m = rowsof(`corstr')
	local np = `m'*(`m'+1)/2

	matrix `T' = J(`np',`nc',0)
	local i = 1
	forvalues j=1/`m' {
		local j2 = `corstr'[`j',`j']
		if (`j2'<.) matrix `T'[`i',`j2'] = 1
		local j1 = `j' + 1
		forvalues k=`j1'/`m' {
			local i = `i'+1
			if `corstr'[`k',`j'] < . {
				local lc = `corstr'[`k',`j']
				local j2 = `nv'+`lc'
				matrix `T'[`i',`j2'] = 1
			}
		}
		local i = `i'+1
	}

	return matrix T = `T'
end

program CheckConstraints, eclass 
	args b nv clist

	local vconstr = 0
	local bconstr = 0
	if `"`clist'"' == "" {
		ereturn local vconstr = `vconstr'
		ereturn local bconstr = `bconstr'
		exit 0
	}
	tempname T a C CV V b1 CB
		
	matrix `b1' = `b'
	matrix `V' = `b''*`b'
	ereturn post `b1' `V' 
	makecns `clist', nocnsnotes r
	if r(k) == 0 {
		ereturn local vconstr = `vconstr'
		ereturn local bconstr = `bconstr'
		exit 0
	}	
	matcproc `T' `a' `C'

	local nr = rowsof(`C')
	local nc = colsof(`C')
	local i1 = `nc'-`nv'-1
	forvalues i=1/`nr' {
		forvalues j=1/`i1' {
			if `C'[`i',`j'] != 0 {
				local `++bconstr'
				matrix `CB' = (nullmat(`CB')\(`C'[`i',1..`i1'],`C'[`i',`nc']))
				continue, break
			}
		}
	}
	ereturn local bconstr = `bconstr'
	if (`bconstr' > 0) ereturn matrix C = `CB'

	if `nv' > 0 {
		local `++i1'
		local `--nc'
		local j = 0

		forvalues i = 1/`nr' {
			forvalues j = `i1'/`nc' {
				if `C'[`i',`j'] != 0 {
					local `++vconstr'
					continue, break
				}
			}
		}
	}

	ereturn local vconstr = `vconstr'
end

program AlternStats, rclass
	syntax varlist [fw iw], nalt(integer) [ altlevels(string) ]

	gettoken case varlist : varlist
	gettoken alternatives varlist : varlist
	gettoken choice varlist : varlist	

	tempvar ix
	tempname stats sum
	matrix `stats' = J(`nalt',4, 0)
	matrix colnames `stats' = level case_present freq_select per_select
	qui gen int `ix' = 0
	scalar `sum' = 0
	forvalues i=1/`nalt' {
		local index `"`index' `i'"'
		if ("`altlevels'" != "") matrix `stats'[`i',1] = `altlevels'[`i',1]
		else matrix `stats'[`i',1] = `i'
		qui replace `ix' = 1 if `alternatives' == `i'
		qui summarize `ix' [`weight'`exp'] 
		matrix `stats'[`i',2] = r(sum)
		qui replace `ix' = 0
		qui replace `ix' = 1 if `alternatives'==`i' & `choice'==1
		qui summarize `ix' [`weight'`exp'] 
		matrix `stats'[`i',3] = r(sum)
		scalar `sum' = `sum'+`stats'[`i',3] 
		qui replace `ix' = 0
	}
	matrix rownames `stats' = `index'
	forvalues i=1/`nalt' {
		matrix `stats'[`i',4] = `stats'[`i',3]/`sum'
	}
	
	return matrix stats = `stats'
end

program CheckMemoryForRobust

	local nalt = $MPROBIT_NALT-2
	if (`nalt'<=0) exit

	local i = 0
	forvalues j = 1/`nalt' {
		foreach scr of global MPROBIT_CSCRS {
			tempvar c`++i'
			qui gen double `c`i'' = 0
		}
	} 
end