roctab_7.ado

来自「是一个经济学管理应用软件 很难找的 但是经济学学生又必须用到」· ADO 代码 · 共 631 行 · 第 1/2 页

*! version 7.1.7  17mar2005
prog def roctab_7, rclass sortpreserve
	version 7, missing
	syntax varlist(numeric min=2 max=2) [if] [in] [ fweight] [, BAMber /*
	*/ noBIASadj Detail Level(cilevel) LORenz TABle Graph /*
	*/ HANley BINOmial SUMmary SPECificity * ]
	if "`specificity'"~="" {
		local graph graph
	}
	if "`graph'"=="" {
		syntax varlist [if] [in] [fweight]  [, BAMber /*
		*/ noBIASadj Detail Level(cilevel) LORenz TABle /*
 		*/ HANley BINOmial SUMmary Graph ]
	}
	marksample touse
	tokenize `varlist'
	local D = `"`1'"'
	local C = `"`2'"'
	cap assert `D'==0 | `D'==1 if `touse'
	if _rc~=0 {
		noi di in red "true status variable `D' must be 0 or 1"
		exit 198
	}
	if "`bamber'"~="" & "`hanley'"~="" {
		di in red "bamber and hanley not allowed together"
                exit 198
	}
	if `"`lorenz'"'~="" {
		if "`graph'"~="" {
			local lgraph="graph"
			local graph="" 
		}
		if "`bamber'"~="" | "`hanley'"~="" {
			di in red /*
			*/ "option lorenz not allowed with bamber or hanley"
                	exit 198 
		}
		if "`binomial'"~="" {
			di in red "option lorenz not allowed with binomial"
			exit 198 
		}
	}

	qui summ `D' if `touse', meanonly
	if r(min) == r(max) {
		di in red "outcome does not vary"
		exit 2000 
	}
	if `"`weight'"' =="" {
		tempvar wv
		qui gen int `wv' = 1 if `touse'
		local weight="fweight"
	}
	else {
		tempvar wv
		qui gen double `wv' `exp'
	}

	tempvar newwt
	sort `touse' `D' `C'
	qui by `touse' `D' `C': gen `newwt'=sum(`wv') if `touse'
	qui by `touse' `D' `C': replace `newwt'=. if _n~=_N
	qui replace `newwt'=. if `newwt'==0
	qui replace `touse'=0 if `newwt'>=.
	qui replace `wv'=`newwt'
	local wt=`"[fweight=`wv']"'
	tempvar MN
	sort `touse' `D' `C'
	qui by `touse' `D' : gen long `MN' = sum(`wv')
	qui by `touse' `D' : replace `MN' = `MN'[_N]
	qui replace `MN'=. if `touse'==0
	if "`table'"~="" {
		noi cap tabulate `D' `C' `wt' if `touse'
		if _rc~=0 {
			tabulate `C' `D' `wt' if `touse'
		}
		else {
			tabulate `D' `C' `wt' if `touse'
		}
	}
	tempvar p
	qui logistic `D' `C' `wt' if `touse', asis
	tempname b
	mat `b'=e(b)
	local bc= colsof(`b') 	
	qui predict double `p' if e(sample), p
	if `bc'>1 {
		if _b[`C']<0 {
			qui MYLRoc, `options' `graph' `specificity' class
		}
		else {
        		qui MYLRoc , `options' `graph' `specificity'
		}
	}
	else {
       		qui MYLRoc , `options' `graph' `specificity'
	}
	tempname area
	scalar `area'= r(area)
	local N=r(N)
	qui sum `D' `wt' if `touse', meanonly
	local na=r(sum)
	local nn=`N'-`na'
	if `"`detail'"'~="" {
	        tempvar prob sens spec
	        qui sum `p', meanonly
	        cap assert reldif(`p', r(min))<1e-12 if `p'<.
	        if _rc==0 {
	                qui _rocsen if `touse', class(`C') genprob(`prob') /*
			*/ gensens(`sens') genspec(`spec')
		}
		else {
			qui lsens if `touse', nograph genprob(`prob') /*
			*/ gensens(`sens') genspec(`spec')
		}
		if _b[`C']<0 {
			tempvar mark
			qui gen int `mark'=1 if `sens'==1 & `spec'==1
			qui replace `mark'=1 if `sens'==0 & `spec'==0
			qui replace `sens' = 1 -`sens' if `mark'!=1
			qui replace `spec' = 1 -`spec' if `mark'!=1
		}
		sort `prob'
		MYDETail `prob' `sens' `spec' `D' `C' `touse' `wt'
		qui replace `sens'=. if `prob'==0 | `prob'==1
		qui replace `spec'=. if `prob'==0 | `prob'==1
		qui replace `prob'=. if `sens'>=. | `spec'>=.
		sort `prob'
		qui replace `prob'=. if `sens'==1 & `spec'==0 & _n==1
	}
	if `"`lorenz'"'~="" {
		tempvar cuma cumn
		qui gen double `cuma'=.
		qui gen double `cumn'=.
		LORenz `cuma' `cumn' `C' `D' `area' `touse' `na' `nn' `wv'
		nobreak {
			local Nmax=_N+2
			qui set obs `Nmax'
			tempvar drp
			qui gen `drp'=1 if _n>`Nmax'-2
			qui replace `cuma'=0 if _n==`Nmax'-1
			qui replace `cumn'=0 if _n==`Nmax'-1
			qui replace `cuma'=1 if _n==`Nmax'
			qui replace `cumn'=1 if _n==`Nmax'
			label var `cuma' "cumulative % of `D'=1"
			label var `cumn' "cumulative % of `D'=0"
			if `"`t1title'"'=="" {
				local t1opt="t1title(Lorenz curve)"
			}
			if "`lgraph'"~="" {
				noi gr7 `cuma' `cumn' `cumn' /*
				*/ , c(ll) s(oi) sort `t1opt' /*
				*/  xlab(0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1) /*
				*/ border /*
				*/  ylab(0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1) /*
				*/ `options'
			}
			qui drop if `drp'==1
		}
		GIni `cuma' `cumn' `C'
 		if "`lgraph'"=="" | "`summary'"~="" {
			noi di _n in gr " Lorenz curve "
			noi di in smcl in gr "{hline 27}"
			noi di in gr "  Pietra index = " in ye %8.4f `s(pietra)'
			noi di in gr "  Gini index   = " in ye %8.4f `s(gini)'
		}
		return scalar gini=`s(gini)'
		return scalar pietra=`s(pietra)'
	}
	else {
		if `"`bamber'"'~= "" | `"`biasadj'"'~="" {
			BAMberSE `C' `D' `area' `touse' `na' `nn' `wv' `biasadj'
			local SEtype="Bamber"
		}
		else if `"`hanley'"' ~="" {
			HANleySE `C' `D' `area' `touse' `na' `nn' `wv'
			local SEtype="Hanley"
		}
		else {
			tempvar v01 v10
			qui gen double `v01'=.
			qui gen double `v10'=.
			preserve
			qui keep if `touse'
			DeLongSE `D' `C' `wv' `na' `nn' `area' `v01' `v10'
			*rename `v01' v01`i'
			*rename `v10' v10`i'
			local SEtype="      "
			restore

		}
		if `"`binomial'"'~="" {
			local CItype="binom"
		}		
		tempname se
		scalar `se'= `s(se)'
		local mygr="`graph'"
		if "`table'"~="" | "`detail'"~="" | "`summary'"~="" {
			local mygr="not"
		}
		if "`mygr'"=="" {
			local mygr="not"
		}
		MYDIspl `N' `area' `se' `level' `mygr' `SEtype' `CItype'
		return scalar ub = `s(ub)'
		return scalar lb = `s(lb)'
		return scalar se = `se'
		return scalar area = `area'
		return scalar N = `N'
	}
end

prog def MYLRoc, rclass
	tempvar touse p w spec sens
	lfit_p `touse' `p' `w' `0'
	local y `"`s(depvar)'"'
	ret scalar N = `s(N)'
	local 0 `", `s(options)'"'
	sret clear
	syntax [, Graph T2title(string) Symbol(string) class /*
	*/ Bands(string) XLAbel(string) YLAbel(string) XLIne(string) /*
	*/ YLIne(string) noREFline SPECificity *]
	if `"`graph'"' ~= `""' {
		if `"`symbol'"' == `""' { local symbol `"o"' }
		if `"`bands'"' == `""' { local bands `"10"' }
		if `"`xlabel'"' == `""' { local xlabel `"0,.25,.5,.75,1"' }
		if `"`ylabel'"' == `""' { local ylabel `"0,.25,.5,.75,1"' }
		if `"`xline'"' == `""' { local xline `".25,.5,.75"' }
		if `"`yline'"' == `""' { local yline `".25,.5,.75"' }
	}
	local old_N = _N
	capture {
		lsens_x `touse' `p' `w' `y' `sens' `spec' one
		replace `p' = sum((`spec'-`spec'[_n-1])*(`sens'+`sens'[_n-1]))
		if `"`class'"'~="" {
			return scalar area = 1 - `p'[_N]/2
		}
		else {
			return scalar area = `p'[_N]/2
		}
		global S_2 `"`return(area)'"'
		if `"`t2title'"' == `""' {
			local area : di %6.4f return(area)
			local t2title `"Area under ROC curve = `area'"'
		}
		if `"`graph'"' ~= `""' {
			if `"`refline'"'=="" {
				replace `w' = /*
				*/ cond(`spec'==0, 0, cond(`spec'==1, 1, .))
			}
			else {
				replace `w'=.
			}
			if `"`class'"'~="" {
				tempvar mark
				qui gen int `mark'=1 if `sens'==1 & `spec'==1
				qui replace `mark'=1 if `sens'==0 & `spec'==0
				replace `sens' = 1 -`sens' if `mark'!=1
				replace `spec' = 1 -`spec' if `mark'!=1
			}
			if `"`specificity'"'~="" {
				replace `spec' = 1 -`spec'
				label var `spec' "Specificity"
			}
			format `sens' `w' `spec' %4.2f
			noi gr7 `sens' `w' `spec', c(ll) s(`symbol'i) /*
			*/ border t2(`"`t2title'"') bands(`bands') /*
			*/ xlabel(`xlabel') ylabel(`ylabel') xline(`xline') /*
			*/  yline(`yline') sort `options'
		}
	}
	nobreak {
		local rc = _rc
		if _N > `old_N' {
			qui drop if `touse' >=.
		}
		if `rc' { error `rc' }
	}
end

prog def LORenz, sclass
	args cuma cumn C D area touse na nn wv
	tempvar lr numb cum lr1 lr2
	quietly {
		sort `touse' `D' `C'
		by `touse' `D' `C': gen double `numb' = sum(`touse'*`wv')
		qui replace `numb' = . if `touse' == 0
		by `touse' `D' `C': replace `numb'= `numb'[_N]
		qui gen double `lr1' = `numb'/`nn' if `D'==0
		qui gen double `lr2' = `numb'/`na' if `D'==1
		sort `touse' `C' `D'
		by `touse' `C' : replace `lr1' = `lr1'[_n-1] if `lr1'>=.
		qui by `touse' `C' : replace `lr2' = `lr2'[_n+1] if `lr2'>=.
		qui gen double `lr' = `lr2'/`lr1'
		drop `lr1' `lr2'
		replace `lr'=. if `touse'~=1
		sort `touse' `C' `D'
		by `touse' `C' `D': replace `lr'=. if _n~=_N
		sort `touse' `C' `lr'
		by `touse' `C': replace `lr'=`lr'[_n-1] if `lr'>=.
		tempvar cum1 cum0
		sort `touse' `lr' `D' `C'
		tempvar order
		qui gen long `order'=_n
		compress `order'
		replace `order'=. if `lr'>=.
		cumul `order' [fw=`wv'] if `touse' & `D'==0, gen(`cum0')
		sort `order'
		cumul `order' [fw=`wv'] if `touse' & `D'==1, gen(`cum1')
		qui gen double `cum'=`cum0' if `D'==0
		qui replace `cum'=`cum1' if `D'==1
		drop `cum0' `cum1' `order'
		sort `touse' `C' `D' `cum'
		by `touse' `C' `D': replace `cum'=`cum'[_N]
		replace `cumn'=`cum' if `D'==0
		replace `cuma'=`cum' if `D'==1