slogit.ado

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

	scalar `ll_0' = e(ll_0)
	scalar `df_0' = e(k_out)-1
	matrix `b' = e(b)

	local nb = colsof(`b')
	local nrp1  = `nreg'+1
	forvalues i = 1(`nrp1')`nb' {
		local j = `i'+`nreg'-1
		matrix `B' = (nullmat(`B') \ `b'[1,`i'..`j'])
	}
	local p = `dim'*`nlm1'
	local k = `nreg'*`dim'+1

	if "`initialize'" == "const" {
		local d = min(1/`dim',.5)
		matrix `P' = J(`p',1,`d')
	}
	else if "`initialize'" == "rand" {
		matrix `P' = matuniform(`p',1)
	}
	else if "`initialize'" == "svd" {
		if `nlm1' >= `nreg' {
			matrix svd `U' `D' `V' = `B'
			matrix `V' = `V''
		}
		else {
			matrix `B' = `B''
			matrix svd `V' `D' `U' = `B'
			matrix `U' = `U''
		}
		if `U'[1,1] < 0.0 {
			matrix `U' = -`U'
			matrix `V' = -`V'
		}
		matrix drop `B'
		forvalues i = 1/`dim' {
			matrix `v' = `D'[1,`i']*`V'[1...,`i']
			matrix `B' = (nullmat(`B'),`v')
			matrix `P' = (nullmat(`P') \ `U'[1...,`i'])
		}
		matrix drop `D' `V' `U' `v'
	}
	else {
		di as error "option initialize() must specify " ///
		 "constant, random, or svd"
		exit 198
	}
	MakeModel `"`resp'"' `"`covar'"'
	local names `"`r(names)'"'
	matrix `from' = J(1,`ncoef',0.0)
	matrix colnames `from' = `names'

	if "`nocorner'" == "" {
		GenConstr 
		local corcon `"`r(constr)'"'
		global MPROBIT_corcon = `"`corcon'"'
		local constr `"`corcon' `constr'"'
	}
	local nc = 0
	if "`constr'" != "" {
		matrix `D' = `from'
		matrix `V'= I(`ncoef')
		matrix rownames `V' = `names'
		matrix colnames `V' = `names'
		ereturn post `D' `V'
		MakeConstr "`constr'" `p' `k' `nlm1' "`P'"
		local nc = `r(nc)'
		if `r(nc)' > 0 {
			tempname C c s
			matrix `C' = r(C)
			matrix `P' = r(P)
			local conopt "constraint(`C')"
			if `"`corcon'"' != "" {
				constraint drop `corcon'
			}
			local nc =  rowsof(`C')
			local p = `nreg'*`dim'
			forvalues j = 1/`p' {
				local k =  mod(`j'-1,`nreg')+1 
				scalar `s' = `sd'[1,`k']
				forvalues i = 1/`nc' {
					matrix `C'[`i',`j'] = `C'[`i',`j']/`s'
				}
			}
		}
	}
	if `nc' == 0 {
		tempname P1 
		matrix `P1' = `P'
		matrix `P'  = J(`nlm1',`dim',0)
		
		local i1 = 0
		forvalues j=1/`dim' {
			forvalues i=1/`nlm1' {
				matrix `P'[`i',`j'] = `P1'[`i1'+`i',1]
			}
			local i1 = `i1'+`nlm1'
		}
	}
	if "`initialize'" != "svd" {
		if `nc' == 0 {
			matrix `B' = `B''
		}
		else {
			tempname DV
			matrix svd `U' `D' `V' = `P'
			matrix `V' = `V''
       			forvalues i = 1/`dim' {
				if `D'[1,`i'] > c(epsdouble) {
					matrix `v' = `V'[1...,`i']/`D'[1,`i']
					matrix `DV' = (nullmat(`DV'),`v')
				}
				else {
					matrix `DV' = (nullmat(`DV'),J(`dim',`dim',0.0))
				}
			}
			matrix `B' = `B''*`U'*`DV'
			matrix drop `D' `V' `U' `DV'
		}
	}
	local kb = 0
	local k = `dim'*`nreg'
	/* initial beta */
	forvalues dm = 1/`dim' {
		forvalues i=1/`nreg' {
			matrix `from'[1,`++kb'] = -`B'[`i',`dm']
		}
		/* initial phi */
		forvalues i = 1/`nlm1' {
			matrix `from'[1,`++k'] = `P'[`i',`dm']
		}
	}
	matrix drop `B' `A'

	/* initial theta */
	forvalues i = `nrp1'(`nrp1')`nb' {
		matrix `from'[1,`++k'] = `b'[1,`i']
	}
	if "`nonormalize'" == "" {
		MakeModel `"`resp'"' `"`scovar'"'
		local model `"`r(model)'"'
		matrix colnames `from' = `r(names)'
		ml model d2 slogit_d2 `model' [`weight'`exp'] `if', `conopt'    ///
			 init(`from') search(off) max nooutput `nolog' `robust' ///
			`cluster' `mlopts' 

		matrix `from' = e(b)
		local lev: word 1 of `levls'
	        local l = colnumb(`from',"phi1_`lev':") 
        	local t = colnumb(`from',"theta`lev':") - 1
		local k = 1
		forvalues i = 1/`dim' {
			scalar `V' = 0.0
			forvalues j = 1/`nreg' {
				matrix `from'[1,`k'] = `from'[1,`k']/`sd'[1,`j']
				scalar `V' = `V' + `from'[1,`k']*`m'[1,`j']
				local k = `k' + 1
			}
			forvalues j = 1/`nlm1' {
				matrix `from'[1,`j'+`t'] = `from'[1,`j'+`t'] + ///
					`from'[1,`l']*`V'
				local l = `l' + 1
			}
		}
		matrix colnames `from' = `names'
		ereturn repost b = `from', rename
	}
	else ereturn post `from'
	
	ereturn scalar ll_0 = `ll_0'
	ereturn scalar df_0 = `df_0' 
end

program MakeModel, rclass
        args resp covar

	local nreg = $STEREO_nreg
	local dim  = $STEREO_dim
	local nlev = $STEREO_nlev
	local levls `"$STEREO_levels1"'

	local nlm1 = `nlev' - 1
	local beta "(dim1: `resp' = `covar', nocons)"
	/* initial beta */
	forvalues dm = 1/`dim' {
		if `dm' > 1 {
			local beta `"`beta' (dim`dm': `covar', nocons)"'
		}
		foreach vari of local covar {
			/* column names of the `from' vector */
			local bfrom `"`bfrom' dim`dm':`vari'"'
		}
		/* initial phi */
		local i = 0
		foreach j of local levls {
			/* names of the score variables */
			local dpv `"`dpv' dpv`dm'`++i'"'
			/* ml model specification */
			local phi `"`phi' /phi`dm'_`j'"'
			/* column names of the `from' vector */
			local pfrom `"`pfrom' phi`dm'_`j':_cons"'
		}
		local dbv `"`dbv' dbv`dm'"'
	}

	/* initial theta */
	local i = 0
	foreach j of local levls {
		/* column names of the `from' vector */
		local tfrom `"`tfrom' theta`j':_cons"'
		/* names of the score variables */
		local dtv `"`dtv' dtv`++i'"'
		/* ml model specification */
		local theta `"`theta' /theta`j'"'
	}
	global STEREO_dv `"`dbv'`dpv' `dtv'"'
	return local names `"`bfrom'`pfrom'`tfrom'"'
	return local model `"`beta'`phi'`theta'"'
end

program GenConstr, rclass
	local nlm1 = $STEREO_nlev-1

        forvalues dm = 1/$STEREO_dim {
        	forvalues j = 1/$STEREO_dim {
                	local i : word `j' of $STEREO_levels
                        constraint free
			local val = (`j'==`dm')
                        constraint `r(free)' [phi`dm'_`i']_cons = `val'
                        local constraint `"`constraint' `r(free)'"'
		}
	}
	return local constr `"`constraint'"'
