stci.ado

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

*! version 7.2.5  17mar2005
program define stci, rclass byable(recall) sort
	version 7, missing
	if _caller() < 8 {
		stci_7 `0'
		return add
		exit
	}

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

	st_is 2 analysis

	local ops BY(varlist) CCorr Emean Median /*
		*/ P(numlist >0 integer max=1) /*
		*/ Rmean noSHow Level(cilevel) /*
		*/ Tmax(numlist >0 max=1) DD(integer -100) 

	syntax [if] [in] [, `ops' Graph * ]
	if "`graph'"=="" {
		syntax [if] [in] [, `ops' ]
	}
	local ops

	local wv  : char _dta[st_wv]
	if "`wv'"~="" {
		noi di as err "weights not allowed"
		exit 101
	}
	if `dd'==-100 {
		local dec="0g"
	}
	else {
		if `dd'<0 | `dd'>8 { 
			di as err "dd() must be between 0 and 8"
			exit 198
		}
		local dec="`dd'f"
	}
	if "`emean'`median'`p'`rmean'"=="" {
		local median="median"
	}

	if (("`emean'"!="") + ("`median'"~="") + ("`p'"~="") /*
		*/ + ("`rmean'"~="") )>1 {
		noi di as err 
		di as err /*
		*/ "only one option " /*
		*/ " rmean, median, emean, or p() may be specified at a time"
		exit 198	
	}
	if "`ccorr'"~="" & "`rmean'"==""  {
		di as err "option ccorr only allowed with option rmean"
		exit 198	
	}
	if "`graph'"~="" & "`emean'"==""  {
		di as err "option graph only allowed with option emean"
		exit 198	
	}
	if "`graph'"~="" & "`by'"~="" {
		di as err /*
		*/ "option graph not valid with by() option"
		exit 198	
	}
	if "`tmax'"~="" & "`graph'"==""  {
		di as err "option tmax() only allowed with option graph"
		exit 198	
	}
	if "`saving'"~="" & "`graph'"==""  {
		di as err "option saving() only allowed with option graph"
		exit 198	
	}
	st_show `show'
	if "`median'"~="" | "`p'"=="50" {
		local p=50
		local ttlhead "Median survival time"
		local median 1
		local mytype= " 50%"
		di
		DispHdr `level' `mytype' "`'" `by'
	}
	else if "`p'"~="" {
		local ttlhead "`p'th percentile of survival time"
		local median 2
		local mytype=" `p'%"
		di
		DispHdr `level' `mytype' "`'" `by'
	}
	else if "`rmean'"~="" {
		local ttlhead "Restricted mean survival time"
		local median 3
		local mytype1="restricted"
		local mytype="mean"
		di
		DispHdr `level' `mytype' `mytype1' `by'
	}
	else {
		local ttlhead "Exponentially extended mean survival time"
		local median 4
		local mytype1="extended"
		local mytype="mean"
		if "`graph'"=="" {
			di
			DispHdr `level' `mytype' `mytype1' `by'
		}
	}
	tempvar touse
	st_smpl `touse' `"`if'"' `"`in'"' `"`by'"' `""'
	if _by() {
		local byind "`_byindex'"
		qui replace `touse'=0 if `byind'!=_byindex()
		local byind
	}
	quietly {
		tempvar atrisk
		gen double `atrisk' = _t - _t0 if `touse'
	}
	if `median'<3 {
		if `"`by'"' != "" {
			tempvar grp subuse
			sort `touse' `by' 
			qui by `touse' `by': gen long `grp'=1 if _n==1 & `touse'
			qui replace `grp'=sum(`grp') if `touse'
			local ng = `grp'[_N]
			local i 1
			while `i' <= `ng' {
				qui gen byte `subuse'=`touse' & `grp'==`i'
				MYStats /*
				*/ `subuse' `atrisk' `"`by'"' `p' `level' `dec'
				drop `subuse'
				local i = `i' + 1
			}
			di as txt "{hline 13}{c +}{hline 61}"
		}
		MYStats `touse' `atrisk' `""' `p' `level' `dec'
		ret add
		exit
	}
	else {              /* median= 3 or 4 */
		if "`graph'"~="" {
			if  "`tmax'"=="" {
				local flag2= -1
			}
			else {
				local flag2=`tmax'
			}
		}
		else {
			local flag2 0
		}
		local flag1=0
		if `"`by'"' != "" {
			tempvar grp subuse N d
			sort `touse' `by' 
			qui by `touse' `by': gen long `grp'=1 if _n==1 & `touse'
			qui replace `grp'=sum(`grp') if `touse'
			local ng = `grp'[_N]
			local i 1
			while `i' <= `ng' {
				qui `vv' sts gen `N'=n if `touse' & `grp'==`i'
				qui `vv' sts gen `d'=d if `touse' & `grp'==`i'
				qui gen byte `subuse'=`touse' & `grp'==`i'
				qui compress `N' `d'
				MYStats1 `subuse' `atrisk'  `"`by'"' "`'" /* 
				*/ `level' `median' `N' `d'  `flag1' /* 
				*/`flag2' "`ccorr'" `"`options'"' "`dec'"
				drop `subuse' `N' `d'
				if `median'>= 3 {
					if `r(f1)'~=0 {
						local flag1=`r(f1)'
					}
				}
				local i = `i' + 1
			}
			if `median'== 4 & "`graph'"=="" {
				di as txt "{hline 13}{c +}{hline 22}"
			}
			else if `median'== 3 {
				di as txt "{hline 13}{c +}{hline 61}"
			}
		}
		tempvar N d
		qui `vv' sts gen `N'=n if `touse'
		qui `vv' sts gen `d'=d if `touse'
		qui compress `N' `d'
		MYStats1 `touse' `atrisk' `""' "`'" `level'  `median' `N' /* 
		*/ `d' `flag1' `flag2' "`ccorr'"  `"`options'"' "`dec'"
		if `median'>= 3 & `flag1'==0 {
			if `r(f1)'~=0 {
				local flag1=`r(f1)'
			}
		}
		if `flag1'==1 {
                        noi di as txt _n "(*) largest observed analysis time " /*
			*/ "is censored, mean is underestimated."

		}
		if `flag1'==2 {
                        noi di as txt _n "(*) no extension needed"
		}
		ret local f1
		ret add
	}
