version 13 mata function avcov(string scalar covmat) { cov = st_matrix(covmat) nc = rows(cov) covvector = J( (nc*(nc+1)/2)-nc,1,.) s = 1 k = 1 tag = J(nc,nc,0) for (j=1; j<=rows(cov); j++) { for (k=1; k<=rows(cov); k++) { if (s <= rows(covvector)) { if ( (j!=k) & (tag[k,j]!= 1) ) { tag[j,k] = 1 covvector[s,1] = cov[j,k] s++ } } } } meancov = mean(covvector) st_numscalar("avcov", meancov) } void greenland_fn(string scalar rr1, string scalar v1, string scalar tot, string scalar cases, string scalar studytype1) { real colvector b, dose, se, n, A, V, cx , ex, sx, sx_1, fitcontrols, SE real scalar i, m1, N, n0, api, a0i, SINCR, DCA, NUMCOR real matrix H1 , H2, AP, INCR, A1, C, X, PASSA, PASSN, R st_view(rr=., .,rr1) st_view(v=., ., v1) st_view(n=., ., tot, .) A = st_data(., cases) study = st_numscalar(studytype1) study if (study==1|study==3) { n = A + n } b = log(rr) se = sqrt(v) tag0 = (se:==0) tag1 = (se:!=0) tagh = (1::rows(A)) rh = select(tagh, tag1)' m1 = colsum(A) N = colsum(n) n0 = select(n, tag0) rg = select(tagh,tag0) // Loop until converence (no more changes of fitted cases) maxiter = 1000 SINCR = 1 converged = 1 countiter = 0 while (abs(SINCR)>1e-5) { api = colsum(select(A, tag1)) a0i = m1 - api ex = J(rows(A), 1,.) if (study==1) { cx = (1:/A) + 1:/(n:-A) for (i=1; i<=rows(A); i++) { ex[i] = b[i] + log(a0i)+log(n[i]-A[i])-log(A[i])-log(n0-a0i) } } if (study==2|study==3) { cx = (1:/A) for (i=1; i<=rows(A); i++) { ex[i] = b[i] + log(a0i)+log(n[i])-log(A[i])-log(n0) } } H = J(rows(A),rows(A),cx[rg]) + diag(cx) H = H[(rh),(rh)] AP = select(A, tag1) + invsym(H)*select(ex, tag1) INCR = invsym(H)*select(ex, tag1) SINCR = colsum(INCR) DCA = m1-sum(AP) countap = (1::rows(AP)) x = 1 for (i=1; i<=rows(A); i++) { if (se[i]==0) { A[i] = DCA } if (se[i]!=0) { A[i] = AP[x] x++ } } countiter++ if(countiter>=maxiter) { printf("{err:not converged}") displayflush() converged = 0 } } // Variances sx = J(rows(A), 1,.) // case-control data if (study==1) { fitcontrols = n :- A sx_1 = sqrt(1:/A :+ 1:/fitcontrols :+ 1/A[rg] :+ 1/fitcontrols[rg]) } // cohort data (cumulative incidence data) if (study==3) { sx_1 = sqrt(1:/A :- 1:/n :+ 1/A[rg] :- 1/n0) fitcontrols = n :- A } // cohort data (incidence rate data) if (study==2) { sx_1 = sqrt(1:/A :+ 1/A[rg]) fitcontrols = n } sx = select(sx_1, tag1) SE = select(se, tag1) // Covariances if (study==1) { NUMCOR = (1/A[rg] + 1/fitcontrols[rg]) } if (study==3) { NUMCOR = (1/A[rg] - 1/n0) } if (study==2) { NUMCOR = (1/A[rg]) } // fill in the variance-covariance matrix _C = diag(select(v,tag1)) SE = diagonal(sqrt(_C)) for (j =1; j<=rows(_C); j++) { for (i =1; i<=rows(_C); i++) { if (i != j) _C[i,j] = ( NUMCOR / ( sx[j]*sx[i]) ) * (SE[j]*SE[i]) } } // average covariance (mean of out of diagonal elements of C) nc = rows(_C) covvector = J((nc*(nc+1)/2)-nc,1,.) s = 1 tag = J(nc,nc,0) for (j=1; j<=rows(_C); j++) { for (k=1; k<=rows(_C); k++) { if (s <= rows(covvector)) { if ( (j!=k) & (tag[k,j]!= 1) ) { tag[j,k] = 1 covvector[s,1] = _C[j,k] s++ } } } } _avcov = mean(covvector) // correlation matrix _R = corr(_C) pA = A pN = fitcontrols st_matrix("cases", pA) st_matrix("noncases", pN) st_matrix("C", _C) st_matrix("R", _R) st_numscalar("avcov", _avcov) st_numscalar("niters", countiter) st_numscalar("converged", converged) } void hamling_fn(todo, p, rr, v, p0, z0, st, lf, g, H) { a0 = p[1,1] b0 = p[1,2] rrs = J(rows(rr)-1,1,.) vs = J(rows(rr)-1,1,.) j = 1 for (i =1; i<=rows(rr); i++) { if (rr[i] != 1) { rrs[j] = rr[i] vs[j] = v[i] j = j+1 } } if (st == 1) { vexs = (vs:-1/a0:-1/b0) ai = (rrs:*(a0/b0):+1):/vexs bi = (b0:/(a0:*rrs):+1):/vexs } if (st == 3) { vexs = (vs:-1/a0:+1/b0) ai = (1:-rrs:*(a0/b0)):/vexs bi = (b0:/(a0:*rrs):-1):/vexs } if (st == 2) { vexs = (vs:-1/a0) ai = 1:/vexs bi = (b0:/(a0:*rrs)):/vexs } p1 = b0 / sum((b0\bi)) z1 = sum(bi) / sum(ai) lf = ((p0-p1))^2 + ((z0-z1))^2 // Create vectors of cases and noncases cases = J(rows(rr),1,.) noncases = J(rows(rr),1,.) j=1 for (i =1; i<=rows(rr); i++) { if (rr[i] == 1) { cases[i] = a0 noncases[i] = b0 } if (rr[i] != 1) { cases[i] = ai[j] noncases[i] = bi[j] j = j + 1 } } st_matrix("cases", cases) st_matrix("noncase", noncases) } function min_hamling_fn(string scalar rr1, string scalar v1 , string scalar p1, string scalar z1, string scalar a01, string scalar b01, string scalar studytype1, string scalar refgroup) { st_view(rr=., .,rr1) st_view(v=., ., v1) p0 = st_numscalar(p1) z0 = st_numscalar(z1) a0 = st_numscalar(a01) b0 = st_numscalar(b01) st = st_numscalar(studytype1) rg = st_numscalar(refgroup) // Initial values. This is important with Nelder-Mead. initp = (a0,b0) delta = (a0 /10, b0/10) S = optimize_init() optimize_init_evaluator(S, &hamling_fn()) optimize_init_evaluatortype(S, "d0") optimize_init_argument(S, 1, rr) optimize_init_argument(S, 2, v) optimize_init_argument(S, 3, p0) optimize_init_argument(S, 4, z0) optimize_init_argument(S, 5, st) optimize_init_params(S, initp) optimize_init_technique(S, "nm") optimize_init_nmsimplexdeltas(S,delta) optimize_init_which(S,"min") optimize_init_conv_ptol(S, 1e-10) optimize_init_conv_vtol(S, 1e-12) optimize_init_conv_nrtol(S, 1e-10) p = optimize(S) result = optimize_result_params(S) niters = optimize_result_iterations(S) converged = optimize_result_converged(S) S = . a0f = p[1,1] b0f = p[1,2] rrs = J(rows(rr)-1,1,.) vs = J(rows(rr)-1,1,.) j = 1 for (i =1; i<=rows(rr); i++) { if (rr[i] != 1) { rrs[j] = rr[i] vs[j] = v[i] j = j+1 } } if (st == 1) { vexs = (vs:-1/a0f:-1/b0f) ai = (rrs:*(a0f/b0f):+1):/vexs bi = (b0f:/(a0f:*rrs):+1):/vexs } if (st == 3) { vexs = (vs:-1/a0f:+1/b0f) ai = (1:-rrs:*(a0f/b0f)):/vexs bi = (b0f:/(a0f:*rrs):-1):/vexs } if (st == 2) { vexs = (vs:-1/a0f) ai = (1:/vexs) bi = (b0f:/(a0f:*rrs)):/vexs } cases = J(rows(rr),1,.) noncases = J(rows(rr),1,.) j=1 for (i =1; i<=rows(rr); i++) { if (rr[i] == 1) { cases[i] = a0f noncases[i] = b0f } if (rr[i] != 1) { cases[i] = ai[j] noncases[i] = bi[j] j = j + 1 } } // create the variance-covariance matrix if (st == 1) { _cov = 1/a0f+1/b0f _se = sqrt(1:/ai :+ 1:/bi :+ 1/a0f :+ 1/b0f) st_numscalar("cov", 1/a0f+1/b0f) } if (st == 3) { _cov = 1/a0f-1/b0f _se = sqrt(1:/ai :- 1:/bi :+ 1/a0f :- 1/b0f) st_numscalar("cov", 1/a0f-1/b0f) } if (st == 2) { _cov = 1/a0f _se = sqrt(1:/ai :+ 1/a0f) st_numscalar("cov", 1/a0f) } _C = diag(vs) SE = sqrt(vs) for (j =1; j<=rows(_C); j++) { for (i =1; i<=rows(_C); i++) { if (i != j) _C[i,j] = ( _cov / ( _se[j]*_se[i]) ) * (SE[j]*SE[i]) } } // create the correlation matrix _R = corr(_C) // Return results st_numscalar("niters", niters) st_numscalar("converged", converged) st_matrix("cases", cases) st_matrix("noncases", noncases) st_matrix("C", _C) st_matrix("R", _R) st_numscalar("avcov", _cov) } function glsest(string scalar y, string scalar x, string scalar cov) { real matrix Y, X, C, BC, VB real scalar Q, LL Y = st_matrix(y) X = st_matrix(x) C = st_matrix(cov) // Variance and betas VB = invsym(X'*invsym(C)*X) BC = invsym(X'*invsym(C)*X)*X'*invsym(C)*Y // Q goodness of fit Q = (Y-X*BC)'*invsym(C)*(Y-X*BC) C2 = diag(C) // log-likelihood LL = -.5*rows(Y)*log(2*pi())-.5*log(det(C))-.5*Q st_matrix("r(BC)", BC) st_matrix("r(VB)", VB) st_numscalar("r(Q)", Q) st_numscalar("r(LL)", LL) st_matrix("r(COVAR)", C) } function crudest(string scalar logrr, string scalar cases, string scalar tot, real scalar study) { real colvector n, A, EXPB, B, OT, COVBV real scalar M_DIFF_C_A_RR real matrix C, R st_view(n=., ., tot, .) st_view(A=., ., cases, .) st_view(LRR=., ., logrr, .) RR = exp(LRR) OT = n - A // estimate crude beta coefficients if (study==1) { EXPB = (A:*OT[1]):/(A[1]:*OT) } if (study==2|study==3) { EXPB = (A:*n[1]):/(A[1]:*n) } B = log(EXPB) // estimate covariances of the crude beta coefficients if (study==1) { COVB = (1/A[1] + 1/OT[1]) } if (study==2) { COVB = (1/A[1]) } if (study==3) { COVB = (1/A[1] - 1/n[1]) } COVBV = J(rows(A)-1,rows(A)-1,COVB) COVBV = COVBV - diag(COVBV) // estimate variances of the crude beta coefficients sx = J(rows(A), 1,.) if (study==1) { sx_1 = (1:/A :+ 1:/OT :+ 1/A[1] :+ 1/OT[1] ) } if (study==2) { sx_1 = (1:/A :+ 1/A[1]) } if (study==3) { sx_1 = (1:/A :- 1:/n :+ 1/A[1] :- 1/n[1]) } sx = sx_1[|2,1 \ ., .|] C = diag(sx[|1,1 \ ., .|]) C = C + COVBV // estimate correlation matrix of the crude beta coefficients R = J(rows(C), cols(C),1) for (j =1; j<=rows(R); j++) { for (i=1; i<=rows(R); i++) { // if (i != j) R[i,j] = COVB / sqrt(C[i,j]*C[j,i]) if (i != j) R[i,j] = COVB / sqrt(sx[j]*sx[i]) } } // relative comparison between crude and adjusted relative risks (check assumption 1) // (crude RR - adjusted RR)/ crude RR * 100 DIFF_C_A_RR = (EXPB :- RR):/(EXPB) * 100 // this provides the percentage of the crude relative risks to be added or subtracted, depending on its // positive or negative sign to the crude relative risks to get the adjusted relative risks // calculate the average relative change (from crude to adjusted) // of the relative risks at different exposure level M_DIFF_C_A_RR = mean( abs(DIFF_C_A_RR[|2,1 \ ., .|] ) ) // I'll also get the maximum and minimum relative change (excluding the referent relative risk) st_matrix("r(RD_C_A)", DIFF_C_A_RR) st_numscalar("r(M_RD_C_A)", M_DIFF_C_A_RR) st_matrix("r(CR_C)", C) st_matrix("r(CR_R)", R) st_matrix("r(CR_B)", B) st_matrix("r(CR_EXPB)", EXPB) st_matrix("r(ADJ_EXPB)", RR) st_numscalar("r(RD_max)", max(DIFF_C_A_RR[|2,1\.,1|]) ) st_numscalar("r(RD_min)", min(DIFF_C_A_RR[|2,1\.,1|]) ) } function blockaccum(string scalar a, string scalar b) { real matrix A, B, GA A = st_matrix(a) B = st_matrix(b) GA = blockdiag(A,B) st_matrix("r(CACC)", GA) } end *! N.Orsini v.1.0.0 10sep18 capture program drop drmeta_cov program drmeta_cov, eclass version 13 syntax varlist [if] [in] [ , s(varname numeric) tot(varname numeric) c(varname numeric) ecovmethod(string) /// CRudes pecohort ptcohort casecontrol meandiff stdmeandiff ts(varname numeric) vwls meancov(varname numeric) matrixcov(string) varlistcov(varlist) detail ] tempvar b dose se n case control v rr tempname studytype C R tokenize `varlist' local depname "`1'" mac shift local xname `*' // to use the option if/in marksample touse, strok novarlist preserve qui keep if `touse' & `depname' != . // check observation qui count if `touse' local nobs = r(N)-1 // get the arguments parse "`varlist'" , parse(" ") qui gen double `b' = `1' qui gen double `rr' = exp(`b') // get the type of study (either single study or multiple study) if `ts'[1] == 1 scalar `studytype' = 1 if `ts'[1] == 2 scalar `studytype' = 2 if `ts'[1] == 3 scalar `studytype' = 3 if `ts'[1] == 4 scalar `studytype' = 4 if `ts'[1] == 5 scalar `studytype' = 5 if "`ts'" == "" { if "`casecontrol'" != "" scalar `studytype' = 1 if "`ptcohort'" != "" scalar `studytype' = 2 if "`pecohort'" != "" scalar `studytype' = 3 if "`meandiff'" != "" scalar `studytype' = 4 if "`stdmeandiff'" != "" scalar `studytype' = 5 } if "`s'" != "" { qui gen double `se' = `s' qui gen double `v' = `se'^2 } else { tempvar se v qui gen `se' = . qui gen `v' = . } tempname vcopy mkmat `v' if `b' != 0, matrix(`vcopy') qui count if `v' == . if r(N) != 0 local var = 0 else local var = 1 if (`studytype'==4) { tempvar sd spi v_md cov_md se_md tag_ref qui gen double `n' = `tot' qui gen double `sd' = `c' qui gen `tag_ref' = `b' != 0 // identify the referent as Mean Difference = 0 sort `tag_ref' qui gen double `spi' = cond(_n==_N,sum( (`n'-1)*`sd'^2)/sum(`n'-1),.) qui replace `spi' = `spi'[_N] qui replace `v' = ((`n'+`n'[1])/(`n'*`n'[1]))*`spi' qui gen double `cov_md' = `sd'[1]^2/(`n'[1]) qui replace `v' = 0 if _n == 1 qui replace `se' = sqrt(`v') tempname mcov C R C1 C2 V1 V2 scalar `mcov' = `cov_md'[1] mat `C1' = J(`c(N)'-1, `c(N)'-1, `mcov') mat `C2' = `C1' - diag(vecdiag(`C1')) mkmat `v' if `b' != 0 , matrix(`V1') mat `V2' = diag(`V1') mat `C' = `C2' + `V2' mata: R = corr(st_matrix("`C'")) mata: st_matrix("_COR", R) mat `R' = _COR mat drop _COR } if (`studytype'==5) { tempvar smd sd spi v_smd se_smd tag_ref seq tempname n0 sumn qui gen double `n' = `tot' qui gen double `sd' = `c' qui gen `tag_ref' = `b' != 0 qui su `n' if `b' == 0 scalar `n0' = r(mean) qui su `n' scalar `sumn' = r(sum) sort `tag_ref' qui gen double `spi' = cond(_n==_N,sum( (`n'-1)*`sd'^2)/sum(`n'-1),.) qui replace `spi' = `spi'[_N] qui gen double `v_smd' = 1/`n'+1/`n0' + (`b'^2/(2*`sumn')) qui replace `v_smd' = 0 if `b' == 0 qui gen `se_smd' = sqrt(`v_smd') tempname V1 covij mkmat `v_smd' if `b' != 0 , matrix(`V1') mat `C' = diag(`V1') qui gen `seq' = _n qui levelsof `seq' if `b' != 0, local(levels) tokenize `levels' forv i = 1/`nobs' { forv j = 1/`nobs' { scalar `covij' = 1/`n0' + ((`b'[``i'']*`b'[``j''])/(2*`sumn')) if (`i' != `j') mat `C'[`i', `j'] = `covij' } } mata: R = corr(st_matrix("`C'")) mata: st_matrix("_COR", R) mat `R' = _COR mat drop _COR } if "`meancov'" == "" & "`matrixcov'" == "" & "`varlistcov'" == "" & inlist(`studytype',4,5)!=1 { qui gen double `n' = `tot' qui gen double `case' = `c' if (`studytype'==1) qui replace `n' = `tot'-`c' *list `n' `tot' `c' `xname' tempname p z tempname a0 b0 a1 b1 tc tnc // Get K X 2 Table of Summarized Data (entry as variables) qui su `case' if `se' != 0 scalar `a1' = r(sum) qui su `case' if `se' == 0 scalar `a0' = r(sum) qui su `n' if `se' != 0 scalar `b1' = r(sum) qui su `n' if `se' == 0 scalar `b0' = r(sum) scalar `tc' = `a0' + `a1' scalar `tnc' = `b0' + `b1' scalar `p' = `b0' / `tnc' scalar `z' = `tnc' / `tc' tempname crefg scalar `crefg' = 1 } tempname FCASE FNCASE // Unless one specify directly the average covariance // Call mata function to calculate covariances using the Greenland and Longnecker method if "`meancov'" == "" & "`matrixcov'" == "" & "`varlistcov'" == "" & inlist(`studytype',4,5)!=1 { if "`ecovmethod'" == "GL" qui mata: greenland_fn("`rr'", "`v'", "`n'", "`case'", "`studytype'") else qui mata: min_hamling_fn("`rr'", "`v'", "`p'", "`z'","`a0'","`b0'", "`studytype'", "`crefg'") mat `C' = C mat `R' = r(R) *mat `FCASE' = r(fitA) *mat `FNCASE' = r(fitB) *svmat `FCASE', name(_A) *svmat `FNCASE' , name(_B) *qui gen NT = _A + _B *eret matrix psc = `FCASE' *eret matrix psnc = `FNCASE' } if "`meancov'" != "" { // Create the var/cov and correlation matrix tempname mcov C1 C2 V1 V2 scalar `mcov' = `meancov'[1] mat `C1' = J(`c(N)'-1, `c(N)'-1, `mcov') mat `C2' = `C1' - diag(vecdiag(`C1')) mkmat `v' if `b' != 0 , matrix(`V1') mat `V2' = diag(`V1') mat `C' = `C2' + `V2' mata: R= corr(st_matrix("`C'")) mata: st_matrix("_COR", R) mat `R' = _COR mat drop _COR } if "`matrixcov'" != "" { // Create the var/cov and correlation matrix mat `C' = `matrixcov' mata: R= corr(st_matrix("`C'")) mata: st_matrix("_COR", R) mat `R' = _COR mat drop _COR } if "`varlistcov'" != "" { // get only variable names corresponding to non-referent exposure levels local nvariables = `c(N)'-1 forv i=1/`nvariables' { local subsetv = "`subsetv' `:word `i' of `varlistcov''" } mkmat `subsetv' if `b' != 0 , mat(`C') mata: R= corr(st_matrix("`C'")) mata: st_matrix("_COR", R) mat `R' = _COR mat drop _COR } tempname VB BC PASS X XP B bc vb pval ll Q fitcases qui mkmat `xname' if `b' != 0, matrix(`X') qui mkmat `b' if `b' != 0, matrix(`B') tempname ZC mat `ZC' = `X' /* if "`meancov'" == "" & "`matrixcov'" == "" & "`varlistcov'" == "" { svmat `FCASE', name(`fitcases') } */ // Estimate beta corrected using weighted least squares for correlated outcomes // Generalized Least Squares * noisily di _n in w "Call Mata glsest()" // Zero-covariance options (replaced 0 off-diagonal) * In case of missing covariance, the out of diagonal matrix is set to zero. tempname missingcovariance scalar `missingcovariance' = 0 mata: st_numscalar("`missingcovariance'", hasmissing(st_matrix("`C'"))) if `missingcovariance' != 0 { tempname CZ if (`var'==1) { mat `CZ' = diag(`vcopy') mat `C' = `CZ' } else { di as err "missing information to reconstruct the variance/covariance matrix" exit 198 } } if "`vwls'" != "" { * Replace the previous C with a diagonal matrix (0 off-diagonal elements) tempname CZ mat `CZ' = diag(vecdiag(`C')) mat `C' = `CZ' } mata: glsest("`B'", "`X'", "`C'") mat `VB' = r(VB) mat `BC' = r(BC) scalar `Q' = r(Q) scalar `ll' = r(LL) tempname b V mat `V' = r(VB) mat `b' = r(BC)' mat rownames `b' = `depname' mat colnames `b' = `xname' mat rownames `V' = `xname' mat colnames `V' = `xname' ereturn post `b' `V' , dep(`depname') obs(`nobs') if "`detail'" != "" ereturn display // Get crude (un-adjusted) estimates of the betas and var-cov matrix if "`crudes'" != "" { * noisily di in w _n "Call Mata crudest()" mata: crudest("`b'", "`case'", "`n'", `typestudy') tempname RD_min RD_max CR_C CR_EXPB CR_B RD_C_A M_RD_C_A CR_R ADJ_EXPB MEANDIFF_C_A DIFF_C_A mat `CR_C' = r(CR_C) mat `CR_R' = r(CR_R) mat `CR_EXPB' = r(CR_EXPB) mat `ADJ_EXPB' = r(ADJ_EXPB) mat `CR_B' = r(CR_B) mat `RD_C_A' = r(RD_C_A) scalar `M_RD_C_A' = r(M_RD_C_A) scalar `RD_min' = r(RD_min) scalar `RD_max' = r(RD_max) // Compare crude and adjusted correlation matrix mata: checklowhigh("`CR_R'", "`R'") scalar `MEANDIFF_C_A' = r(meandiffca) mat `DIFF_C_A' = r(diffca) } matrix colnames `X' = doses matrix colnames `B' = betas ereturn matrix x = `X' ereturn matrix B = `B' ereturn matrix R = `R' ereturn scalar N = c(N)- 1 if "`crudes'" != "" { ereturn mat CR_C = `CR_C' ereturn mat CR_EXPB = `CR_EXPB' ereturn mat ADJ_EXPB = `ADJ_EXPB' ereturn mat CR_B = `CR_B' ereturn matrix RD_C_A = `RD_C_A' ereturn scalar M_RD_C_A = `M_RD_C_A' ereturn scalar RD_min = `RD_min' ereturn scalar RD_max = `RD_max' ereturn mat CR_R = `CR_R' ereturn scalar MEANDIFF_C_A = `MEANDIFF_C_A' ereturn matrix DIFF_C_A = `DIFF_C_A' } // saved results ereturn scalar ll = `ll' ereturn matrix BC = `BC' ereturn matrix VB = `VB' ereturn matrix C = `C' ereturn matrix Z = `ZC' eret scalar chi2_gf2 = `Q' end