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.
1169 lines
33 KiB
Plaintext
1169 lines
33 KiB
Plaintext
*! version 2.2.5 SRH 7 Sept 2011
|
|
program define gllarob, eclass
|
|
version 6.0
|
|
|
|
syntax [,CLuster(varname) DOts First Macs SCorefil(string) temp noROb]
|
|
|
|
tempname Vr b V
|
|
matrix `V' = e(V)
|
|
matrix `b' = e(b)
|
|
|
|
/* first: have not computed robust se before */
|
|
/* macs: macros are already there */
|
|
/* rob: do not compute/report robust ses */
|
|
|
|
*disp in re "first = `first' and mac= `macs' "
|
|
|
|
/* sort out depvar */
|
|
local depv "`e(depvar)'"
|
|
global ML_y1 "`depv'"
|
|
|
|
|
|
/* sort out scorefil */
|
|
|
|
if "`scorefil'"~=""{
|
|
if "`e(scorefil)'"~=""{
|
|
disp in re "There is already a score file `e(scorefil)', option ignored"
|
|
local score
|
|
}
|
|
else{
|
|
* check if file can be opened
|
|
capture postfile junk a using "`scorefil'"
|
|
if _rc~=0{
|
|
disp in re "cannot open `scorefil'.dta for writing"
|
|
exit 198
|
|
}
|
|
postclose junk
|
|
local score "`scorefil'"
|
|
}
|
|
|
|
}
|
|
/* sort out first and calc */
|
|
if "`first'"~=""{
|
|
local first = 1
|
|
local calc = 1
|
|
|
|
}
|
|
else{
|
|
local first = 0
|
|
}
|
|
|
|
local robu = 1
|
|
if "`rob'"~=""{
|
|
local robu = 0
|
|
}
|
|
if `first' == 0 {
|
|
global HG_const = e(const)
|
|
matrix `V' = e(Vs)
|
|
local robclus "`e(robclus)'"
|
|
local calc = 0
|
|
* disp "`robclus' == `cluster' ?"
|
|
capture matrix `Vr' = e(Vr)
|
|
if _rc>0|"`robclus'"~="`cluster'"{
|
|
local calc = 1
|
|
}
|
|
if "`score'"~=""{
|
|
local calc = 1
|
|
}
|
|
}
|
|
* disp "first = " `first' " and calc = " `calc'
|
|
*if `first'==0& `calc' {
|
|
if "`macs'"==""& `calc' {
|
|
if "`cluster'"~=""{
|
|
qui count if `cluster'==.&e(sample)
|
|
if r(N)>0{
|
|
disp in re "`cluster' has missing values in the estimation sample"
|
|
exit(198)
|
|
}
|
|
}
|
|
preserve
|
|
qui keep if e(sample)
|
|
/* set all global macros needed by gllam_ll */
|
|
setmacs
|
|
/* sort out temporary variables */
|
|
/* sort out weight */
|
|
local weight "`e(weight)'"
|
|
global HG_weigh "`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'
|
|
}
|
|
|
|
/* 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
|
|
if $HG_tplv == 1{
|
|
global HG_clus "`id'"
|
|
}
|
|
else{
|
|
tokenize "`clus'"
|
|
local l= $HG_tplv
|
|
local `l' "`id'"
|
|
global HG_clus "`*'"
|
|
}
|
|
}
|
|
* disp in re "HG_tplv = " $HG_tplv " and HG_clus: $HG_clus"
|
|
/* sort out denom */
|
|
local denom "`e(denom)'"
|
|
if "`denom'"~=""{
|
|
capture confirm variable `denom'
|
|
if _rc>0{
|
|
tempvar den
|
|
qui gen byte `den'=1
|
|
global HG_denom "`den'"
|
|
}
|
|
else{
|
|
global HG_denom `denom'
|
|
}
|
|
}
|
|
|
|
/* sort out HG_ind */
|
|
capture confirm variable $HG_ind
|
|
if _rc>0{
|
|
tempname junk
|
|
global HG_ind "`junk'"
|
|
gen byte $HG_ind=1
|
|
}
|
|
|
|
/* sort out HG_lvolo (from gllapred) */
|
|
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
|
|
}
|
|
}
|
|
}
|
|
|
|
/** (from gllapred) **/
|
|
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
|
|
}
|
|
}
|
|
|
|
|
|
|
|
/* sort out constraints */
|
|
if $HG_const {
|
|
* disp "constraints used"
|
|
matrix `b' = `b'*M_T
|
|
matrix `V' = M_T'*`V'*M_T
|
|
*matrix junk = M_T*`V'*M_T'
|
|
* matrix list junk
|
|
}
|
|
|
|
tempname junk
|
|
capture matrix `junk' = inv(`V')
|
|
if _rc>0{
|
|
disp in re "parameter covariance matrix not invertible"
|
|
exit(198)
|
|
}
|
|
|
|
/* set up HG_MU, HG_SD and HG_Cij */
|
|
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
|
|
}
|
|
}
|
|
|
|
/* endif set-up macros and variables */
|
|
|
|
/* compute scores and/or robust standard errors */
|
|
if `calc'{
|
|
*set trace on
|
|
tempvar tpwt
|
|
gen int `tpwt' = 1
|
|
global HG_tpwt "`tpwt'"
|
|
local weight "$HG_weigh"
|
|
* 10/20/06
|
|
if $HG_init{
|
|
local numlv: word count `e(clus)'
|
|
local i = 1
|
|
while `i'<=`numlv'{
|
|
capture confirm variable `weight'`i'
|
|
if _rc==0{
|
|
qui replace `tpwt' = `tpwt'*`weight'`i'
|
|
}
|
|
local i = `i' + 1
|
|
}
|
|
}
|
|
else{
|
|
local l = $HG_tplv
|
|
capture confirm variable `weight'`l'
|
|
if _rc==0 {
|
|
/* there are frequency weights at the top level */
|
|
qui replace `tpwt' = `tpwt' * `weight'`l'
|
|
}
|
|
}
|
|
*summ `tpwt'
|
|
* disp "before comprob, HG_const = " $HG_const " and first = " `first'
|
|
noi cap noi comprob3 "`b'" "`V'" "`cluster'" "`score'" "`dots'" `robu'
|
|
if _rc>0{
|
|
disp in re "something went wrong in comprob3"
|
|
delmacs
|
|
exit 198
|
|
}
|
|
matrix `Vr' = `V'
|
|
}
|
|
|
|
/* post results */
|
|
*disp in re "temp = `temp' score = `score' "
|
|
if "`score'"~=""&"`temp'"==""{
|
|
est local scorefil "`score'"
|
|
}
|
|
if `robu'{
|
|
* disp "after comprob, HG_const = " $HG_const " and first = " `first'
|
|
if $HG_const&`first' == 0{
|
|
matrix `V' = `Vr'
|
|
est matrix Vr `V'
|
|
tempname M_T
|
|
matrix `M_T'=e(T)
|
|
matrix `Vr' = `M_T'*`Vr'*`M_T''
|
|
* matrix list `Vr'
|
|
}
|
|
else{
|
|
matrix `V' = `Vr'
|
|
est matrix Vr `V'
|
|
* matrix list e(Vr)
|
|
}
|
|
estimates repost V = `Vr'
|
|
est local robclus "`cluster'"
|
|
}
|
|
if `first' == 0&`calc'{
|
|
delmacs
|
|
}
|
|
|
|
end
|
|
|
|
|
|
program define comprob3
|
|
version 6.0
|
|
args coeffs var cluster score dots rob
|
|
*set trace on
|
|
*disp in re "in comprob3: dots=`dots', score = `score', rob=`rob' "
|
|
if "`cluster'"~=""{
|
|
local cluster cluster(`cluster')
|
|
}
|
|
*disp "cluster is `cluster'"
|
|
*matrix list `coeffs'
|
|
|
|
tempvar where last
|
|
local l = $HG_tplv
|
|
local weight "$HG_tpwt"
|
|
|
|
if $HG_tplv>1{
|
|
local top: word 1 of $HG_clus
|
|
}
|
|
else{
|
|
local k: word count $HG_clus
|
|
local top: word `k' of $HG_clus
|
|
}
|
|
sort `top' $HG_ind
|
|
qui by `top': gen byte `last' = _n==_N
|
|
qui by `top': gen int `where' = _n==1
|
|
qui replace `where' = sum(`where')
|
|
local n = colsof(`coeffs')
|
|
|
|
/* compute scores */
|
|
if "`e(scorefil)'"==""{
|
|
*disp "Computing scores"
|
|
tempname b1 lnf
|
|
tempname S g fm fp fm0 S0 h Sgoal0 Sgoal1 Sming
|
|
tempvar llp llm lls done dfvar ok goal0 goal1 mingoal
|
|
|
|
/* sort out adapt */
|
|
local adapt = 0
|
|
if $HG_adapt==1{
|
|
local adapt = 1
|
|
}
|
|
if `adapt'{
|
|
tempname llast lnf
|
|
global HG_adapt=1
|
|
noi gllam_ll 1 `coeffs' "`lnf'" "junk" "junk" 1
|
|
disp in gre "Non-adaptive log-likelihood: " in ye `lnf'
|
|
scalar `llast' = 0
|
|
local i = 1
|
|
qui `noi' disp in gr "Updating posterior means and variances"
|
|
qui `noi' disp in gr "log-likelihood: "
|
|
while abs((`llast'-`lnf')/`lnf')>1e-8&`i'<60{
|
|
scalar `llast' = `lnf'
|
|
qui gllam_ll 1 "`coeffs'" "`lnf'" "junk" "junk" 1
|
|
disp in ye %10.4f `lnf' " " _c
|
|
if mod(`i',6)==0 {disp " " }
|
|
local i = `i' + 1
|
|
}
|
|
}
|
|
|
|
qui gen double `llm'=.
|
|
qui gen double `llp'=.
|
|
qui gen double `lls'=.
|
|
gllam_ll 1 `coeffs' "`lnf'" "junk" "junk" 3 "`lls'"
|
|
* with mlogit link, all but last lls are missing:
|
|
sort `top' `last'
|
|
qui by `top': replace `lls' = `lls'[_N]
|
|
|
|
if abs((`lnf'-`e(ll)')/`e(ll)')>1e-5{
|
|
disp in re "can't get correct log-likelihood: " `lnf' " should be " `e(ll)'
|
|
exit 198
|
|
}
|
|
|
|
*disp in re "got the right likelihood: " `e(ll)'
|
|
|
|
qui count if `last'>0
|
|
local N = r(N)
|
|
|
|
|
|
local l 1e-8
|
|
local u 1e-7
|
|
local m 1e-10
|
|
local epsf 1e-3
|
|
local j = 1
|
|
* disp "N = " `N'
|
|
|
|
* CHANGED TO VARIABLES
|
|
gen double `goal0' = (abs(`lls')+`l')*`l'
|
|
gen double `goal1' = (abs(`lls')+`u')*`u'
|
|
gen double `mingoal' = (abs(`lls')+`m')*`m'
|
|
|
|
qui gen byte `done' = 0
|
|
qui gen byte `ok' = 0
|
|
qui gen double `dfvar' = 0
|
|
|
|
local ds
|
|
local ss
|
|
|
|
local i = 1
|
|
while `i'<=`n'{ /* loop over parameters */
|
|
* if "`dots'"~=""{ noi disp in gr "." _c}
|
|
*JUNK
|
|
* disp in re " "
|
|
* disp in re "parameter " `i'
|
|
scalar `S' = 1 /* ML_d0_S[1,`i'] */
|
|
scalar `h' = (abs(`coeffs'[1,`i'])+`epsf')*`epsf'
|
|
matrix `b1' = `coeffs'
|
|
|
|
/* find zero derivatives */
|
|
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+500*`h'*`S'
|
|
*JUNK
|
|
* noi matrix list `b1'
|
|
gllam_ll 1 `b1' "`lnf'" "junk" "junk" 3 "`llp'"
|
|
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-500*`h'*`S'
|
|
*JUNK
|
|
* noi matrix list `b1'
|
|
gllam_ll 1 `b1' "`lnf'" "junk" "junk" 3 "`llm'"
|
|
|
|
qui replace `done' = abs(`llp' - `llm')<`goal0' /* derivative is zero */
|
|
sort `top' `last'
|
|
qui by `top': replace `done' = `done'[_N]
|
|
|
|
*JUNK
|
|
* disp in re "non-zero derivatives for following clusters (showing lls llm llp and goal0) step = " 1000*`h'*`S'
|
|
* noi list `top' `lls' `llm' `llp' `goal0' if `last'==1&`done'==0
|
|
|
|
tempvar d`i'
|
|
qui gen double `d`i''= 0 if `done' == 1&`last'==1
|
|
local ds "`ds' `d`i''"
|
|
|
|
if "`score'"~=""{
|
|
tempvar s`i'
|
|
qui gen double `s`i''= 0 if `done' == 1&`last'==1
|
|
local ss "`ss' `s`i''"
|
|
}
|
|
|
|
qui count if `done'==0&`last'==1
|
|
local num = r(N)
|
|
|
|
while `num'>0{
|
|
**disp "`num' clusters left to do"
|
|
scalar `S' = 1 /* ML_d0_S[1,`i'] */
|
|
if "`dots'"~=""{ noi disp in ye "." _c}
|
|
sort `done' `where'
|
|
local nxt = `where'[1]
|
|
scalar `lnf' = `lls'[1]
|
|
|
|
scalar `Sgoal0' = (abs(scalar(`lnf'))+`l')*`l'
|
|
scalar `Sgoal1' = (abs(scalar(`lnf'))+`u')*`u'
|
|
scalar `Sming' = (abs(scalar(`lnf'))+`m')*`m'
|
|
|
|
preserve
|
|
|
|
***disp in re " "
|
|
*JUNK
|
|
* disp in re "sorting out cluster `nxt': `top' = " `top'[1]
|
|
qui keep if `where' == `nxt'
|
|
|
|
*JUNK
|
|
* if `nxt'==241{disp in re "lnf = " `lnf' " goal0 = " `Sgoal0' " goal1 = " `Sgoal1'}
|
|
* disp in re "got here!"
|
|
GetStep `coeffs' `h' `S' `i' `Sgoal0' `Sgoal1' `Sming' `lnf' /* "`coeffs'" */
|
|
*JUNK
|
|
* if `nxt'==241{ disp in re "after GetStep: S = " `S' " h = " `h'}
|
|
|
|
restore
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
gllam_ll 1 `b1' "`lnf'" "junk" "junk" 3 "`llm'"
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+`h'*`S'
|
|
gllam_ll 1 `b1' "`lnf'" "junk" "junk" 3 "`llp'"
|
|
qui replace `dfvar' = abs(`lls'-`llm')
|
|
qui replace `ok' = `goal0'<`dfvar'&`dfvar'<`goal1'
|
|
*JUNK
|
|
* if `nxt'==241{
|
|
* disp in re "goal0 = " `Sgoal0' " goal1 = " `Sgoal1'
|
|
* noi list `goal0' `goal1' if `where'==`nxt'
|
|
* disp in re "llm llp lls"
|
|
* noi list `llm' `llp' `lls' if `where'==`nxt'
|
|
* }
|
|
* first derivatives
|
|
qui replace `d`i'' = (`llp' - `llm')/(2*`h'*`S'*`weight') if `ok' == 1&`last'==1
|
|
if "`score'"~=""{
|
|
* second derivatives
|
|
qui replace `s`i'' = (`llp' + `llm' -2*`lls' )/(`h'*`S'*`h'*`S'*`weight') /*
|
|
*/ if `ok' == 1&`last'==1
|
|
}
|
|
qui replace `done' = 1 if `ok'==1
|
|
sort `top' `last'
|
|
qui by `top': replace `done' = `done'[_N]
|
|
|
|
*JUNK?
|
|
* if program didn't crash, derivative for `nxt' is valid:
|
|
qui replace `done' = 1 if `where'==`nxt'
|
|
/*
|
|
qui summ `done' if `where' == `nxt', meanonly
|
|
if abs(r(mean)-1)>1e-3{
|
|
disp in re "Problem with derivative for parameter `i', cluster `nxt'"
|
|
}
|
|
*/
|
|
qui count if `done'==0&`last'==1
|
|
local num = r(N)
|
|
}
|
|
*summ `d`i''
|
|
local i = `i'+1
|
|
}
|
|
*set trace on
|
|
if "`score'"~=""{
|
|
preserve
|
|
format `ds' `ss' %16.11g
|
|
qui outfile `top' `ds' `ss' if `last'==1 using "`score'.dta", replace
|
|
local tp `top'
|
|
if $HG_tplv==1{
|
|
local tp __idno
|
|
}
|
|
qui infile `tp' double (d1-d`n' s1-s`n') using "`score'.dta", clear
|
|
qui sort `tp'
|
|
qui save "`score'", replace
|
|
restore
|
|
}
|
|
} /*endif*/
|
|
/* compute robust ses */
|
|
if `rob'{
|
|
local es
|
|
local dds
|
|
local i = 1
|
|
while `i'<=`n'{
|
|
local dds "`dds' d`i'"
|
|
local es "`es' e`i'"
|
|
local i = `i' + 1
|
|
}
|
|
* disp " "
|
|
local eqs: coleq(`var')
|
|
local rown: rownames(`var')
|
|
local coln: colnames(`var')
|
|
* matrix list `var'
|
|
matrix coleq `var' = `es'
|
|
matrix roweq `var' = `es'
|
|
matrix colnames `var' = _cons
|
|
matrix rownames `var' = _cons
|
|
|
|
if "`e(scorefil)'"~=""{
|
|
preserve
|
|
local tp `top'
|
|
if $HG_tplv == 1{
|
|
rename $HG_clus __idno
|
|
local tp __idno
|
|
}
|
|
sort `tp' `last'
|
|
merge `tp' using `e(scorefil)'
|
|
noi _robust `dds' [fweight=`weight'] if `last'>0, `cluster' variance(`var')
|
|
restore
|
|
}
|
|
else{
|
|
* matrix list `var'
|
|
*disp "before _robust, _rc = " _rc
|
|
*corr `ds', cov
|
|
* disp "_robust `ds' [fweight=`weight'] if `last'>0, `cluster' variance(`var')"
|
|
noi _robust `ds' [fweight=`weight'] if `last'>0, `cluster' variance(`var')
|
|
*disp "after _robust, _rc = " _rc
|
|
* matrix list `var'
|
|
}
|
|
|
|
* disp "setting equation names"
|
|
matrix coleq `var' = `eqs'
|
|
matrix roweq `var' = `eqs'
|
|
matrix colnames `var' = `coln'
|
|
matrix rownames `var' = `rown'
|
|
* matrix list `var'
|
|
}
|
|
exit(0)
|
|
end
|
|
|
|
program define GetStep
|
|
version 6.0
|
|
|
|
args a h S i goal0 goal1 mingoal lnf /* coeffs */
|
|
|
|
***disp in re "In GetStep: h = " `h' " S = " `S' " i = " `i' " goal0 = " `goal0'
|
|
***disp in re "goal0 = " `goal1' " mingoal = " `mingoal' " lnf = " `lnf'
|
|
tempname b1 S0 fm0 fp fm coeffs
|
|
matrix `coeffs' = `a'
|
|
matrix `b1' = `coeffs'
|
|
* matrix list `coeffs'
|
|
***disp in re " "
|
|
|
|
/***** from here, stolen from ml_adj */
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
gllam_ll 1 `b1' "`fm'"
|
|
***disp in re "in iteration 0, lnf = " `lnf' " and fm = " `fm'
|
|
|
|
/* Save initial values of S and fm. */
|
|
|
|
scalar `S0' = `S'
|
|
scalar `fm0' = `fm'
|
|
|
|
if `fm'==.{
|
|
* disp in re "calling MisStep now"
|
|
* disp in re "step before: " `S'
|
|
MisStep `coeffs' `h' `S' `i' `lnf'
|
|
* disp in re "step before: " `S'
|
|
exit
|
|
}
|
|
|
|
/* Compute df. We want goal0 <= df <= goal1. */
|
|
|
|
local df = abs(scalar(`lnf')-`fm')
|
|
|
|
local Sold1 0
|
|
local dfold1 0
|
|
local iter 1
|
|
|
|
local itmax = 20
|
|
|
|
while (`df'<`goal0' | `df'>`goal1') & `iter'<=`itmax' {
|
|
|
|
GetS `mingoal' `goal0' `goal1' `S' `df' /* interpolate ...
|
|
*/ `Sold1' `dfold1' `Sold2' `dfold2'
|
|
local Sold2 `Sold1'
|
|
local dfold2 `dfold1'
|
|
local Sold1 = `S'
|
|
local dfold1 `df'
|
|
|
|
scalar `S' = r(S)
|
|
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
*JUNK
|
|
* noi disp in re "changing paramter by " `h'*`S' " to " `b1'[1,`i']
|
|
gllam_ll 1 `b1' "`fm'"
|
|
*JUNK
|
|
* disp in re "in iteration `iter', S= " `S' " fm = " `fm'
|
|
|
|
if `fm'==. {
|
|
* disp in re "calling MisStep now"
|
|
* disp in re "step before: " `S'
|
|
MisStep `coeffs' `h' `S' `i' `lnf'
|
|
* disp in re "step after: " `S'
|
|
exit
|
|
}
|
|
|
|
local df = abs(scalar(`lnf')-`fm')
|
|
local iter = `iter' + 1
|
|
}
|
|
|
|
if `df'<`goal0' | `df'>`goal1' { /* did not meet goal */
|
|
scalar `S' = `S0' /* go back to initial values */
|
|
scalar `fm' = `fm0' /* guaranteed to be nonmissing */
|
|
}
|
|
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+`h'*`S'
|
|
gllam_ll 1 `b1' "`fp'"
|
|
|
|
if `fp'==. {
|
|
* disp in re "calling MisStep now"
|
|
* disp in re "step before: " `S'
|
|
MisStep `coeffs' `h' `S' `i' `lnf'
|
|
* disp in re "step after: " `S'
|
|
exit
|
|
}
|
|
|
|
if `df'<`goal0' | `df'>`goal1' { /* did not meet goal; we redo
|
|
stepsize adjustment looking at
|
|
both sides; starting values are
|
|
guaranteed to be nonmissing
|
|
*/
|
|
*JUNK
|
|
* disp in re "calling TwoStep now, lnf = " `lnf'
|
|
* disp in re "lnf = " `lnf' " fm = " `fm' " df = " `df'
|
|
* disp in re "step before: " `S'
|
|
TwoStep `fp' `fm' `coeffs' `h' `S' `i' `lnf'
|
|
* disp in re "step after: " `S'
|
|
|
|
}
|
|
/***** up to here, stolen from ml_adj */
|
|
end
|
|
|
|
program define GetS, rclass
|
|
* stolen from ml_adj
|
|
args mingoal goal0 goal1 S df Sold1 dfold1 Sold2 dfold2
|
|
|
|
if `df' < `mingoal' {
|
|
/* di "GetS: below mingoal, doubling S --> 2*S" */ /* diag */
|
|
return scalar S = 2*`S'
|
|
exit
|
|
}
|
|
|
|
/* Interpolate to get f(newS)=mgoal.
|
|
|
|
When `Sold2' and `dfold2' are empty (on the first iteration), we do
|
|
linear interpolation of f(S)=df, f(0)=0.
|
|
|
|
Thereafter, we do quadratic interpolation with the current and previous
|
|
two positions.
|
|
*/
|
|
tempname newS
|
|
local mgoal = (`goal0' + `goal1')/2
|
|
|
|
Intpol `newS' `mgoal' `S' `df' `Sold1' `dfold1' `Sold2' `dfold2'
|
|
|
|
if `newS'==. | `newS'<=0 | (`df'>`goal1' & `newS'>`S') /*
|
|
*/ | (`df'<`goal0' & `newS'<`S') {
|
|
|
|
return scalar S = `S'*cond(`df'<`goal0',2,.5)
|
|
}
|
|
else return scalar S = `newS'
|
|
end
|
|
|
|
|
|
program define Intpol
|
|
* stolen from ml_adj
|
|
args y x y0 x0 y1 x1 y2 x2
|
|
|
|
if "`y2'"=="" { local linear 1 }
|
|
else if `y2'==. | `x2'==. { local linear 1 }
|
|
|
|
if "`linear'"!="" {
|
|
scalar `y' = ((`y1')-(`y0'))*((`x')-(`x0'))/((`x1')-(`x0')) /*
|
|
*/ + (`y0')
|
|
exit
|
|
}
|
|
|
|
scalar `y' = /*
|
|
*/ (`y0')*((`x')-(`x1'))*((`x')-(`x2'))/(((`x0')-(`x1'))*((`x0')-(`x2'))) /*
|
|
*/ + (`y1')*((`x')-(`x0'))*((`x')-(`x2'))/(((`x1')-(`x0'))*((`x1')-(`x2'))) /*
|
|
*/ + (`y2')*((`x')-(`x0'))*((`x')-(`x1'))/(((`x2')-(`x0'))*((`x2')-(`x1')))
|
|
end
|
|
|
|
|
|
|
|
|
|
program define MisStep /* This routine is called if missing values were
|
|
encountered in GetStep.
|
|
*/
|
|
|
|
/* di "in MisStep!" */ /* diag */
|
|
*args h S caller i fpout fmout x0
|
|
args coeffs h S i lnf
|
|
*macro shift 7
|
|
*local list "`*'"
|
|
|
|
local itmax 50
|
|
|
|
tempname fm fp b1
|
|
scalar `fm' = .
|
|
scalar `fp' = .
|
|
local iter 1
|
|
while (`fm'==. | `fp'==.) & `iter'<=`itmax' {
|
|
scalar `S' = `S'/2
|
|
|
|
matrix `b1' = `coeffs'
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
gllam_ll 1 `b1' "`fm'"
|
|
|
|
if `fm'!=. {
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+`h'*`S'
|
|
gllam_ll 1 `b1' "`fp'"
|
|
}
|
|
|
|
local iter = `iter' + 1
|
|
}
|
|
|
|
if `fm'==. | `fp'==. {
|
|
di as err "could not calculate numerical derivatives" _n /*
|
|
*/ "discontinuous region with missing values encountered"
|
|
exit 430
|
|
}
|
|
|
|
TwoStep `fp' `fm' `coeffs' `h' `S' `i' `lnf'
|
|
end
|
|
|
|
program define TwoStep /* This routine is called if
|
|
|
|
(1) goal was not reached, or
|
|
|
|
(2) missing values were encountered
|
|
and MisStep then found nonmissing
|
|
values.
|
|
|
|
Note: Input is guaranteed to be nonmissing
|
|
on both sides.
|
|
*/
|
|
|
|
/* di "in two-step" */ /* diag */
|
|
*args fp fm h S caller i fpout fmout x0
|
|
args fp fm coeffs h S i lnf
|
|
*macro shift 9
|
|
*local list "`*'"
|
|
|
|
tempname bestS b1
|
|
|
|
local ep0 1e-8
|
|
local ep1 1e-7
|
|
local epmin 1e-12
|
|
local itmax 40
|
|
|
|
local goal0 = (abs(scalar(`lnf'))+`ep0')*`ep0'
|
|
local goal1 = (abs(scalar(`lnf'))+`ep1')*`ep1'
|
|
local mingoal = (abs(scalar(`lnf'))+`epmin')*`epmin'
|
|
|
|
local df = (abs(scalar(`lnf')-`fp')+abs(scalar(`lnf')-`fm'))/2
|
|
local bestdf `df'
|
|
scalar `bestS' = `S'
|
|
local Sold1 0
|
|
local dfold1 0
|
|
local iter 1
|
|
|
|
while (`df'<`goal0' | `df'>`goal1') & `iter'<=`itmax' {
|
|
|
|
*di "TwoStep iter = `iter' df = " %12.4e `df' " S = " %12.3e `S'
|
|
|
|
GetS `mingoal' `goal0' `goal1' `S' `df' /* interpolate ...
|
|
*/ `Sold1' `dfold1' `Sold2' `dfold2'
|
|
|
|
local Sold2 `Sold1'
|
|
local dfold2 `dfold1'
|
|
local Sold1 = `S'
|
|
local dfold1 `df'
|
|
|
|
scalar `S' = r(S)
|
|
|
|
matrix `b1' = `coeffs'
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
gllam_ll 1 `b1' "`fm'"
|
|
|
|
*Lik`caller' -`h'*`S' `i' `fm' `fmout' `x0' `list'
|
|
|
|
if `fm'!=. {
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+`h'*`S'
|
|
gllam_ll 1 `b1' "`fp'"
|
|
* Lik`caller' `h'*`S' `i' `fp' `fpout' `x0' `list'
|
|
}
|
|
if `fm'==. | `fp'==. {
|
|
if `bestdf' >= `mingoal' { /* go with best value */
|
|
scalar `S' = `bestS'
|
|
|
|
matrix `b1' = `coeffs'
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
gllam_ll 1 `b1' "`fm'"
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+`h'*`S'
|
|
gllam_ll 1 `b1' "`fp'"
|
|
|
|
di as txt /*
|
|
*/ "numerical derivatives are approximate" /*
|
|
*/ _n "nearby values are missing"
|
|
exit
|
|
}
|
|
|
|
di as err /*
|
|
*/ "could not calculate numerical derivatives" /*
|
|
*/ _n "missing values encountered"
|
|
exit 430
|
|
}
|
|
|
|
local df = (abs(scalar(`lnf')-`fp')+abs(scalar(`lnf')-`fm'))/2
|
|
|
|
if `df'>1.1*`bestdf' | (`df'>=0.9*`bestdf' & `S'<`bestS') {
|
|
local bestdf `df'
|
|
scalar `bestS' = `S'
|
|
}
|
|
|
|
local iter = `iter' + 1
|
|
}
|
|
|
|
*JUNK
|
|
*disp in re "TwoStep df = " %12.4e `df' " S = " %12.3e `S' " goal0 = " `goal0' " goal1 = " `goal1' " lnf = " `lnf'
|
|
|
|
if `df'<`goal0' | `df'>`goal1' { /* did not reach goal */
|
|
|
|
disp in re "TwoStep: did not reach goal"
|
|
|
|
if `bestdf' >= `mingoal' { /* go with best value */
|
|
scalar `S' = `bestS'
|
|
|
|
matrix `b1' = `coeffs'
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']-`h'*`S'
|
|
gllam_ll 1 `b1' "`fm'"
|
|
matrix `b1'[1,`i'] = `coeffs'[1,`i']+`h'*`S'
|
|
gllam_ll 1 `b1' "`fp'"
|
|
|
|
di as txt "numerical derivatives are approximate" /*
|
|
*/ _n "flat or discontinuous region encountered"
|
|
}
|
|
else {
|
|
di as err "could not calculate numerical derivatives" /*
|
|
*/ _n "flat or discontinuous region encountered"
|
|
exit 430
|
|
}
|
|
}
|
|
end
|
|
|
|
|
|
|
|
program define setmacs
|
|
version 6.0
|
|
/* may not work for higher level models yet */
|
|
/* tplv */
|
|
global HG_tplv = e(tplv)
|
|
|
|
/* 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_lv "`e(lv)'"
|
|
global HG_fv "`e(fv)'"
|
|
global HG_oth = e(oth)
|
|
global HG_mlog = e(mlog)
|
|
global HG_smlog = `e(smlog)'
|
|
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)
|
|
capture matrix ML_d0_S=e(do_S)
|
|
global HG_exp = e(exp)
|
|
global HG_expf = e(expf)
|
|
global HG_ind = "`e(ind)'"
|
|
global HG_init = e(init)
|
|
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
|
|
}
|
|
}
|
|
|
|
/* prior related global macros */
|
|
global HP_prior = e(prior)
|
|
if $HP_prior == 1{
|
|
global HP_sprd = 1
|
|
global HP_invga = e(invga)
|
|
global HP_invwi = e(invwi)
|
|
global HP_foldt = e(foldt)
|
|
global HP_logno = e(logno)
|
|
global HP_gamma = e(gamma)
|
|
global HP_corre = e(corre)
|
|
global HP_boxco = e(boxco)
|
|
global HP_spect = e(spect)
|
|
global HP_wisha = e(wisha)
|
|
if $HP_invga==1{
|
|
global shape = e(shape)
|
|
global rate = e(rate)
|
|
}
|
|
if $HP_invwi==1{
|
|
global df = e(df)
|
|
matrix scale = e(scale)
|
|
}
|
|
if $HP_foldt==1{
|
|
global df = e(df)
|
|
global scale = e(scale)
|
|
global location = e(location)
|
|
}
|
|
if $HP_logno==1{
|
|
global meanlog = e(meanlog)
|
|
global sdlog = mean(sdlog)
|
|
}
|
|
if $HP_gamma==1{
|
|
global HP_scale = e(scale)
|
|
global HP_var = e(var)
|
|
global HP_shape = e(shape)
|
|
}
|
|
if $HP_corre==1{
|
|
global alpha = e(alpha)
|
|
global beta = e(beta)
|
|
}
|
|
if $HP_boxco==1{
|
|
global scale = e(scale)
|
|
global lambda = e(lambda)
|
|
}
|
|
if $HP_spect==1{
|
|
global alpha = e(alpha)
|
|
global beta = e(beta)
|
|
}
|
|
if $HP_wisha==1{
|
|
global wisha = e(wisha)
|
|
global df = e(df)
|
|
matrix scale =e(scale)
|
|
}
|
|
matrix M_nu = e(nu)
|
|
}
|
|
|
|
|
|
/* 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_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 = 4
|
|
global HG_off "`e(offset)'"
|
|
global HG_error = 0
|
|
global HG_cor = `e(cor)'
|
|
global HG_bmat = e(bmat)
|
|
global HG_tprf = e(tprf)
|
|
global HG_const = e(const)
|
|
if $HG_const==1{
|
|
matrix M_T = e(T)
|
|
matrix M_a = e(a)
|
|
}
|
|
global HG_ngeqs = e(ngeqs)
|
|
global HG_inter = e(inter)
|
|
global HG_dots = 0
|
|
matrix M_nbrf = e(nbrf)
|
|
matrix M_nrfc = e(nrfc)
|
|
matrix M_ip = J(1,$HG_tprf+2,1)
|
|
matrix M_nffc = e(nffc)
|
|
local tprf = $HG_tprf
|
|
if `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)
|
|
*matrix M_chol = e(chol)
|
|
local l = M_nrfc[1,1] + 1 /* loop */
|
|
local k = M_nrfc[2,1] + 1 /* r. eff. */
|
|
if $HG_tplv>1{
|
|
while `l'<=M_nrfc[1,2]{
|
|
while `k'<=M_nrfc[2,2]{
|
|
* disp "loop " `l' " random effect " `k'
|
|
local w = M_nip[2,`k']
|
|
|
|
/* same loc and prob as before? */
|
|
local found = 0
|
|
local ii=M_nrfc[2,1] + 1
|
|
while `ii'<`k'{
|
|
if `w'==M_nip[2,`ii']{
|
|
local found = 1
|
|
}
|
|
local ii = `ii'+1
|
|
}
|
|
|
|
|
|
capture matrix M_zps`w' =e(zps`w')
|
|
|
|
* disp "M_zlc`w'"
|
|
matrix M_zlc`w'=e(zlc`w')
|
|
local k = `k' + 1
|
|
}
|
|
local l = `l' + 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{
|
|
capture 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_noC2
|
|
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_linko
|
|
global HG_nolog
|
|
global HG_lvolo
|
|
global HG_oth
|
|
global HG_mlog
|
|
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_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_tpwt
|
|
global HG_ethr
|
|
global HG_mult
|
|
global HG_lzpr
|
|
global HG_zip
|
|
global HG_cip
|
|
global HG_comp
|
|
global HG_pwt
|
|
global HG_befB
|
|
global HG_smlog
|
|
global HG_cn
|
|
capture drop macro HG_co*
|
|
end
|