mlogit_p.ado

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

*! version 1.2.7  31mar2005
program define mlogit_p /* predict for mlogit and svymlogit */
	version 6, missing

/* Parse. */

	ParseNewVars `0'
	local varspec `s(varspec)'
	local varlist `s(varlist)'
	local typlist `s(typlist)'
	local nvars : word count `varlist'
	local if `"`s(if)'"'
	local in `"`s(in)'"'
	local options `"`s(options)'"'

	ParseOptions, `options'
	local equatio `"`s(outcome)'"'
	local type `s(type)'
	if "`type'" != "" {
		local `type' `type'
	}
	else {
		if `"`equatio'"' != "" {
			di in gr "(option pr assumed; predicted probability)"
		}
		else {
			di in gr "(option pr assumed; predicted probabilities)"
		}
	}

/* Check syntax. */

	if `nvars' > 1 {
		if `"`equatio'"' != "" {
			if inlist("`type'", "", "pr") {
				local tt "p with outcome()"
			}
			else	local tt `type'
			Onevar "`tt'" `varlist'
		}
		else {
			MultVars `varlist'
		}
		if `"`equatio'"' != "" {
			di as err ///
"option outcome() is not allowed when multiple new variables are specified"
			exit 198
		}
		if !inlist("`type'","","pr","scores") {
			di as err ///
			"option `type' requires the outcome() option"
			exit 198
		}
	}
	else if inlist("`type'","","pr","scores") & `"`equatio'"' == "" {
		MultVars `varlist'
	}
	else if `"`equatio'"' == "" {
		di as err ///
		"option `type' requires the outcome() option"
		exit 198
	}

/* Process equation/outcome. */

	if `"`equatio'"'!="" {
		local eqorig `"`equatio'"'

		if "`e(cmd)'`e(prefix)'"!="mlogit" {
			EqNo "`type'" `equatio'
			local equatio `"`s(eqno)'"'
				/* this is empty if basecategory selected */
			if "`s(stddp)'"=="stdp" {
				local stddp "stdp"
			}
				/* local stddp is changed to stdp if
				   basecategory selected as one of the
				   equations
				*/
		}
		else if `"`type'"' == "stddp" {
			EqNo2 "`type'" `equatio'
			local equatio `"`s(eqno)'"'
		}

		local eqopt `"equation(`"`equatio'"')"'
	}

/* scores */

	if `"`type'"' == "scores" {
		if `"`equatio'"' != "" {
			local type `"equation(`equatio')"'
		}
		GenScores `varspec' `if' `in', `type'
		sret clear
		exit
	}

/* Index, XB, or STDP. */

	if "`type'"=="index" | "`type'"=="xb" | "`type'"=="stdp" /*
	*/ | "`type'"=="stddp" {

		Onevar `type' `varlist'

		if "`equatio'"!="" {
			_predict `typlist' `varlist' `if' `in', /*
			*/ ``type'' `eqopt' 
					/* note: `type' may be stddp,
					   but ``type'' may be stdp
					*/
		}
		else	Zero `typlist' `varlist' `if' `in' 

		if "`type'"=="index" | "`type'"=="xb"  {
			Outcome `equatio'
			label var `varlist' /*
		*/ `"Linear prediction, `e(depvar)'==`s(outcome)'"'
		}
		else if "`type'"=="stdp"  {
			Outcome `equatio'
			label var `varlist' /*
		*/ `"S.E. of linear prediction, `e(depvar)'==`s(outcome)'"'
		}
		else /* stddp */ label var `varlist' `"stddp(`eqorig')"'

		sret clear
		exit
	}

/* Probability with outcome() specified: create one variable. */

	if ("`type'"=="pr" | "`type'"=="") & `"`eqopt'"'!="" {
		Onevar "p with outcome()" `varlist'

		if "`e(cmd)'`e(prefix)'"=="mlogit" {
			_predict `typlist' `varlist' `if' `in', `eqopt' 
		}
		else { /* svymlogit */
			OnePsvy `typlist' `varlist' `if' `in', `eqopt' 
		}

		Outcome `equatio'
		label var `varlist' `"Pr(`e(depvar)'==`s(outcome)')"'
		sret clear
		exit
	}

/* Probabilities with outcome() not specified: create e(k_cat) variables. */

	tempvar touse
	mark `touse' `if' `in'

	if "`e(cmd)'`e(prefix)'"=="mlogit" {
		AllPmlog "`typlist'" "`varlist'" `touse' 
	}
	else if "`e(prefix)'" != "" {
		AllPsvy "`typlist'" "`varlist'" `touse' 
	}
	else { /* svymlogit */
		OldPsvy "`typlist'" "`varlist'" `touse' 
	}
end

