*! version 1.3.8  08jan2000
program define weibhet, eclass
	version 6.0
	if replay() { 
		if `"`e(cmd)'"' != "weibhet" { error 301 } 
		syntax [, Level(integer $S_level) noCOEF noHEADer HR ]
	}
	else {
		syntax [varlist] [if] [in] [fweight pweight iweight] /*
			*/ [, noCOEF CLuster(string) Dead(string)/*
			*/ DEBUG FROM(string) noHEADer MLMethod(string) /*
			*/ MLOpt(string) SHApe(real 1 ) noCONStant /*
			*/ Level(integer $S_level) noLOG OFFset(string) /*
			*/ Robust SCore(string) T0(string) SKIP TR *]


		tokenize `varlist'
		local t `1'
		mac shift 
		local rhs `*'

		if "`cluster'"!="" {
			local cluopt cluster(`cluster')
		}
		if "`from'" != "" { local iniopt init(`from') }
		if "`mlmethod'" == "" { local mlmetho = "d2" }
		if "`offset'" !="" { local offopt = "offset(`offset')" }
		mlopts options, `options'
		
		if "`score'" != "" {
			local n : word count `score'
			if `n' != 3 { 
				di in red /*
			*/ "score() invalid:  three new variable names required"
				exit 198 
			}
			confirm new var `score'
			local scopt "score(`score')"
		}

		if "`weight'" != "" { 
			tempvar wv
			qui gen double `wv' `exp'
			local w [`weight'=`wv']
		}

		tempvar touse 
		mark `touse' `w' `if' `in'
		markout `touse' `t' `rhs' `dead' `t0'
		markout `touse' `cluster', strok


		if "`dead'" != "" {
			local sdead "`dead'"
			capture assert `dead'==0 | `dead'==1 if `touse'
			if _rc { 
				tempvar mydead 
				qui gen byte `mydead' = `dead'!=0 if `touse'
				local dead "mydead"
			}
		}
		else {
			tempvar dead 
			qui gen byte `dead'=1
			local sdead 1
		}

		if "`t0'" == "" {
			local t0 0
		}
		capture assert `t0' < `t' if `touse'
		if _rc {
			di in red "`t0' >= `t' in some obs."
			exit 498
		}


		_rmcoll `rhs' `w' if `touse', `constant'
		local rhs "$S_1"
		global S_1

		global EREGd `dead'
		global EREGt0 `t0'

		if "`log'"!="" { local nlog="*" }
		tempvar mysamp num den
		tempname b f V  g b0 bc0
		quietly { 
		        if "`weight'"=="aweight" | "`weight'"=="pweight" {
                                tempvar wvn
                                summ `wv' if `touse', meanonly
                                gen double `wvn' = `wv'/r(mean)
                                local wvngen 1
                        }
                        else if "`weight'"!="" {
                                local wvn `wv'
                        }
                        else {
                                local wvn 1
                        }
			count if `touse'
			local myN=r(N)
                        gen double `num' = sum(`wvn'*`dead')
                        gen double `den' = sum(`wvn'*(`t'-$EREGt0))
                        local cons = ln(`num'[_N]/`den'[_N])
                        drop `num' `den'
                        gen double `num' = `wvn'*ln(`t') if `touse' & `dead'
                        replace `num' = sum(`num')
                        global EREGa = `num'[_N]/`myN'
			drop `num'
			if "`wvngen'"!=""  { drop `wvn' }
		}
		if "`constant'"!="" {
			local skip = "skip"
			`nlog' di in gr "Fitting full model:"
		}
		if "`rhs'" != "" & "`skip'"=="" { 
			qui stweib, estimate 	
			local cval=_b[`t':_cons]
			`nlog' di ""
			`nlog' di in gr "Fitting constant-only model:"
			ml model lf weiht_lf (`t': `t'=, `offopt') /*
			*/ /ln_sig /ln_p `w' if `touse', /*
			*/ init(_cons=`cval' /ln_sig=0 /ln_p=0) /*
				*/ missing collin nopreserve wald(0) `mlopt' /*
				*/ max noout `log' `options' search(off) 
			local cont continue
			`nlog' di ""
			`nlog' di in gr "Fitting full model:"
		}
		else {
			
			local cont wald(1)
			if "`iniopt'"=="" {
				if "`constant'"=="" { 
					summ `dead' if `touse', meanonly
					local mysumd = r(sum)
					summ `t' if `touse', meanonly
					local mysumt = r(sum)
					local cval = -ln(`mysumd'/`mysumt')
					local iniopt= /*
				      */ "init(_cons=`cval' /ln_sig=1 /ln_p=1)"
				}
				else {
					local iniopt= /*
				      */ "init( /ln_sig=1 /ln_p=1)"
				}
			}
		}
		ml model lf  weiht_lf /*
			*/ (`t': `t'=`rhs' , `offopt' `constant' )  /*
			*/ /ln_sig /ln_p `w' if `touse', `cont' noout /*
			*/ `robust' `cluopt' `scopt' `iniopt' `mlopt' /*
			*/ missing collin nopreserve /*
			*/ max search(off) `log' `options' 
		if "`e(wtype)'" != "" { 
			est local wexp "`exp'"
		}
		est local title "log relative-hazard form"
		est local predict weibhet_p
		est local cmd weibhet 
		est local t0 `t0'
		est local dead `sdead'

		global S_E_cmd weibhet
	}
	global EREGw
	global EREGd
	global EREGt
	global EREGt0
	global EREGa

	if "`coef'"=="" {
		if `"`hr'"'!=`""' {
			local hr `"eform(Haz. Ratio)"'
                }

		if "`header'" == "" {
			di _n in gr /*
			*/ "Weibull regression with gamma heterogeneity" /*
			*/ "-- entry time `e(t0)'"
			ml di, `hr' level(`level') first
		}
		else	est di, `hr' level(`level') first
		local bg "[ln_sig]_b[_cons]"
		local sg "[ln_sig]_se[_cons]"
		local iz = invnorm(1-(1-`level'/100)/2)
		local ll = `bg'-`sg'*`iz'
		local uu = `bg'+`sg'*`iz'
		local zz = `bg'/`sg'
		local se = sqrt(exp(`bg')*exp(`bg')*`sg'*`sg')
		local bb "[ln_p]_b[_cons]"
		local sb "[ln_p]_se[_cons]"
		local sa = sqrt(exp(`bb')*exp(`bb')*`sb'*`sb')
		local bl = `bb'-`sb'*`iz'
		local bu = `bb'+`sb'*`iz'
		local bz = `bb'/`sb'
		local ig = 1/exp(`bg')
		local ib = 1/exp(`bb')
		
		est scalar varg = exp(`bg')
		est scalar ln_p = `bb'
		
		di in gr   " /ln_var |  "  in ye %9.0g `bg' /*
			*/ "  " %9.0g (`sg') " " %10.3f (`zz') /*
			*/ " " %7.3f (normprob(-abs(`zz'))*2) /*
			*/ _col(58) %9.0g (`ll') "   " %9.0g (`uu')
		di in gr   "   /ln_p |  "  in ye %9.0g `bb' /*
			*/ "  " %9.0g (`sb') " " %10.3f (`bz') /*
			*/ " " %7.3f (normprob(-abs(`bz'))*2) /*
			*/ _col(58) %9.0g (`bl') "   " %9.0g (`bu')
		di in gr _dup(78) "-"
		di in gr   "    varg |  "  in ye %9.0g exp(`bg') /*
			*/ "  " %9.0g (`se') " "  /*
			*/ _col(58) %9.0g exp(`ll') "   " %9.0g exp(`uu')
		_diparm ln_p, level(`level') exp label("p")
        	_diparm ln_p, level(`level') f(exp(-@)) d(exp(-@)) label("1/p")

		di in gr _dup(78) "-"
	}
end