*! clhet_d2 1.1.0 13Aug2007 *! author arh program define clhet_d2 version 9.2 args todo b lnf g negH tempvar theta1 theta2 nobs num den last mleval `theta1' = `b', eq(1) mleval `theta2' = `b', eq(2) quietly { local id $CLHET_ID local clustid $CLHET_CLUSTID by `id': gen double `num' = cond(_n==_N,exp(sum($ML_y1*`theta1'*exp(`theta2'))),.) if $ML_samp by `id': gen double `den' = cond(_n==_N,sum(exp(`theta1'*exp(`theta2'))),.) if $ML_samp by `id': gen `last' = 1 if _n==_N & $ML_samp mlsum `lnf' = $CLHET_WGT * ln(`num'/`den') if `last' ==1 if (`todo'==0 | `lnf'>=.) exit tempvar pr g1 g2 v vsum tempname d1 d2 ** Calculate probabilities ** by `id': gen double `pr' = sum(exp(`theta1'*exp(`theta2'))) if $ML_samp by `id': replace `pr' = exp(`theta1'*exp(`theta2')) / `pr'[_N] if $ML_samp ** Calculate scores for eq1 ** gen double `g1' = ($ML_y1 - `pr') * exp(`theta2') if $ML_samp mlvecsum `lnf' `d1' = $CLHET_WGT * `g1', eq(1) by `id': gen double `v' = cond(_n==_N,sum($ML_y1*`theta1'),.) if $ML_samp by `id': gen double `vsum' = cond(_n==_N,sum(`pr'*`theta1'),.) if $ML_samp ** Calculate scores for eq2 ** gen double `g2' = (`v' - `vsum') * exp(`theta2') if $ML_samp mlvecsum `lnf' `d2' = $CLHET_WGT * `g2' if `last' == 1, eq(2) matrix `g' = (`d1',`d2') if (`todo'==1 | `lnf'>=.) exit tempvar xc xp xcxpm local k1: word count $CLHET_X local k2: word count $CLHET_HET local k = `k1' + `k2' ** Calculate scores for eq1 ** local i = 1 foreach var of global CLHET_X { capture drop `xc' `xp' by `id': gen double `xc' = cond(_n==_N,sum(`var'*$ML_y1),.) if $ML_samp by `id': gen double `xp' = cond(_n==_N,sum(`var'*`pr'),.) if $ML_samp tempvar xcxp`i' gen double `xcxp`i'' = (`xc' - `xp') * exp(`theta2') if $ML_samp local scores `scores' `xcxp`i'' local i = `i' + 1 } ** Calculate scores for eq2 ** by `id': replace `xc' = cond(_n==_N,sum(`theta1'*$ML_y1),.) if $ML_samp by `id': replace `xp' = cond(_n==_N,sum(`theta1'*`pr'),.) if $ML_samp foreach var of global CLHET_HET { tempvar xcxp`i' gen double `xcxp`i'' = (`xc' - `xp') * exp(`theta2') * `var' if $ML_samp local scores `scores' `xcxp`i'' local i = `i' + 1 } ** Sum scores over clusters ** if "`clustid'" != "" { sort `clustid' local scores forvalues i = 1(1)`k' { by `clustid': replace `xcxp`i'' = cond(_n==_N,sum($CLHET_WGT * `xcxp`i''),.) if $ML_samp local scores `scores' `xcxp`i'' } sort `id' } ** Calculate OPG matrix ** if "`clustid'" != "" { matrix accum `negH' = `scores', noconst } else if "$CLHET_WGTTYP" == "iweight" | "$CLHET_WGTTYP" == "pweight" { matrix accum `negH' = `scores' [iw=$CLHET_WGT^2], noconst } else { matrix accum `negH' = `scores' [iw=$CLHET_WGT], noconst } } end