mfp.ado

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

		}
		else {
			* accept
			local ss=cond(`m0'==-1,"*","+")
			qui fracgen `n' `pwrs', `options' `catzero' replace
			local n `r(names)'
		}
	}
}
if `aic'==0 & "`sequential'"!="" {
/*
	Sequential tests
	Note: ignores undocumented testlinear option for dropping m=1 vs. linear comparison
*/
	local j0 `m'
	while !`done' & `j0'>`m0' {
		local j=`j0'-1
		if `j0'==0 {		/* null vs. linear (+cz) */
			local vs1 lin.
			local vs null
			local n1=1+`cz'
			local pwrs 1
			local pwrs2 .
		}
		else if `j0'==1 {	/* linear vs. m=1 */
			local n1 1
			local vs1 FP1
			local vs lin.
			local pwrs=e(fp_p`j0')
			local pwrs2 1
		}
		else {
			local n1 2
			local vs1 "FP`j0'"
			local vs "FP`j'"
			local pwrs=e(fp_p`j0')
			local pwrs2=e(fp_p`j')
		}
		local j1=`j0'+1
		local d=`dev`j0''-`dev`j1''
		local n2=`rdf'-`n1'
		frac_pv `normal' "`weight'" `nobs' `d' `n1' `n2'
		local P = r(P)
		local pnom=cond(`j0'==0,`select',`alpha')
		local ss=cond(`j0'==0,"*","+")
		if `P'<=`pnom' {
			local done 1
			local star *
			local dev `dev`j1''
			qui fracgen `n' `pwrs', `options' `catzero' replace
			local n `r(names)'
		}
		else local dev `dev`j0''
		di in smcl in gr "`hed'" _col(14) "`vs1'" /*
		 */ _col(21) "`vs'" _col(26) %10.3f in ye `dev`j1'' /*
		 */ _col(38) %8.3f `d' %7.3f `P' "`star'" /*
		 */ _col(57) "`pwrs'" _col(67) "`pwrs2'"
		local hed
		local j0 `j'
	}
	if !`done' {
		if `omit' {	/* drop */
			local pwrs "."
			local n
			local dev `dev0'
		}
		else {		/* linear */
			local pwrs 1
			qui fracgen `n' `pwrs', `options' `catzero' replace
			local n `r(names)'
			local dev `dev1'
		}
	}
}
di in smcl in gr _col(14) "Final" _col(28) in ye %8.3f `dev' _col(57) "`pwrs'"
local rhs "`rhs' `n'"
di
ret local rhs `rhs'
ret local pwrs `pwrs'
ret scalar dev=`dev'
ret local n `n'
end

program define FracAdj, rclass
version 8
* Inputs: 1=macro `adjust', 2=case filter.
* Returns adjustment values in r(adj1),...
* Returns number of unique values in r(uniq1),...

args adjust touse
if "`adjust'"=="" {
	FracDis mean adjust
}
else FracDis "`adjust'" adjust
tempname u
local i 1
while `i'<=$MFP_n {
	local x ${MFP_`i'}
	quietly inspect `x' if `touse'
	scalar `u'=r(N_unique)
	local nx: word count `x'
	if `nx'==1 {	/* can only adjust if single predictor */
		local a ${S_`i'}
		if "`a'"=="" | "`adjust'"=="" {	/* identifies default cases */
			if `u'==1 {		/* no adjustment */
				local a
			}
			else if `u'==2 {	/* adjust to min value */
				quietly summarize `x' if `touse', meanonly
				if r(min)==0 {
					local a
				}
				else local a=r(min)
			}
			else local a mean
		}
		else if "`a'"=="no" {
			local a
		}
		else if "`a'"!="mean" {
			confirm num `a'
		}
	}
	return local adj`i' `a'
	return scalar uniq`i'=`u'
	local i=`i'+1
}
end

program define FracDis
version 8
* Disentangle varlist:string clusters---e.g. for DF.
* Returns values in $S_*.
* If `3' is null, lowest and highest value checking is disabled.

local target "`1'"		/* string to be processed */
local tname "`2'"		/* name of option in calling program */
if "`3'"!="" {
	local low "`3'"		/* lowest permitted value */
	local high "`4'"	/* highest permitted value */
}
tokenize "`target'", parse(",")
local ncl 0 			/* # of comma-delimited clusters */
while "`1'"!="" {
	if "`1'"=="," {
		mac shift
	}
	local ncl=`ncl'+1
	local clust`ncl' "`1'"
	mac shift
}
if "`clust`ncl''"=="" {
	local ncl=`ncl'-1
}
if `ncl'>$MFP_n {
	di in red "too many `tname'() values specified"
	exit 198
}
/*
	Disentangle each varlist:string cluster
*/
local i 1
while `i'<=`ncl' {
	tokenize "`clust`i''", parse("=:")
	if "`2'"!=":" & "`2'"!="=" {
		if `i'>1 {
			noi di in red /*
			*/ "invalid `tname'() value `clust`i''" /*
		 	*/ ", must be first item"
			exit 198
		}
		local 2 ":"
		local 3 `1'
		local j 0
		local 1
		while `j'<$MFP_n {
			local j=`j'+1
			local nxi: word count ${MFP_`j'}
			if `nxi'>1 {
				 local 1 `1' (${MFP_`j'})
			}
			else local 1 `1' ${MFP_`j'}
		}
	}
	local arg3 `3'
	if "`low'"!="" & "`high'"!="" {
		cap confirm num `arg3'
		if _rc {
			di in red "invalid `tname'() value `arg3'"
			exit 198
		}
		if `arg3'<`low' | `arg3'>`high' {
			di in red /*
			*/ "`tname'() value `arg3' out of allowed range"
			exit 198
		}
	}
	while "`1'"!="" {
		gettoken tok 1 : 1
		if substr("`tok'",1,1)=="(" {
			local list
			while substr("`tok'",-1,1)!=")" {
				if "`tok'"=="" {
					di in red "varlist invalid"
					exit 198
				}
				local list "`list' `tok'"
				gettoken tok 1 : 1
			}
			unabbrev `list' `tok'
			local w `s(varlist)'
			FracIn "`w'"
			local v`s(k)' `arg3'
		}
		else {
			unabbrev `tok'
			local tok `s(varlist)'
			local j 1
			local w : word 1 of `tok'
			while "`w'" != "" {
				FracIn `w'
				local v`s(k)' `arg3'
				local j=`j'+1
				local w : word `j' of `tok'
			}
		}
	}
	local i = `i'+1
}
local j 0
while `j'<$MFP_n {
	local j=`j'+1
	if "`v`j''"!="" {
		global S_`j' `v`j''
	}
	else global S_`j'
}
end

program define FracIn, sclass /* target varname/varlist */
version 8
* Returns s(k) = index # of target in MFP varlists.
args v
sret clear
sret local k 0
local j 0
while `j'<$MFP_n {
	local j = `j'+1
	if "`v'"=="${MFP_`j'}" {
		sret local k `j'
		local j $MFP_n
	}
}
if `s(k)'==0 {
   	di in red "`v' is not an xvar"
   	exit 198
}
end