end

program define MYStats, rclass /* touse atrisk by p level */
	args touse atrisk by p level dec

	local id : char _dta[st_id]
	local wv  : char _dta[st_wv]

	tempname tatr m s j0 lb ub
	quietly {
		if `"`wv'"'==`""' {
			summ `atrisk' if `touse'
			scalar `tatr' = r(sum)
			summ _d if `touse'
			local fail = r(sum)
			if `"`id'"'==`""' {
				count if `touse'
				local nsubj = r(N)
			}
			else {
				sort `touse' `id'
				by `touse' `id': /*
				*/ gen byte `m'=1 if _n==1 & `touse'
				summ `m'
				local nsubj = r(sum)
			}
		}
		else {
			tempvar z
			gen double `z' = `wv'*`atrisk'
			summ `z' if `touse'
			scalar `tatr' = r(sum)
			replace `z' = `wv'*_d
			summ `z' if `touse'
			local fail = r(sum)
			drop `z'
			if `"`id'"'==`""' {
				summ `wv' if `touse'
				local nsubj = r(sum)
			}
			else {
				sort `touse' `id'
				by `touse' `id': /*
				*/ gen double `z'=`wv' if _n==1 & `touse'
				summ `z' if `touse'
				local nsubj = r(sum)
			}
		}

		Settitle `touse' `"`by'"'
		local ttl `"$S_1"'
		tempvar  greenV psl psu tb1 tb2
		tempname tb1 tb2
		`vv' sts gen `greenV'=se(s)
		qui `vv' sts gen `lb'=lb(s) if `touse', level(`level')
		qui `vv' sts gen `ub'=ub(s) if `touse', level(`level')
		capture GetS `touse' `s'
		if _rc==0 { 
			replace `touse' = 0 if `s'>=.
			sort `touse' _t 
			gen long `j0' = _n if `touse'==0
			summ `j0'
			local j0 = cond(r(max)>=.,1,r(max)+1)
			Findptl (1-`p'/100) `s' `j0'
			local ps $S_1
			local s2 $S_2
			Findptl (1-`p'/100) `lb' `j0' 
			scalar `psl'= $S_1
			Findptl (1-`p'/100) `ub' `j0' 
			scalar `psu'= $S_1
			Findptl (1-`p'/100-0.05) `s' `j0' 
			scalar `tb1'= $S_1
			Findptl2 (1-`p'/100+0.05) `s' `j0' 
			scalar `tb2'= $S_1
			
			summ `s'  if abs(_t-`psl')<1e-8  , meanonly
			local sl=r(mean) 
			summ `s'  if abs(_t-`psu')<1e-8  , meanonly
			local su=r(mean) 
			summ `s'  if abs(_t-`tb1')<1e-8  , meanonly
			local su1=r(mean) 
			summ `s'  if abs(_t-`tb2')<1e-8  , meanonly 
			local sl1=r(mean) 

			summ `greenV'  if abs(_t-`ps')<1e-8, meanonly
			local sv=r(mean) 
			tempname f se nse
			scalar `f'= (`sl1' - `su1')/(`tb1'-`tb2')
			/* from Collett: being used */
			scalar `se'= `sv'/`f'
			/* from Klein */
			scalar `nse'= (`p'/100)*`sv'/(sqrt(`s2')*`f')
		}
		else {
			local ps .
			local se .
			local nse .
			local psl .
			local psu .
		}
	}

	Displine /*
	*/ `"`ttl'"' `nsubj' `ps' `se' `psl' `psu' "`median'" "`flag'" `dec'
	ret scalar ub = `psu'
	ret scalar lb = `psl'
	ret scalar se = `se'
	ret scalar p`p' = `ps'
	ret scalar N_sub = `nsubj'
	
end
program define MYStats1, rclass 
	args touse atrisk by p level median N d flag1 flag2 ccorr options dec

	_get_gropts , graphopts(`options') getallowed(plot addplot)
	local plot `"`s(plot)'"'
	local addplot `"`s(addplot)'"'
	local options `"`s(graphopts)'"'

	local id : char _dta[st_id]
	local wv  : char _dta[st_wv]

	tempname tatr m s j0 lb ub

quietly {

	if `"`wv'"'==`""' {
		summ `atrisk' if `touse'
		scalar `tatr' = r(sum)
		summ _d if `touse'
		local fail = r(sum)
		if `"`id'"'==`""' {
			count if `touse'
			local nsubj = r(N)
		}
		else {
			sort `touse' `id'
			by `touse' `id': /*
			*/ gen byte `m'=1 if _n==1 & `touse'
			summ `m'
			local nsubj = r(sum)
		}
	}
	else {
		tempvar z
		gen double `z' = `wv'*`atrisk'
		summ `z' if `touse'
		scalar `tatr' = r(sum)
		replace `z' = `wv'*_d
		summ `z' if `touse'
		local fail = r(sum)
		drop `z'
		if `"`id'"'==`""' {
			summ `wv' if `touse'
			local nsubj = r(sum)
		}