_mprobitestimator.ado

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

				matrix `corfix'[`j',`j'] = .
			}
			
		}
		else { /* "`vartype'" == "fixed" */
			local val = `varstr'[1,`i']
			matrix `corfix'[`j',`j'] = `val'
			if `val' < . {
				if `val' <= 0.0 {
					di as error "{p}fixed standard deviation specified " ///
					 "in `varmat' for alternative `choi', " %10.0g `val' ///
					 ", is not valid {p_end}"
					exit 411
				}
				/* fixed to a user specified constant */
				if ("`base'"=="" & "`fixed'"!="`choi'")	local base = `choi'
				else if ("`fixed'"=="" & "`base'"!="`choi'") local fixed = `choi'

				matrix `corstr'[`j',`j'] = .
			}
			else {
				/* free parameter, add to pattern matrix */
				matrix `corstr'[`j',`j'] = `++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 `nchoice'{p_end}"
				error 417
			}
		}
	}
	return local base `base'
	return local fixed `fixed'
	return local nvar `nvar'
end

program CorStruct, rclass
	args mchoices correlation stddev base fixed varmat varcopy ///
		vartype

	local nchoice = rowsof(`mchoices')
	tempname corstr corfix
	matrix `corstr' = J(`nchoice',`nchoice',.)
	matrix `corfix' = I(`nchoice')
	
	if `varmat' {
		local nclust = 1

		local choices  = `mchoices'[1,1]
		forvalues i=2/`nchoice' {
			local choi = `mchoices'[`i',1]
			local choices `"`choices' `choi'"'
		}
		matrix rownames `corstr' = `choices'
		matrix colnames `corstr' = `choices'
		matrix rownames `corfix' = `choices'
		matrix colnames `corfix' = `choices'

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

		CopyVarStruct "`corstr'" "`corfix'" "`varstr'" "`varmat'" "`vartype'" ///
			`varcopy' "`base'" "`fixed'" 
		local base = "`r(base)'"
		local fixed = "`r(fixed)'"
		local nvar = `r(nvar)'
		if "`base'" == "" {
			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 "`fixed'" == "" {
			di in gr "{p 0 7}Note: could not find an appropriate scale alternative; " /// 
			 "the model may not be scaled{p_end}"
			local fixed = .
		}
	}
	else {
		local nclust = 1

		if "`base'" == ""  {
			local base = `mchoices'[1,1]
			if ("`base'"=="`fixed'") local base = `mchoices'[2,1]
		}
		if "`fixed'"=="" {
			local fixed = `mchoices'[1,1]
			if (`fixed'==`base') local fixed = `mchoices'[2,1]
		}
		if "`correlation'"=="unstruct" & "`stddev'"=="heter" {
			/* reorder so base is the first alternative and scale is second */
			if `base'!=`mchoices'[1,1] | `fixed'!=`mchoices'[2,1] {
				local k = `nchoice'
				forvalues i=`nchoice'(-1)1 {
					local choi = `mchoices'[`i',1]
					if `choi' == `base' {
						local cb = `choi'
						continue
					}
					else if `choi' == `fixed' {
						local cf = `choi'
						continue
					}
					matrix `mchoices'[`k--',1] = `choi'
				}
				matrix `mchoices'[`k--',1] = `cf'
				matrix `mchoices'[`k',1] = `cb'
			}
		}
		local choices  = `mchoices'[1,1]
		forvalues i=2/`nchoice' {
			local choi = `mchoices'[`i',1]
			local choices `"`choices' `choi'"'
		}
		matrix rownames `corstr' = `choices'
		matrix colnames `corstr' = `choices'
		matrix rownames `corfix' = `choices'
		matrix colnames `corfix' = `choices'
	}

	local alpha = 1
	local sigma = 1

	if "`correlation'" == "indep" {
		forvalues i=1/`nchoice' {
			local choi = `mchoices'[`i',1]
			if (`choi'==`base' | `choi'==`fixed') 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/`nchoice' {
			local choj = `mchoices'[`j',1]
			if `choj' == `base' {
				local ibs = `j'
				continue
			}
			else if `choj' == `fixed' { 
				local ifx = `j'
			}
			else if "`stddev'"=="heter" {
				matrix `corstr'[`j',`j'] = `sigma'
				matrix `corfix'[`j',`j'] = .
				local sigma = `sigma'+1
			}
			local i1 = `j'+1
			forvalues i=`i1'/`nchoice' {
				local choi = `mchoices'[`i',1]
				if `choi' != `base' { 
					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 local base = `base'
	return local fixed = `fixed'	
	return matrix corstr = `corstr'
	return local stddev "`stddev'"
	return matrix corfix = `corfix'
end
	
program ValidateCorStruct, rclass
	args corstr mchoices cormat vars base fixed corcopy cortype bvarmat varcopy ///
		vartype

	local nchoice = rowsof(`mchoices')
	if rowsof(`corstr')!=`nchoice' | colsof(`corstr')!=`nchoice' {
		di as error "matrix specified in correlation() must be " ///
		 "`nchoice' by `nchoice'"
		exit 198
	}
	if `corcopy' == 0 {
		/* permute correlation pattern/fixed matrix to be in the same order 	*/
		/* order as the matrix mchoices	  					*/
		ChoiceOrderC "`corstr'" "`mchoices'" "`cormat'" 0
	}
	tempname corfix
	if "`cortype'" == "fixed" {
		matrix `corfix' = `corstr'
		matrix `corstr' = J(`nchoice',`nchoice',.)
	}
	else {
		matrix `corfix' = J(`nchoice',`nchoice',0)
	}
	matrix `corstr'[1,1] = .
	local choices = `mchoices'[1,1]
	forvalues i=2/`nchoice' {
		matrix `corstr'[`i',`i'] = .
		if `corstr'[`i',1] == 0 {
			matrix `corstr'[`i',1] = .
			matrix `corstr'[1,`i'] = .
		}
		local i1 = `i'+1
		forvalues j=`i1'/`nchoice' {
			if `corstr'[`j',`i'] == 0 {
				matrix `corstr'[`j',`i'] = .
				matrix `corstr'[`i',`j'] = .
			}
		}
		local choi = `mchoices'[`i',1]
		local choices `"`choices' `choi'"'
	}
	matrix rownames `corstr' = `choices'
	matrix colnames `corstr' = `choices'
	matrix rownames `corfix' = `choices'
	matrix colnames `corfix' = `choices'

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

		CopyVarStruct "`corstr'" "`corfix'" "`varstr'" "`varmat'" "`vartype'" ///
			`varcopy' "`base'" "`fixed'" 
		local nvar = `r(nvar)'
	}
	local ncor = 0
	if "`cortype'" == "pattern" {
		tempname r  
		local n = `nchoice'*(`nchoice'-1)/2
		matrix `r' = J(`n',1,0)
	}
	tempname nfree
	matrix `nfree' = J(1,`nchoice',0)
	forvalues i=1/`nchoice' {
		local j1 = `i'+1 
		forvalues j=`j1'/`nchoice' {
			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 "   ///
						 "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 "`base'" == "" {
		forvalues i=1/`nchoice' {
			if `corstr'[`i',`i']>=. & `nfree'[1,`i']==0 {
				local base : word `i' of `choices'
				continue, break
			}
		}
		if "`base'" == "" {
			forvalues i=1/`nchoice' {
				if `nfree'[1,`i'] == 0 {
					local base : word `i' of `choices'
					continue, break
				}
			}
		}
	}
	if "`base'" == "" {
		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 "`fixed'" == "" {
		forvalues i=1/`nchoice' {
			if `corstr'[`i',`i'] >= . {
				local choi : word `i' of `choices'
				if "`choi'" != "`base'" {
					local fixed = `choi'
					continue, break
				}
			}
		}
	}
	if "`fixed'" == "" {
		di in gr "{p 0 7}Note: could not find an appropriate scale alternative; " /// 
		 "the model may not be scaled{p_end}"
		local fixed = .
	}
	else if !`bvarmat' {
		local nvar = 0
		if "`vars'" == "heter" {
			forvalues i=1/`nchoice' {
				if `mchoices'[`i',1]!=`base' & `mchoices'[`i',1]!=`fixed' {
					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/`nchoice' {
				matrix `corstr'[`i',`i'] = .
				matrix `corfix'[`i',`i'] = 1
			}
		}
	}
	
	return local ncor = `ncor'
	return local nvar = `nvar'
	return local stddev  "`vars'"
	return local base = `base'
	return local fixed = `fixed'
	return matrix corfix = `corfix'
	return matrix corstr = `corstr'
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)
        if `unstr' {
		matrix `T' = J(`np',`nc',0)
		local i = 0
		local j2 = 0
		forvalues j=1/`m' {
			local i = `i' + 1
			if `corstr'[`j',`j']<. {
				matrix `T'[`i',`++j2'] = 1
			}
			local j1 = `j' + 1
			forvalues k=`j1'/`m' {
				local i = `i'+1
				if `corstr'[`k',`j']<. {
					matrix `T'[`i',`++j2'] = 1
				}
			}
		}
	}
	else {
		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