slogit.ado

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

*! version 1.2.0  03jun2005
* slogit - maximum likelihood estimation of a stereotype regression model 

program slogit, sortpreserve byable(onecall) prop(ml_score)
	version 9

	if _by() {
		local BY `"by `_byvars'`_byrc0':"'
	}
	`BY' _vce_parserun slogit : `0'
	if "`s(exit)'" != "" {
		exit
	}
	if replay() {
		if _by() error 190
		if `"`e(cmd)'"' != "slogit" error 301
		Replay `0'
		exit
	}
	cap noi `BY' Estimate `0'
	local rc = _rc
	if `"$MPROBIT_corcon"' != "" {
		constraint drop $MPROBIT_corcon
	}
	macro drop STEREO_*
	exit `rc'
end

program Estimate, eclass byable(recall)
	syntax varlist(min=2) [if] [in] [fw pw iw] [,	///
		DIMension(integer 1) 			///
		Baseoutcome(string)			///
		Level(cilevel)		 		///
		Robust 					///
                noLOg                                   ///
		CONSTraints(numlist > 0 integer)	///
		noCORNer				///
		INITialize(passthru)			///
		noNORMalize				///
		FROM(string)				///
                SCore(passthru)                         ///
		CLuster(passthru)			///
		noDROP					///
		DEBug					///
		* ]

	gettoken resp covar : varlist
	mlopts mlopts rest, `options'
	if "`rest'" != "" {
		PostError, `rest'
	}
	local diopts level(`level')
	if "`score'" != "" {
		local nopre  nopre
	}
	marksample touse
	cap confirm string variable `resp'
	if _rc == 0 {
		di as error "{p}dependent variable is a string variable; " ///
		 "use {help encode##|_new:encode} to convert it{p_end}"
		exit 108
	}
	if "`drop'"!="" & "`from'"=="" {
		/* nodrop is undocumented; prevents dropping collinear 	*/
		/*  variables.						*/
		di as error "must use from() with the nodrop option"
		exit 198
	}
	if "`drop'" == "" {
		/* remove collinear variables */
		_rmcoll `covar' if `touse'
		local covar `"`r(varlist)'"'
	}

	local tabwgt  "`weight'"
	if "`tabwgt'" == "pweight" {
		local tabwgt "iweight"
	}
	tempname levels labels
	local labels : value label `resp'
	qui tabulate `resp' [`tabwgt'`exp'] if `touse', matrow(`levels')

	local nlev = r(r)
	if `nlev' == 1 {
		di as error "there is only one outcome in `resp'"
		exit 148
	}
	if `nlev' > 30 {
		di as error "there are `nlev' outcomes in `resp'; the maximum " ///
		 "number of outcomes is 30"
		exit 149
	}

	local nlm1 = `nlev'-1
	local nreg: word count `covar'

	local maxdim = min(`nlm1',`nreg')
	if `dimension'<=0 | `dimension'>`maxdim' {
		di as error "{p}dimension() must be a positive integer and "   ///
"cannot exceed `maxdim'; see {help slogit##|_new:slogit} for a definition " ///
		 "of the dimension limits{p_end}"
		exit 198
	}
	local ncoef = `dimension'*(`nreg'+`nlm1')+`nlm1'
	
	CategoryIndex "`levels'" "`labels'" "`baseoutcome'" "`resp'"
	local levls `"`r(levels)'"' 
	local ibase = `r(index)'

	/* create a proper factor variable for the response */
	tempvar fresp
	cap qui egen `fresp' = group(`resp') if `touse'
	if _rc > 0 {
		/* should not happen */
		di as error "failed to renumber outcome levels"
		error _rc
	}

        global STEREO_nreg = `nreg'
	global STEREO_dim = `dimension'
	global STEREO_nlev = `nlev'
	global STEREO_levels `"`levls' `ibase'"'
	global STEREO_levels1 `"`levls'"'
	global STEREO_base = `ibase'
	global STEREO_resp `"`fresp'"'

	tempname ll_0 df_0
	if "`from'" == "" {
		InitStereo `resp' `covar' [`weight'`exp'] if `touse', ///
			constr(`constraints') `corner' `initialize'   /// 
			`normalize' `log' `robust' `cluster' `mlopts'

		if "`normalize'" == "" {
			local log nolog
			local qui qui 
			tempname ic ilog
			scalar `ic' = e(ic)
			matrix `ilog' = e(ilog)
			local converged = e(converged)
			local rc = e(rc)
			if `converged' == 0 {
				/* prevent exceeding maxit again */
				local 0 ,`mlopts'
				syntax [, ITERate(int -1) *]
				mlopts mlopts rest, `options'
				local iteropt iterate(1)
			}
		}

		tempname from
		matrix `from' = e(b)
		tempname ll_0 df_0 
		scalar `ll_0' = e(ll_0)
		scalar `df_0' = e(df_0)
		local d2 d2
	}
	else {
		qui mlogit `fresp' if `touse'
		local search quietly
		scalar `df_0' = e(k_cat)-1
		scalar `ll_0' = e(ll)
		if ("`debug'" == "") local d2 d2
		else {
			local d2 d2debug
			local debopt trace gradient hessian   
		}	
	}
	MakeModel `"`resp'"' `"`covar'"'
	local model `"`r(model)'"'
	if "`corner'" == "" {
		GenConstr 
		global MPROBIT_corcon `"`r(constr)'"'
		local constraints `"$MPROBIT_corcon `constraints'"'
	}
	`qui' ml model `d2' slogit_d2 `model' [`weight'`exp'] if `touse',  ///
		constraints(`constraints') `robust' `nopre' init(`from')   ///
		max nooutput `log' `score' `cluster' waldtest(`dimension') ///
		search(off) collinear `mlopts' `iteropt' `debopt' 

	forvalues i=`nlev'(-1)1 {
		local a`i' = `levels'[`i',1]
		if "`labels'" != "" {
			local lab`i' : label `labels' `a`i''
			ereturn local out`i' `"`lab`i''"'
			local outlab `"`"`lab`i''"' `outlab'"'
		}
		else {
			ereturn local out`i' `"`a`i''"'
			local outlab `"`"`a`i''"' `outlab'"'
		}
	}
	ereturn local labels `"`:list retok outlab'"'
	ereturn matrix outcomes = `levels'
	ereturn local indvars `"`covar'"'
	ereturn local title "Stereotype logistic regression"
	ereturn scalar k_dim = `dimension'
	ereturn scalar k_indvars = $STEREO_nreg
	ereturn scalar k_out = $STEREO_nlev
	ereturn scalar i_base = $STEREO_base
	ereturn scalar ll_0 = `ll_0'
	ereturn scalar df_0 = `df_0'
	if "`ic'" != "" {
		ereturn scalar ic = `ic'
		ereturn scalar converged = `converged'
		ereturn matrix ilog = `ilog'
		ereturn scalar rc = `rc'
	}
	ereturn local k_dv 
	ereturn local k_eq	

	ereturn local predict "slogit_p"
	ereturn local cmd slogit

	Replay, `diopts'
end

program Replay
	syntax [, Level(cilevel)]

	local dim = e(k_dim)
	local nl = e(k_out)
	if `dim' == 1 {
		ml display, level(`level') first plus
	}
	else {
		ml display, level(`level') neq(`dim') plus
	}
	forvalues dm = 1/`dim' {
		forvalues j= 1/`nl' {
			if `j' == e(i_base) {
				_choice_table phi`dm'_`j', value(0) ///
					comment("  (base outcome)") nosep aux
			}
			else {
				_diparm phi`dm'_`j', level(`level')
			}
		}
		_get_diparmopts, diparmopts(diparm(__sep__)) execute
	}
	forvalues j= 1/`nl' {
		if `j' == e(i_base) {
			_choice_table theta`j', value(0) ///
				comment("  (base outcome)") nosep aux
		}
		else {
			_diparm theta`j', level(`level')
		}
	}
	_get_diparmopts, bottom execute
	local i = `e(i_base)'
	if (wordcount("`e(out`i')'") > 1) local base `""`=abbrev("`e(out`i')'",17)'""'
	else local base `"`=abbrev(`"`e(out`i')'"',17)'"'
        di in gr `"{p}(`e(depvar)'=`base' is the base outcome){p_end}"'

	_prefix_footnote
end

program PostError
        syntax [, DIMension(string) ]

	if "`dimension'" != "" {
		di as error "option dimension() must be a positive integer"
		exit 198
	}
end

program InitStereo, eclass
        syntax varlist [fw pw iw] if, [constr(numlist) NOCOrner   ///
		INITialize(string) NONORMalize NOLOg Robust       ///
		CLuster(passthru) *]

        gettoken resp covar : varlist
	mlopts mlopts, `options' 

	local nreg = $STEREO_nreg
	local dim  = $STEREO_dim
	local nlev = $STEREO_nlev
	local levls `"$STEREO_levels"'
	local base = $STEREO_base
	local fresp `"$STEREO_resp"'

	local nlm1 = `nlev' - 1
	local ncoef = `dim'*(`nreg'+`nlm1')+`nlm1'

	local linit = length("`initialize'")
	if "`initialize'"=="" || "`initialize'"==substr("constant",1,max(5,`linit')) {
		local initialize "const"
	}
	else if "`initialize'" == substr("random",1,max(4,`linit')) {
		local initialize "rand"
	}

	/* create standardized variables */
	tempname m sd
	matrix `m' = J(1,`nreg',0)
	matrix `sd' = J(1,`nreg',1)

	if "`nonormalize'" == "" {
		local i = 0
		foreach vari of local covar {
			cap confirm byte variable `vari'
			if _rc == 0 { 
				local scovar `"`scovar' `vari'"'
				local i = `i' + 1
			}
			else {
				tempvar x`++i'
				local sumwgt  "`weight'"
				if "`sumwgt'" == "pweight" {
					local sumwgt "iweight"
				}
				qui summarize `vari' [`sumwgt'`exp']
				matrix `m'[1,`i'] = r(mean)
				if r(sd) > 0.0 {
					matrix `sd'[1,`i'] = r(sd)
				}
				qui gen double `x`i'' = (`vari'-r(mean))/`sd'[1,`i']
				local scovar `"`scovar' `x`i''"'
			}
		}
	}
	else local scovar `"`covar'"'

	qui mlogit `fresp' `scovar' [`weight'`exp'] `if', base(`base') nolog

	tempname ll_0 df_0 b from B D U V P v