cttost.ado

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

*! version 1.2.1  16dec2002
program define cttost
* touched by kth
	version 6.0

	syntax [, CLEAR noPreserve Wvar(string) T0var(string) ]

	ct_is

	if `"`clear'"'=="" {
		qui desc
		if r(changed) { error 4 }
	}

	MakeVar "wvar()" `"`wvar'"' w pop weight wgt 
	local w `"`s(newvar)'"'

	local t : char _dta[ct_t]
	local die : char _dta[ct_d]
	local cens : char _dta[ct_c]
	local ent : char _dta[ct_e]
	local by : char _dta[ct_by]

	if `"`ent'"'!="" {
		quietly {
			tempvar pt
			sort `by' `t'
			by `by' `t': gen int `pt' = 1 if _n==1
			if `"`by'"'!="" {
				local byp `"by `by':"'
			}
			`byp' replace `pt'= sum(`pt')
			capture assert `ent'==0 if `pt'>1
			if _rc { 
				MakeVar "t0()" `"`t0var'"' t0 time0 etime
				local t0 `"`s(newvar)'"'
				preserve
				char _dta[ct_e] 
				drop `ent'
				cttost, wvar(`w') nopreserve clear
				tempfile file1
				save `"`file1'"'
				restore, preserve
				keep if `ent'
				keep `t' `ent' 
				append using `"`file1'"'
				cycle `"`by'"' `t' `die' `w' `ent' -> `t0'
				if _caller()<6 {
					noi ztset_5 `t' `die' [fw=`w'], t0(`t0')
				}
				else	noi stset `t' [fw=`w'], fail(`die') /*
					*/ enter(`t0')
				restore, not 
				exit
			}
		}
	}
	if `"`preserv'"'=="" {
		preserve
	}
	global S_FN
	global S_FNDATE
	quietly {
		if `"`ent'"'!="" {
			keep if `ent'==0
			drop `ent'
		}
	}

	ctset, clear

	if `"`cens'"'=="" {
		quietly {
			drop if `die'==0
			gen double `w' = `die' 
			drop `die'
			compress `w'
		}
		if _caller()<6 {
			ztset_5 `t' [fweight=`w']
		}
		else	stset `t' [fw=`w']
	}
	else {
		quietly {
			local N = _N
			local Np1 = _N + 1
			expand 2 
			gen double `w'=`cens' in 1/`N'
			replace `die' = 0 in 1/`N'
			replace `w' = `die' in `Np1'/l
			replace `die' = 1 in `Np1'/l
			drop if `w'==0 
			compress `w'
		}
		di in gr "(data are now st)"
		if _caller()<6 {
			ztset_5 `t' `die' [fweight=`w']
		}
		else	stset `t' [fw=`w'], fail(`die')
	}
	if `"`cens'"'!="" {
		drop `cens'
	}
	if `"`preserv'"' == "" {
		restore, not
	}
end


program define cycle /* by t1 d pop e -> t0 */
	args by t1 d pop e ARROW t0

	local tyt0 : type `t1'
	local tye  : type `e'
	tempvar mark newmark newt0 newe newpop

	if `"`by'"' != "" {
		local byp `"by `by':"'
		local bys `"by `by'"'
	}

	quietly {
		gen `tyt0' `t0' = `t1' if `e'!=.
		gen byte `mark' = 0 
		while (1) {
			count if `mark'==0
			if r(N)==0 { 
				drop `e'
				exit
			}
			sort `by' `mark' `t1' `pop' /* make es second */
			count if `e' != .
			if r(N) == 1 {
				sort  `by' `mark'  `e' 
			}
			else {
				tempvar ord1 ord2 group
				gen `ord1' = _n
				sort `by' `mark' `t1' `e'
				gen `ord2' = _n
				egen `group' = group(`by' `mark' `t1')
				replace `ord1' = `ord2' if `group' == 1
				sort `ord1'
			}
			`byp' gen `tyt0' `newt0' = cond(`mark',`t0',`t0'[_n-1])
			`byp' gen `tye'  `newe'  = cond(`mark',`e',`e'[_n-1])
			drop `t0' `e'
			rename `newt0' `t0'
			rename `newe' `e'
			drop if `e'==. & `pop'==. & `mark'==0

			gen byte `newmark' = `pop'!=. & `e'!=. & `mark'==0
			gen double `newpop' = min(`pop',`e') if `newmark'
			local N = _N 
			expand 2 if `newmark' & `pop'!=`e'

			/* marked Obs in 1/N are now complete */
			replace `pop' = `newpop' if `newmark' in 1/`N'
			replace `e' = . if `newmark' in 1/`N'

			if `N'<_N {
				local Np1 = `N' + 1
				replace `newmark'=0 in `Np1'/l
				replace `pop' = `pop'-`newpop' in `Np1'/l
				replace `e'   = (`e') - `newpop' in `Np1'/l
				drop `newpop'

				/* either the queue is done ... */
				replace `d'=. if `pop'==0 in `Np1'/l
				replace `pop' = . if `pop'==0 in `Np1'/l

				/* or death/censoring is done ... */
				replace `t0'=. if `e'==0 in `Np1'/l
				replace `e' =. if `e'==0 in `Np1'/l
			}
			else	drop `newpop'

			replace `mark'=1 if `newmark'
			drop `newmark'
		}
	}
end

program define MakeVar, sclass /* opname "[var]" <potential-name-list> */
	local option `"`1'"'
	if `"`2'"'!="" {
		local n : word count `"`2'"'
		if `n'!=1 {
			di in red `"`option' invalid"'
			exit 198
		}
		confirm new var `2'
		sret local newvar `"`2'"'
		exit
	}
	mac shift 2
	local list `"`*'"'
	while `"`1'"'!="" {
		capture confirm new var `1'
		if _rc==0 {
			sret local newvar `"`1'"'
			exit
		}
		mac shift
	}
	di in red `"could not find variable name for `option'"'
	di in red `"      tried:  `list'"'
	di in red `"      specify `option' explicitly"'
	exit 110
end