roctab.ado

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

*! version 7.3.7  26apr2005
prog def roctab, rclass sortpreserve
	version 7, missing
	if _caller() < 8 {
		roctab_7 `0'
		return add
		exit
	}

	local vv : display "version " string(_caller()) ", missing:"

	syntax varlist(numeric min=2 max=2)	///
		[if] [in] [ fweight]		///
		[,				///
		BAMber				///
		noBIASadj			///
		Detail				///
		Level(cilevel)			///
		LORenz				///
		TABle				///
		HANley				///
		BINOmial			///
		SUMmary				///
		Graph				/// graph opts
		SPECificity			///
		*				///
		]

	if `"`specificity'"' != "" {
		local graph graph
	}

	if "`graph'"=="" {
		syntax varlist(numeric min=2 max=2)	///
			[if] [in] [ fweight]		///
			[,				///
			BAMber				///
			noBIASadj			///
			Detail				///
			Level(cilevel)			///
			LORenz				///
			TABle				///
			HANley				///
			BINOmial			///
			SUMmary				///
			Graph				///
			]
	}

	marksample touse
	tokenize `varlist'
	local D = `"`1'"'
	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 C
	qui egen int `C' = group(`2') if `touse', label
	label var `C' `2'
	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 `vv' 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'"~="" {
			_get_gropts , graphopts(`options')	///
				getallowed(PLOTOPts RLOPts plot addplot)
			local options `"`s(graphopts)'"'
			local rlopts `"`s(rlopts)'"'
			local plotopts `"`s(plotopts)'"'
			local plot `"`s(plot)'"'
			local addplot `"`s(addplot)'"'
			_check4gropts rlopts, opt(`rlopts')
			_check4gropts plotopts, opt(`plotopts')
			if `"`plot'`addplot'"' == "" {
				local legend legend(nodraw)
			}

			local yttl : var label `cuma'
			local xttl : var label `cumn'
			noi				///
			version 8: graph twoway		///
			(connected `cuma' `cumn',	///
				sort			///
				title("Lorenz curve")	///
				ylabel(0(.1)1)		///
				ytitle(`"`yttl'"')	///
				xtitle(`"`xttl'"')	///
				xlabel(0(.1)1)		///
				`legend'		///
				`options'		///
				`plotopts'		///
			)				///
			(function y=x			///
				if `touse',		///
				range(`cumn')		///
				n(2)			///
				lstyle(refline)		///
				yvarlabel("Reference")	///
				`rlopts'		///
			)				///
			|| `plot' || `addplot'		///
			// blank
		}
		qui drop if `drp'==1
} // nobreak
		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 class noREFline SPECificity *]

	_get_gropts , graphopts(`options') ///
		getallowed(PLOTOPts RLOPts plot addplot)
	local options `"`s(graphopts)'"'
	local rlopts `"`s(rlopts)'"'
	local plotopts `"`s(plotopts)'"'
	local plot `"`s(plot)'"'
	local addplot `"`s(addplot)'"'
	_check4gropts rlopts, opt(`rlopts')
	_check4gropts plotopts, opt(`plotopts')
	if `"`plot'`addplot'"' == "" {
		local legend legend(nodraw)
	}

	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 `"`graph'"' ~= `""' {
		local note : display	///
			`"Area under ROC curve = "' %6.4f return(area)
		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"
			local yofx "y=1-x"
		}
		else	local yofx "y=x"
		if `"`refline'"'=="" {
			local rlgraph			///
			(function `yofx',		///
				range(`spec')		///
				n(2)			///
				lstyle(refline)		///
				yvarlabel("Reference")	///
				`rlopts'		/// graph opts
			)				///
			// blank
		}
		else {
			replace `w'=.
			local w
		}
		format `sens' `w' `spec' %4.2f
		local yttl : var label `sens'
		local xttl : var label `spec'
		noi					///
		version 8: graph twoway			///
		(connected `sens' `spec',		///
			sort(`spec' `sens')		///
			ylabel(0(.25)1, grid)		///
			xlabel(0(.25)1, grid)		///
			ytitle(`"`yttl'"')		///