fracpoly.ado

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

*! version 1.8.1  17sep2004/27Feb1999
* (PR)
program define fracpoly, eclass
	version 6, missing
	if replay() {
		frac_154 `0'
		di in gr "Deviance:" in ye %9.2f e(fp_dev) in gr "."
		exit
	}
	gettoken cmd 0 : 0
	frac_chk `cmd' 
	if `s(bad)' {
		di in red "invalid or unrecognized command, `cmd'"
		exit 198
	}
	local dist `s(dist)'
	if `dist' != 7 {
		gettoken lhs 0 : 0, parse(" ,")
	}
	/*
		Look for predictors and associated powers
	*/
	local pwrs
	local rhs
	local nx 0
	local lastnv 0
	parse "`*'", parse(" ,[")

	gettoken next : 0, parse(" ,[")
	while "`next'"!= ""  & "`next'"!="," & "`next'"!="if" & /*
	*/    "`next'"!="in" & "`next'"!="[" { 
		gettoken next 0 : 0, parse(" ,[")	/* make real */
		cap unabbrev `next'
		if _rc == 0 { 		/* found a new xvarlist */
			local varl `s(varlist)'
			local nv `s(k)'
			if `nx'>0 {	/* have a previous xvarlist */
				if "`pwrs'"=="" & `nx'>1 {
					local pwrs 1
				}
				/*
					Flush powers
				*/
				local j=`nx'-`lastnv'+1
				while `j'<=`nx' {
					local p`j' `pwrs'
					local j=`j'+1
				}
				local pwrs
			}
			else {		/* this is first xvarlist */
				if `nv'>1 { 
					di in red /*
*/ "`next' ambiguous---xvar [#] required before covariate model is specified"
					exit 198
				}
			}
			/*
				Store current xvarlist names and 
				update variable count
			*/
			local j 1
			while `j'<=`nv' {
				local nx=`nx'+1
				local v`nx': word `j' of `varl'
				local rhs `rhs' `v`nx''
				local j=`j'+1
			}
			local lastnv `nv'
		}
		else {			/* got power(s) */
			if `nx'==0 {
				di in red /*
				*/ "invalid `next', not a varlist"
				exit 198
			}
			cap confirm num `next'
			if _rc { 
				di in red /*
*/ `""`next'" found where number or varlist expected"'
				exit 7
			}
			local pwrs `pwrs' `next'
		}
		gettoken next : 0, parse(" ,[")
	}

	if `nx'==0 {
		di in red "no xvar found"
		exit 198
	}

	/*
		Flush powers
	*/
	if "`pwrs'"=="" & `nx'>1 { local pwrs 1 }
	local j=`nx'-`lastnv'+1
	while `j'<=`nx' {
		local p`j' `pwrs'
		local j=`j'+1
	}

	local 0 `"`lhs' `0'"'
	if `dist' != 7 {
		local vv varname
	}
	syntax `vv' [if] [in] [aw fw pw iw] [, /* 
		*/ ADjust(str) ALL DEAD(varname) EXPx(str) ZERo(varlist) /*
		*/ CATZero(varlist) ORIgin(str) noSCAling * ]

	marksample touse
	markout `touse' `rhs' `dead' `zero' `catzero'

	frac_cox "`dead'" `dist'
	if "`dead'"!="" { local dead dead(`dead') }

	/*
		vars to be adjusted, taking number of unique values 
		into account.
	*/
	frac_adj "`adjust'" "`rhs'" `touse'
	local i 0
	while `i'<`nx' {
		local i=`i'+1
		local a `r(adj`i')'
		if "`a'"!="" {
			local adj`i'=cond(`i'==1, "`a'", "adjust(`a')" )
		}
	}
	/*
		vars with expx option
	*/
	if "`expx'"!="" {
		frac_dis "`expx'" expx "`rhs'"
		local j 0
		while `j'<`nx' {
			local j=`j'+1
			if "${S_`j'}"!="" {
				local exp`j' expx(${S_`j'})
			}
		}
	}
	/*
		vars with origin option
	*/
	if "`origin'"!="" {
		frac_dis "`origin'" origin "`rhs'"
		local j 0
		while `j'<`nx' {
			local j=`j'+1
			if "${S_`j'}"!="" {
				local ori`j' origin(${S_`j'})
			}
		}
	}
	/*
		Vars with zero option
	*/
	if "`zero'"!="" {
		tokenize `zero'
		while "`1'"!="" {
			frac_in `1' "`rhs'"
			local zer`s(k)' "zero"
			mac shift
		}
	}
	/*
		Vars with catzero option
	*/
	if "`catzero'"!="" {
		tokenize `catzero'
		while "`1'"!="" {
			frac_in `1' "`rhs'"
			local cat`s(k)' "catzero"
			local zer`s(k)' "zero"	/* catzero implies zero */
			mac shift
		}
	}
	/*
		Construct fracpoly command to go to frac_154.
		First, remove old I* variables.
	*/
	local i 1
	while `i'<=`nx' {
		frac_mun `v`i'' purge
		local i=`i'+1
	}
	local base
	local i 1
	while `i'<=`nx' {
		local create= /*
		*/ ("`p`i''"!="1" | "`zer`i''`ori`i''`exp`i''`adj`i''"!="")
		if `create' {		/* garner unique name stub */
			frac_mun `v`i''
			local vn `s(name)'
			if `i'==1 {
				qui gen byte `vn'_1=. /*reserves name `vn'_1*/
				local n name(`vn')    /*force name in frac_154*/
			}
			else {
				fracgen `v`i'' `p`i'' if `touse', /*
				*/ `all' sayesamp name(`vn') /*
				*/ `adj`i'' `exp`i'' /*
				*/ `zer`i'' `cat`i'' `ori`i'' `scaling'
				local base `base' `r(names)'
			}
		}
		else {
			if `i'>1 {
				local base `base' `v`i''
			}
		}
		local i=`i'+1
	}

	if "`adj1'"=="" { local adj adjust(no) }
	else 	local adj adjust(`adj1')

	frac_154 `cmd' `lhs' `v1' `p1' `base' if `touse' [`weight' `exp'], /*
	*/ `all' `n' `adj' `exp1' `zer1' `cat1' `ori1' `scaling' /*
	*/ `dead' `options'

	/*
		Store covariate names and their (fixed) powers, if any.
		Also, note presence of catzero variables in e(fp_c`i').
	*/
	if e(fp_catz) { est local fp_c1 1 }
	local i 2
	while `i'<=`nx' {
		est local fp_x`i' `v`i''
		est local fp_k`i' `p`i''
		if "`cat`i''"!="" { est local fp_c`i' 1 }
		local i=`i'+1
	}
	est scalar fp_nx = `nx' 
end