end

/* taken from matcproc to apply constraints only on Phi's */
program MakeConstr, rclass
	args constr p k q P

	tempname C0 C1 C V V2 D Z v a c c1
	matrix makeCns `constr'
	matrix `C0' = get(Cns)
	local j = `k'+`p'-1
	matrix `C1' = `C0'[.,`k'..`j']
	/* remove rows of C with zeros */
	local nc = rowsof(`C1')
	local j = colsof(`C0')
	matrix `c1' = `C0'[1...,`j']
	forvalues i = 1/`nc' {
		matrix `v' = `C1'[`i',1...]
		matrix `a' = `v'*`v''
		/* phi constraint */
		if `a'[1,1] > c(epsdouble) {
			matrix `C' = (nullmat(`C') \ `v')
			matrix `c' = (nullmat(`c') \ `c1'[`i',1])
		}
	}
	cap local nc = rowsof(`C')
	if _rc > 0 {
		return local nc = 0
		exit 0
	}
	local k = `p' - `nc'
	local kp1 = `k'+1
	matrix `Z' = I(`p') - `C''*syminv(`C'*`C'')*`C'

	matrix symeig `V' `D' = `Z'
    	if `D'[1,`kp1'] > .5 { 
		error 412
	}
	matrix `V2' = `V'[.,`kp1'...]
	matrix `a' = `V2'*inv(`C'*`V2')*`c'
	if `k' > 0 {
		matrix `V' = `V'[.,1..`k']
		matrix `a' = `V'*`V''*`P' + `a'
	}
	matrix drop `D'
	forvalues j = 1(`q')`p' {
		local k = `j' + `q' - 1
		matrix `D' = (nullmat(`D'),`a'[`j'..`k',1])
	}
	local nc = rowsof(`C0')
	return local nc = `nc'
	return matrix C = `C0'
	return matrix P = `D'
end

program CategoryIndex, rclass
        args  catlevels catlabels level resp

        local index = .
        local ncat = rowsof(`catlevels')
        if "`level'"!="" {
                local i = 0
                while `++i'<=`ncat' & `index'>=. {
                        local icat = `catlevels'[`i',1]
                        if (`"`level'"'==`"`icat'"') local index = `i'
                }
                if `index'>=. & "`catlabels'"!="" {
                        local i = 0
                        while `++i'<=`ncat' & `index'>=. {
                                local label : label `catlabels' `=`catlevels'[`i',1]'
                                if (`"`level'"'==`"`label'"') local index = `i'
                        }
                }
                if `index' >= . {
			di as error "{p}baseoutcome(`level') is not an "  ///
	"outcome of `resp'; use {help tabulate##|_new:tabulate} for a " ///
			 "list of values{p_end}"
			exit 459
                }
	
        }
	else local index = `ncat'
	
	forvalues i=1/`ncat' {
		if (`i' == `index') continue
		local levels `"`levels' `i'"'
	}

        return local index = `index'
	return local levels  `"`levels'"'
end