program MultVars
	local nvars : word count `0'
	if `nvars' != e(k_cat) {
		capture noisily error cond(`nvars'<e(k_cat), 102, 103)
		di in red /*
		*/ "`e(depvar)' has `e(k_cat)' outcomes and so you " /*
		*/ "must specify `e(k_cat)' new variables, or " _n /*
		*/ "you can use the outcome() option and specify " /*
		*/ "variables one at a time"
		exit cond(`nvars'<e(k_cat), 102, 103)
	}
end

// generate a variable that identifies observations that take on a value
// identified by an mlogit equation
program GenD
	version 8.2, missing
	gettoken d 0 : 0
	syntax [if] [in] [, eq(string) ]
	local ieq = substr("`eq'",2,.)
	marksample doit
	local depvar `e(depvar)'
	tempname cat
	mat `cat' = e(cat)
	if e(ibasecat) == 1 {
		mat `cat' = `cat'[1,2...]
	}
	else if e(ibasecat) == colsof(`cat') {
		mat `cat' = `cat'[1,1..`=e(ibasecat)-1']
	}
	else {
		mat `cat' = `cat'[1,1..`=e(ibasecat)-1'], ///
			    `cat'[1,`=e(ibasecat)+1'...]
	}
	scalar `cat' = `cat'[1,`ieq']
	gen byte `d' = (reldif(`cat',`depvar') < 1e-7) if `doit'
end

program define Outcome, sclass
	version 6
	if "`e(cmd)'`e(prefix)'"=="mlogit" {
		local o = trim(`"`0'"')
		if substr(`"`o'"',1,1)=="#" {
			local i = substr(`"`o'"',2,.)
			if `i' >= e(ibasecat) {
				local i = `i' + 1
			}
			sret local outcome = el(e(cat),1,`i')
		}
		else	sret local outcome `"`o'"'
		exit
	}

/* If here, command is svy[:]mlogit.

   Either "`0'"=="#`i'" (no spaces) or "`0'"=="" (meaning basecategory).
*/
	if "`0'"=="" {
		sret local outcome = substr(`"`e(baselab)'"',1,8)
		exit
	}
	local i = substr("`0'",2,.)
	local coleq : coleq e(b), quote
	local coleq : list clean coleq
	local coleq : list uniq coleq
	sret local outcome : word `i' of `coleq'
end

program define Onevar
	gettoken option 0 : 0
	local n : word count `0'
	if `n'==1 { exit }
	di in red "option `option' requires that you specify 1 new variable"
	error cond(`n'==0,102,103)
end

program define EqNo2, sclass
	sreturn clear
	gettoken type 0 : 0
	if `"`type'"' != "stddp" {
		sreturn local eqno `"`0'"'
		exit
	}

	gettoken eq1 0 : 0, parse(" ,")
	gettoken comma eq2 : 0, parse(",")
	if `"`comma'"' != "," {
		di in red "second equation not found"
		exit 303
	}
	sreturn local eqno `"`eq1',`eq2'"'
end

program define EqNo, sclass
	sret clear
	gettoken type 0 : 0
	if "`type'"!="stddp" {
		Eq `0'
		exit
	}

/* If here, "`type'"=="stddp". */

	gettoken eq1 0 : 0, parse(",")
	gettoken comma eq2 : 0, parse(",")
	if "`comma'"!="," {
		di in red "second equation not found"
		exit 303
	}

	Eq `eq1'
	local eq1 `"`s(eqno)'"'
	Eq `eq2'
	if `"`eq1'"'!="" & `"`s(eqno)'"'!="" {
		sret local eqno `"`eq1',`s(eqno)'"'
	}
	else {
		sret local eqno `"`eq1'`s(eqno)'"'
		sret local stddp "stdp"
	}
end

program define Eq, sclass /* returns nothing if basecategory */
	sret clear
	local eqlab = trim(`"`0'"')
	if substr(`"`eqlab'"',1,1)=="#" {
		sret local eqno `"`eqlab'"'
		exit
	}
	capture confirm number `eqlab'
	if _rc == 0 {
		local i 1
		while `i' <= e(k_cat) {
			if `eqlab' == el(e(cat),1,`i') {
				Match `i'
				exit
			}
			local i = `i' + 1
		}
	}
	else {
		if "`e(prefix)'" != "" & "`e(cmd)'" == "mlogit" {
			local coleq : coleq e(b), quote
			local coleq : list uniq coleq
			local qeqlab `"`"`eqlab'"'"'
			local xx :list qeqlab in coleq
			local baselab `"`e(baselab)'"'
			if `:list eqlab in baselab' {
				exit
			}
			if `:list qeqlab in coleq' {
				local i : list posof `"`eqlab'"' in coleq
				if `i' >= e(ibaseout) {
					local ++i
				}
				Match `i'
				exit
			}
		}
		else {
			tempname cat cati
			mat `cat' = e(cat)
			local i 1
			while `i' <= e(k_cat) {
				mat `cati' = `cat'[1,`i'..`i']
				local eqi : coleq `cati'

				if `"`eqlab'"'==trim(`"`eqi'"') {
					Match `i'
					exit
				}
				local i = `i' + 1
			}
		}
	}

	di in red `"equation `eqlab' not found"'
	exit 303
end

program define Match, sclass /* returns nothing if basecategory */
	args i
	if `i' != e(ibasecat) {
		local i = cond(`i'<e(ibasecat),`i',`i'-1)
		sret local eqno "#`i'"
	}
end

program define Zero
	syntax newvarname [if] [in] 
	tempvar xb
	qui _predict double `xb' `if' `in' 
	gen `typlist' `varlist' = 0 if `xb'<.
end

program define OnePsvy
	version 6, missing
	syntax newvarname [if] [in] [, Equation(string) ]
	tempvar touse den xb
	mark `touse' `if' `in'

/* This command is only called with equation() in #eqno form, or
   with equation() empty signifying basecategory.
*/
	local equatio = substr(`"`equatio'"',2,.)

	quietly {

/* Compute denominator `den' = 1 + Sum(exp(`xb')). */

		gen double `den' = 1 if `touse'
		local i 1
		while `i' < e(k_cat) {