You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1238 lines
42 KiB
Plaintext

7 months ago
*! version 2.3.8 SRH 7 Sept 2011
program define gllapred
version 6.0
if "`e(cmd)'" ~= "gllamm" {
di in red "gllamm was not the last command"
exit 301
}
*syntax anything(name=pref id="prefix for variable(s)") [if] [in]
syntax newvarname [if] [in] /*
*/ [,XB U USTD P S LInpred MU ADapt LL FAC Deviance PEarson Anscombe COoksd SCorefil(string) /* DFBeta
*/ MArginal OUTcome(int -99) ABove(numlist integer) US(string) CORR noOFFset FSAMPLE ADOONLY FRom(string)]
local nopt = ("`u'"~="") + ("`ustd'"~="") + ("`p'"~="") + ("`xb'"~="") + ("`s'"~="") /*
*/ + ("`linpred'"~="") + ("`mu'"~="") + ("`ll'"~="") + ("`fac'"~="") /*
*/ + ("`deviance'"~="") + ("`pearson'"~="") + ("`anscombe'"~="") /*
*/ + ("`dfbeta'"~="") + ("`cooksd'"~="")
global HG_final = 0
local pref `varlist'
if `nopt'>1 {
disp in re "only one of these options allowed: xb, u, fac, linpred, mu, ll, p, s, deviance, pearson, anscombe, dfbeta"
exit 198
}
** 11/4/06
if "`corr'"~=""&"`u'"==""{
disp in re "corr option allowed only with u option"
exit 198
}
local tplv = e(tplv)
local tprf = e(tprf)
local vars
if `nopt'==0 {
local xb "xb"
}
if "`ustd'"~=""{
local u "u"
}
if "`xb'"~=""|"`s'"~=""{
local what = 0
local vars `pref'
if "`xb'"~=""{
disp in gr "(xb will be stored in `pref')"
}
else{
disp in gr "(s will be stored in `pref')"
}
}
else if "`p'"~="" {
if `tplv' < 2{
disp in re "p option not valid for 1 level model"
exit 198
}
local what = 2
tempname mat
matrix `mat'=e(nip)
local nip = `mat'[1,2]
local i = 1
while `i'<=`nip'{
local vars `vars' `pref'`i'
local i = `i' + 1
}
disp in gr "(probabilities will be stored in `vars')"
global HG_post = 1
}
else if "`ll'"~="" {
local what = 4
local vars `pref'
disp in gr "(ll will be stored in `pref')"
global HG_post = 1
if "`fsample'"!=""{
disp in gr "Note: conditional response probability/density set to 1""
disp in gr " for observartions with missing values"
disp " "
}
}
else if "`mu'"~=""{
local what = 5
local vars `pref'
disp in gr "(mu will be stored in `pref')"
global HG_post = 1
if "`marginal'"~=""{
global HG_post = 0
}
}
else if "`deviance'"~=""|"`pearson'"~=""|"`anscombe'"~=""{
local vars `pref'
disp in gr "(residuals will be stored in `pref')"
if "`pearson'"~="" {
local what = 6
}
else if "`deviance'"~=""{
local what = 7
}
else{
local what = 8
}
global HG_post = 1
if "`marginal'"~=""{
global HG_post = 0
}
}
else if "`u'"~=""|"`linpred'"~=""|"`fac'"~=""{
local what = 1
global HG_post = 1 /* added Jan 12 2008: signals that gllapred called gllam_ll */
if `tplv' < 2{
if "`u'"~=""|"`fac'"~=""{
disp in re "u, and fac options not valid for 1-level model"
exit 198
}
else if "`linpred'"~=""{
disp in re "linpred option equivalent to xb for this model"
local xb "xb"
local what = 0
}
* else if "`mu'"~=""?
}
if "`fac'"~=""{
local i = 1
while `i' < `tprf'{
local vars `vars' `pref'm`i'
local i = `i' + 1
}
disp in gr "(means will be stored in `vars')"
}
else if "`u'"~=""{
local i = 1
while `i' < `tprf'{
local vars `vars' `pref'm`i' `pref's`i'
local i = `i' + 1
}
disp in gr "(means and standard deviations will be stored in `vars')"
**11/4/06
if "`corr'"~=""{
local corvars
local i = 1
while `i' < `tprf'{
local rfs = 1
while `rfs' < `i'{
local vars `vars' `pref'c`i'`rfs'
local corvars `corvars' `pref'c`i'`rfs'
local rfs = `rfs' + 1
}
local i = `i' + 1
}
disp in gr "(correlations will be stored in `corvars')"
}
}
else if "`linpred'"~=""{
local vars `pref'
disp in gr "(linear predictor will be stored in `pref')"
}
}
else if "`dfbeta'"~=""{
local k = e(k)
local i = 1
while `i'<= `k'{
local vars `vars' `pref'`i'
local i = `i' + 1
}
disp in gr "(dfbetas will be stored in `vars')"
}
else if "`cooksd'"~=""{
local vars `vars' `pref'
disp in gr "(Cook's D will be stored in `vars')"
}
if "`offset'"~=""{
if "`linpred'"==""&"`xb'"==""&"`mu'"==""{
disp in re "nooffset option only allowed with xb, mu or linpred options"
exit 198
}
}
if "`us'"~="" {
if `what'<5{
disp in re "us() option only valid with mu, pearson, deviance or anscombe"
exit 198
}
}
/* check if variables already exist */
confirm new var `vars'
/* restrict to estimation sample */
tempvar idno
gen long `idno' = _n
preserve
if "`fsample'"==""{
qui keep if e(sample)
}
/* interpret if and in */
marksample touse, novarlist
qui count if `touse'
if _result(1) < 1 {
di in red "insufficient observations"
exit 2001
}
qui keep if `touse'
tempfile file
/* influence statistics (don't need macros) */
if "`dfbeta'"~=""|"`cooksd'"~=""{
*disp in re "`e(scorefil)'"
if "`e(scorefil)'"~=""{
local fil2 "`e(scorefil)'"
}
else if "`scorefil'"~=""{
local fil2 "`scorefil'"
}
else{
tempfile fil2
}
if "`e(scorefil)'"==""{
if "`scorefil'"~=""{
gllarob, scorefil(`fil2') norob
}
else{
gllarob, scorefil(`fil2') temp norob
}
}
local clus `e(clus)'
if `e(tplv)'==1{
local top `idno'
}
else{
local top: word 1 of `clus'
}
sort `top'
qui save "`file'", replace
tempname H d junk junk1
matrix `H' = e(Vs)
if `e(const)' {
* disp "constraints used"
* matrix `b' = `b'*M_T
matrix `H' = M_T'*`H'*M_T
}
capture matrix `H' = inv(`H')
if _rc>0{
disp in re "parameter covariance matrix not invertible"
exit(198)
}
use `fil2', clear
tempvar cons
qui gen byte `cons' = 1
local k = colsof(`H')
local N = _N
matrix `d' = vecdiag(`H')
matrix `d' = diag(`d')
matrix `junk' = `d'*`d''
scalar `junk1' = trace(`junk')
scalar `junk1' = sqrt(`junk1')
matrix `d' = `d'/`N'
matrix `H' = `H'*(`N'-1)/`N' + `d'
if "`dfbeta'"~=""{
tempname Hi covi dbi sumi
local j = 1
while `j'<=`k'{
qui gen `pref'`j' = .
local j = `j' + 1
}
qui gen `pref'0 = .
local i = 1
while `i'<=`N'{
mkmat s1-s`k' if _n==`i', matrix(`Hi')
matrix `Hi' = diag(`Hi')
matrix `junk' = `Hi' + `d'
matrix `junk' = `junk'*`junk''
matrix `junk' = trace(`junk')
qui replace `pref'0 = 100*sqrt(`junk'[1,1])/`junk1' in `i'
matrix `covi' = `H' + `Hi'
*if `i'==49{matrix list `covi'}
matrix vecaccum `sumi' = `cons' d1-d`k' if _n~=`i', nocons
*if `i'==49{matrix list `sumi'}
matrix `dbi' = inv(`covi')*`sumi''
matrix `Hi' = e(Vs)
local j = 1
while `j'<=`k'{
qui replace `pref'`j' = `dbi'[`j',1]/sqrt(`Hi'[`j',`j']) in `i'
local j = `j' + 1
}
local i = `i' + 1
}
local vars `vars' `pref'0
}
else{ /* Cook's D */
*disp in re "calculating cook's d"
matrix `H' = inv(`H')
tempname scorei ci
qui gen `pref' = .
local i = 1
while `i'<=`N'{
mkmat d1-d`k' if _n==`i', matrix(`scorei')
*matrix list `scorei'
matrix `ci' = 2*`scorei'*`H'*`scorei''
*matrix list `ci'
qui replace `pref' = `ci'[1,1] in `i'
local i = `i' + 1
}
}
if `e(tplv)'==1{
rename __idno `top'
}
keep `top' `vars'
sort `top'
tempvar mrge
merge `top' using "`file'", _merge(`mrge')
qui drop `mrge'
sort `idno'
}
else{
/* set all global macros needed by gllam_ll */
setmacs `what'
if "`offset'"~=""{ /* nooffset not specified: will subtract HG_offs=HG_off */
global HG_offs $HG_off
}
else{
tempvar offs
global HG_offs `offs'
gen `offs'=0
}
/* deal with outcome() and above() */
if `what'>=5&$HG_nolog>0{ /* mu or residuals */
if "`above'"==""{
disp in re "must specify above() option for ordinal responses"
exit 198
}
else{
matrix M_above = J(1,$HG_nolog,0)
local num: word count `above'
if `num'>1&`num'~=$HG_nolog{
disp in re "wrong length of numlist in above() option"
exit 198
}
local no = 1
local k = 1
while `no' <= $HG_nolog{
if `num'>1{
local k = `no'
}
local ab: word `k' of `above'
* disp in re "`no'th ordinal response, above = `ab'"
local n=M_nresp[1,`no']
local i = 1
local found = 0
while `i'<= `n'&`found'==0{
if M_resp[`i',`no']==`ab'{
local found=`i'
matrix M_above[1,`no']=`i'
}
local i = `i' + 1
}
if `found'==0{
disp in re "`ab' not a category for `no'th ordinal response"
exit 198
}
else if `found' == `n'{
disp in re "`ab' is highest category for `no'th ordinal response"
exit 198
}
local no = `no' + 1
}
}
* noi matrix list M_above
}
if `what'>=5&$HG_mlog>0{ /* mu or residuals */
if `outcome'==-99&$HG_exp==0{
disp in re "must specify outcome() option for nominal responses unless data in expanded form"
exit 198
}
if $HG_exp==0{
local n=rowsof(M_respm)
local found = 0
local i = 1
while `i'<= `n'&`found'==0{
if M_respm[`i',1]==`outcome'{
local found=`i'
}
local i = `i' + 1
}
if `found'==0{
disp in re "`outcome not a category of the nominal response'"
exit 198
}
global HG_outc=`outcome'
}
}
if "`adoonly'"!="" {
global HG_noC = 1
global HG_noC1 = 1
}
*disp "HG_free = " $HG_free
tempname b
matrix `b'=e(b)
/* deal with from */
if "`from'"~=""{
capture qui matrix list `from'
local rc=_rc
if `rc'>1{
disp in red "`from' not a matrix"
exit 111
}
local ncol = colsof(`from')
local nrow = rowsof(`from')
local ncolb = colsof(`b')
if `ncolb'~=`ncol'{
disp in re "from matrix has `ncol' columns but should have `ncolb'"
exit 111
}
if `nrow'~=1{
disp in re "from matrix has more than one row"
exit 111
}
local coln: colnames(`b')
local cole: coleq(`b')
matrix `b' = `from'
matrix colnames `b' = `coln'
matrix coleq `b' = `cole'
}
if "`s'"~=""|"`xb'"~=""|"`us'"~=""{
/* run remcor */
/* set up names for HG_xb`i' */
local i = 1
while (`i' <= $HG_tpff){
tempname junk
global HG_xb`i' "`junk'"
local i = `i' + 1
}
/* set up names for HG_s`i' */
local i = 1
while (`i'<=$HG_tprf){
tempname junk
global HG_s`i' "`junk'"
local i = `i'+1
}
qui remcor "`b'" "`us'"
if "`s'"~=""{
qui gen double `pref' = ${HG_s1}
}
else if "`xb'"~=""{
qui gen double `pref' = $HG_xb1
if "`offset'"~=""&"$HG_off"~=""{ /* nooffset specified - changed oct 2004 */
qui replace `pref' = `pref' - $HG_off
}
}
else if "`us'"~="" {
tempvar lpred muu
local j = 1
qui gen double `lpred' = $HG_xb1
if "`offset'"~=""&"$HG_off"~=""{
qui replace `lpred' = `lpred' - $HG_off
}
while `j'<$HG_tprf{
capture confirm variable `us'`j'
if _rc~=0{
disp in re "variable `us'`j' not found"
exit 111
}
local jp = `j' + 1
qui replace `lpred' = `lpred' + `us'`j' * ${HG_s`jp'}
local j = `j' + 1
}
}
}
if "`s'"==""&"`xb'"==""{
/* sort out temporary variables for gllas_yu or gllam_ll */
/* sort out denom */
local denom "`e(denom)'"
if "`denom'"~=""{
*capture confirm variable `denom'
*if _rc>0{
if substr("`denom'",1,2)=="__" { /*sort this out in future! */
tempvar den
qui gen byte `den'=1
global HG_denom "`den'"
}
else{
* disp in re "denom given"
global HG_denom `denom'
}
}
/* sort out HG_ind */
*capture confirm variable $HG_ind
*if _rc>0{
if substr("$HG_ind",1,2)=="__" { /*sort this out in future! */
tempname junk
global HG_ind "`junk'"
gen byte $HG_ind=1
}
/* sort out HG_lvolo */
if $HG_nolog>0{
tempname junk
global HG_lvolo "`junk'"
qui gen byte $HG_lvolo = 0
local no = 1
if "$HG_lv"==""{
local olog = M_olog[1,`no']
qui replace $HG_lvolo = 1
}
else{
while `no'<=$HG_nolog{
local olog = M_olog[1,`no']
qui replace $HG_lvolo = 1 if $HG_lv == `olog'
local no = `no' + 1
}
}
}
/** added this 24th feb 2004 **/
if $HG_mlog>0{
if $HG_nolog==0{
tempname junk
global HG_lvolo "`junk'"
qui gen byte $HG_lvolo = 0
}
if "$HG_lv"~=""{ /* more than one link */
qui replace $HG_lvolo = 1 if $HG_lv == $HG_mlog
}
else{
qui replace $HG_lvolo = 1
}
}
/** end added this **/
/* sort out level 1 clus variable */
local clus `e(clus)'
global HG_clus `clus'
tempvar id
if $HG_exp~=1&$HG_comp==0{
gen long `id'=_n
tokenize "`clus'"
local l= $HG_tplv
local `l' "`id'"
if $HG_tplv>1{
global HG_clus "`*'"
}
else{
global HG_clus "`1'"
}
}
*disp "HG_clus: $HG_clus"
if "`us'"~=""{
qui gen double `muu' = 0
qui gen double `pref' = 0
sort $HG_clus
gllas_yu `pref' `lpred' `muu' `what'
}
}
if "`s'"==""&"`xb'"==""&"`us'"==""{ /* need to call gllam_ll */
/* sort out temporary variables for gllam_ll */
/* sort out weight */
local weight "`e(weight)'"
local pweight "`e(pweight)'"
*10/29/06
local numlv: word count `e(clus)'
tempvar wt
quietly gen double `wt'=1
*End 10/29/06
local i = 1
while `i'<= `numlv'{ /* 10/29/06 not $HG_tplv{ because wrong for init option */
tempvar wt`i'
qui gen double `wt`i''=1
global HG_wt`i' "`wt`i''"
capture confirm variable `weight'`i'
if _rc==0 {
qui replace `wt`i'' = `wt`i'' * `weight'`i'
}
capture confirm variable `pweight'`i'
if _rc==0{
qui replace `wt`i'' = `wt`i'' * `pweight'`i'
}
*10/29/06
qui replace `wt' = `wt'*`wt`i''
local i = `i'+1
}
*10/29/06
if `e(init)'{
qui replace `wt1' = `wt'
}
tempname lnf
/* deal with adapt */
if "`adapt'"~=""{
local adapt = 1
}
else if $HG_adapt==0{
local adapt = 0
}
if $HG_adapt==1{
local adapt = 1
}
if `what'==2{ /* posterior probs */
if $HG_tplv~=2{
disp in re "cannot compute posterior probabilities in higher level models"
exit 301
}
else if $HG_free~=1{
if $HG_tprf>2{
disp in re "cannot compute posterior probabilities for more than 1 continuous latent variable"
exit 301
}
}
else{
local i=1
while `i'<=M_nip[1,2]{
global HG_p`i' `pref'`i'
qui gen double `pref'`i' = 0
local i = `i' + 1
}
noi gllam_ll 1 `b' "`lnf'" "junk" "junk" `what'
disp in gr "log-likelihood:" in ye `lnf'
}
}
if `what'>=4|(`what'==2&$HG_free~=1){ /* ll, mu or resids or posterior probs */
if `adapt'&$HG_post{ /* want posterior quant., therefore adaptive good */
local rf = 1
while `rf'<=$HG_tprf{
tempname junk
global HG_MU`rf' "`junk'"
tempname junk
global HG_SD`rf' "`junk'"
gen double ${HG_MU`rf'}=0
gen double ${HG_SD`rf'}=1
local rf2 = `rf' + 1
while `rf2' < $HG_tprf {
tempname junk
global HG_C`rf2'`rf' "`junk'"
gen double ${HG_C`rf2'`rf'}=0
local rf2 = `rf2' + 1
}
local rf = `rf' + 1
}
noi gllam_ll 1 `b' "`lnf'" "junk" "junk" 1
tempname last
disp in gre "Non-adaptive log-likelihood: " in ye `lnf'
global HG_adapt=1
tempname last
scalar `last' = 0
local i = 1
qui `noi' disp in gr "Updating posterior means and variances"
qui `noi' disp in gr "log-likelihood: "
while abs((`last'-`lnf')/`lnf')>1e-8&`i'<60&`lnf'~=.{
scalar `last' = `lnf'
qui gllam_ll 1 "`b'" "`lnf'" "junk" "junk" 1
disp in ye %10.4f `lnf' " " _c
if mod(`i',6)==0 {disp " " }
local j = 1
local i = `i' + 1
}
if mod(`i',6)~=1{disp " "}
} /* end if adapt */
else{ /* want marginal quantity, use ordinary quad */
global HG_adapt = 0
}
if `what'>=5{
global HG_noC1 = 1
}
if `what'==2{
local i=1
while `i'<=M_nip[1,2]{
*disp in re "making `pref'`i'"
global HG_p`i' `pref'`i'
qui gen double `pref'`i' = 0
local i = `i' + 1
}
*noi gllam_ll 1 `b' "`lnf'" "junk" "junk" `what'
*disp in gr "log-likelihood:" in ye `lnf'
}
else {
qui gen double `pref' = 0
}
**Test
global HG_final = 1
noi gllam_ll 1 `b' "`lnf'" "junk" "junk" `what' `pref'
if `lnf'==.{
disp in re "log-likelihood cannot be computed"
disp in re "for observations that should not contribute to posterior or ll,"
disp in re " set response variable to missing"
exit 198
}
if `adapt'==0|(`adapt'==1&$HG_post==1){
disp in gr "log-likelihood:" in ye `lnf'
}
}
else if `what'==1 { /* u, fac or linpred */
local rf = 1
while `rf'<=$HG_tprf{
tempname junk
global HG_MU`rf' "`junk'"
tempname junk
global HG_SD`rf' "`junk'"
gen double ${HG_MU`rf'}=0
gen double ${HG_SD`rf'}=1
local rf2 = `rf' + 1
while `rf2' < $HG_tprf {
tempname junk
global HG_C`rf2'`rf' "`junk'"
gen double ${HG_C`rf2'`rf'}=0
local rf2 = `rf2' + 1
}
local rf = `rf' + 1
}
noi gllam_ll 1 `b' "`lnf'" "junk" "junk" `what'
if `lnf'==.{
disp in re "log-likelihood cannot be computed"
disp in re "for observations that should not contribute to posterior,"
disp in re " set response variable to missing"
exit 198
}
if `adapt'{
tempname last
disp in gre "Non-adaptive log-likelihood: " in ye `lnf'
global HG_adapt=1
tempname last
scalar `last' = 0
local i = 1
qui `noi' disp in gr "Updating posterior means and variances"
qui `noi' disp in gr "log-likelihood: "
while abs((`last'-`lnf')/`lnf')>1e-8&`i'<60&`lnf'~=.{
scalar `last' = `lnf'
qui gllam_ll 1 "`b'" "`lnf'" "junk" "junk" 1
disp in ye %10.4f `lnf' " " _c
if mod(`i',6)==0 {disp " " }
local j = 1
local i = `i' + 1
}
if mod(`i',6)~=1{disp " "}
disp in gr "log-likelihood:" in ye `lnf'
* disp in re "call gllam_ll without running prepadpt"
global HG_adapt = 2
**Test
global HG_final = 1
qui gllam_ll 1 "`b'" "`lnf'" "junk" "junk" 1
if `lnf'==.{
disp in re "log-likelihood cannot be computed"
disp in re "for observations that should not contribute to posterior,"
disp in re " set response variable to missing"
exit 198
}
}
if "`u'"~=""|"`fac'"~=""{
* noi matrix list CHmat
tempname vari
if $HG_free==0{
local lv = 2
local rf = 1
while `lv'<=$HG_tplv{
local minrf = `rf'
local maxrf = M_nrfc[2,`lv']
while `rf'<`maxrf'{
qui gen double `pref'm`rf'=0
qui gen double `pref's`rf'=0 /* will be deleted later if option is fac */
scalar `vari' = 0
local rf2 = `minrf'
while `rf2'<=`rf'{ /* lower block triangular matrix */
* disp in re "`pref'm`rf' = `pref'm`rf' + CHmat[`rf',`rf2']*HG_MU`rf2'"
qui replace `pref'm`rf'=`pref'm`rf'+CHmat[`rf',`rf2']*${HG_MU`rf2'}
* disp in re "`pref's`rf' = `pref's`rf' + CHmat[`rf',`rf2']^2*HG_SD`rf2'^2"
qui replace `pref's`rf'=`pref's`rf'+CHmat[`rf',`rf2']^2*${HG_SD`rf2'}^2
* was scalar `vari' = `vari' + CHmat[`rf',`rf2']*CHmat[`rf2',`rf']
scalar `vari' = `vari' + CHmat[`rf',`rf2']*CHmat[`rf',`rf2']
local rf3 = `minrf'
while `rf3'<`rf2'{
* disp in re "`pref's`rf' = `pref's`rf' + 2*CHmat[`rf',`rf2']*CHmat[`rf',`rf3']*HG_C`rf2'`rf3'"
qui replace `pref's`rf'=`pref's`rf'+2*CHmat[`rf',`rf2']*CHmat[`rf',`rf3']*${HG_C`rf2'`rf3'}
local rf3 = `rf3' + 1
}
local rf2 = `rf2' + 1
}
if "`ustd'"~=""{
*disp in re "variance = " `vari'
qui replace `pref's`rf' = sqrt(`vari'-`pref's`rf')
qui replace `pref'm`rf' = `pref'm`rf'/`pref's`rf'
}
else{
qui replace `pref's`rf' = sqrt(`pref's`rf')
}
** 11/4/06
if "`corr'"~=""{
*set trace on
local rfs = 1
while `rfs'<`rf'{
*disp in re "generating `pref'c`rf'`rfs'"
qui gen double `pref'c`rf'`rfs'=0
local rf2 = `minrf'
while `rf2'<= `rf' {
local rf3 = 1
while `rf3'<= `rfs'{
*disp in re "add CHmat[`rf',`rf2']*CHmat[`rfs',`rf3']*HG_C`rf2'`rf3'"
if `rf3'<`rf2'{
qui replace `pref'c`rf'`rfs' = `pref'c`rf'`rfs' + CHmat[`rf',`rf2']*CHmat[`rfs',`rf3']*${HG_C`rf2'`rf3'}
}
else if `rf3'==`rf2'{
qui replace `pref'c`rf'`rfs' = `pref'c`rf'`rfs' + CHmat[`rf',`rf2']*CHmat[`rfs',`rf3']*${HG_SD`rf2'}^2
}
else{
qui replace `pref'c`rf'`rfs' = `pref'c`rf'`rfs' + CHmat[`rf',`rf2']*CHmat[`rfs',`rf3']*${HG_C`rf3'`rf2'}
}
local rf3 = `rf3' + 1
}
local rf2 = `rf2' + 1
}
qui replace `pref'c`rf'`rfs' = `pref'c`rf'`rfs'/(`pref's`rf'*`pref's`rfs')
local rfs = `rfs' + 1
}
*set trace off
}
local rf = `rf' + 1
}
local lv = `lv' + 1
}
}
else{ /* not $HG_free */
local i = 1
while `i'<$HG_tprf{
qui gen double `pref'm`i'=${HG_MU`i'}
qui gen double `pref's`i'=${HG_SD`i'}
local rf2 = 1
while `rf2'<`i'{
qui gen double `pref'c`i'`rf2' = ${HG_C`i'`rf2'}/(`pref's`i'*`pref's`rf2')
local rf2 = `rf2' + 1
}
local i = `i' + 1
}
}
if "`fac'"~=""{
*disp "dealing with geqs"
tempname junk s1
local i = 1
while `i'<=$HG_ngeqs{
local k = M_ngeqs[1,`i']
local n = M_ngeqs[2,`i']
local nxt = M_ngeqs[3,`i']
* disp "random effect `k'-1 has `n' covariates"
local nxt2 = `nxt'+`n'-1
matrix `s1' = `b'[1,`nxt'..`nxt2']
* matrix list `s1'
local nxt = `nxt2' + 1
capture drop `junk'
matrix score double `junk' = `s1'
local rf = `k' - 1
qui replace `pref'm`rf' = `pref'm`rf' + `junk'
local i = `i' + 1
}
*disp "dealing with bmat"
if $HG_bmat{
local rf = $HG_tprf - 1
/* commands for sds are wrong: qui replace `pref's`rf' = `pref's`rf'^2 */
local rf = $HG_tprf - 2
while `rf'>0{
* qui replace `pref's`rf' = `pref's`rf'^2
local rf2 = `rf'+1
while `rf2'<=$HG_tprf - 1 { /* upper triangular matrix */
*disp in re "`pref'm`rf'=`pref'm`rf'+Bmat[`rf',`rf2']*`pref'm`rf2'"
qui replace `pref'm`rf'=`pref'm`rf'+Bmat[`rf',`rf2']*`pref'm`rf2'
*qui replace `pref's`rf'=`pref's`rf'+Bmat[`rf',`rf2']^2*`pref's`rf2'/*
* */ + 2*Bmat[`rf',`rf2']*CHmat[`rf2',`rf2']*CHmat[`rf',`rf']${HG_C`rf2'`rf'}
*local rf3 = `rf' + 1
*while `rf3'<`rf2'{
* qui replace `pref's`rf'=`pref's`rf' /*
* */ + 2*Bmat[`rf',`rf2']*Bmat[`rf',`rf3']*CHmat[`rf2',`rf2']*CHmat[`rf3',`rf3']${HG_C`rf2'`rf3'}
* local rf3 = `rf3' + 1
*}
local rf2 = `rf2' + 1
}
local rf = `rf' -1
}
local rf = 1
while `rf'<=$HG_tprf - 1{
* qui replace `pref's`rf' = sqrt(`pref's`rf')
drop `pref's`rf'
local rf = `rf' + 1
}
}
}
}
else if "`linpred'"~="" { /* linpred */
/* set up variable names $HG_xb1 for remcor */
local i = 1
while (`i' <= $HG_tpff){
tempname junk
global HG_xb`i' "`junk'"
local i = `i' + 1
}
/* set up names for HG_s`i' */
local i = 1
while (`i'<=$HG_tprf){
tempname junk
global HG_s`i' "`junk'"
local i = `i'+1
}
qui remcor `b'
* fixed part
qui gen double `pref' = $HG_xb1
if "`offset'"~=""&"$HG_off"~=""{
qui replace `pref' = `pref' - $HG_off
}
* add random part
local i = 2
while (`i' <= $HG_tprf){
local im = `i' - 1
qui replace `pref' = `pref' + ${HG_MU`im'} * ${HG_s`i'}
local i = `i' + 1
}
}
}
}
/* delete macros */
delmacs
} /* endelse influence */
qui keep `idno' `vars'
qui sort `idno'
qui save "`file'", replace
restore
sort `idno'
tempvar mrge
qui merge `idno' using "`file'", _merge(`mrge')
qui drop `mrge'
end
program define setmacs
version 6.0
args what
/* sort out depvar */
local depv "`e(depvar)'"
global ML_y1 "`depv'"
/* link and family-related macros */
global HG_famil "`e(famil)'"
global HG_link "`e(link)'"
global HG_linko "`e(linko)'"
global HG_nolog = `e(nolog)'
global HG_ethr = `e(ethr)'
global HG_mlog = `e(mlog)'
global HG_smlog = `e(smlog)'
global HG_oth = `e(oth)'
global HG_lv "`e(lv)'"
global HG_fv "`e(fv)'"
capture matrix M_resp=e(mresp)
capture matrix M_respm=e(mrespm)
capture matrix M_frld=e(frld)
capture matrix M_olog=e(olog)
capture matrix M_oth=e(moth)
global HG_exp = e(exp)
global HG_expf = e(expf)
global HG_ind = "`e(ind)'"
global HG_lev1 = e(lev1)
global HG_comp = e(comp)
capture local coall "`e(coall)'"
if $HG_comp~=0{
local i = 1
while `i'<=$HG_comp{
local k: word `i' of `coall'
global HG_co`i' `k'
local i = `i' + 1
}
}
/* macros related to priors */
global HP_prior = 0 /* assume that we never use the prior in gllapred */
/* set all other global macros */
global HG_nats = `e(nats)'
global HG_noC = `e(noC)'
global HG_noC1 = `e(noC1)'
global HG_adapt = `e(adapt)'
global HG_tplv = e(tplv)
global HG_tpff = `e(tpff)'
global HG_tpi = `e(tpi)'
global HG_tprf = e(tprf)
local tprf = $HG_tprf
global HG_free = e(free)
global HG_mult = e(mult)
global HG_lzpr lzprobg
global HG_zip zipg
if $HG_mult{
global HG_lzpr lzprobm
}
else if $HG_free{
global HG_lzpr lzprobf
global HG_zip zipf
matrix M_np=e(mnp)
}
global HG_cip = e(cip)
global which = 1
global HG_off "`e(offset)'"
global HG_error = 0
global HG_cor = `e(cor)'
global HG_bmat = e(bmat)
global HG_const = 0
global HG_ngeqs = e(ngeqs)
global HG_inter = e(inter)
global HG_dots = 0
global HG_init = e(init)
matrix M_nbrf = e(nbrf)
matrix M_nrfc = e(nrfc)
matrix M_ip = J(1,$HG_tprf+2,1)
matrix M_nffc = e(nffc)
if $HG_tprf<2{ local tprf = 2}
matrix M_znow =J(1,`tprf'-1,1)
matrix M_nip = e(nip)
capture matrix M_ngeqs = e(mngeqs)
capture matrix M_b=e(mb)
capture matrix M_chol = e(chol)
local lev = 2
while `lev'<=$HG_tplv{
local l = M_nrfc[1,`lev'-1] + 1 /* loop */
local k = M_nrfc[2,`lev'-1] + 1 /* r. eff. */
while `l'<=M_nrfc[1,`lev']&$HG_tplv>1{
local tp = M_nrfc[2,`lev']
if $HG_mult{
local tp = `k' /* only one z-matrix per level */
}
while `k'<=`tp'{
*disp "loop " `l' " random effect " `k'
local kk = `k'
if $HG_mult{
local kk = `l'
}
local w = M_nip[2,`kk']
/* same loc and prob as before? */
local found = 0
local ii=M_nrfc[2,1] + 1
while `ii'<`kk'{
if `w'==M_nip[2,`ii']{
local found = 1
}
local ii = `ii'+1
}
capture matrix M_zps`w' =e(zps`w')
*matrix list M_zps`w'
if `what'==2{
if $HG_free {
if `k' == M_nrfc[1,`l']{
local nip = colsof(M_zps`w')
noi disp in gr "prior probabilities"
local j = 2
local zz=string(exp(M_zps`w'[1,1]),"%6.0gc")
if `nip'>1{
local mm "0`zz'"
}
else{
local mm "1"
}
while `j'<=`nip'{
local zz=string(exp(M_zps`w'[1,`j']),"%6.0gc")
local mm "`mm'" ", " "0`zz'"
local j = `j' + 1
}
disp in gr " prob: " in ye "`mm'"
disp " "
}
}
else if `found'==0{
*noi disp in gr "probabilities for `w' quad. points"
*noi matrix list M_zps`w'
*disp " "
}
}
* disp "M_zlc`w'"
matrix M_zlc`w'=e(zlc`w')
*matrix list M_zlc`w'
if `what'==2{
if $HG_free{
noi disp in gr "locations for random effect " `w'-1
local mm=string(M_zlc`w'[1,1],"%6.0gc")
local j = 2
while `j'<= `nip'{
local zz=string(M_zlc`w'[1,`j'],"%6.0gc")
local mm "`mm'" ", " "`zz'"
local j = `j' + 1
}
disp in gr " loc: " in ye "`mm'"
disp " "
}
else if `found'==0{
*noi disp in gr "locations for `w' quadrature points"
*noi matrix list M_zlc`w'
*disp " "
}
}
local k = `k' + 1
}
local l = `l' + 1
}
local lev = `lev' + 1
}
end
program define delmacs
version 6.0
/* deletes all global macros and matrices*/
tempname var
if "$HG_tplv"==""{
* macros already gone
exit
}
local nrfold = M_nrfc[2,1]
local lev = 2
while (`lev'<=$HG_tplv){
local i2 = M_nrfc[2,`lev']
local i1 = `nrfold'+1
local i = `i1'
local nrfold = M_nrfc[2,`lev']
while `i' <= `i2'{
local n = M_nip[2,`i']
if `i' <= M_nrfc[1,`lev']{
capture matrix drop M_zps`n'
}
capture matrix drop M_zlc`n'
local i = `i' + 1
}
local lev = `lev' + 1
}
if $HG_free==0&$HG_init==0{
matrix drop M_chol
}
matrix drop M_nrfc
matrix drop M_nffc
matrix drop M_nbrf
matrix drop M_ip
capture matrix drop M_b
capture matrix drop M_resp
capture matrix drop M_respm
capture matrix drop M_frld
matrix drop M_nip
matrix drop M_znow
capture matrix drop M_ngeqs
capture matrix drop CHmat
/* globals defined in gllam_ll */
local i=1
while (`i'<=$HG_tpff){
global HG_xb`i'
local i= `i'+1
}
local i = 1
while (`i'<=$HG_tprf){
global HG_s`i'
local i= `i'+1
}
local i = 1
while (`i'<=$HG_tplv){
global HG_wt`i'
local i = `i' + 1
}
global HG_nats
global HG_noC
global HG_noC1
global HG_adapt
global HG_fixe
global HG_lev1
global HG_bmat
global HG_tplv
global HG_tprf
global HG_tpi
global HG_tpff
global HG_clus
global HG_weigh
global which
global HG_gauss
global HG_free
global HG_famil
global HG_link
global HG_nolog
global HG_olog
global HG_mlog
global HG_smlog
global HG_oth
global HG_exp
global HG_expf
global HG_lv
global HG_fv
global HG_nump
global HG_eqs
global HG_obs
global HG_off
global HG_offs
global HG_denom
global HG_cor
global HG_s1
global HG_init
global HG_ind
global HG_const
global HG_dots
global HG_inter
global HG_ngeqs
global HG_ethr
global HG_mult
global HG_lzpr
global HG_zip
global HG_cip
global HG_post
global HG_outc
global HG_comp
global HG_final
capture macro drop HG_co*
capture matrix drop M_above
end