xtpoisson.ado

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

*! version 3.2.8  27jun2005
program define xtpoisson, byable(onecall) prop(irr)
        local vv : display "version " string(_caller()) ", missing:"
	global XT_CL : di _caller()
	version 6, missing
	if replay() {
		if "`e(cmd)'"!="xtpoisson" & "`e(cmd2)'"!="xtpoisson" {
			error 301
		}
		if _by() { error 190 }
		if "`e(distrib)'"=="Gaussian" {
			xtps_ren `0'
			exit
		}
		if "`e(cmd)'" == "xtgee" {
			syntax [, IRr EForm ]
			if "`irr'"!="" {
				local eform "eform"
			}
			xtgee , `eform'
			exit
		}
		Display `0'
		error `e(rc)'
		exit
	}

	if _by() {
		local by "by `_byvars'`_byrc0':"
	}
	`vv' `by' _vce_parserun xtpoisson, panel : `0'
	if "`s(exit)'" != "" {
		exit
	}
	nobreak {
		capture noisily break {
			`by' Estimate `0'
		}
		macro drop S_XT*
		exit _rc
	}
end

program define Estimate, eclass byable(recall) sort
	syntax varlist(numeric ts) [if] [in] [iweight fweight pweight] /*
	*/ [, I(varname num) RE FE PA IRr EForm noCONstant noSKIP /*
	*/ noDIFficult Exposure(varname num) OFFset(varname num) /*
	*/ FROM(string) Level(cilevel) noLOg GAUSSian NORMAL * ]

	if length("`fe'`re'`pa'") > 2 {
		di in red "choose one of re, fe, or pa"
		exit 198
	}

/* Mark sample except for offset/exposure. */

	marksample touse
	xt_iis `i'
	local ivar "`s(ivar)'"
	markout `touse' `ivar' /* iis does not allow string */


	if "`normal'"!="" | "`gaussia'"!="" {
		syntax varlist [if] [in] [iweight fweight pweight] [, ///
		INTPoints(int 12) Quad(int 12) *]
		if "`weight'"!="" {
			local weight "[`weight'`exp']"
		}

		/* version 6 so local macros restricted to 7 characters */
		if `intpoin' != 12 {
			if `quad' != 12 {
				di as err "intpoints() and quad() may not be specified together."
				exit(198)
			}
			local options `options' quad(`intpoin')
		}
		else {
			local options `options' quad(`quad')
		}
		if $XT_CL < 9 {
			xtps_ren_8 `varlist' `weight' if `touse', 	///
			`options'
			exit
		}
		xtps_ren `varlist' `weight' if `touse', `options' 
		exit
	}

	if "`pa'"!="" {
		if "`i'"!="" { local iarg "i(`i')" }
		if "`offset'"!="" {
			local offset "offset(`offset')"
		}
		if "`exposur'"!="" {
			local exposur "exposure(`exposur')"
		}
		if `"`from'"' != "" {
			local farg "from(`from')"
		}
		if "`irr'"!="" {
			local eform "eform"
		}
		xtgee `varlist' if `touse' [`weight'`exp'], /*
		*/ fam(poisson) link(log) rc0 level(`level') /*
		*/ `farg' `iarg' `constan' `offset' `exposur' /*
		*/ `eform' `options' `log'
		est local predict xtpoisson_pa_p
		if e(rc) == 0 | e(rc) == 430 {
			est local estat_cmd ""	// reset from xtgee
			est local cmd2 "xtpoisson"
		}
		error `e(rc)'
		exit
	}

/* If here, we are doing re (default) or fe. */

	if "`fe'`re'"=="" { local re "re" }

/* Check syntax and set options. */

	mlopts mlopts, `options'

	local nvar : word count `varlist'"

	if "`weight'"=="fweight" | "`weight'"=="pweight" {
		di in red /*
		*/ "`weight' not allowed with fixed- and random-effects models"
		exit 101
	}
	if "`offset'"!="" & "`exposur'"!="" {
		di in red "only one of offset() or exposure() can be specified"
		exit 198
	}
	if "`fe'"!="" {
		if `nvar' == 1 {
			di in red "independent variables required with " /*
			*/ "fixed-effects model"
			exit 102
		}
		if "`constan'"!="" {
			di in gr "note: noconstant option ignored"
			local constan /* erase macro (for _rmcoll) */
		}
		if "`skip'"!="" {
			di in gr /*
			*/ "note: noskip option ignored;" _n /*
			*/ "      cannot estimate a fixed-effects " /*
			*/ "constant-only model"
			local skip /* erase macro */
		}

		local title "Conditional fixed-effects Poisson regression"
		local prog  "xtps_fe"
	}
	else { /* re */
		if "`constan'"!="" & `nvar' == 1 {
			di in red "independent variables required with " /*
			*/ "noconstant option"
			exit 102
		}

		local title "Random-effects Poisson regression"
		local prog  "xtps_lf"
		local distr "Gamma"
		local eqaux "/lnalpha"
	}
	if "`skip'"=="" | `"`from'"'!="" | "`constan'"!="" {
		local skip "skip"
	}
	else	local skip /* erase macro */

	local difficu = cond("`difficu'"=="", "difficult", "")


/* Process offset/exposure. */

	if "`exposur'"!="" {
		capture assert `exposur' > 0 if `touse'
		if _rc {
			di in red "exposure() must be greater than zero"
			exit 459
		}
		tempvar offset
		qui gen double `offset' = ln(`exposur')
		local offvar "ln(`exposur')"
	}

	if "`offset'"!="" {
		markout `touse' `offset'
		local offopt "offset(`offset')"
		if "`offvar'"=="" {
			local offvar "`offset'"
		}
	}

/* Count obs, check for negative values of `y', and compute mean. */

	gettoken y xvars : varlist
	
	local yname `y'
	local ystr : subinstr local yname "." "_"
	local xvarsnm `xvars'
	_find_tsops `y' `xvars'
	if `r(tsops)' {
		qui tsset
		tsrevar `y'
		local y `r(varlist)'
		tsrevar `xvars'
		local xvars `r(varlist)'
	}
	
	summarize `y' if `touse', meanonly

	if r(N) == 0 { error 2000 }
	if r(N) == 1 { error 2001 }

	if r(min) < 0 {
		di in red "`y' must be greater than or equal to zero"
		exit 459
	}

	tempname mean
	scalar `mean' = r(mean)

/* Issue warning if `y' is not an integer. */

	capture assert `y' == int(`y') if `touse'
	if _rc {
		di in gr "note: you are responsible for " /*
		*/ "interpretation of non-count dep. variable"
	}

/* Sort. */

	tempvar nn
	gen long `nn' = _n
	sort `touse' `ivar' `nn' /* deterministic sort */

/* Check weights. */

	if "`weight'"!="" {
		tempvar w
		qui gen double `w' `exp'
		_crcchkw `ivar' `w' `touse'
		drop `w'
	}

/* For fe model, drop any groups with `y' all zeros or those of size 1. */

	if "`fe'"!="" {
		DropOne  `touse' `ivar' `nn' `y' `mean'
		DropZero `touse' `ivar' `nn' `y' `mean'
	}

	drop `nn'

/* Drop any variables that are constant within group. */

	if "`fe'"!="" {
		DropVars `touse' `ivar' `xvars'
		local xvars `r(varlist)'
	}

/* Remove collinearity. */
	
	local oldxvars `xvars'
	qui _rmcoll `xvars' [`weight'`exp'] if `touse', `constan'
	local xvars "`r(varlist)'"
	local dropped : list oldxvars - xvars
	foreach x of local dropped {
		local j : list posof "`x'" in oldxvars
		local x2 : word `j' of `xvarsnm'
		noi di as txt "note: `x2' dropped due to collinearity"
	}

	if "`fe'"!="" {
		local nvar : word count `xvars'
		if `nvar' == 0 {
			di in red "independent variables required with " /*
			*/ "fixed-effects model"
			exit 102
		}
	}

