*! v 1.0.3 PR 29Jun1999.   STB-50 sg81.2
program define frac_sel, rclass
version 6
gettoken cmd 0 : 0	/* frac_chk `cmd' omitted, caller assumed competent */
syntax varlist(min=2 max=2) [if] [in] [aw fw pw iw] [, /*
*/ ALpha(real .05) SELect(real .05) noHEad DF(int -1) /*
*/ POwers(string) BAse(string) noTIDy CATzero SEQuential IV * ]
if `df'==0 | `df'<-1 {
	di in red "invalid df"
	exit 198
}
local cz="`catzero'"!=""
local omit=(`select'<1)
if `df'==-1 { local df 4 }
local m=int((`df'+.5)/2)	/* df=1 => m=0 => linear */
local m0=cond(`omit',-1,0)	/* lowest "degree", omit=-1, linear=0 */
if `df'==1 {			/* linear */
	if "`powers'"!="" {
		di in red "powers() invalid with df(1)"
		exit 198
	}
	local fixpowe 1
	local iv		/* iv does not apply unless m>=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']"
}
gettoken lhs xvar: varlist
local xvar=trim("`xvar'")
if "`head'"=="" {
	di in gr "Variable" _col(10) "Model" _col(16) "(vs.)" /*
	 */ _col(24) "Deviance" _col(34) "Dev diff.   P      Powers    (vs.)"
	di in gr _dup(70) "-"
}
local n `xvar'
local pwrs 1
qui frac_154 `cmd' `lhs' `n' `fixpowe' `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)
/*
	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
}
local m0 0
if `omit' & "`iv'"=="" { local m0 -1 }
local hed `xvar'
local star " "
local done 0
if "`sequent'"=="" {
/*
	Closed tests
*/
	local m1=`m'+1
	local bigdev `dev`m1''
	if `m'==0 { local degmax lin. }
	else local degmax m=`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 "m=`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 gr "`hed'" _col(10) "`degmax'" /*
		 */ _col(16) "(`vs')" _col(22) %10.3f in ye `dev`j'' /*
		 */ _col(34) %8.3f `d' %7.3f `P' "`star'" /*
		 */ _col(53) "`bigpwrs'" _col(63) "`pwrs'"
		local hed
		local degmax
		if `j0'<`m' & `P'>`pnom' {
			if !`sig' & "`iv'"!="" {	/* IV lin vs null */
				local j 0
				local n1=1+`cz'
				local n2=`rdf'-`n1'
				local d=`dev`j''-`dev1'
				frac_pv `normal' "`weight'" `nobs' `d' `n1' `n2'
				local P = r(P)
				local degmax lin.
				local vs null
				local bigpwrs 1
				local pwrs .
				if `P'>`select' {
					local j0 -1
				}
				else {
					local j0 0
					local pwrs 1
					local star `ss'
				}
				di in gr "`hed'" _col(10) "`degmax'" /*
				 */ _col(16) "(`vs')" /*
				 */ _col(22) %10.3f in ye `dev`j'' /*
				 */ _col(34) %8.3f `d' %7.3f `P' "`star'" /*
				 */ _col(53) "`bigpwrs'" _col(63) "`pwrs'"
				local j=`j0'+1
				local hed
				local degmax
			}
			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 " "
		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 "`sequent'"!="" {
/*
	Sequential tests
*/
	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 m=1
			local vs lin.
			local pwrs=e(fp_p`j0')
			local pwrs2 1
		}
		else {
			local n1 2
			local vs1 "m=`j0'"
			local vs "m=`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' {		/* NS, finished */
			local done 1
			local star *
			local dev `dev`j0''
			qui fracgen `n' `pwrs', `options' `catzero' replace
			local n `r(names)'
		}
		di in gr "`hed'" _col(10) "`vs1'" /*
		 */ _col(16) "(`vs')" _col(22) %10.3f in ye `dev`j0'' /*
		 */ _col(34) %8.3f `d' %7.3f `P' "`star'" /*
		 */ _col(53) "`pwrs'" _col(63) "`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 gr "`xvar'" _col(10) "final" _col(24) in ye %8.3f `dev' _col(53) "`pwrs'"
local rhs "`rhs' `n'"
di
ret local rhs `rhs'
ret local pwrs `pwrs'
ret scalar dev=`dev'
ret local n `n'
end