mfp.ado

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

}
ereturn scalar fp_dist=`dist'
ereturn local fp_wgt `weight'
ereturn local fp_exp `exp'
ereturn local fp_depv `lhs'
if `dist'==7 {
	ereturn local fp_depv _t
}
ereturn scalar fp_dev=`dev'
ereturn local fp_rhs	/* deliberately blank for consistency with fracpoly */
ereturn local fp_opts `regopt'
ereturn local fp_fvl `finalvl'
ereturn scalar fp_nx=`nx2'
ereturn local fp_t1t "Fractional Polynomial"
FracRep "fractional polynomial" "  df  " "Powers"
ereturn local fp_cmd "fracpoly"
ereturn local fp_cmd2 "mfp"

end

program define GetVL, sclass /* varlist [if|in|,|[weight]] */
macro drop MFP_*
if $MFpdist != 7 {
	gettoken tok 0 : 0
	unabbrev `tok'
	global MFP_dv "`s(varlist)'"
}

global MFP_cur		/* MFP_cur will contain full term list */
global MFP_n 0

gettoken tok : 0, parse(" ,[")
IfEndTrm "`tok'"
while `s(IsEndTrm)'==0 {
	gettoken tok 0 : 0, parse(" ,[")
	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 0 : 0, parse(" ,[")
		}
		local list "`list' `tok'"
		unabbrev `list'
		global MFP_n = $MFP_n + 1
		global MFP_$MFP_n "`s(varlist)'"
		global MFP_cur "$MFP_cur `s(varlist)'"
	}
	else {
		unabbrev `tok'
		local i 1
		local w : word 1 of `s(varlist)'
		while "`w'" != "" {
			global MFP_n = $MFP_n + 1
			global MFP_$MFP_n "`w'"
			local i = `i' + 1
			local w : word `i' of `s(varlist)'
		}
		global MFP_cur "$MFP_cur `s(varlist)'"
	}
	gettoken tok : 0, parse(" ,[")
	IfEndTrm "`tok'"
}
sret local nought `0'
end

program define IfEndTrm, sclass
sret local IsEndTrm 1
if "`1'"=="," | "`1'"=="in" | "`1'"=="if" | /*
*/ "`1'"=="" | "`1'"=="[" {
	exit
}
sret local IsEndTrm 0
end