/* Get number of groups and group size min, mean, and max. */

	tempvar T
	qui by `touse' `ivar': gen long `T' = _N if _n==1 & `touse'
	summarize `T' if `touse', meanonly
	local ng = r(N)
	local g1 = r(min)
	local g2 = r(mean)
	local g3 = r(max)

/* Fit comparison Poisson model for re model. */

	if "`log'"!="" { local qui "quietly" }

	if "`re'"!="" & `"`from'"'=="" {
		`qui' di in gr _n "Fitting Poisson model:"
		`qui' poisson `y' `xvars' if `touse' [`weight'`exp'], /*
		*/ `constan' `offopt' `mlopts' nodisplay
		tempname llp b0
		scalar `llp'  = e(ll)
		mat `b0' = e(b)
		local b0n : colfullnames `b0'
		local b0n : subinstr local b0n "`y'" "`ystr'", all
		local init0 "init(`b0', skip)"
	}

/* Set up global for use by likelihood program. */

	global S_XTby "`touse' `ivar'"

/* Fit constant-only model. */

	if "`re'"!="" & "`skip'"=="" {

	/* Get starting values for constant-only model. */

		if "`offset'"!="" {
			SolveC `y' `offset' [`weight'`exp'] if `touse', /*
			*/ mean(`mean')
			local c = r(_cons)
		}
		else	local c = ln(`mean')

		if `c'>=. { local c 0 }

		tempname b00
		mat `b00' = (`c', 0)
		mat colnames `b00' = `y':_cons lnalpha:_cons

		`qui' di _n in gr "Fitting constant-only model:"
		ml model d2 `prog' (`ystr': `y' = , `offopt') `eqaux' /*
		*/ if `touse' [`weight'`exp'], /*
		*/ collinear missing max nooutput nopreserve wald(0) /*
		*/ init(`b00') search(off) `mlopts' `log' `difficu'

		if "`xvars'"=="" { local init0 /* erase macro */ }

		local continu "continue"

		`qui' di in gr _n "Fitting full model:"
	}
	else if "`re'"!="" & `"`from'"'=="" {
		`qui' di in gr _n "Fitting full model:"
	}

/* Fit full model. */

	if `"`from'"'!="" { local init0 `"init(`from')"' }

	if "`fe'"!="" { local constan "noconstant" }

	ml model d2 `prog' (`ystr': `y' = `xvars', `constan' `offopt') `eqaux'/*
	*/ if `touse' [`weight'`exp'], /*
	*/ collinear missing max nooutput nopreserve `init0' search(off) /*
	*/ `mlopts' `log' `difficu' `continu' title(`title')