program define FracRep
* 1=descriptor e.g. FRACTIONAL POLYNOMIAL
* 2=param descriptor e.g. df
* 3=param names e.g. powers
version 8
args desc param paramv
local i 1
local l=length("`paramv'")
while `i'<=$MFP_n {
	local l=max(`l',length("`e(Fp_k`i')'"))
	local i=`i'+1
}
local l=`l'+48
local title "Final multivariable `desc' model for `e(fp_depv)'"
local lt=length("`title'")
di in smcl _n in gr "`title'"
di in smcl in gr "{hline 13}{c TT}{hline `l'}"
di in smcl in gr _skip(4) "Variable {c |}" _col(19) "{hline 5}" _col(24) /*
 */ "Initial" /*
 */ _col(31) "{hline 5}" _col(46) "{hline 5}" _col(51) "Final" /*
 */ _col(56) "{hline 5}"
di in smcl in gr _col(14) "{c |} `param'"/*
 */ _col(25) "Select" /*
 */ _col(34) "Alpha" /*
 */ _col(43) "Status" /*
 */ _col(51) "`param'" /*
 */ _col(59) "`paramv'"
di in smcl in gr "{hline 13}{c +}{hline `l'}"
local i 1
while `i'<=$MFP_n {
	local pars `e(Fp_k`i')'
	if "`pars'"=="" | "`pars'"=="." {
		local final 0
		local status out
		local pars
	}
	else {
		local status in
		local final=e(Fp_fd`i')
	}
	local name ${MFP_`i'}
	local skip=12-length("`name'")
	if `skip'<=0 {
		local name=substr("`name'",1,9)+"..."
		local skip 0
	}
	local select=e(Fp_se`i')
	local alpha=e(Fp_al`i')
	if `select'==-1 {
		local select " A.I.C."
	}
	else local select: di %7.4f `select'
	if `alpha'==-1 {
		local alpha " A.I.C."
	}
	else local alpha: di %7.4f `alpha'

	di in smcl in gr _skip(`skip') "`name' {c |}" in ye /*
	 */ _col(19) e(Fp_id`i') /*
	 */ _col(24) "`select'" /*
	 */ _col(33) "`alpha'" /*
	 */ _col(45) "`status'" /*
	 */ _col(53) "`final'" /*
	 */ _col(59) "`pars'"
	local i=`i'+1
}
di in smcl in gr "{hline 13}{c BT}{hline `l'}"
`e(cmd)'
di in smcl in gr "Deviance:" in ye %9.3f e(fp_dev) in gr "."
end

*! version 1.0.0 PR 11Jul2002.
program define TestVars, rclass /* LR-blocktests variables in varlist, adj base */
	version 8
	gettoken cmd 0 : 0, parse(" ")
	frac_chk `cmd' 
	if `s(bad)' {
		di in red "invalid or unrecognised command, `cmd'"
		exit 198
	}
	local dist `s(dist)'
	local glm `s(isglm)'
	local qreg `s(isqreg)'
	local xtgee `s(isxtgee)'
	local normal `s(isnorm)'
	if $MFpdist != 7 {
		local vv varlist(min=2) 
	}
	else {
		local vv varlist(min=1)
	}
	syntax `vv' [if] [in] [aw fw pw iw], /*
	 */ [, DEAD(string) noCONStant BASE(varlist) * ]
	frac_cox "`dead'" `dist'
	if "`constant'"=="noconstant" {
		if "`cmd'"=="fit" | "`cmd'"=="cox" | $MFpdist==7 {
			di in red "noconstant invalid with `cmd'"
			exit 198
		}
		local options "`options' nocons"
	}
	tokenize `varlist'
	if $MFpdist != 7 {
		local y `1'
		mac shift
	}
	local rhs `*'
	tempvar touse
	quietly {
		mark `touse' [`weight' `exp'] `if' `in'
		markout `touse' `rhs' `y' `base' `dead'
		if "`dead'"!="" {
			local options "`options' dead(`dead')"
		}
	/*
		Deal with weights.
	*/
		frac_wgt `"`exp'"' `touse' `"`weight'"'
		local mnlnwt = r(mnlnwt) /* mean log normalized weights */
		local wgt `r(wgt)'
		count if `touse'
		local nobs = r(N)
	}
	/*
		Calc deviance=-2(log likelihood) for regression on base covars only,
		allowing for possible weights.
	
		Note that for logit/clogit/logistic with nocons, must regress
		on zero, otherwise get r(102) error.
	*/
	if (`glm' | `dist'==1) & "`constant'"=="noconstant" {
		tempvar z0
		qui gen `z0'=0
	}
	qui `cmd' `y' `z0' `base' `wgt' if `touse', `options'
	if `xtgee' & "`base'"=="" {
		global S_E_chi2 0
	}
	local glmwarn 0
	if `glm' {
 		local scale 1
 		local small 1e-30
 		if abs(e(dispersp)/e(delta)-1)>`small' & /*
		*/ abs(e(dispers)/e(delta)-1)>`small' {
			local scale = e(delta)
 		}
 		else 	local glmwarn 1
	}
	frac_dv `normal' "`wgt'" `nobs' `mnlnwt' `dist' /*
		*/ `glm' `xtgee' `qreg' "`scale'"
	local dev0 = r(deviance)
	if `normal' {
		local rsd0=e(rmse)
	}
	/*
		Fit full model
	*/
	`cmd' `y' `rhs' `base' `wgt' if `touse', `options'
	frac_dv `normal' "`wgt'" `nobs' `mnlnwt' `dist' `glm' /*
 	*/ `xtgee' `qreg' "`scale'"
	local dev1 = r(deviance)
	if `normal' {
		local rsd1=e(rmse)
	}
	local df: word count `rhs'
	local bdf: word count `base'
	local df_r = `nobs'-`df'-`bdf'-("`constant'"!="noconstant")
	local d=`dev0'-`dev1'
	frac_pv `normal' "`wgt'" `nobs' `d' `df' `df_r'
	local P = r(P)
	di in smcl in gr "Deviance 1:" in ye %9.2g `dev1' in gr ". " _cont
	di in smcl in gr "Deviance 0:" in ye %9.2g `dev0' in gr ". "
	di in smcl in gr "Deviance d:" in ye %9.2g `d' in gr ". P = " in ye %8.4f `P'
	* store
	return scalar dev0 = `dev0'
	return scalar dev1 = `dev1'
	if `normal' {
		return scalar s0 = `rsd0'
		return scalar s1 = `rsd1'
	}
	return scalar df_m = `df'
	return scalar df_r = `df_r'
	return scalar devdif = `d'
	return scalar P=`P'
	return scalar N = `nobs'
end

program define GetParam, sclass
/*
	For given model j0, return its descriptor, numerator df and powers.
	cz is catzero indicator.
	j0: -1 null model, 0 linear, >0 FPj0
	Returns s(j) as index for dev`j' local macros
*/
args j0 cz
if `j0'==-1 {
	local desc null
	local n1 0
	local pwrs .
}
else if `j0'==0 {
	local desc lin.
	local n1=1+`cz'
	local pwrs 1
}
else {
	local desc FP`j0'
	local n1=2*`j0'+`cz'
	local pwrs=e(fp_p`j0')
}
local j=`j0'+1
sret local j `j'
sret local desc `desc'
sret local df `n1'
sret local pwrs `pwrs'
end