program define FracOrd, sclass
version 8
sret clear
syntax [if] [in] [aw fw pw iw] [, CMd(string) ORDer(string) * ]
if "`cmd'"=="" {
	local cmd "regress"
}
if "`order'"=="" {
	di in red "order() must be specified"
	exit 198
}
local order=substr("`order'",1,1)
if "`order'"!="+" &"`order'"!="-" &"`order'"!="r" &"`order'"!="n" {
	di in red "invalid order()"
	exit 198
}
quietly {
	local nx $MFP_n
	if "`order'"=="n" {
		* variable order as given
		local i 1
		while `i'<=`nx' {
			local r`i' `i'
			local i=`i'+1
		}
	}
	else {
		if "`order'"=="+" | "`order'"=="-" {
			`cmd' $MFP_dv $MFP_cur `if' `in' [`weight' `exp'], `options'
		}
		tempvar c n
		tempname p dfnum dfres stat
		gen `c'=.
		gen int `n'=_n in 1/`nx'
		if "`order'"=="+" | "`order'"=="-" {
			local i 1
			while `i'<=`nx' {
				local n`i' ${MFP_`i'}
				capture test `n`i''	/* could comprise >1 variable */
				local rc=_rc
				if `rc'!=0 {
					noi di in red "could not test ${MFP_`i'}---collinearity?"
					exit 1001
				}
				scalar `p'=r(p)
				if "`order'"=="-" { /* reducing P-value */
					replace `c'=-`p' in `i'
				}
				else replace `c'=`p' in `i'
				local i=`i'+1
			}
		}
		if "`order'"=="r" {
			replace `c'=uniform() in 1/`nx'
		}
		sort `c'
		local i 0
		while `i'<`nx' {
			local i=`i'+1
/*
	Store positions of sorted predictors in user's list
*/
			local j 0
			while `j'<`nx' {
				local j=`j'+1
				if `i'==`n'[`j'] {
					local r`j' `i'
					local j `nx'
				}
			}
		}
	}
}
/*
	Store original positions of variables in ant1, ant2, ...
*/
local i 1
while `i'<=`nx' {
	sret local ant`i' `r`i''
	local i=`i'+1
}
sret local names `names'
end

program define FracSel, rclass
version 8
gettoken cmd 0 : 0	/* frac_chk `cmd' omitted, caller assumed competent */
if $MFpdist != 7 {
	local vv varlist(min=2) 
}
else {
	local vv varlist(min=1)
}
syntax `vv' [if] [in] [aw fw pw iw] [, /*
*/ ALpha(real .05) SELect(real .05) noHEad DF(int -1) /*
*/ POwers(string) BAse(string) noTIDy CATzero SEQuential noTESTLinear * ]
if `df'==0 | `df'<-1 {
	di in red "invalid df"
	exit 198
}
local cz="`catzero'"!=""
local omit=(`select'<1)
local aic=(`select'==-1 | `alpha'==-1)
if `df'==-1 {
	local df 4
}
local m=int((`df'+.5)/2)	/* df=1 => m=0 => linear */
if `df'==1 {			/* linear */
	if "`powers'"!="" {
		di in red "powers() invalid with df(1)"
		exit 198
	}
	local fixpowers 1
}
else {
	if "`powers'"=="" {
		local powers "-2,-1,-.5,0,.5,1,2,3"
	}
	local powers "powers(`powers')"
	local degree "degree(`m')"
}
if "`weight'"!="" { 
	local weight "[`weight'`exp']"
}
tokenize `varlist'
if $MFpdist != 7 {
	local lhs `1'
	local n `2'
	mac shift 2
}
else {
	local lhs
	local n `1'
	mac shift 1
}
local nn `*'
if "`head'"=="" {
	di in smcl in gr "Variable" _col(14) "Model" _col(20) "(vs.)" /*
	 */ _col(28) "Deviance" _col(38) "Dev diff.   P      Powers   (vs.)"
	di in smcl "{hline 70}"
}
local vname `n' `nn'
if length("`vname'")>12 {
	local vname=substr("`vname'",1,9)+"..."
}
local pwrs 1
if "`nn'"!="" | `df'==1 {
	* test linear for single or group of predictors, adjusting for base
	local pwrs2 .
	if "`base'"!="" {
		local base base(`base')
	}
	local n `n' `nn'
	qui TestVars `cmd' `lhs' `n' `if' `in' `weight', `base' `options'
	local P = r(P)
	local dev1 = r(dev1)
	local dev0 = r(dev0)
	local d = r(devdif)
	if "`sequential'"=="" {
		local vs1 null
		local vs lin.
		local dfirst `dev0'
	}
	else {
		local vs1 lin.
		local vs null
		local dfirst `dev1'
	}
	if `aic'==0 {
		if `P'<=`select' {
			local star *
			local dev `dev1'
		}
		else {
			local star
			local n
			local dev `dev0'
		}
	}
	else {	/* select by AIC */
		local nnn: word count `n'	/* no. of vars being tested */
		if (`dev1'+2*`nnn')<`dev0' {
			local star *
			local dev `dev1'
		}
		else {
			local star
			local n
			local dev `dev0'
		}
	}
	di in smcl in gr "`vname'" _col(14) "`vs1'" /*
	 */ _col(21) "`vs'" _col(27) %9.3f in ye `dfirst' /*
	 */ _col(38) %8.3f `d' %7.3f `P' "`star'" /*
	 */ _col(57) "`pwrs2'" _col(67) "`pwrs'"
	if "`n'"=="" {
		local pwrs .
	}
	di in gr _col(14) "Final" _col(27) %9.3f in ye `dev' _col(57) "`pwrs'"
	di
	ret local rhs `n'
	ret local pwrs `pwrs'
	ret scalar dev=`dev'
	exit
}
local xvar `n'
qui frac_154 `cmd' `lhs' `n' `fixpowers' `nn' `base' `if' `in' /*
 */ `weight', `degree' `powers' `options' `catzero'
local normal=(e(fp_dist)==0)
local nobs=e(fp_N)
local rdf=e(fp_rdf)
local bigpwrs=e(fp_k1)
local bigp `bigpwrs'
/*
	Store deviances for testing,
	starting with index 0 for null model.
*/
local j0 -1
local j 0
while `j'<=(`m'+1) {
	if `j'==0 {
		local dev0=e(fp_d0)
	}
	else if `j'==1 {
		local dev1=e(fp_dlin)
	}
	else local dev`j'=e(fp_d`j0')
	local j0 `j'
	local j=`j'+1
}
/*
	m0 is lowest model entertained.
	m0=-1 => can omit.
*/
if `omit' 	{
	local m0 -1
}
else if `m'==0 	{
	local m0 0
}		/* highest possible model is linear */
else {
	if "`testlinear'"=="notestlinear" {
		local m0 1		/* skip testing m=`m' vs. linear */
	}
	else 	local m0 0		/* standard mfracpol default */
}
local hed `vname'
local star " "
local done 0
if `aic'==0 & "`sequential'"=="" {
/*
	Closed tests
*/
	local m1=`m'+1
	local bigdev `dev`m1''
	if `m'==0 {
		local degmax lin.
	}
	else local degmax FP`m'
	local sig 0
	local j0 `m0'
	while !`done' & `j0'<`m' {
		local j=`j0'+1
		if `j0'==-1 {		/* null vs. model (+catzero) */
			local vs null
			if `m'==0 {	/* null vs. linear (+cz) */
				local n1=1+`cz'
			}
			else 	local n1=2*`m'+`cz'
			local pwrs "."
		}
		else if `j0'==0 {	/* linear (+cz) vs. m (+cz) */
			local vs lin.
			local n1=2*`m'-1
			local pwrs 1
		}
		else {
			local n1=2*(`m'-`j0') /* m (+cz) vs m0 (+cz) */
			local vs "FP`j0'"
			local pwrs=e(fp_p`j0')
		}
		local n2=`rdf'-`n1'
		local d=`dev`j''-`bigdev'
		frac_pv `normal' "`weight'" `nobs' `d' `n1' `n2'
		local P = r(P)
		local pnom=cond(`j0'==-1,`select',`alpha')
		local ss=cond(`j0'==-1,"*","+")
		if `alpha'==1 & `j0'>-1 {
			local j0 `m'		/* finished */
		}
		else if `P'<=`pnom' {
			local sig 1
			local star `ss'
		}
		di in smcl in gr "`hed'" _col(14) "`vs'" /*
		 */ _col(21) "`degmax'" _col(26) %10.3f in ye `dev`j'' /*
		 */ _col(38) %8.3f `d' %7.3f `P' "`star'" /*
		 */ _col(57) "`pwrs'" _col(67) "`bigp'"
		local hed
		local degmax
		local bigp
		if `j0'<`m' & `P'>`pnom' {
			local done 1
			local dev `dev`j''
			if `j0'==-1 {		/* drop */
				local n
			}
			else {
/*
	Not sig, so selecting degree less than m.
	Re-estimate powers, shd be unnecessary.
*/
				qui fracgen `n' `pwrs', /*
				 */ `options' `catzero' replace
				local n `r(names)'
			}
		}
		local star " "
		if `m'>0 & `j0'==-1 & "`testlinear'"=="notestlinear" {
			local j0 1			/* skip testing linear */
		}
		else 	local j0=`j0'+1
	}
	if !`done' {	/* highest model was best */
		local done 1
		local dev `bigdev'
		local pwrs `bigpwrs'
		qui fracgen `n' `pwrs', `options' `catzero' replace
		local n `r(names)'
	}
}
if `aic' {		/* AIC selection of function and/or variable */
	local ss `star'
	if `m'==0 {
		local degmax lin.
	}
	else local degmax FP`m'
	if `alpha'==1 {			/* do not optimise function */
		* null model
		GetParam `m0' `cz'
		local vs_0 `s(desc)'
		local df_0 `s(df)'
		local pwrs_0 `s(pwrs)'
		local dev_0 `dev`s(j)''
		* max model
		GetParam `m' `cz'
		local vs_1 `s(desc)'
		local df_1 `s(df)'
		local pwrs_1 `s(pwrs)'
		local dev_1 `dev`s(j)''
		* compute AICs
		forvalues j=0/1 {
			local aic_`j'=`dev_`j''+2*`df_`j''
			di in gr "`hed'" _col(14) "`vs_`j''" /*
			 */ _col(26) %10.3f in ye `dev_`j'' /*
			 */ _col(57) "`pwrs_`j''"
			 local hed
		}
		if `select'==1 | (`select'==-1 & (`aic_1'<`aic_0')) {
			* accept max model
			local sig 1
			local ss "*"
			qui fracgen `n' `pwrs_1', /*
			 */ `options' `catzero' replace
			local n `r(names)'
			local pwrs `pwrs_1'
			local dev `dev_1'
		}
		else {
			* drop
			local n
			local pwrs `pwrs_0'
			local dev `dev_0'
		}
	}
	else {		/* optimise function */
		local aicopt .
		local jopt .
		forvalues j=`m0'/`m' {
			if "`testlin'"!="notestlinear" | `j'!=0 {
				GetParam `j' `cz'
				local Aic=`dev`s(j)''+2*`s(df)'
				di in gr "`hed'" _col(14) "`s(desc)'" /*
				 */ _col(26) %10.3f in ye `dev`s(j)'' /*
				 */ _col(57) "`s(pwrs)'"
				if `Aic'<`aicopt' {
					local jopt `j'
					local aicopt `Aic'
				}
				local hed
			}
		}
		* Opt values
		GetParam `jopt' `cz'
		local pwrs `s(pwrs)'
		local dev `dev`s(j)''
		if `jopt'==-1 {
			* drop
			local n