/* Redi matrix strips on b and V, removing names of tempvars due to TS ops */
	tempname b V
	matrix `b' = e(b)
	matrix `V' = e(V)
	local names : colfullnames `b'
	foreach x of local xvars {
		local j : list posof "`x'" in oldxvars
		local x2 : word `j' of `xvarsnm'
		local names : subinstr local names "`x'" "`x2'"
	}
	mat colnames `b' = `names'
	mat colnames `V' = `names'
	mat rownames `V' = `names'
	est repost b = `b' V = `V', rename
	est local depvar "`yname'"
		
	est local cmd

	if "`llp'"!="" {
		est local chi2_ct "LR"
		est scalar ll_c = `llp'
		if e(ll) < e(ll_c) {
			est scalar chi2_c = 0
		}
		else	est scalar chi2_c = 2*(e(ll)-e(ll_c))
	}

	est scalar N_g    = `ng'
	est scalar g_min  = `g1'
	est scalar g_avg  = `g2'
	est scalar g_max  = `g3'

	if "`re'"!="" {
		est scalar alpha = exp(_b[/lnalpha])
	}

	est local method  "ml"
	est local distrib "`distr'"
	est local ivar    "`ivar'"
	est local offset1 /* erase from ml */
	est local offset  "`offvar'"
	est local predict "xtpoisson_refe_p"
	est local cmd	  "xtpoisson"

	Display , level(`level') `irr' `eform'
	error `e(rc)'
end

program define Display
	syntax [, Level(cilevel) IRr EForm ]
	if "`eform'"!="" { local irr "irr" }

	if "`irr'"!="" { local irr "eform(IRR)" }

	_crcphdr
	if "`e(distrib)'"=="Gamma" { local plus "plus" }

	version 9: ///
	ml mlout, level(`level') `irr' first nohead `plus' nofootnote

	if "`e(distrib)'"=="Gamma" {
		_diparm lnalpha, level(`level') noprob
		di in smcl in gr "{hline 13}{c +}{hline 64}"
		_diparm lnalpha, level(`level') exp label("alpha")
		di in smcl in gr "{hline 13}{c BT}{hline 64}"

		if e(chi2_c)>=. { exit }
		tempname pval
                scalar `pval' =  chiprob(1, e(chi2_c))*0.5
                if e(chi2_c)==0 { scalar `pval'= 1 }
		if ((e(chi2_c) > 0.005) & (e(chi2_c)<1e4)) | (e(chi2_c)==0) {
                        local fmt "%8.2f"
                }
                else    local fmt "%8.2e"
                di in green "Likelihood-ratio test of alpha=0: " _c
                di in green in smcl "{help j_chibar##|_new:chibar2(01) = }" /*
                        */ in ye `fmt' e(chi2_c) _c
                di in green " Prob>=chibar2 = " in ye %5.3f /*
                        */ `pval'
	}
	_prefix_footnote
end

program define NonNeg, rclass /* checks whether `y' >= 0 */
	args y touse

	summarize `y' if `touse', meanonly

	if r(N) == 0 { error 2000 }
	if r(N) == 1 { error 2001 }

	if r(min) < 0 {
		di in red "`y' must be greater than or equal to zero"
		exit 459
	}

	ret scalar mean = r(mean)
end

program define DropOne /* drop groups of size one */
	args touse ivar nn y mean

	tempvar one
	qui by `touse' `ivar': gen byte `one' = (_N==1) if `touse'

	qui count if `one' & `touse'
	local ndrop `r(N)'

	if `ndrop' == 0 { exit } /* no groups with all zeros */

	if `ndrop' > 1 { local s "s" }
	di in gr "note: `ndrop' group`s' " /*
	*/ "(`ndrop' obs) dropped because of only one obs per group"

	qui replace `touse' = 0 if `one' & `touse'

	sort `touse' `ivar' `nn' /* redo sort */

	summarize `y' if `touse', meanonly
	if r(N) == 0 { error 2000 }
	if r(N) == 1 { error 2001 }
	scalar `mean' = r(mean)
end

program define DropZero /* drop groups with all zero counts */
	args touse ivar nn y mean

	tempvar sumy
	qui by `touse' `ivar': gen double `sumy' = /*
	*/ cond(_n==_N, sum(`y'), .) if `touse'

	qui count if `sumy'==0
	local ngrp `r(N)'

	if `ngrp' == 0 { exit } /* no groups with all zeros */

	qui by `touse' `ivar': replace `sumy' = `sumy'[_N] if `touse'

	qui count if `sumy'==0
	local ndrop `r(N)'

	if `ngrp' > 1 { local s "s" }
	di in gr "note: `ngrp' group`s' " /*
	*/ "(`ndrop' obs) dropped due to all zero outcomes"

	qui replace `touse' = 0 if `sumy'==0 & `touse'

	sort `touse' `ivar' `nn' /* redo sort */

	summarize `y' if `touse', meanonly
	if r(N) == 0 { error 2000 }
	if r(N) == 1 { error 2001 }
	scalar `mean' = r(mean)
end

program define DropVars, rclass
	args touse ivar
	local i 3
	while "``i''"!="" {
		capture by `touse' `ivar': assert ``i''==``i''[1] if `touse'
		if _rc == 0 {
			di in gr "note: ``i'' omitted " /*
			*/ "because it is constant within group"
		}
		else	local varlist `varlist' ``i''

		local i = `i' + 1
	}

	ret local varlist `varlist'
end

program define SolveC, rclass /* modified from poisson.ado */
	gettoken y  0 : 0
	gettoken xb 0 : 0
	syntax [fw aw pw iw] [if] , Mean(string)
	if "`weight'"=="pweight" | "`weight'"=="iweight" {
		local weight "aweight"
	}
	summarize `xb' `if', meanonly
	if r(max) - r(min) > 2*709 { /* unavoidable exp() over/underflow */
		exit /* r(_cons) >=. */
	}
	if r(max) > 709 | r(min) < -709  {
		tempname shift
		if r(max) > 709 { scalar `shift' =  709 - r(max) }
		else		  scalar `shift' = -709 - r(min)
		local shift "+`shift'"
	}
	tempvar expoff
	qui gen double `expoff' = exp(`xb'`shift') `if'
	summarize `expoff' [`weight'`exp'], meanonly
	return scalar _cons = ln(`mean')-ln(r(mean))`shift'
end

exit

Notes:

1.  Uses -difficult- optimizer by default.  Specify -nodifficult- to get
    standard optimizer.

2.  Skips the constant-only model by default.  Specify -noskip- to estimate
    constant-only model.

3.            Model                Starting values
    --------------------------     ----------------
    xtpoisson, fe (full model)     (0)
    xtpoisson, re (full model)     poisson and lnalpha = 0
    xtpoisson, re (constant only)  ln(mean) or SolveC with lnalpha = 0

<end of file>