[med-svn] [r-cran-epir] 01/10: New upstream version 0.9-87
Andreas Tille
tille at debian.org
Mon Oct 2 19:18:04 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-epir.
commit 78fa4718a0028f0fbca41438796cba337ad4fda0
Author: Andreas Tille <tille at debian.org>
Date: Mon Oct 2 20:43:25 2017 +0200
New upstream version 0.9-87
---
DESCRIPTION | 10 +-
MD5 | 54 +-
NAMESPACE | 2 +-
R/epi.2by2.R | 4862 ++++++++++++++++++++++++-------------------------
R/epi.ccc.R | 163 +-
R/epi.ccsize.R | 119 +-
R/epi.conf.R | 43 +-
R/epi.dsl.R | 28 +-
R/epi.equivb.R | 70 +-
R/epi.iv.R | 28 +-
R/epi.kappa.R | 37 +-
R/epi.mh.R | 28 +-
R/epi.nomogram.R | 4 +-
R/epi.smd.R | 13 +-
R/epi.tests.R | 38 +-
man/epi.2by2.Rd | 75 +-
man/epi.betabuster.Rd | 17 +-
man/epi.ccc.Rd | 89 +-
man/epi.ccsize.Rd | 85 +-
man/epi.cohortsize.Rd | 2 +-
man/epi.conf.Rd | 5 +-
man/epi.dsl.Rd | 8 +-
man/epi.edr.Rd | 38 +-
man/epi.empbayes.Rd | 34 +-
man/epi.iv.Rd | 8 +-
man/epi.meansize.Rd | 6 +-
man/epi.mh.Rd | 8 +-
man/epi.nomogram.Rd | 10 +-
28 files changed, 3112 insertions(+), 2772 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index f681091..22e2f15 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Package: epiR
-Version: 0.9-79
-Date: 2016-07-16
+Version: 0.9-87
+Date: 2017-06-30
Title: Tools for the Analysis of Epidemiological Data
-Author: Mark Stevenson <mark.stevenson1 at unimelb.edu.au> with contributions from Telmo Nunes, Cord Heuer, Jonathon Marshall, Javier Sanchez, Ron Thornton, Jeno Reiczigel, Jim Robison-Cox, Paola Sebastiani, Peter Solymos, Kazuki Yoshida, Geoff Jones, Sarah Pirikahu, Simon Firestone and Ryan Kyle
+Author: Mark Stevenson <mark.stevenson1 at unimelb.edu.au> with contributions from Telmo Nunes, Cord Heuer, Jonathon Marshall, Javier Sanchez, Ron Thornton, Jeno Reiczigel, Jim Robison-Cox, Paola Sebastiani, Peter Solymos, Kazuki Yoshida, Geoff Jones, Sarah Pirikahu, Simon Firestone and Ryan Kyle.
Maintainer: Mark Stevenson <mark.stevenson1 at unimelb.edu.au>
Description: Tools for the analysis of epidemiological data. Contains functions for directly and indirectly adjusting measures of disease frequency, quantifying measures of association on the basis of single or multiple strata of count data presented in a contingency table, and computing confidence intervals around incidence risk and incidence rate estimates. Miscellaneous functions for use in meta-analysis, diagnostic test interpretation, and sample size calculations.
Depends: R (>= 3.0.0), survival
@@ -11,6 +11,6 @@ Suggests: MASS (>= 3.1-20)
License: GPL (>= 2)
URL: http://fvas.unimelb.edu.au/veam
NeedsCompilation: no
-Packaged: 2016-07-16 09:08:17 UTC; Mark
+Packaged: 2017-06-30 07:54:55 UTC; Mark
Repository: CRAN
-Date/Publication: 2016-07-18 14:10:53
+Date/Publication: 2017-06-30 22:15:10 UTC
diff --git a/MD5 b/MD5
index 697053f..8cca1cd 100644
--- a/MD5
+++ b/MD5
@@ -1,18 +1,18 @@
-fa3ebdfb71ffc114024922f34d3ae5d8 *DESCRIPTION
-768be02285ea0371a36370a0ba64c50f *NAMESPACE
-c4421c06e63ba15a0690596f66349fd6 *R/epi.2by2.R
+3153e775b66b924b25a378df61848059 *DESCRIPTION
+7fef6704a714f9fc47a477f6b751aaab *NAMESPACE
+36914e5e5904e60bd5bd33af6cb05a45 *R/epi.2by2.R
90797cfa53b823b298af4c32eb3435bf *R/epi.RtoBUGS.R
a9a4deaaec9cd9435529455159385225 *R/epi.about.R
35dd233e3feeceefc29040363acdbadd *R/epi.asc.R
88fc1fad29654a3b8cff28d58bd332d6 *R/epi.betabuster.R
89e1ade6b7a25729a3e7db833abd2739 *R/epi.bohning.R
-b0409b337ea6dd9275f69b8c9374f616 *R/epi.ccc.R
-c03097a5d0b255638bc857e398a5a186 *R/epi.ccsize.R
+b8e64c719988731209aa1fbc7fdcc5aa *R/epi.ccc.R
+fdcbfe2ac48ef09a6028cb3ab86293e2 *R/epi.ccsize.R
52927695dc6e0d0002c6ab70a12ac926 *R/epi.cluster1size.R
aed994d4e585e092089481c32bc12835 *R/epi.cluster2size.R
c3ff42af84bb01e927867d54b4ac4334 *R/epi.clustersize.R
e52bded5499df4fecafc409235593c79 *R/epi.cohortsize.R
-f4fd3d1b84ce96671b0e0c1c08433990 *R/epi.conf.R
+8e08de8792494503161a98b7e38d9ef9 *R/epi.conf.R
d535d0aaae250f95c38e00ccbba0b7ca *R/epi.convgrid.R
4eb1a96f7427ea81382d37754d717f49 *R/epi.cp.R
0bce821540346b1e58e640d7334c043b *R/epi.cpresids.R
@@ -21,21 +21,21 @@ e3d7b38e88eb943c976edb0f38350174 *R/epi.descriptives.R
da3832a85a8085b34f75455e6defbf24 *R/epi.dgamma.R
4788877af77c92892dc43e324ccd05c5 *R/epi.directadj.R
85be50061d94e87a31c52f3287e8e492 *R/epi.dms.R
-4a8af6911e7c482c1235fdca46584d68 *R/epi.dsl.R
+c4af10a5115fd3bb7713694393c9a3d3 *R/epi.dsl.R
276cc7e048b9b12cad3c16fe60190600 *R/epi.edr.R
658381258fe39d7cdbe6253c66a49034 *R/epi.empbayes.R
-25a7d22e5c980e9e3d39a47409d03faf *R/epi.equivb.R
+b16940bceb6fbbefcc39988bf2dee103 *R/epi.equivb.R
6b7b26071dd172c6b73408f5301b9c21 *R/epi.equivc.R
e935ed017215d39b2225f61b23de3bfd *R/epi.herdtest.R
566a1b7408b9ecb76c20bb182fb11d18 *R/epi.indirectadj.R
9c2fdb99c5701dca5359dca3e651e5a2 *R/epi.insthaz.R
8198e262aafd2a83bba29777a1189a99 *R/epi.interaction.r
-2a952ef6d504f5a1d6d1e39fd3d42666 *R/epi.iv.R
-098e035a862a53f70d3c0490384bc8e1 *R/epi.kappa.R
+c6d1bbc1733a57b2ed6973bbc9a2689a *R/epi.iv.R
+0231853e687a5153f9e9bb186bfd5fed *R/epi.kappa.R
dd5a6b971d1652170e84fa8a709215a9 *R/epi.ltd.R
20acf4c5b5334be8d1d66a8c83bcdace *R/epi.meansize.R
-ea1981a5c3db03399670c25ae1cbca6a *R/epi.mh.R
-3d98611d0dba6b2b3d0fc12fac16b800 *R/epi.nomogram.R
+27df85ca4570d0077ec68ff552739d13 *R/epi.mh.R
+064a3d44cfc040bc957d37d9dd6ac64b *R/epi.nomogram.R
fda5a6132e84888d9ae9ec0e3054aee6 *R/epi.noninfb.R
a724e7cb4906adc1328f3226ef0d6a6b *R/epi.noninfc.R
dd89f9509954970ef09f36b06192b96c *R/epi.occc.R
@@ -46,30 +46,30 @@ b1c0bdf50b56a4b9df09ac89f2de0b98 *R/epi.pooled.R
3f91e8c64f3dda591ed7f2d98dc5d39c *R/epi.prev.R
aeafef81811418812f4d895466a1e480 *R/epi.propsize.R
b149e431ad851995742d356767b1a1ab *R/epi.simplesize.R
-42ff19ebe373602acc39ab1a1dc7d244 *R/epi.smd.R
+4e719a2b9c4ba572f0ee3c3d70d54190 *R/epi.smd.R
32b646ecabba4110b2566b44d1879d49 *R/epi.stratasize.R
3c43a7f1e6a661729b3668d33b4c2358 *R/epi.supb.R
535c35e8a4673060a17e60183c257fa5 *R/epi.supc.R
868c42db0fc929ef5c2fdc7406e05c6f *R/epi.survivalsize.R
-8f5b83fec83ff62be7024a30faa505b7 *R/epi.tests.R
+c5d0ef995dc9b3280ccca3697a608c37 *R/epi.tests.R
00c26a92f3e827fd67862cf8434ecad2 *R/zzz.R
e21ab6f2a8b2c8ed12468ce39757977e *data/epi.SClip.RData
fd9920dce74d1e6cce1932570a9e85f4 *data/epi.epidural.RData
64af3548130a5495e0aed3c2b58f864f *data/epi.incin.RData
-1118f4f95414e924666264d8455fc0af *man/epi.2by2.Rd
+9b78dd79a673dd0eab9f81468e220af3 *man/epi.2by2.Rd
f42bb15fa9bf5d14f728c1c1aa147e36 *man/epi.RtoBUGS.Rd
189a2a8bdb0082ceeaf7d721ef637686 *man/epi.SClip.Rd
c0207f2c0a218b3c799cfd6e5b0df220 *man/epi.about.Rd
5779280680d12e1355f64bf0984401fe *man/epi.asc.Rd
-ebbb59b1d73bff580541aec8b587b077 *man/epi.betabuster.Rd
+a3f56b6074f71a9f6a5356d298d20a01 *man/epi.betabuster.Rd
7e06c95f246ea6a933847b73c2c0288a *man/epi.bohning.Rd
-f9891e1869974984477f827669561624 *man/epi.ccc.Rd
-56e75e4d60846130fcd908078f0f149f *man/epi.ccsize.Rd
+3ba388722aeff534ebc8661ac89051f0 *man/epi.ccc.Rd
+7142895a2342a283b2c732428536f340 *man/epi.ccsize.Rd
2758ba80c5bde26752e8b5de29e03161 *man/epi.cluster1size.Rd
b86f88dbb6fdfca830a2afbc9a764f30 *man/epi.cluster2size.Rd
572fe905ca4759a69445fda1de10d48e *man/epi.clustersize.Rd
-0c278ab9489f84e427b6182205f1796a *man/epi.cohortsize.Rd
-ca14fcd917a902eebcd9587dbd9fecb2 *man/epi.conf.Rd
+a83f74d10ec9b3bf0f9cb140d8f6fcba *man/epi.cohortsize.Rd
+ddc1befc74ee119935f03d93a3301e04 *man/epi.conf.Rd
07e702fd65b9cc6710d27c133b94f89f *man/epi.convgrid.Rd
b8c620a7bf19cdff691279488646ab37 *man/epi.cp.Rd
11dc595f8d992cd9b43c0c1eb83879e7 *man/epi.cpresids.Rd
@@ -78,9 +78,9 @@ b8c620a7bf19cdff691279488646ab37 *man/epi.cp.Rd
8b3b0014ef1fd0e3fc8da5c53b70e8ff *man/epi.dgamma.Rd
ca643841b6f39fe1c48f335b14db1b5d *man/epi.directadj.Rd
9424e6c2bec3dea4d79f1551b8080901 *man/epi.dms.Rd
-7b5172ac33a3a2452fcde4a664f95ffc *man/epi.dsl.Rd
-b3474fa80a9a967c3a8848a1a9936e5f *man/epi.edr.Rd
-8df7a37faf9dd8ef2d3cbe6f6ff92d9a *man/epi.empbayes.Rd
+2ec45cd68f08c7eff379cf0a62c96bed *man/epi.dsl.Rd
+b19c83df0d6b24e3c9acdc9bf99ddfce *man/epi.edr.Rd
+f3402d302b0f91d5659aeedf917a2bd2 *man/epi.empbayes.Rd
623bf229ccd13149e887c7760b3baf44 *man/epi.epidural.Rd
16330eaf3ebe580b208e8150534c6e80 *man/epi.equivb.Rd
0bad95a3d47cef2edcb385c9a9c50d1a *man/epi.equivc.Rd
@@ -89,12 +89,12 @@ e9184315369aa93b32e1126e1487cf95 *man/epi.incin.Rd
ae24ad247f63522997605f8be967f0cf *man/epi.indirectadj.Rd
c7d89bc6c96dc8dde6c4793982960c85 *man/epi.insthaz.Rd
f5eb9a339ceb32787522e1b10cfd2693 *man/epi.interaction.Rd
-35859ed56cd79a40bd8f87855160ad9a *man/epi.iv.Rd
+ede50c148a4b3ab71a74733a0ac953db *man/epi.iv.Rd
866584c8d65a7cf56e3e3a85b0250096 *man/epi.kappa.Rd
85eb0f47054239387557a52af03a674f *man/epi.ltd.Rd
-8f48415a3afaa5ae47900f7be8de5d25 *man/epi.meansize.Rd
-bc96a2d036ef70851bb08581300677ed *man/epi.mh.Rd
-bc1165287dfa87662f653457a7a5aac6 *man/epi.nomogram.Rd
+28437d1309ead1e42782b863a71b9b6f *man/epi.meansize.Rd
+867e8fc4d3f310a9f044d02309d6a5b4 *man/epi.mh.Rd
+22c11e69793964a066401af0d99903dd *man/epi.nomogram.Rd
f10943cdc98bd05521d53f5218844743 *man/epi.noninfb.Rd
dfa590480de8b6d29cac5616c47846ea *man/epi.noninfc.Rd
1fdb2c4457d7da77f04f42d432c19d58 *man/epi.occc.Rd
diff --git a/NAMESPACE b/NAMESPACE
index 4c149a2..bc5b88e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -13,5 +13,5 @@ import(survival)
importFrom(BiasedUrn, dFNCHypergeo)
importFrom("graphics", "hist")
importFrom("methods", "slot")
-importFrom("stats", "addmargins", "complete.cases", "cor", "cov", "fisher.test", "mantelhaen.test", "model.matrix", "pbeta", "pbinom", "pchisq", "phyper", "pnorm", "pt", "qbeta", "qbinom", "qchisq", "qf", "qgamma", "qnorm", "qpois", "qt", "quantile", "rpois", "sd", "uniroot", "var", "vcov")
+importFrom("stats", "anova", "aov", "addmargins", "complete.cases", "cor", "cov", "fisher.test", "mantelhaen.test", "model.matrix", "pbeta", "pbinom", "pchisq", "phyper", "pnorm", "pt", "qbeta", "qbinom", "qchisq", "qf", "qgamma", "qnorm", "qpois", "qt", "quantile", "rpois", "sd", "uniroot", "var", "vcov")
importFrom("utils", "packageDescription", "write.table")
\ No newline at end of file
diff --git a/R/epi.2by2.R b/R/epi.2by2.R
index 7d2a59d..2b36954 100644
--- a/R/epi.2by2.R
+++ b/R/epi.2by2.R
@@ -1,2475 +1,2467 @@
"epi.2by2" <- function(dat, method = "cohort.count", conf.level = 0.95, units = 100, homogeneity = "breslow.day", outcome = "as.columns"){
- ## Elwoood JM (1992). Causal Relationships in Medicine - A Practical System for Critical Appraisal. Oxford Medical Publications, London, p 266 - 293.
- ## Rothman KJ (2002). Epidemiology An Introduction. Oxford University Press, London, p 130 - 143.
- ## Hanley JA (2001). A heuristic approach to the formulas for population attributable fraction. J. Epidemiol. Community Health 55: 508 - 514.
- ## Jewell NP (2004). Statistics for Epidemiology. Chapman & Hall/CRC, New York, p 84 - 85.
-
- ## Incidence risk in exposed: IRiske
- ## Incidence risk in unexposed: IRisko
- ## Incidence risk in population: IRpop
-
- ## Incidence rate in exposed: IRatee
- ## Incidence rate in unexposed: IRateo
- ## Incidence rate in population: IRatepop
-
- ## Odds in exposed: Oe
- ## Odds in unexposed: Oo
- ## Odds in population: Opop
-
- ## Incidence risk ratio: RR.p
- ## Incidence rate ratio: IRR.p
- ## Odds ratio: OR.p
-
- ## Attributable risk: ARisk.p
- ## Attributable rate: ARate.p
-
- ## Attributable fraction risk data: AFRisk.p
- ## Attributable fraction rate data: AFRate.p
- ## Estimated attributable fraction: AFest.p
-
- ## Population attributable risk: PARisk.p
- ## Population attributable rate: PARate.p
-
- ## Population attributable fraction risk data: PAFRisk.p
- ## Population attributable fraction rate data: PAFRate.p
-
- ## Crude incidence risk ratio (strata): cRR.p
- ## Crude incidence rate ratio (strata): cIRR.p
- ## Crude incidence odds ratio (strata): cOR.p
- ## Crude attributable risk (strata): cARisk.p
- ## Crude attributable rate (strata): cARate.p
-
- ## Summary incidence risk ratio: sRR.p
- ## Summary incidence rate ratio: sIRR.p
- ## Summary incidence odds ratio: sOR.p
- ## Summary attributable risk: sARisk.p
- ## Summary attributable rate: sARate.p
-
- ## Reporting - method == cohort.count:
- ## Inc risk ratio; odds ratio
- ## Attributable risk; attributable risk in population
- ## Attributable fraction in exposed; attributable fraction in population
-
- ## Reporting - method == cohort.time:
- ## Inc rate ratio
- ## Attributable rate; attributable rate in population
- ## Attributable fraction in exposed; attributable fraction in population
-
- ## Reporting - method == case.control:
- ## Odds ratio
- ## Attributable prevalence; attributable prevalence in population
- ## Attributable fraction (est) in exposed; attributable fraction (est) in population
-
- ## Reporting - method == cross.sectional:
- ## Prevalence ratio; odds ratio
- ## Attributable prevalence; attributable prevalence in population
- ## Attributable fraction in exposed; attributable fraction in population
-
- ## If outcome is assigned by column, leave the data as is:
- if(outcome == "as.columns"){
- dat <- dat}
-
- ## If outcome is assigned by row, transpose it:
- if(outcome == "as.rows"){
- dat <- t(dat)}
-
- ## Make a copy of the original data. These values used when sums of cells across all strata are greater than zero but some strata contain zero cell frequencies:
- if(length(dim(dat)) == 2){
- a <- dat[1]; A <- a
- b <- dat[3]; B <- b
- c <- dat[2]; C <- c
- d <- dat[4]; D <- d
- }
-
- if(length(dim(dat)) > 2){
- a <- dat[1,1,]; A <- a
- b <- dat[1,2,]; B <- b
- c <- dat[2,1,]; C <- c
- d <- dat[2,2,]; D <- d
- }
-
- ## Test each strata for zero values. Add 0.5 to all cells if any cell has a zero value:
- for(i in 1:length(a)){
- if(a[i] < 1 | b[i] < 1 | c[i] < 1 | d[i] < 1){
- a[i] <- a[i] + 0.5; b[i] <- b[i] + 0.5; c[i] <- c[i] + 0.5; d[i] <- d[i] + 0.5
- }
- }
-
- .funincrisk <- function(dat, conf.level){
- ## Exact binomial confidence limits from D. Collett (1999) Modelling binary data. Chapman & Hall/CRC, Boca Raton Florida, p. 24.
- N. <- 1 - ((1 - conf.level) / 2)
- a <- dat[,1]
- n <- dat[,2]
- b <- n - a
- p <- a / n
-
- ## Wilson's method (see Rothman, Epidemiology An Introduction, page 132):
- ## N. <- 1 - ((1 - conf.level) / 2)
- ## z <- qnorm(N., mean = 0, sd = 1)
- ## a <- dat[,1]
- ## n <- dat[,2]
- ## p <- dat[,1] / dat[,2]
-
- ## a. <- n/(n + z^2)
- ## b. <- a/n
- ## c. <- z^2/(2 * n)
- ## d. <- (a * (n - a)) / n^3
- ## e. <- z^2 / (4 * n^2)
- ## low <- a. * (b. + c. - (z * sqrt(d. + e.)))
- ## up <- a. * (b. + c. + (z * sqrt(d. + e.)))
-
- a. <- ifelse(a == 0, a + 1, a); b. <- ifelse(b == 0, b + 1, b)
- low <- a. /(a. + (b. + 1) * (1 / qf(1 - N., 2 * a., 2 * b. + 2)))
- up <- (a. + 1) / (a. + 1 + b. / (1 / qf(1 - N., 2 * b., 2 * a. + 2)))
- low <- ifelse(a == 0, 0, low)
- up <- ifelse(a == n, 1, up)
- rval <- data.frame(p, low, up)
- names(rval) <- c("est", "lower", "upper")
- rval
- }
-
- .funincrate <- function(dat, conf.level){
- N. <- 1 - ((1 - conf.level) / 2)
- a <- dat[,1]
- n <- dat[,2]
- p <- a / n
- low <- 0.5 * qchisq(p = N., df = 2 * a + 2, lower.tail = FALSE) / n
- up <- 0.5 * qchisq(p = 1 - N., df = 2 * a + 2, lower.tail = FALSE) / n
- ## a.prime <- dat[,1] + 0.5
- ## p <- dat[,1]/dat[,2]
- ## PT <- dat[,2]
- ## low <- (a.prime * (1 - (1/(9 * a.prime)) - (z/3 * sqrt(1/a.prime)))^3)/PT
- ## up <- (a.prime * (1 - (1/(9 * a.prime)) + (z/3 * sqrt(1/a.prime)))^3)/PT
-
- ## Wilson's method (see Rothman, Epidemiology An Introduction, page 132):
- ## N. <- 1 - ((1 - conf.level) / 2)
- ## z <- qnorm(N., mean = 0, sd = 1)
- ## a <- dat[,1]
- ## n <- dat[,2]
- ## p <- dat[,1] / dat[,2]
- ## a. <- n/(n + z^2)
- ## b. <- a/n
- ## c. <- z^2/(2 * n)
- ## d. <- (a * (n - a)) / n^3
- ## e. <- z^2 / (4 * n^2)
- ## low <- a. * (b. + c. - (z * sqrt(d. + e.)))
- ## up <- a. * (b. + c. + (z * sqrt(d. + e.)))
-
- rval <- data.frame(p, low, up)
- names(rval) <- c("est", "lower", "upper")
- rval
- }
-
- .funRRwald <- function(dat, conf.level){
- N. <- 1 - ((1 - conf.level) / 2)
- z <- qnorm(N., mean = 0, sd = 1)
-
- a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
- N1 <- a + b; N0 <- c + d
-
- wRR.p <- (a / N1) / (c / N0)
- lnwRR <- log(wRR.p)
- lnwRR.var <- (1 / a) - (1 / N1) + (1 / c) - (1 / N0)
- lnwRR.se <- sqrt((1 / a) - (1 / N1) + (1 / c) - (1 / N0))
- wRR.se <- exp(lnwRR.se)
- ll <- exp(lnwRR - (z * lnwRR.se))
- ul <- exp(lnwRR + (z * lnwRR.se))
- c(wRR.p, ll, ul)
- }
-
- .funRRscore <- function(dat, conf.level){
- N. <- 1 - ((1 - conf.level) / 2)
- z <- qnorm(N., mean = 0, sd = 1)
+ ## Elwoood JM (1992). Causal Relationships in Medicine - A Practical System for Critical Appraisal. Oxford Medical Publications, London, p 266 - 293.
+ ## Rothman KJ (2002). Epidemiology An Introduction. Oxford University Press, London, p 130 - 143.
+ ## Hanley JA (2001). A heuristic approach to the formulas for population attributable fraction. J. Epidemiol. Community Health 55: 508 - 514.
+ ## Jewell NP (2004). Statistics for Epidemiology. Chapman & Hall/CRC, New York, p 84 - 85.
- a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
- N1 <- a + b; N0 <- c + d
-
- scRR.p <- (a / N1) / (c / N0)
-
- if ((c == 0) && (a == 0)){
- ul = Inf
- ll = 0
- }
-
- else{
- a1 = N0 * (N0 * (N0 + N1) * a + N1 * (N0 + a) * (z^2))
- a2 = -N0 * (N0 * N1 * (c + a) + 2 * (N0 + N1) * c * a + N1 * (N0 + c + 2 * a) * (z^2))
- a3 = 2 * N0 * N1 * c * (c + a) + (N0 + N1) * (c^2) * a + N0 * N1 * (c + a) * (z^2)
- a4 = -N1 * (c ^ 2) * (c + a)
-
- b1 = a2 / a1
- b2 = a3 / a1
- b3 = a4 / a1
- c1 = b2 - (b1^2) / 3
- c2 = b3 - b1 * b2 / 3 + 2 * (b1^3) / 27
- ceta = acos(sqrt(27) * c2 / (2 * c1 * sqrt(-c1)))
- t1 = -2 * sqrt(-c1 / 3) * cos(pi / 3 - ceta / 3)
- t2 = -2 * sqrt(-c1 / 3) * cos(pi / 3 + ceta / 3)
- t3 = 2 * sqrt(-c1 / 3) * cos(ceta / 3)
- p01 = t1 - b1 / 3
- p02 = t2 - b1 / 3
- p03 = t3 - b1 / 3
- p0sum = p01 + p02 + p03
- p0up = min(p01, p02, p03)
- p0low = p0sum - p0up - max(p01, p02, p03)
-
- if( (c == 0) && (a != 0) ){
- ll = (1 - (N1 - a) * (1 - p0low) / (c + N1 - (N0 + N1) * p0low)) / p0low
- ul = Inf
- }
-
- else if((c != N0) && (a == 0)){
- ul = (1 - (N1 - a) * (1 - p0up) / (c + N1 - (N0 + N1) * p0up)) / p0up
- ll = 0
- }
-
- else if((c == N0) && (a == N1)){
- ul = (N0 + z^2) / N0
- ll = N1 / (N1 + z^2)
- }
-
- else if((a == N1) || (c == N0)){
- if((c == N0) && (a == 0)) {ll = 0}
- if((c == N0) && (a != 0)) {
- phat1 = c / N0
- phat2 = a / N1
- phihat = phat2 / phat1
- phil = 0.95 * phihat
- chi2 = 0
- while (chi2 <= z){
- a = (N0 + N1) * phil
- b = -((c + N1) * phil + a + N0)
- c = c + a
- p1hat = (-b - sqrt(b^2 -4 * a * c)) / (2 * a)
- p2hat = p1hat * phil
- q2hat = 1 - p2hat
- var = (N0 * N1 * p2hat) / (N1 * (phil - p2hat) + N0 * q2hat)
- chi2 = ((a - N1 * p2hat) / q2hat) / sqrt(var)
- ll = phil
- phil = ll / 1.0001}}
- i = c
- j = a
- ni = N0
- nj = N1
-
- if(a == N1){
- i = a
- j = c
- ni = N1
- nj = N0
- }
- phat1 = i / ni
- phat2 = j / nj
- phihat = phat2 / phat1
- phiu = 1.1 * phihat
-
- if((c == N0) && (a == 0)) {
- if(N0 < 100) {phiu = 0.01}
- else {phiu = 0.001}
- }
-
- chi1 = 0
- while (chi1 >= -z){
- a. = (ni + nj) * phiu
- b. = -((i + nj) * phiu + j + ni)
- c. = i + j
- p1hat = (-b. - sqrt(b.^2 - 4 * a. * c.)) / (2 * a.)
- p2hat = p1hat * phiu
- q2hat = 1 - p2hat
- var = (ni * nj * p2hat) / (nj * (phiu - p2hat) + ni * q2hat)
- chi1 = ((j - nj * p2hat) / q2hat) / sqrt(var)
- phiu1 = phiu
- phiu = 1.0001 * phiu1
- }
-
- if(a == N1) {
- ul = (1 - (N1 - a) * (1 - p0up) / (c + N1 - (N0 + N1) * p0up)) / p0up
- ll = 1 / phiu1
- }
-
- else{ul = phiu1}
- }
-
- else{
- ul = (1 - (N1 - a) * (1 - p0up) / (c + N1 - (N0 + N1) * p0up)) /p0up
- ll = (1 - (N1 - a) * (1 - p0low) / (c + N1 - (N0 + N1) * p0low)) / p0low
- }
- }
- c(scRR.p, ll, ul)
- }
-
- .funORwald <- function(dat, conf.level){
- N. <- 1 - ((1 - conf.level) / 2)
- z <- qnorm(N., mean = 0, sd = 1)
-
- a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
- N1 <- a + b; N0 <- c + d
-
- wOR.p <- (a / b) / (c / d)
- lnwOR <- log(wOR.p)
- lnwOR.var <- 1/a + 1/b + 1/c + 1/d
- lnwOR.se <- sqrt(lnwOR.var)
- ll <- exp(lnwOR - (z * lnwOR.se))
- ul <- exp(lnwOR + (z * lnwOR.se))
- c(wOR.p, ll, ul)
- }
-
- .funORcfield <- function (dat, conf.level, interval = c(1e-08, 1e+08)){
- a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
- N1 <- a + b; N0 <- c + d
-
- cfOR.p <- (a / b) / (c / d)
-
- if (((a == 0) && (c == 0)) || ((a == N1) && (c == N0))) {
- ll <- 0
- ul <- Inf
- }
-
- else if (c == N0 || a == 0) {
- ll <- 0
- ul <- uniroot(function(or) {
- sum(sapply(max(0, a + c - N0):a, dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
- }, interval = interval)$root
- }
- else if (a == N1 || c == 0) {
- ll <- uniroot(function(or) {
- sum(sapply(a:min(N1, a + c), dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
- }, interval = interval)$root
- ul <- Inf
- }
- else {
- ll <- uniroot(function(or) {
- sum(sapply(a:min(N1, a + c), dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
- }, interval = interval)$root
- ul <- uniroot(function(or) {
- sum(sapply(max(0, a + c - N0):a, dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
- }, interval = interval)$root
- }
- c(cfOR.p, ll, ul)
- }
-
- # dFNCHypergeo <- function (x, m1, m2, n, odds, precision = 1e-07){
- # stopifnot(is.numeric(x), is.numeric(m1), is.numeric(m2),
- # is.numeric(n), is.numeric(odds), is.numeric(precision))
- # .Call("dFNCHypergeo", as.integer(x), as.integer(m1), as.integer(m2),
- # as.integer(n), as.double(odds), as.double(precision),
- # PACKAGE = "BiasedUrn")
- # }
-
- .limit <- function(x, nx, y, ny, conf.level, lim, t){
- z = qchisq(conf.level, 1)
- px = x / nx
- score = 0
- while (score < z){
- a = ny *(lim - 1)
- b = nx * lim + ny - (x + y) * (lim - 1)
- c = -(x + y)
- p2d = (-b + sqrt(b^2 - 4 * a * c)) / (2 * a)
- p1d = p2d * lim / (1 + p2d * (lim - 1))
- score = ((nx * (px - p1d))^2) * (1 / (nx * p1d * (1 - p1d)) + 1 / (ny * p2d * (1 - p2d)))
- ci = lim
- if(t == 0) {lim = ci / 1.001}
- else{lim = ci * 1.001}
- }
- return(ci)
- }
+ ## Incidence risk in exposed: IRiske
+ ## Incidence risk in unexposed: IRisko
+ ## Incidence risk in population: IRpop
+
+ ## Incidence rate in exposed: IRatee
+ ## Incidence rate in unexposed: IRateo
+ ## Incidence rate in population: IRatepop
+
+ ## Odds in exposed: Oe
+ ## Odds in unexposed: Oo
+ ## Odds in population: Opop
+
+ ## Incidence risk ratio: RR.p
+ ## Incidence rate ratio: IRR.p
+ ## Odds ratio: OR.p
+
+ ## Attributable risk: ARisk.p
+ ## Attributable rate: ARate.p
+
+ ## Attributable fraction risk data: AFRisk.p
+ ## Attributable fraction rate data: AFRate.p
+ ## Estimated attributable fraction: AFest.p
+
+ ## Population attributable risk: PARisk.p
+ ## Population attributable rate: PARate.p
+
+ ## Population attributable fraction risk data: PAFRisk.p
+ ## Population attributable fraction rate data: PAFRate.p
+
+ ## Crude incidence risk ratio (strata): cRR.p
+ ## Crude incidence rate ratio (strata): cIRR.p
+ ## Crude incidence odds ratio (strata): cOR.p
+ ## Crude attributable risk (strata): cARisk.p
+ ## Crude attributable rate (strata): cARate.p
+
+ ## Summary incidence risk ratio: sRR.p
+ ## Summary incidence rate ratio: sIRR.p
+ ## Summary incidence odds ratio: sOR.p
+ ## Summary attributable risk: sARisk.p
+ ## Summary attributable rate: sARate.p
+
+ ## Reporting - method == cohort.count:
+ ## Inc risk ratio; odds ratio
+ ## Attributable risk; attributable risk in population
+ ## Attributable fraction in exposed; attributable fraction in population
+
+ ## Reporting - method == cohort.time:
+ ## Inc rate ratio
+ ## Attributable rate; attributable rate in population
+ ## Attributable fraction in exposed; attributable fraction in population
+
+ ## Reporting - method == case.control:
+ ## Odds ratio
+ ## Attributable prevalence; attributable prevalence in population
+ ## Attributable fraction (est) in exposed; attributable fraction (est) in population
+
+ ## Reporting - method == cross.sectional:
+ ## Prevalence ratio; odds ratio
+ ## Attributable prevalence; attributable prevalence in population
+ ## Attributable fraction in exposed; attributable fraction in population
+
+ ## If outcome is assigned by column, leave the data as is:
+ if(outcome == "as.columns"){
+ dat <- dat}
+
+ ## If outcome is assigned by row, transpose it:
+ if(outcome == "as.rows"){
+ dat <- t(dat)}
+
+ ## Make a copy of the original data. These values used when sums of cells across all strata are greater than zero but some strata contain zero cell frequencies:
+ if(length(dim(dat)) == 2){
+ a <- dat[1]; A <- a
+ b <- dat[3]; B <- b
+ c <- dat[2]; C <- c
+ d <- dat[4]; D <- d
+ }
+
+ if(length(dim(dat)) > 2){
+ a <- dat[1,1,]; A <- a
+ b <- dat[1,2,]; B <- b
+ c <- dat[2,1,]; C <- c
+ d <- dat[2,2,]; D <- d
+ }
+
+
+ # Commented this section out 100617. The CI methods that are used are robust to zero cell frequencies.
+ # Test each strata for zero values. Add 0.5 to all cells if any cell has a zero value:
+ # for(i in 1:length(a)){
+ # if(a[i] < 1 | b[i] < 1 | c[i] < 1 | d[i] < 1){
+ # a[i] <- a[i] + 0.5; b[i] <- b[i] + 0.5; c[i] <- c[i] + 0.5; d[i] <- d[i] + 0.5
+ # }
+ # }
+
+ .funincrisk <- function(dat, conf.level){
+ ## Exact binomial confidence limits from function binom::binom.confint. Changed 190716.
+ alpha <- 1 - conf.level
+ alpha2 <- 0.5 * alpha
+ x <- dat[,1]; n <- dat[,2]
-
- .funORscore <- function(dat, conf.level){
- a <- dat[1]
- N1 <- dat[1] + dat[3]
- c <- dat[2]
- N0 <- dat[2] + dat[4]
-
- px <- a / N1
- py <- c / N0
- scOR.p <- (a / b) / (c / d)
-
- if(((a == 0) && (c == 0)) || ((a == N1) && (c == N0))){
- ul <- 1 / 0
- ll <- 0
- }
-
- else if((a == 0) || (c == N0)){
- ll <- 0
- theta <- 0.01 / N0
- ul <- .limit(a, N1, c, N0, conf.level, theta, 1)
- }
-
- else if((a == N1) || (c == 0)){
- ul <- 1 / 0
- theta <- 100 * N1
- ll <- .limit(a, N1, c, N0, conf.level, theta, 0)
- }
-
- else{
- # Changed 120316 due to NaN returned with some 2 by 2 table data:
- theta <- px / (1 - px) / (py / (1 - py)) / 1.1111
- # theta <- px / (1 - px) / (py / (1 - py)) / 1.1
- ll <- .limit(a, N1, c, N0, conf.level, theta, 0)
- theta <- px / (1 - px) / (py / (1 - py)) * 1.1
- ul <- .limit(a, N1, c, N0, conf.level, theta, 1)
- }
- c(scOR.p, ll, ul)
- }
-
- .funORml <- function(dat, conf.level){
- mOR.tmp <- fisher.test(dat, conf.int = TRUE, conf.level = conf.level)
-
- mOR.p <- as.numeric(mOR.tmp$estimate)
- mOR.l <- as.numeric(mOR.tmp$conf.int)[1]
- mOR.u <- as.numeric(mOR.tmp$conf.int)[2]
-
- c(mOR.p, mOR.l, mOR.u)
- }
-
- .funARwald <- function(dat, conf.level, units){
- N. <- 1 - ((1 - conf.level) / 2)
- z <- qnorm(N., mean = 0, sd = 1)
-
- a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
- N1 <- a + b; N0 <- c + d
-
- wARisk.p <- ((a / N1) - (c / N0))
- ## wARisk.var <- (((a * b) / (N1^2 * (N1 - 1))) + ((c * d) / (N0^2 * (N0 - 1))))
- wARisk.se <- (sqrt(((a * (N1 - a))/N1^3) + ((c * (N0 - c))/N0^3)))
- ll <- (wARisk.p - (z * wARisk.se))
- ul <- (wARisk.p + (z * wARisk.se))
- c(wARisk.p * units, ll * units, ul * units)
- }
-
- .funARscore <- function(dat, conf.level, units){
- N. <- 1 - ((1 - conf.level) / 2)
- z <- qnorm(N., mean = 0, sd = 1)
-
- a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
- N1 <- a + b; N0 <- c + d
-
- sARisk.p <- ((a / N1) - (c / N0))
- px = a / N1
- py = c / N0
- z = qchisq(conf.level, 1)
- proot = px - py
- dp = 1 - proot
- niter = 1
- while(niter <= 50){
- dp = 0.5 * dp
- up2 = proot + dp
- score = .z2stat(px, N1, py, N0, up2)
- if(score < z){proot = up2}
- niter = niter + 1
- if((dp < 0.0000001) || (abs(z - score) < 0.000001)){
- niter = 51
- ul = up2
- }
- }
-
- proot = px - py
- dp = 1 + proot
- niter = 1
- while(niter <= 50){
- dp = 0.5 * dp
- low2 = proot - dp
- score = .z2stat(px, N1, py, N0, low2)
- if(score < z){proot = low2}
- niter = niter + 1
- if((dp < 0.0000001) || (abs(z - score) < 0.000001)){
- ll = low2
- niter = 51
- }
- }
- c(sARisk.p * units, ll * units, ul * units)
- }
-
- .z2stat <- function (p1x, nx, p1y, ny, dif){
- diff = p1x-p1y-dif
- if (abs(diff) == 0) {
- fmdiff = 0}
- else{
- t = ny / nx
- a = 1 + t
- b = -(1 + t + p1x + t * p1y + dif * (t + 2))
- c = dif * dif + dif * (2 * p1x + t + 1) + p1x + t * p1y
- d = -p1x * dif * (1 + dif)
- v = (b / a / 3)^3 - b * c / (6 * a * a) + d / a / 2
- s = sqrt((b / a / 3)^2 - c / a / 3)
- if(v > 0){u = s}
- else{u = -s}
- w = (3.141592654 + acos(v / u^3)) / 3
- p1d = 2 * u * cos(w) - b / a / 3
- p2d = p1d - dif
- var = p1d * (1 - p1d) / nx + p2d * (1 - p2d) / ny
- fmdiff = diff^2 / var
- }
- return(fmdiff)
-}
-
- .funMHRD.Sato0 <- function(dat, conf.level = 0.95, units = units) {
- if(length(dim(dat)) > 2){
- ndat <- addmargins(A = dat, margin = 2, FUN = sum, quiet = FALSE)
- c1 <- ndat[1,1,]; c2 <- ndat[1,3,]; c3 <- ndat[2,1,]; c4 <- ndat[2,3,]
- dataset <- cbind(c1, c2, c3, c4)
-
- num <- sum(apply(X = dataset, MARGIN = 1, FUN = function(ro) (ro[1] * ro[4] - ro[3] * ro[2]) / (ro[2] + ro[4])))
- W <- sum(apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4]))) # Cochrane weights
- delta.MH <- num / W
- P <- sum(apply(dataset, 1, function(ro) (ro[2]^2 * ro[3] - ro[4]^2 * ro[1] + 0.5 * ro[2] * ro[4] * (ro[4] - ro[2])) / (ro[2] + ro[4])^2))
- Q <- sum(apply(dataset,1,function(ro) (ro[1] * (ro[4] - ro[3]) + ro[3] * (ro[2] - ro[1])) / (2 * (ro[2] + ro[4]))))
-
- delta.Mid <- delta.MH + 0.5 * qchisq(conf.level, df = 1) * (P / W^2)
- ME <- sqrt(delta.Mid^2 - delta.MH^2 + qchisq(conf.level, df = 1) * Q / W^2)
- CI <- delta.Mid + cbind(-1,1) * ME
-
- Sato0ARisk.p <- delta.Mid
- Sato0ARisk.l <- Sato0ARisk.p - ME
- Sato0ARisk.u <- Sato0ARisk.p + ME
- c(Sato0ARisk.p * units, Sato0ARisk.l * units, Sato0ARisk.u * units)
- }
- }
-
-
- .funMHRD.Sato <- function(dat, conf.level = 0.95, units = units) {
- if(length(dim(dat)) > 2){
- ndat <- addmargins(A = dat, margin = 2, FUN = sum, quiet = FALSE)
- c1 <- ndat[1,1,]; c2 <- ndat[1,3,]; c3 <- ndat[2,1,]; c4 <- ndat[2,3,]
- dataset <- cbind(c1, c2, c3, c4)
-
- num <- sum(apply(X = dataset, MARGIN = 1, FUN = function(ro) (ro[1] * ro[4] - ro[3] * ro[2]) / (ro[2] + ro[4])))
- W <- sum(apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4]))) # Cochrane weights
- delta.MH <- num / W
- P <- sum(apply(dataset, 1, function(ro) (ro[2]^2 * ro[3] - ro[4]^2 * ro[1] + 0.5 * ro[2] * ro[4] * (ro[4] - ro[2])) / (ro[2] + ro[4])^2))
- Q <- sum(apply(dataset,1,function(ro) (ro[1] * (ro[4] - ro[3]) + ro[3] * (ro[2] - ro[1])) / (2 * (ro[2] + ro[4]))))
- var.delta.MH = (delta.MH * P + Q) / W^2
-
- SatoARisk.p <- delta.MH
- SatoARisk.l <- SatoARisk.p - qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
- SatoARisk.u <- SatoARisk.p + qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
- c(SatoARisk.p * units, SatoARisk.l * units, SatoARisk.u * units)
- }
- }
-
-
- .funMHRD.GR <- function(dat, conf.level = 0.95, units = units) {
- if(length(dim(dat)) > 2){
- ndat <- addmargins(A = dat, margin = 2, FUN = sum, quiet = FALSE)
- c1 <- ndat[1,1,]; c2 <- ndat[1,3,]; c3 <- ndat[2,1,]; c4 <- ndat[2,3,]
- dataset <- cbind(c1, c2, c3, c4)
-
- num <- sum(apply(X = dataset, MARGIN = 1, FUN = function(ro) (ro[1] * ro[4] - ro[3] * ro[2]) / (ro[2] + ro[4])))
- W <- sum(apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4]))) # Cochrane weights
- delta.MH <- num / W
- P <- sum(apply(dataset, 1, function(ro) (ro[2]^2 * ro[3] - ro[4]^2 * ro[1] + 0.5 * ro[2] * ro[4] * (ro[4] - ro[2])) / (ro[2] + ro[4])^2))
- Q <- sum(apply(dataset,1,function(ro) (ro[1] * (ro[4] - ro[3]) + ro[3] * (ro[2] - ro[1])) / (2 * (ro[2] + ro[4]))))
- p1 <- dataset[,1] / dataset[,2]
- p2 <- dataset[,3] / dataset[,4]
- denom <- apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4])) # Cochrane weights
- var.delta.MH <- sum (denom^2 * (p1 * (1 - p1) / dataset[,2] + p2 * (1 - p2) / dataset[,4])) / W^2
-
- GRARisk.p <- delta.MH
- GRARisk.l <- GRARisk.p - qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
- GRARisk.u <- GRARisk.p + qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
- c(GRARisk.p * units, GRARisk.l * units, GRARisk.u * units)
- }
- }
-
-
- ## =================
- ## DECLARE VARIABLES
- ## =================
-
- ## | D+ | D- | Total
- ## ----------------------------
- ## Exp + | a | b | N1
- ## Exp - | c | d | N0
- ## -------|------|------|------
- ## Total | M1 | M0 | Total
-
-
- N. <- 1 - ((1 - conf.level) / 2)
- z <- qnorm(N., mean = 0, sd = 1)
-
- ## For large numbers you need to use floating point rather than integer representation. This will avoid "integer overflow" messages:
- a <- as.numeric(a); A <- as.numeric(A)
- b <- as.numeric(b); B <- as.numeric(B)
- c <- as.numeric(c); C <- as.numeric(C)
- d <- as.numeric(d); D <- as.numeric(D)
-
- ## Total within strata cases:
- M1 <- a + c
- ## Total within strata non-cases:
- M0 <- b + d
- ## Total within strata exposed:
- N1 <- a + b
- ## Total within strata unexposed:
- N0 <- c + d
- ## Total within strata subjects:
- total <- a + b + c + d
- ## Number of strata:
- n.strata <- length(a)
-
- ## Added 190809:
- ## If the sums across strata for all cells are greater than 0, use the sums of the crude data (cf the sums of the adjusted values):
- if(sum(A) > 0 & sum(B) > 0 & sum(C) > 0 & sum(D) > 0){
- sa <- sum(A); sb <- sum(B); sc <- sum(C); sd <- sum(D)
- }
-
- ## If the sums across strata for all cells contain a 0, use the sums of the adjusted data:
- if(sum(A) == 0 | sum(B) == 0 | sum(C) == 0 | sum(D) == 0){
- sa <- sum(a); sb <- sum(b); sc <- sum(c); sd <- sum(d)
- }
-
- ## sa <- sum(a); sb <- sum(b); sc <- sum(c); sd <- sum(d)
-
- ## Grand total cases:
- sM1 <- sa + sc
- ## Grand total non-cases:
- sM0 <- sb + sd
- ## Grand total exposed:
- sN1 <- sa + sb
- ## Grand total unexposed:
- sN0 <- sc + sd
- ## Grand total:
- stotal <- sa + sb + sc + sd
-
- ## Within-strata incidence risk in exposed:
- .tmp <- .funincrisk(as.matrix(cbind(a, N1)), conf.level = conf.level)
- IRiske.p <- as.numeric(.tmp[,1]) * units
- IRiske.l <- as.numeric(.tmp[,2]) * units
- IRiske.u <- as.numeric(.tmp[,3]) * units
-
- ## Within-strata incidence risk in unexposed:
- .tmp <- .funincrisk(as.matrix(cbind(c, N0)), conf.level = conf.level)
- IRisko.p <- as.numeric(.tmp[,1]) * units
- IRisko.l <- as.numeric(.tmp[,2]) * units
- IRisko.u <- as.numeric(.tmp[,3]) * units
-
- ## Within-strata incidence risk in population:
- .tmp <- .funincrisk(as.matrix(cbind(M1, total)), conf.level = conf.level)
- IRiskpop.p <- as.numeric(.tmp[,1]) * units
- IRiskpop.l <- as.numeric(.tmp[,2]) * units
- IRiskpop.u <- as.numeric(.tmp[,3]) * units
-
- ## Within-strata incidence rate in exposed:
- .tmp <- .funincrate(as.matrix(cbind(a, b)), conf.level = conf.level)
- IRatee.p <- as.numeric(.tmp[,1]) * units
- IRatee.l <- as.numeric(.tmp[,2]) * units
- IRatee.u <- as.numeric(.tmp[,3]) * units
-
- ## Within-strata incidence rate in unexposed:
- .tmp <- .funincrate(as.matrix(cbind(c, d)), conf.level = conf.level)
- IRateo.p <- as.numeric(.tmp[,1]) * units
- IRateo.l <- as.numeric(.tmp[,2]) * units
- IRateo.u <- as.numeric(.tmp[,3]) * units
-
- ## Within-strata incidence rate in population:
- .tmp <- .funincrate(as.matrix(cbind(M1, M0)), conf.level = conf.level)
- IRatepop.p <- as.numeric(.tmp[,1]) * units
- IRatepop.l <- as.numeric(.tmp[,2]) * units
- IRatepop.u <- as.numeric(.tmp[,3]) * units
-
- ## Within-strata odds in exposed (based on Ederer F and Mantel N (1974) Confidence limits on the ratio of two Poisson variables.
- ## American Journal of Epidemiology 100: 165 - 167.
- ## Cited in Altman, Machin, Bryant, and Gardner (2000) Statistics with Confidence, British Medical Journal, page 69).
- ## Added 160609.
- Al <- (qbinom(1 - N., size = a + b, prob = (a / (a + b)))) / (a + b)
- Au <- (qbinom(N., size = a + b, prob = (a / (a + b)))) / (a + b)
- Oe.p <- (a / b)
- Oe.l <- (Al / (1 - Al))
- Oe.u <- (Au / (1 - Au))
-
- ## Within-strata odds in unexposed:
- Al <- (qbinom(1 - N., size = c + d, prob = (c / (c + d)))) / (c + d)
- Au <- (qbinom(N., size = c + d, prob = (c / (c + d)))) / (c + d)
- Oo.p <- (c / d)
- Oo.l <- (Al / (1 - Al))
- Oo.u <- (Au / (1 - Au))
-
- ## Within-strata odds in population:
- Al <- (qbinom(1 - N., size = M1 + M0, prob = (M1 / (M1 + M0)))) / (M1 + M0)
- Au <- (qbinom(N., size = M1 + M0, prob = (M1 / (M1 + M0)))) / (M1 + M0)
- Opop.p <- (M1 / M0)
- Opop.l <- (Al / (1 - Al))
- Opop.u <- (Au / (1 - Au))
-
- ## Crude incidence risk in exposed:
- .tmp <- .funincrisk(as.matrix(cbind(sa, sN1)), conf.level = conf.level)
- cIRiske.p <- as.numeric(.tmp[,1]) * units
- cIRiske.l <- as.numeric(.tmp[,2]) * units
- cIRiske.u <- as.numeric(.tmp[,3]) * units
-
- ## Crude incidence risk in unexposed:
- .tmp <- .funincrisk(as.matrix(cbind(sc, sN0)), conf.level = conf.level)
- cIRisko.p <- as.numeric(.tmp[,1]) * units
- cIRisko.l <- as.numeric(.tmp[,2]) * units
- cIRisko.u <- as.numeric(.tmp[,3]) * units
-
- ## Crude incidence risk in population:
- .tmp <- .funincrisk(as.matrix(cbind(sM1, stotal)), conf.level = conf.level)
- cIRiskpop.p <- as.numeric(.tmp[,1]) * units
- cIRiskpop.l <- as.numeric(.tmp[,2]) * units
- cIRiskpop.u <- as.numeric(.tmp[,3]) * units
-
- ## Crude incidence rate in exposed:
- .tmp <- .funincrate(as.matrix(cbind(sa, sb)), conf.level = conf.level)
- cIRatee.p <- as.numeric(.tmp[,1]) * units
- cIRatee.l <- as.numeric(.tmp[,2]) * units
- cIRatee.u <- as.numeric(.tmp[,3]) * units
-
- ## Crude incidence rate in unexposed:
- .tmp <- .funincrate(as.matrix(cbind(sc, sd)), conf.level = conf.level)
- cIRateo.p <- as.numeric(.tmp[,1]) * units
- cIRateo.l <- as.numeric(.tmp[,2]) * units
- cIRateo.u <- as.numeric(.tmp[,3]) * units
-
- ## Crude incidence risk in population:
- .tmp <- .funincrate(as.matrix(cbind(sM1, sM0)), conf.level = conf.level)
- cIRatepop.p <- as.numeric(.tmp[,1]) * units
- cIRatepop.l <- as.numeric(.tmp[,2]) * units
- cIRatepop.u <- as.numeric(.tmp[,3]) * units
-
- ## Crude odds in exposed (based on Ederer F and Mantel N (1974) Confidence limits on the ratio of two Poisson variables.
- ## American Journal of Epidemiology 100: 165 - 167.
- ## Cited in Altman, Machin, Bryant, and Gardner (2000) Statistics with Confidence, British Medical Journal, page 69).
- ## Added 160609
- Al <- (qbinom(1 - N., size = sa + sb, prob = (sa / (sa + sb)))) / (sa + sb)
- u <- (qbinom(N., size = sa + sb, prob = (sa / (sa + sb)))) / (sa + sb)
- cOe.p <- sa / sb
- cOe.l <- Al / (1 - Al)
- cOe.u <- Au / (1 - Au)
-
- ## Crude odds in unexposed:
- Al <- (qbinom(1 - N., size = sc + sd, prob = (sc / (sc + sd)))) / (sc + sd)
- u <- (qbinom(N., size = sc + sd, prob = (sc / (sc + sd)))) / (sc + sd)
- cOo.p <- sc / sd
- cOo.l <- Al / (1 - Al)
- cOo.u <- Au / (1 - Au)
-
- ## Crude odds in population:
- Al <- (qbinom(1 - N., size = sM1 + sM0, prob = (sM1 / (sM1 + sM0)))) / (sM1 + sM0)
- u <- (qbinom(N., size = sM1 + sM0, prob = (sM1 / (sM1 + sM0)))) / (sM1 + sM0)
- cOpop.p <- sM1 / sM0
- cOpop.l <- Al / (1 - Al)
- cOpop.u <- Au / (1 - Au)
-
-
- ## =========================================
- ## INDIVIDUAL STRATA MEASURES OF ASSOCIATION
- ## =========================================
-
- ## Individual strata incidence risk ratio - Wald confidence limits (Rothman p 135 equation 7-3):
- wRR.ctype <- "Wald"
- wRR.p <- c(); wRR.l <- c(); wRR.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funRRwald(dat[,,i], conf.level)
- wRR.p <- c(wRR.p, .tmp[1])
- wRR.l <- c(wRR.l, .tmp[2])
- wRR.u <- c(wRR.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funRRwald(dat, conf.level)
- wRR.p <- .tmp[1]
- wRR.l <- .tmp[2]
- wRR.u <- .tmp[3]
- }
-
- ## Individual strata incidence risk ratio - score confidence limits:
- scRR.ctype <- "Score"
- scRR.p <- c(); scRR.l <- c(); scRR.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funRRscore(dat[,,i], conf.level)
- scRR.p <- c(scRR.p, .tmp[1])
- scRR.l <- c(scRR.l, .tmp[2])
- scRR.u <- c(scRR.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funRRscore(dat, conf.level)
- scRR.p <- .tmp[1]
- scRR.l <- .tmp[2]
- scRR.u <- .tmp[3]
- }
-
- ## Individual strata incidence rate ratio (exact confidence intervals from epibasic.xlsx http://ph.au.dk/uddannelse/software/):
- IRR.ctype <- ""
- IRR.p <- (a / b) / (c / d)
- lnIRR <- log(IRR.p)
- lnIRR.var <- (1 / a) + (1 / c)
- lnIRR.se <- sqrt((1 / a) + (1 / c))
- IRR.se <- exp(lnIRR.se)
- pl <- a / (a + (c + 1) * (1 / qf(1 - N., 2 * a, 2 * c + 2)))
- ph <- (a + 1) / (a + 1 + c / (1 / qf(1 - N., 2 * c, 2 * a + 2)))
- IRR.l <- pl * d / ((1 - pl) * b)
- IRR.u <- ph * d / ((1 - ph) * b)
- ## lnIRR.l <- lnIRR - (z * lnIRR.se)
- ## lnIRR.u <- lnIRR + (z * lnIRR.se)
- ## IRR.l <- exp(lnIRR.l)
- ## IRR.u <- exp(lnIRR.u)
- ## Incidence rate ratio weights (equal to precision, the inverse of the variance of the IRR. See Woodward page 168):
- IRR.w <- 1 / (exp(lnIRR.var))
-
- ## Individual strata Wald odds ratios (Rothman p 139 equation 7-6):
- wOR.ctype <- "Wald"
- wOR.p <- c(); wOR.l <- c(); wOR.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funORwald(dat[,,i], conf.level)
- wOR.p <- c(wOR.p, .tmp[1])
- wOR.l <- c(wOR.l, .tmp[2])
- wOR.u <- c(wOR.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funORwald(dat, conf.level)
- wOR.p <- .tmp[1]
- wOR.l <- .tmp[2]
- wOR.u <- .tmp[3]
- }
-
-
- ## Individual strata odds ratio - Cornfield confidence limits:
- cfOR.ctype <- "Cornfield"
- cfOR.p <- c(); cfOR.l <- c(); cfOR.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funORcfield(dat[,,i], conf.level)
- cfOR.p <- c(cfOR.p, .tmp[1])
- cfOR.l <- c(cfOR.l, .tmp[2])
- cfOR.u <- c(cfOR.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funORcfield(dat, conf.level)
- cfOR.p <- .tmp[1]
- cfOR.l <- .tmp[2]
- cfOR.u <- .tmp[3]
- }
-
- ## Individual strata odds ratio - score confidence limits:
- scOR.ctype <- "Score"
- scOR.p <- c(); scOR.l <- c(); scOR.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funORscore(dat[,,i], conf.level)
- scOR.p <- c(scOR.p, .tmp[1])
- scOR.l <- c(scOR.l, .tmp[2])
- scOR.u <- c(scOR.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funORscore(dat, conf.level)
- scOR.p <- .tmp[1]
- scOR.l <- .tmp[2]
- scOR.u <- .tmp[3]
- }
-
- ## Individual strata odds ratios - maximum likelihood estimate (using fisher.test function):
- ## Replaced 130612.
- mOR.ctype <- "MLE"
- mOR.p <- c(); mOR.l <- c(); mOR.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funORml(dat[,,i], conf.level)
- mOR.p <- c(mOR.p, .tmp[1])
- mOR.l <- c(mOR.l, .tmp[2])
- mOR.u <- c(mOR.u, .tmp[3])
- }
- }
-
- if(length(dim(dat)) == 2){
- .tmp <- .funORml(dat, conf.level)
- mOR.p <- .tmp[1]
- mOR.l <- .tmp[2]
- mOR.u <- .tmp[3]
- }
-
- ## Individual strata attributable risk (Rothman p 135 equation 7-2):
- wARisk.ctype <- "Wald"
- wARisk.p <- c(); wARisk.l <- c(); wARisk.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funARwald(dat[,,i], conf.level, units)
- wARisk.p <- c(wARisk.p, .tmp[1])
- wARisk.l <- c(wARisk.l, .tmp[2])
- wARisk.u <- c(wARisk.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funARwald(dat, conf.level, units)
- wARisk.p <- .tmp[1]
- wARisk.l <- .tmp[2]
- wARisk.u <- .tmp[3]
- }
-
- ## Individual strata attributable risk - score confidence limits:
- scARisk.ctype <- "Score"
- scARisk.p <- c(); scARisk.l <- c(); scARisk.u <- c()
- if(length(dim(dat)) == 3){
- for(i in 1:dim(dat)[3]){
- .tmp <- .funARscore(dat[,,i], conf.level, units)
- scARisk.p <- c(scARisk.p, .tmp[1])
- scARisk.l <- c(scARisk.l, .tmp[2])
- scARisk.u <- c(scARisk.u, .tmp[3])
- }
- }
- if(length(dim(dat)) == 2){
- .tmp <- .funARscore(dat, conf.level, units)
- scARisk.p <- .tmp[1]
- scARisk.l <- .tmp[2]
- scARisk.u <- .tmp[3]
- }
-
- ## Individual strata attributable rate (Rothman p 137 equation 7-4):
- ARate.ctype <- ""
- ARate.p <- ((a / b) - (c / d)) * units
- ARate.var <- (a / b^2) + (c / d^2)
- ARate.se <- (sqrt((a / b^2) + (c / d^2))) * units
- ARate.l <- ARate.p - (z * ARate.se)
- ARate.u <- ARate.p + (z * ARate.se)
- ## Attribtable rate weights (equal to precision, the inverse of the variance of the RR. See Woodward page 168):
- ARate.w <- 1 / (ARate.var)
-
- ## Individual strata attributable fraction for risk data (from Hanley 2001):
- AFRisk.ctype <- ""
- AFRisk.p <- ((wRR.p - 1) / wRR.p)
- AFRisk.l <- (wRR.l - 1) / wRR.l
- AFRisk.u <- (wRR.u - 1) / wRR.u
- ## AFRisk.l <- min((wRR.l - 1) / wRR.l, (wRR.u - 1) / wRR.u)
- ## AFRisk.u <- max((wRR.l - 1) / wRR.l, (wRR.u - 1) / wRR.u)
-
- ## Individual strata attributable fraction for rate data (from Hanley 2001):
- AFRate.ctype <- ""
- AFRate.p <- (IRR.p - 1) / IRR.p
- ## Bug found 031013. The following two lines of code replace those on lines 449 and 450.
- AFRate.l <- (IRR.l - 1) / IRR.l
- AFRate.u <- (IRR.u - 1) / IRR.u
- ## AFRate.l <- min((IRR.l - 1) / IRR.l, (IRR.u - 1) / IRR.u)
- ## AFRate.u <- max((IRR.l - 1) / IRR.l, (IRR.u - 1) / IRR.u)
-
- ## Individual strata estimated attributable fraction (from Hanley 2001):
- AFest.ctype <- ""
- AFest.p <- (mOR.p - 1) / mOR.p
- AFest.l <- (mOR.l - 1) / mOR.l
- AFest.u <- (mOR.u - 1) / mOR.u
- ## Bug found 031013. The following two lines of code replace those on lines 457 and 458.
- ## AFest.l <- min((OR.l - 1) / OR.l, (OR.u - 1) / OR.u)
- ## AFest.u <- max((OR.l - 1) / OR.l, (OR.u - 1) / OR.u)
-
- ## Individual strata population attributable risk (same as Rothman p 135 equation 7-2):
- wPARisk.ctype <- ""
- wPARisk.p <- ((M1 / total) - (c / N0)) * units
- wPARisk.se <- (sqrt(((M1 * (total - M1))/total^3) + ((c * (N0 - c))/N0^3))) * units
- wPARisk.l <- wPARisk.p - (z * wPARisk.se)
- wPARisk.u <- wPARisk.p + (z * wPARisk.se)
-
- ## 270115 Confidence intervals for PAR from Sarah Pirikahu MSc thesis.
- pPARisk.ctype <- "Pirikahu"
- pPARisk.p <- ((M1 / total) - (c / N0)) * units
- pPARisk.d1 <- (1 / total) - ((a + c) / total^2)
- pPARisk.d2 <- -((a + c) / total^2)
- pPARisk.d3 <- (c / (c + d)^2) - ((a + c) / total^2) + (1 / total) - (1 / (c + d))
- pPARisk.d4 <- (c / (c + d)^2) - ((a + c) / total^2)
- pPARisk.var <- ((pPARisk.d1^2) * a) + ((pPARisk.d2^2) * b) + ((pPARisk.d3^2) * c) + ((pPARisk.d4^2) * d)
- pPARisk.se <- sqrt(pPARisk.var) * units
- pPARisk.l <- pPARisk.p - (z * pPARisk.se)
- pPARisk.u <- pPARisk.p + (z * pPARisk.se)
-
- ## Individual strata population attributable rate (same as Rothman p 137 equation 7-4):
- PARate.ctype <- ""
- PARate.p <- ((M1 / M0) - (c / d)) * units
- PARate.se <- (sqrt((M1 / M0^2) + (c / d^2))) * units
- PARate.l <- PARate.p - (z * PARate.se)
- PARate.u <- PARate.p + (z * PARate.se)
-
- ## Individual strata population attributable fractions for risk data (from Hanley, 2001):
- ## PAFRisk.p <- ((wRR.p - 1) / wRR.p) * (a / M1)
- ## PAFRisk.l <- ((wRR.l - 1) / wRR.l) * (a / M1)
- ## PAFRisk.u <- ((wRR.u - 1) / wRR.u) * (a / M1)
-
- ## Individual strata population attributable fractions for risk data (from OpenEpi TwobyTwo):
- ## PAFRisk.p <- (IRiskpop.p - IRisko.p) / IRiskpop.p
- ## PAFRisk.l <- min((IRiskpop.l - IRisko.l) / IRiskpop.l, (IRiskpop.u - IRisko.u) / IRiskpop.u)
- ## PAFRisk.u <- max((IRiskpop.l - IRisko.l) / IRiskpop.l, (IRiskpop.u - IRisko.u) / IRiskpop.u)
-
- ## Individual strata population attributable fractions for risk data (from Jewell, page 84):
- PAFRisk.ctype <- "Jewell"
- PAFRisk.p <- ((a * d) - (b * c)) / ((a + c) * (c + d))
- PAFRisk.var <- (b + (PAFRisk.p * (a + d))) / (total * c)
- PAFRisk.l <- 1 - exp(log(1 - PAFRisk.p) + (z * sqrt(PAFRisk.var)))
- PAFRisk.u <- 1 - exp(log(1 - PAFRisk.p) - (z * sqrt(PAFRisk.var)))
-
- ## Individual strata population attributable fractions for rate data (from Hanley, 2001):
- ## PAFRate.p <- ((IRR.p - 1) / IRR.p) * (a / M1)
- ## PAFRate.l <- ((IRR.l - 1) / IRR.l) * (a / M1)
- ## PAFRate.u <- ((IRR.u - 1) / IRR.u) * (a / M1)
-
- ## Individual strata population attributable fractions for rate data (from OpenEpi TwobyTwo - Jewell doesn't provide a method for rate data):
- PAFRate.ctype <- "Sullivan"
- PAFRate.p <- (IRatepop.p - IRateo.p) / IRatepop.p
- PAFRate.l <- min((IRatepop.l - IRateo.l) / IRatepop.l, (IRatepop.u - IRateo.u) / IRatepop.u)
- PAFRate.u <- max((IRatepop.l - IRateo.l) / IRatepop.l, (IRatepop.u - IRateo.u) / IRatepop.u)
-
- ## Individual strata estimated population attributable fraction (from Hanley, 2001):
- ## PAFest.p <- ((OR.p - 1) / OR.p) * (a / M1)
- ## PAFest.l <- ((OR.l - 1) / OR.l) * (a / M1)
- ## PAFest.u <- ((OR.u - 1) / OR.u) * (a / M1)
-
- ## Individual strata estimated population attributable fraction (from OpenEpi TwobyTwo):
- ## PAFest.p <- (Opop.p - Oo.p) / Opop.p
- ## PAFest.l <- min((Opop.l - Oo.l) / Opop.l, (Opop.u - Oo.u) / Opop.u)
- ## PAFest.u <- max((Opop.l - Oo.l) / Opop.l, (Opop.u - Oo.u) / Opop.u)
-
- ## Individual strata population attributable fractions for risk data (from Jewell, page 84):
- PAFest.ctype <- "Jewell"
- PAFest.p <- ((a * d) - (b * c)) / (d * (a + c))
- PAFest.var <- (a / (c * (a + c))) + (b / (d * (b + d)))
- PAFest.l <- 1 - exp(log(1 - PAFest.p) + (z * sqrt(PAFest.var)))
- PAFest.u <- 1 - exp(log(1 - PAFest.p) - (z * sqrt(PAFest.var)))
-
-
- ## =============================
- ## CRUDE MEASURES OF ASSOCIATION
- ## =============================
-
- ## Crude incidence risk ratio - Wald confidence limits (Rothman p 135 equation 7-3):
- cwRR.ctype <- "Wald"
- .tmp <- .funRRwald(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
- cwRR.p <- .tmp[1]
- cwRR.l <- .tmp[2]
- cwRR.u <- .tmp[3]
-
- ## Crude incidence risk ratio - score confidence limits:
- csRR.ctype <- "Score"
- .tmp <- .funRRscore(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
- csRR.p <- .tmp[1]
- csRR.l <- .tmp[2]
- csRR.u <- .tmp[3]
-
- ## Crude incidence rate ratio (exact confidence intervals from epibasic.xlsx http://ph.au.dk/uddannelse/software/):
- ceIRR.ctype <- "Exact"
- ceIRR.p <- (sa / sb) / (sc / sd)
- celnIRR <- log(ceIRR.p)
- celnIRR.se <- sqrt((1 / sa) + (1 / sc))
- ceIRR.se <- exp(celnIRR.se)
- pl <- sa / (sa + (sc + 1) * (1 / qf(1 - N., 2 * sa, 2 * sc + 2)))
- ph <- (sa + 1) / (sa + 1 + sc / (1 / qf(1 - N., 2 * sc, 2 * sa + 2)))
- ceIRR.l <- pl * sd / ((1 - pl) * sb)
- ceIRR.u <- ph * sd / ((1 - ph) * sb)
-
- ## Crude odds ratio - Wald confidence limits:
- cwOR.ctype <- "Wald"
- .tmp <- .funORwald(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
- cwOR.p <- .tmp[1]
- cwOR.l <- .tmp[2]
- cwOR.u <- .tmp[3]
-
- ## Crude odds ratio - Cornfield confidence limits:
- ccfOR.ctype <- "Cornfield"
- .tmp <- .funORcfield(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
- ccfOR.p <- .tmp[1]
- ccfOR.l <- .tmp[2]
- ccfOR.u <- .tmp[3]
-
- ## Crude odds ratio - score confidence limits:
- csOR.ctype <- "Score"
- .tmp <- .funORscore(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
- csOR.p <- .tmp[1]
- csOR.l <- .tmp[2]
- csOR.u <- .tmp[3]
-
- ## Crude odds ratio - maximum likelihood estimate (using fisher.test function):
- ## Replaced 130612.
- cmOR.ctype <- "MLE"
- cmOR.tmp <- fisher.test(apply(dat, MARGIN = c(1,2), FUN = sum), conf.int = TRUE, conf.level = conf.level)
- cmOR.p <- as.numeric(cmOR.tmp$estimate)
- cmOR.l <- as.numeric(cmOR.tmp$conf.int)[1]
- cmOR.u <- as.numeric(cmOR.tmp$conf.int)[2]
-
- ## Crude attributable risk - Wald confidence limits (Rothman p 135 equation 7-2):
- cwARisk.ctype <- "Wald"
- .tmp <- .funARwald(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level, units)
- cwARisk.p <- .tmp[1]
- cwARisk.l <- .tmp[2]
- cwARisk.u <- .tmp[3]
-
- ## Crude attributable risk - score confidence limits:
- cscARisk.ctype <- "Score"
- .tmp <- .funARscore(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level, units)
- cscARisk.p <- .tmp[1]
- cscARisk.l <- .tmp[2]
- cscARisk.u <- .tmp[3]
-
- ## Crude attributable rate (Rothman p 137 equation 7-4):
- cARate.ctype <- "Wald"
- cARate.p <- ((sa / sb) - (sc / sd)) * units
- cARate.se <- (sqrt((sa / sb^2) + (sc / sd^2))) * units
- cARate.l <- cARate.p - (z * cARate.se)
- cARate.u <- cARate.p + (z * cARate.se)
-
- ## Crude attributable fraction for risk data (from Hanley 2001):
- cAFrisk.ctype <- "Score"
- cAFRisk.p <- (csRR.p - 1) / csRR.p
- cAFRisk.l <- min((csRR.l - 1) / csRR.l, (csRR.u - 1) / csRR.u)
- cAFRisk.u <- max((csRR.l - 1) / csRR.l, (csRR.u - 1) / csRR.u)
-
- ## Crude attributable fraction for rate data (from Hanley 2001):
- cAFRate.ctype <- "Exact"
- cAFRate.p <- (ceIRR.p - 1) / ceIRR.p
- cAFRate.l <- min((ceIRR.l - 1) / ceIRR.l, (ceIRR.u - 1) / ceIRR.u)
- cAFRate.u <- max((ceIRR.l - 1) / ceIRR.l, (ceIRR.u - 1) / ceIRR.u)
-
- ## Crude estimated attributable fraction (from Hanley 2001):
- cAFest.ctype <- "Score"
- cAFest.p <- (scOR.p - 1) / scOR.p
- cAFest.l <- min((scOR.l - 1) / scOR.l, (scOR.u - 1) / scOR.u)
- cAFest.u <- max((scOR.l - 1) / scOR.l, (scOR.u - 1) / scOR.u)
-
- ## Crude population attributable risk (same as Rothman p 135 equation 7-2):
- cwPARisk.ctype <- "Wald"
- cwPARisk.p <- ((sM1 / stotal) - (sc / sN0)) * units
- cwPARisk.se <- (sqrt(((sM1 * (stotal - sM1))/stotal^3) + ((sc * (sN0 - sc))/sN0^3))) * units
- cwPARisk.l <- cwPARisk.p - (z * cwPARisk.se)
- cwPARisk.u <- cwPARisk.p + (z * cwPARisk.se)
-
- ## 270115 Confidence intervals for PAR from Sarah Pirikahu MSc thesis.
- cpPARisk.ctype <- "Pirikahu"
- cpPARisk.p <- ((sM1 / stotal) - (sc / sN0)) * units
- cpPARisk.d1 <- (1 / stotal) - ((sa + sc) / stotal^2)
- cpPARisk.d2 <- -((sa + sc) / stotal^2)
- cpPARisk.d3 <- (sc / (sc + sd)^2) - ((sa + sc) / stotal^2) + (1 / stotal) - (1 / (sc + sd))
- cpPARisk.d4 <- (sc / (sc + sd)^2) - ((sa + sc) / stotal^2)
- cpPARisk.var <- ((cpPARisk.d1^2) * sa) + ((cpPARisk.d2^2) * sb) + ((cpPARisk.d3^2) * sc) + ((cpPARisk.d4^2) * sd)
- cpPARisk.se <- sqrt(cpPARisk.var) * units
- cpPARisk.l <- cpPARisk.p - (z * cpPARisk.se)
- cpPARisk.u <- cpPARisk.p + (z * cpPARisk.se)
-
-
- ## Crude population attributable rate (same as Rothman p 137 equation 7-4):
- cPARate.ctype <- "Wald"
- cPARate.p <- ((sM1 / sM0) - (sc / sd)) * units
- cPARate.se <- (sqrt((sM1 / sM0^2) + (sc / sd^2))) * units
- cPARate.l <- cPARate.p - (z * cPARate.se)
- cPARate.u <- cPARate.p + (z * cPARate.se)
- ## Crude population attributable fractions for risk data (from Hanley 2001):
- ## cPAFRisk.p <- ((csRR.p - 1) / csRR.p) * (sa / sM1)
- ## cPAFRisk.l <- ((csRR.l - 1) / csRR.l) * (sa / sM1)
- ## cPAFRisk.u <- ((csRR.u - 1) / csRR.u) * (sa / sM1)
-
- ## Crude population attributable fractions for risk data (from OpenEpi TwobyTwo):
- ## Changed 160609
- cPAFRisk.ctype <- ""
- cPAFRisk.p <- (cIRiskpop.p - cIRisko.p) / cIRiskpop.p
- cPAFRisk.l <- min((cIRiskpop.l - cIRisko.l) / cIRiskpop.l, (cIRiskpop.u - cIRisko.u) / cIRiskpop.u)
- cPAFRisk.u <- max((cIRiskpop.l - cIRisko.l) / cIRiskpop.l, (cIRiskpop.u - cIRisko.u) / cIRiskpop.u)
-
- ## Crude population attributable fractions for rate data (from Hanley 2001):
- ## cPAFRate.ctype <- "Exact"
- ## cPAFRate.p <- ((ceIRR.p - 1) / ceIRR.p) * (sa / sM1)
- ## cPAFRate.l <- ((ceIRR.p - 1) / ceIRR.p) * (sa / sM1)
- ## cPAFRate.u <- ((ceIRR.p - 1) / ceIRR.p) * (sa / sM1)
-
- ## Crude population attributable fractions for rate data (from OpenEpi TwobyTwo):
- ## Changed 160609
- cPAFRate.ctype <- ""
- cPAFRate.p <- (cIRatepop.p - cIRateo.p) / cIRatepop.p
- cPAFRate.l <- min((cIRatepop.l - cIRateo.l) / cIRatepop.l, (cIRatepop.u - cIRateo.u) / cIRatepop.u)
- cPAFRate.u <- max((cIRatepop.l - cIRateo.l) / cIRatepop.l, (cIRatepop.u - cIRateo.u) / cIRatepop.u)
-
- ## Crude estimated population attributable fraction (from Hanley, 2001):
- ## cPAFest.p <- ((scOR.p - 1) / scOR.p) * (sa / sM1)
- ## cPAFest.l <- ((scOR.p - 1) / scOR.p) * (sa / sM1)
- ## cPAFest.u <- ((scOR.p - 1) / scOR.p) * (sa / sM1)
-
- ## Crude estimated population attributable fraction (from OpenEpi TwobyTwo):
- ## Changed 160609
- cPAFest.ctype <- ""
- cPAFest.p <- (cOpop.p - cOo.p) / cOpop.p
- cPAFest.l <- min((cOpop.l - cOo.l) / cOpop.l, (cOpop.u - cOo.u) / cOpop.u)
- cPAFest.u <- max((cOpop.l - cOo.l) / cOpop.l, (cOpop.u - cOo.u) / cOpop.u)
-
-
- ## ===============================
- ## MANTEL-HAENZEL SUMMARY MEASURES
- ## ===============================
-
- ## Summary incidence risk ratio (Rothman 2002 p 148 and 152, equation 8-2):
- sRR.p <- sum((a * N0 / total)) / sum((c * N1 / total))
- varLNRR.s <- sum(((M1 * N1 * N0) / total^2) - ((a * c)/ total)) /
- (sum((a * N0)/total) * sum((c * N1)/total))
- lnRR.s <- log(sRR.p)
- sRR.se <- (sqrt(varLNRR.s))
- sRR.l <- exp(lnRR.s - (z * sqrt(varLNRR.s)))
- sRR.u <- exp(lnRR.s + (z * sqrt(varLNRR.s)))
-
- ## Summary incidence rate ratio (Rothman 2002 p 153, equation 8-5):
- sIRR.p <- sum((a * d) / M0) / sum((c * b) / M0)
- lnIRR.s <- log(sIRR.p)
- varLNIRR.s <- (sum((M1 * b * d) / M0^2)) / (sum((a * d) / M0) * sum((c * b) / M0))
- sIRR.se <- sqrt(varLNIRR.s)
- sIRR.l <- exp(lnIRR.s - (z * sqrt(varLNIRR.s)))
- sIRR.u <- exp(lnIRR.s + (z * sqrt(varLNIRR.s)))
-
- ## Summary odds ratio (Cord Heuer 211004):
- sOR.p <- sum((a * d / total)) / sum((b * c / total))
- G <- a * d / total
- H <- b * c / total
- P <- (a + d) / total
- Q <- (b + c) / total
- GQ.HP <- G * Q + H * P
- sumG <- sum(G)
- sumH <- sum(H)
- sumGP <- sum(G * P)
- sumGH <- sum(G * H)
- sumHQ <- sum(H * Q)
- sumGQ <- sum(G * Q)
- sumGQ.HP <- sum(GQ.HP)
-
- ## Correction from Richard Bourgon 29 September 2010:
- varLNOR.s <- sumGP / (2 * sumG^2) + sumGQ.HP / (2 * sumG * sumH) + sumHQ / (2 * sumH^2)
- ## varLNOR.s <- sumGP / (2 * sumG^2) + sumGQ.HP / (2 * sumGH) + sumHQ / (2 * sumG * sumH)
- lnOR.s <- log(sOR.p)
- sOR.se <- sqrt(varLNOR.s)
- sOR.l <- exp(lnOR.s - z * sqrt(varLNOR.s))
- sOR.u <- exp(lnOR.s + z * sqrt(varLNOR.s))
-
- ## Summary attributable risk (Rothman 2002 p 147 and p 152, equation 8-1):
- sARisk.p <- (sum(((a * N0) - (c * N1)) / total) / sum((N1 * N0) / total)) * units
- w <- (N1 * N0) / total
- var.p1 <- (((a * d) / (N1^2 * (N1 - 1))) + ((c * b) / (N0^2 * (N0 - 1))))
- var.p1[N0 == 1] <- 0
- var.p1[N1 == 1] <- 0
- varARisk.s <- sum(w^2 * var.p1) / sum(w)^2
- sARisk.se <- (sqrt(varARisk.s)) * units
- sARisk.l <- sARisk.p - (z * sARisk.se)
- sARisk.u <- sARisk.p + (z * sARisk.se)
-
- # Summary attributable risk (Klingenberg (2014) Statistics in Medicine 33: 2968 - 2983.
- SatoARisk.ctype <- "Sato"
- .tmp <- .funMHRD.Sato(dat, conf.level, units)
- SatoARisk.p <- .tmp[1]
- SatoARisk.l <- .tmp[2]
- SatoARisk.u <- .tmp[3]
-
- # Summary attributable risk (Klingenberg (2014) Statistics in Medicine 33: 2968 - 2983.
- GRARisk.ctype <- "Greenland-Robins"
- .tmp <- .funMHRD.GR(dat, conf.level, units)
- GRARisk.p <- .tmp[1]
- GRARisk.l <- .tmp[2]
- GRARisk.u <- .tmp[3]
-
- ## Summary attributable rate (Rothman 2002 p 153, equation 8-4):
- sARate.p <- sum(((a * d) - (c * b)) / M0) / sum((b * d) / M0) * units
- varARate.s <- sum(((b * d) / M0)^2 * ((a / b^2) + (c / d^2 ))) / sum((b * d) / M0)^2
- sARate.se <- sqrt(varARate.s) * units
- sARate.l <- sARate.p - (z * sARate.se)
- sARate.u <- sARate.p + (z * sARate.se)
-
-
- ## ===============================
- ## EFFECT OF CONFOUNDING
- ## ===============================
- ## Effect of confounding for risk ratio (Woodward p 172):
- RR.conf.p <- (csRR.p / sRR.p)
- RR.conf.l <- (csRR.l / sRR.l)
- RR.conf.u <- (csRR.u / sRR.u)
-
- ## Effect of confounding for incidence risk ratio (Woodward p 172):
- IRR.conf.p <- (ceIRR.p / sIRR.p)
- IRR.conf.l <- (ceIRR.l / sIRR.l)
- IRR.conf.u <- (ceIRR.u / sIRR.u)
-
- ## Effect of confounding for odds ratio (Woodward p 172):
- OR.conf.p <- (scOR.p / sOR.p)
- OR.conf.l <- (scOR.l / sOR.l)
- OR.conf.u <- (scOR.u / sOR.u)
-
- ## Effect of confounding for attributable risk (Woodward p 172):
- ARisk.conf.p <- (cscARisk.p / scARisk.p)
- ARisk.conf.l <- (cscARisk.l / scARisk.l)
- ARisk.conf.u <- (cscARisk.u / scARisk.u)
-
- ## Effect of confounding for attributable rate (Woodward p 172):
- ARate.conf.p <- (cARate.p / sARate.p)
- ARate.conf.l <- (cARate.l / sARate.l)
- ARate.conf.u <- (cARate.u / sARate.u)
-
-
- ## ===========================================
- ## CHI-SQUARED TESTS OF HOMOGENEITY AND EFFECT
- ## ===========================================
+ p <- x/n
+ x1 <- x == 0; x2 <- x == n
+ lb <- ub <- x
+ lb[x1] <- 1
+ ub[x2] <- n[x2] - 1
+ lcl <- 1 - qbeta(1 - alpha2, n + 1 - x, lb)
+ ucl <- 1 - qbeta(alpha2, n - ub, x + 1)
+
+ if (any(x1))
+ lcl[x1] <- rep(0, sum(x1))
+
+ if (any(x2))
+ ucl[x2] <- rep(1, sum(x2))
+
+ rval <- data.frame(est = p, lower = lcl, upper = ucl)
+ rval
+ }
+
+ .funincrate <- function(dat, conf.level){
+ N. <- 1 - ((1 - conf.level) / 2)
+ a <- dat[,1]
+ n <- dat[,2]
+ p <- a / n
+ low <- 0.5 * qchisq(p = N., df = 2 * a + 2, lower.tail = FALSE) / n
+ up <- 0.5 * qchisq(p = 1 - N., df = 2 * a + 2, lower.tail = FALSE) / n
+ ## a.prime <- dat[,1] + 0.5
+ ## p <- dat[,1]/dat[,2]
+ ## PT <- dat[,2]
+ ## low <- (a.prime * (1 - (1/(9 * a.prime)) - (z/3 * sqrt(1/a.prime)))^3)/PT
+ ## up <- (a.prime * (1 - (1/(9 * a.prime)) + (z/3 * sqrt(1/a.prime)))^3)/PT
+
+ ## Wilson's method (see Rothman, Epidemiology An Introduction, page 132):
+ ## N. <- 1 - ((1 - conf.level) / 2)
+ ## z <- qnorm(N., mean = 0, sd = 1)
+ ## a <- dat[,1]
+ ## n <- dat[,2]
+ ## p <- dat[,1] / dat[,2]
+ ## a. <- n/(n + z^2)
+ ## b. <- a/n
+ ## c. <- z^2/(2 * n)
+ ## d. <- (a * (n - a)) / n^3
+ ## e. <- z^2 / (4 * n^2)
+ ## low <- a. * (b. + c. - (z * sqrt(d. + e.)))
+ ## up <- a. * (b. + c. + (z * sqrt(d. + e.)))
+
+ rval <- data.frame(p, low, up)
+ names(rval) <- c("est", "lower", "upper")
+ rval
+ }
+
+ .funRRwald <- function(dat, conf.level){
+ N. <- 1 - ((1 - conf.level) / 2)
+ z <- qnorm(N., mean = 0, sd = 1)
+
+ a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
+ N1 <- a + b; N0 <- c + d
+
+ wRR.p <- (a / N1) / (c / N0)
+ lnwRR <- log(wRR.p)
+ lnwRR.var <- (1 / a) - (1 / N1) + (1 / c) - (1 / N0)
+ lnwRR.se <- sqrt((1 / a) - (1 / N1) + (1 / c) - (1 / N0))
+ wRR.se <- exp(lnwRR.se)
+ ll <- exp(lnwRR - (z * lnwRR.se))
+ ul <- exp(lnwRR + (z * lnwRR.se))
+ c(wRR.p, ll, ul)
+ }
+
+ .funRRscore <- function(dat, conf.level){
+ N. <- 1 - ((1 - conf.level) / 2)
+ z <- qnorm(N., mean = 0, sd = 1)
+
+ a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
+ N1 <- a + b; N0 <- c + d
+
+ scRR.p <- (a / N1) / (c / N0)
+
+ if ((c == 0) && (a == 0)){
+ ul = Inf
+ ll = 0
+ }
+
+ else{
+ a1 = N0 * (N0 * (N0 + N1) * a + N1 * (N0 + a) * (z^2))
+ a2 = -N0 * (N0 * N1 * (c + a) + 2 * (N0 + N1) * c * a + N1 * (N0 + c + 2 * a) * (z^2))
+ a3 = 2 * N0 * N1 * c * (c + a) + (N0 + N1) * (c^2) * a + N0 * N1 * (c + a) * (z^2)
+ a4 = -N1 * (c ^ 2) * (c + a)
+
+ b1 = a2 / a1
+ b2 = a3 / a1
+ b3 = a4 / a1
+ c1 = b2 - (b1^2) / 3
+ c2 = b3 - b1 * b2 / 3 + 2 * (b1^3) / 27
+ ceta = acos(sqrt(27) * c2 / (2 * c1 * sqrt(-c1)))
+ t1 = -2 * sqrt(-c1 / 3) * cos(pi / 3 - ceta / 3)
+ t2 = -2 * sqrt(-c1 / 3) * cos(pi / 3 + ceta / 3)
+ t3 = 2 * sqrt(-c1 / 3) * cos(ceta / 3)
+ p01 = t1 - b1 / 3
+ p02 = t2 - b1 / 3
+ p03 = t3 - b1 / 3
+ p0sum = p01 + p02 + p03
+ p0up = min(p01, p02, p03)
+ p0low = p0sum - p0up - max(p01, p02, p03)
+
+ if( (c == 0) && (a != 0) ){
+ ll = (1 - (N1 - a) * (1 - p0low) / (c + N1 - (N0 + N1) * p0low)) / p0low
+ ul = Inf
+ }
+
+ else if((c != N0) && (a == 0)){
+ ul = (1 - (N1 - a) * (1 - p0up) / (c + N1 - (N0 + N1) * p0up)) / p0up
+ ll = 0
+ }
+
+ else if((c == N0) && (a == N1)){
+ ul = (N0 + z^2) / N0
+ ll = N1 / (N1 + z^2)
+ }
+
+ else if((a == N1) || (c == N0)){
+ if((c == N0) && (a == 0)) {ll = 0}
+ if((c == N0) && (a != 0)) {
+ phat1 = c / N0
+ phat2 = a / N1
+ phihat = phat2 / phat1
+ phil = 0.95 * phihat
+ chi2 = 0
+ while (chi2 <= z){
+ a = (N0 + N1) * phil
+ b = -((c + N1) * phil + a + N0)
+ c = c + a
+ p1hat = (-b - sqrt(b^2 -4 * a * c)) / (2 * a)
+ p2hat = p1hat * phil
+ q2hat = 1 - p2hat
+ var = (N0 * N1 * p2hat) / (N1 * (phil - p2hat) + N0 * q2hat)
+ chi2 = ((a - N1 * p2hat) / q2hat) / sqrt(var)
+ ll = phil
+ phil = ll / 1.0001}}
+ i = c
+ j = a
+ ni = N0
+ nj = N1
- ## Chi-squared test statistic for individual strata. See Dawson Saunders and Trapp page 151:
- exp.a <- (N1 * M1) / total
- exp.b <- (N1 * M0) / total
- exp.c <- (N0 * M1) / total
- exp.d <- (N0 * M0) / total
- chi2 <- (((a - exp.a)^2)/ exp.a) + (((b - exp.b)^2)/ exp.b) + (((c - exp.c)^2)/ exp.c) + (((d - exp.d)^2)/ exp.d)
- p.chi2 <- 1 - pchisq(chi2, df = 1)
+ if(a == N1){
+ i = a
+ j = c
+ ni = N1
+ nj = N0
+ }
+ phat1 = i / ni
+ phat2 = j / nj
+ phihat = phat2 / phat1
+ phiu = 1.1 * phihat
- ## Crude summary chi-squared test statistic with 1 degree of freedom:
- exp.sa <- (sN1 * sM1) / stotal
- exp.sb <- (sN1 * sM0) / stotal
- exp.sc <- (sN0 * sM1) / stotal
- exp.sd <- (sN0 * sM0) / stotal
- chi2s <- (((sa - exp.sa)^2)/ exp.sa) + (((sb - exp.sb)^2)/ exp.sb) + (((sc - exp.sc)^2)/ exp.sc) + (((sd - exp.sd)^2)/ exp.sd)
- p.chi2s <- 1 - pchisq(chi2s, df = 1)
+ if((c == N0) && (a == 0)) {
+ if(N0 < 100) {phiu = 0.01}
+ else {phiu = 0.001}
+ }
- ## Mantel-Haenszel chi-squared test:
- if(length(a) > 1){
- chi2m <- as.numeric(mantelhaen.test(dat)$statistic)
- p.chi2m <- as.numeric(mantelhaen.test(dat)$p.value)
+ chi1 = 0
+ while (chi1 >= -z){
+ a. = (ni + nj) * phiu
+ b. = -((i + nj) * phiu + j + ni)
+ c. = i + j
+ p1hat = (-b. - sqrt(b.^2 - 4 * a. * c.)) / (2 * a.)
+ p2hat = p1hat * phiu
+ q2hat = 1 - p2hat
+ var = (ni * nj * p2hat) / (nj * (phiu - p2hat) + ni * q2hat)
+ chi1 = ((j - nj * p2hat) / q2hat) / sqrt(var)
+ phiu1 = phiu
+ phiu = 1.0001 * phiu1
}
- if(length(a) > 1){
- if(homogeneity == "woolf"){
-
- ## Test of homogeneity of risk ratios (Jewell 2004, page 154). First work out the Woolf estimate of the adjusted risk ratio (labelled lnRR.s. here) based on Jewell (2004, page 134):
- lnRR. <- log((a / (a + b)) / (c / (c + d)))
- lnRR.var. <- (b / (a * (a + b))) + (d / (c * (c + d)))
- wRR. <- 1 / lnRR.var.
- lnRR.s. <- sum(wRR. * lnRR.) / sum(wRR.)
-
- ## Equation 10.3 from Jewell (2004):
- RR.homogeneity <- sum(wRR. * (lnRR. - lnRR.s.)^2)
- RR.homogeneity.p <- 1 - pchisq(RR.homogeneity, df = n.strata - 1)
- RR.homog <- data.frame(test.statistic = RR.homogeneity, df = n.strata - 1, p.value = RR.homogeneity.p)
-
- ## Test of homogeneity of odds ratios (Jewell 2004, page 154). First work out the Woolf estimate of the adjusted odds ratio (labelled lnOR.s. here) based on Jewell (2004, page 129):
- lnOR. <- log(((a + 0.5) * (d + 0.5)) / ((b + 0.5) * (c + 0.5)))
- lnOR.var. <- (1 / (a + 0.5)) + (1 / (b + 0.5)) + (1 / (c + 0.5)) + (1 / (d + 0.5))
- wOR. <- 1 / lnOR.var.
- lnOR.s. <- sum((wOR. * lnOR.)) / sum(wOR.)
-
- ## Equation 10.3 from Jewell (2004):
- OR.homogeneity <- sum(wOR. * (lnOR. - lnOR.s.)^2)
- OR.homogeneity.p <- 1 - pchisq(OR.homogeneity, df = n.strata - 1)
- OR.homog <- data.frame(test.statistic = OR.homogeneity, df = n.strata - 1, p.value = OR.homogeneity.p)
- }
-
- if(homogeneity == "breslow.day"){
- ## Setup calculations. From Jim Robison-Cox, based on Jewell (2004, page 154).
- n11k <- dat[1,1,]
- n21k <- dat[2,1,]
- n12k <- dat[1,2,]
- n22k <- dat[2,2,]
- row1sums <- n11k + n12k
- row2sums <- n21k + n22k
- col1sums <- n11k + n21k
- Amax <- apply(cbind(row1sums, col1sums), 1, min)
-
- ## Breslow-Day test of homogeneity of risk ratios. Astar must be no more than col1sums and no more than row1sums:
- bb <- row2sums + row1sums * sRR.p - col1sums * (1 - sRR.p)
- determ <- sqrt(bb^2 + 4 * (1 - sRR.p) * sRR.p * row1sums * col1sums)
- Astar <- (-bb + cbind(-determ, determ)) / (2 - 2 * sRR.p)
- Astar <- ifelse(Astar[,1] <= Amax & Astar[,1] >= 0, Astar[,1], Astar[,2])
- ## print(Astar)
- Bstar <- row1sums - Astar
- Cstar <- col1sums - Astar
- Dstar <- row2sums - col1sums + Astar
- Var <- apply(1 / cbind(Astar, Bstar, Cstar, Dstar), 1, sum)^(-1)
- ## print(Var)
-
- RR.homogeneity <- sum((dat[1,1,] - Astar)^2 / Var)
- RR.homogeneity.p <- 1 - pchisq(RR.homogeneity, df = n.strata - 1)
-
-
- ## Breslow-Day test of homogeneity of odds ratios. Astar must be no more than col1sums and no more than row1sums:
- bb <- row2sums + row1sums * sOR.p - col1sums * (1 - sOR.p)
- determ <- sqrt(bb^2 + 4 * (1 - sOR.p) * sOR.p * row1sums * col1sums)
- Astar <- (-bb + cbind(-determ, determ)) / (2 - 2 * sOR.p)
- Astar <-ifelse(Astar[,1] <= Amax & Astar[,1] >= 0, Astar[,1], Astar[,2])
- ## print(Astar)
- Bstar <-row1sums - Astar
- Cstar <- col1sums - Astar
- Dstar <- row2sums - col1sums + Astar
- Var <- apply(1 / cbind(Astar, Bstar, Cstar, Dstar), 1, sum)^(-1)
- ## print(Var)
-
- OR.homogeneity <- sum((dat[1,1,] - Astar)^2 / Var)
- OR.homogeneity.p <- 1 - pchisq(OR.homogeneity, df = n.strata - 1)
-
- }
+ if(a == N1) {
+ ul = (1 - (N1 - a) * (1 - p0up) / (c + N1 - (N0 + N1) * p0up)) / p0up
+ ll = 1 / phiu1
}
-
- ## Test of attributable risk homogeneity (see Woodward p 207):
- ## AR.homogeneity <- sum(AR.p - AR.s)^2 / SE.AR^2
- ## Test of effect:
- ## AR.homogeneity.p <- 1 - pchisq(AR.homogeneity, df = n.strata - 1)
- ## AR.homog <- data.frame(test.statistic = AR.homogeneity, df = n.strata - 1, p.value = AR.homogeneity.p)
-
-
- ## ===============================
- ## RESULTS
- ## ===============================
- ## Results are entered in a list
- res <- list(
-
- ## Strata incidence risk ratio:
- RR.strata.wald = data.frame(est = wRR.p, lower = wRR.l, upper = wRR.u),
- RR.strata.score = data.frame(est = scRR.p, lower = scRR.l, upper = scRR.u),
-
- ## Crude incidence risk ratio:
- RR.crude.wald = data.frame(est = cwRR.p, lower = cwRR.l, upper = cwRR.u),
- RR.crude.score = data.frame(est = csRR.p, lower = csRR.l, upper = csRR.u),
-
- ## Mantel-Haenszel incidence risk ratio:
- RR.mh.wald = data.frame(est = sRR.p, lower = sRR.l, upper = sRR.u),
-
- ## Strata incidence rate ratio:
- IRR.strata.wald = data.frame(est = IRR.p, lower = IRR.l, upper = IRR.u),
-
- ## Crude incidence rate ratio:
- IRR.crude.wald = data.frame(est = ceIRR.p, lower = ceIRR.l, upper = ceIRR.u),
-
- ## Mantel-Haenszel incidence rate ratio:
- IRR.mh.wald = data.frame(est = sIRR.p, lower = sIRR.l, upper = sIRR.u),
-
-
- ## Strata odds ratio:
- OR.strata.wald = data.frame(est = wOR.p, lower = wOR.l, upper = wOR.u),
- OR.strata.score = data.frame(est = scOR.p, lower = scOR.l, upper = scOR.u),
- OR.strata.cfield = data.frame(est = cfOR.p, lower = cfOR.l, upper = cfOR.u),
- OR.strata.mle = data.frame(est = mOR.p, lower = mOR.l, upper = mOR.u),
-
- ## Crude odds ratio:
- OR.crude.wald = data.frame(est = cwOR.p, lower = cwOR.l, upper = cwOR.u),
- OR.crude.score = data.frame(est = csOR.p, lower = csOR.l, upper = csOR.u),
- OR.crude.cfield = data.frame(est = ccfOR.p, lower = ccfOR.l, upper = ccfOR.u),
- OR.crude.mle = data.frame(est = cmOR.p, lower = cmOR.l, upper = cmOR.u),
-
- ## Mantel-Haenszel odds ratio:
- OR.mh.wald = data.frame(est = sOR.p, lower = sOR.l, upper = sOR.u),
-
-
- ## Strata attributable risk:
- ARisk.strata.wald = data.frame(est = wARisk.p, lower = wARisk.l, upper = wARisk.u),
- ARisk.strata.score = data.frame(est = scARisk.p, lower = scARisk.l, upper = scARisk.u),
-
- ## Crude attributable risk:
- ARisk.crude.wald = data.frame(est = cwARisk.p, lower = cwARisk.l, upper = cwARisk.u),
- ARisk.crude.score = data.frame(est = cscARisk.p, lower = cscARisk.l, upper = cscARisk.u),
-
- ## Mantel-Haenszel attributable risk:
- ARisk.mh.wald = data.frame(est = sARisk.p, lower = sARisk.l, upper = sARisk.u),
- ARisk.mh.sato = data.frame(est = SatoARisk.p, lower = SatoARisk.l, upper = SatoARisk.u),
- ARisk.mh.green = data.frame(est = GRARisk.p, lower = GRARisk.l, upper = GRARisk.u),
-
-
- ## Strata attributable rate:
- ARate.strata.wald = data.frame(est = ARate.p, lower = ARate.l, upper = ARate.u),
-
- ## Crude attributable rate:
- ARate.crude.wald = data.frame(est = cARate.p, lower = cARate.l, upper = cARate.u),
-
- ## Mantel-Haenszel adjusted attributable rate:
- ARate.mh.wald = data.frame(est = sARate.p, lower = sARate.l, upper = sARate.u),
-
-
- ## Strata attributable fraction for risk data:
- AFRisk.strata.wald = data.frame(est = AFRisk.p, lower = AFRisk.l, upper = AFRisk.u),
-
- ## Crude attributable fraction for risk data:
- AFRisk.crude.wald = data.frame(est = cAFRisk.p, lower = cAFRisk.l, upper = cAFRisk.u),
-
-
- ## Strata attributable fraction for rate data:
- AFRate.strata.wald = data.frame(est = AFRate.p, lower = AFRate.l, upper = AFRate.u),
-
- ## Crude attributable fraction for rate data:
- AFRate.crude.wald = data.frame(est = cAFRate.p, lower = cAFRate.l, upper = cAFRate.u),
-
-
- ## Strata estimated attributable fraction:
- AFest.strata.wald = data.frame(est = AFest.p, lower = AFest.l, upper = AFest.u),
-
- ## Crude estimated attributable fraction:
- AFest.crude.wald = data.frame(est = cAFest.p, lower = cAFest.l, upper = cAFest.u),
-
-
- ## Strata population attributable risk:
- PARisk.strata.wald = data.frame(est = wPARisk.p, lower = wPARisk.l, upper = wPARisk.u),
- PARisk.strata.piri = data.frame(est = pPARisk.p, lower = pPARisk.l, upper = pPARisk.u),
-
- ## Crude population attributable risk:
- PARisk.crude.wald = data.frame(est = cwPARisk.p, lower = cwPARisk.l, upper = cwPARisk.u),
- PARisk.crude.piri = data.frame(est = cpPARisk.p, lower = cpPARisk.l, upper = cpPARisk.u),
-
-
- ## Strata population attributable rate:
- PARate.strata.wald = data.frame(est = PARate.p, lower = PARate.l, upper = PARate.u),
-
- ## Crude population attributable rate:
- PARate.crude.wald = data.frame(est = cPARate.p, lower = cPARate.l, upper = cPARate.u),
-
-
- ## Strata population attributable fraction for risk data:
- PAFRisk.strata.wald = data.frame(est = PAFRisk.p, lower = PAFRisk.l, upper = PAFRisk.u),
-
- ## Crude population attributable fraction for risk data:
- PAFRisk.crude.wald = data.frame(est = cPAFRisk.p, lower = cPAFRisk.l, upper = cPAFRisk.u),
-
-
- ## Strata population attributable fraction for rate data:
- PAFRate.strata.wald = data.frame(est = PAFRate.p, lower = PAFRate.l, upper = PAFRate.u),
-
- ## Crude population attributable fraction for rate data:
- PAFRate.crude.wald = data.frame(est = cPAFRate.p, lower = cPAFRate.l, upper = cPAFRate.u),
-
-
- ## Strata estimated population attributable fraction:
- PAFest.strata.wald = data.frame(est = PAFest.p, lower = PAFest.l, upper = PAFest.u),
-
- ## Crude estimated population attributable fraction:
- PAFest.crude.wald = data.frame(est = cPAFest.p, lower = cPAFest.l, upper = cPAFest.u),
-
-
- ## Effect of confounding for risk ratio (Woodward p 172):
- RR.conf = data.frame(est = RR.conf.p, lower = RR.conf.l, upper = RR.conf.u),
-
- ## Effect of confounding for rate ratio (Woodward p 172):
- IRR.conf = data.frame(est = IRR.conf.p, lower = IRR.conf.l, upper = IRR.conf.u),
-
- ## Effect of confounding for odds ratio (Woodward p 172):
- OR.conf = data.frame(est = OR.conf.p, lower = OR.conf.l, upper = OR.conf.u),
-
- ## Effect of confounding for attributable risk (Woodward p 172):
- ARisk.conf = data.frame(est = ARisk.conf.p, lower = ARisk.conf.l, upper = ARisk.conf.u),
-
- ## Effect of confounding for attributable rate (Woodward p 172):
- ARate.conf = data.frame(est = ARate.conf.p, lower = ARate.conf.l, upper = ARate.conf.u),
-
- ## Labelling for incidence prevalence units:
- count.units = ifelse(units == 1, "Outcomes per population unit", paste("Outcomes per ", units, " population units", sep = "")),
-
- time.units = ifelse(units == 1, "Outcomes per unit of population time at risk", paste("Outcomes per ", units, " units of population time at risk", sep = "")),
-
- chisq.strata = data.frame(test.statistic = chi2, df = 1, p.value = p.chi2),
-
- chisq.crude = data.frame(test.statistic = chi2s, df = 1, p.value = p.chi2s)
- )
-
- if(n.strata > 1){
- res$chisq.mh = data.frame(test.statistic = chi2m, df = 1, p.value = p.chi2m)
- res$RR.homog = data.frame(test.statistic = RR.homogeneity, df = n.strata - 1, p.value = RR.homogeneity.p)
- res$OR.homog = data.frame(test.statistic = OR.homogeneity, df = n.strata - 1, p.value = OR.homogeneity.p)
- }
+ else{ul = phiu1}
+ }
+
+ else{
+ ul = (1 - (N1 - a) * (1 - p0up) / (c + N1 - (N0 + N1) * p0up)) /p0up
+ ll = (1 - (N1 - a) * (1 - p0low) / (c + N1 - (N0 + N1) * p0low)) / p0low
+ }
+ }
+ c(scRR.p, ll, ul)
+ }
+
+ .funORwald <- function(dat, conf.level){
+ N. <- 1 - ((1 - conf.level) / 2)
+ z <- qnorm(N., mean = 0, sd = 1)
-
- ## ===============================
- ## REPORTING
- ## ===============================
-
- ## method = "cohort.count", single strata:
- if(method == "cohort.count" & n.strata == 1){
-
- ## Verbose part:
- massoc <- list(
- RR.strata.wald = res$RR.strata.wald,
- RR.strata.score = res$RR.strata.score,
-
- OR.strata.wald = res$OR.strata.wald,
- OR.strata.score = res$OR.strata.score,
- OR.strata.cfield = res$OR.strata.cfield,
- OR.strata.mle = res$OR.strata.mle,
-
- ARisk.strata.wald = res$ARisk.strata.wald,
- ARisk.strata.score = res$ARisk.strata.score,
-
- PARisk.strata.wald = res$PARisk.strata.wald,
- PARisk.strata.piri = res$PARisk.strata.piri,
-
- AFRisk.strata.wald = res$AFRisk.strata.wald,
- PAFRisk.strata.wald= res$PAFRisk.strata.wald,
-
- chisq.strata = res$chisq.strata)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(a, b, N1, cIRiske.p, cOe.p)
- r2 <- c(c, d, N0, cIRisko.p, cOo.p)
- r3 <- c(M1, M0, M0 + M1, cIRiskpop.p, cOpop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Inc risk *", " Odds")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(a, c, M1)
- r2 <- c(b, d, M0)
- r3 <- c(N1, N0, N0 + N1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "cohort.count", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
+ N1 <- a + b; N0 <- c + d
+
+ wOR.p <- (a / b) / (c / d)
+ lnwOR <- log(wOR.p)
+ lnwOR.var <- 1/a + 1/b + 1/c + 1/d
+ lnwOR.se <- sqrt(lnwOR.var)
+ ll <- exp(lnwOR - (z * lnwOR.se))
+ ul <- exp(lnwOR + (z * lnwOR.se))
+ c(wOR.p, ll, ul)
+ }
+
+ .funORcfield <- function (dat, conf.level, interval = c(1e-08, 1e+08)){
+ a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
+ N1 <- a + b; N0 <- c + d
+
+ cfOR.p <- (a / b) / (c / d)
+
+ if (((a == 0) && (c == 0)) || ((a == N1) && (c == N0))) {
+ ll <- 0
+ ul <- Inf
+ }
+
+ else if (c == N0 || a == 0) {
+ ll <- 0
+ ul <- uniroot(function(or) {
+ sum(sapply(max(0, a + c - N0):a, dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
+ }, interval = interval)$root
+ }
+ else if (a == N1 || c == 0) {
+ ll <- uniroot(function(or) {
+ sum(sapply(a:min(N1, a + c), dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
+ }, interval = interval)$root
+ ul <- Inf
+ }
+ else {
+ ll <- uniroot(function(or) {
+ sum(sapply(a:min(N1, a + c), dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
+ }, interval = interval)$root
+ ul <- uniroot(function(or) {
+ sum(sapply(max(0, a + c - N0):a, dFNCHypergeo, N1, N0, a + c, or)) - dFNCHypergeo(a, N1, N0, a + c, or)/2 - (1 - conf.level)/2
+ }, interval = interval)$root
+ }
+ c(cfOR.p, ll, ul)
+ }
+
+ # dFNCHypergeo <- function (x, m1, m2, n, odds, precision = 1e-07){
+ # stopifnot(is.numeric(x), is.numeric(m1), is.numeric(m2),
+ # is.numeric(n), is.numeric(odds), is.numeric(precision))
+ # .Call("dFNCHypergeo", as.integer(x), as.integer(m1), as.integer(m2),
+ # as.integer(n), as.double(odds), as.double(precision),
+ # PACKAGE = "BiasedUrn")
+ # }
+
+ # See http://www.stat.ufl.edu/~aa/cda/R/two-sample/R2/index.html
+ # See https://stackoverflow.com/questions/4357827/do-while-loop-in-r
+ .limit <- function(x1, n1, x2, n2, conf.level, lim, t){
+ z = qchisq(conf.level, 1)
+ px = x1 / n1
+ score <- 1:1000
+ score = 0
+ # Edited from Agresti version to increase speed 290617:
+ repeat{
+ a. = n2 *(lim - 1)
+ b. = n1 * lim + n2 - (x1 + x2) * (lim - 1)
+ c. = -(x1 + x2)
+ p2d = (-b. + sqrt(b.^2 - 4 * a. * c.)) / (2 * a.)
+ p1d = p2d * lim / (1 + p2d * (lim - 1))
+ score = ((n1 * (px - p1d))^2) * (1 / (n1 * p1d * (1 - p1d)) + 1 / (n2 * p2d * (1 - p2d)))
+ ci = lim
+ if(t == 0) {lim = ci / 1.001}
+ else{lim = ci * 1.001}
+ if(score > z){ break }
+ }
+ return(ci)
+ }
+
+ .funORscore <- function(dat, conf.level){
+ x1 <- dat[1]; n1 <- dat[1] + dat[3]
+ x2 <- dat[2]; n2 <- dat[2] + dat[4]
+
+ px = x1 / n1
+ py = x2 / n2
+
+ scOR.p <- (dat[1] / dat[3]) / (dat[2] / dat[4])
+
+ if(((x1 == 0) && (x2 == 0)) || ((x1 == n1) && (x2 == n2))){
+ ul = 1/0
+ ll = 0
+ }
+
+ else if((x1 == 0) || (x2 == n2)){
+ ll = 0
+ theta = 0.01 / n2
+ ul = .limit(x1, n1, x2, n2, conf.level, theta, 1)
+ }
+
+ else if((x1 == n1) || (x2 == 0)){
+ ul = 1 / 0
+ theta = 100 * n1
+ ll = .limit(x1, n1, x2, n2, conf.level, theta, 0)
+ }
+
+ else{
+ theta = px / (1 - px) / (py / (1 - py)) / 1.1
+ ll = .limit(x1, n1, x2, n2, conf.level, theta, 0)
+ theta = px / (1 - px) / (py / (1 - py)) * 1.1
+ ul = .limit(x1, n1, x2, n2, conf.level, theta, 1)
+ }
+ c(scOR.p, ll,ul)
+ }
+
+ .funORml <- function(dat, conf.level){
+ mOR.tmp <- fisher.test(dat, conf.int = TRUE, conf.level = conf.level)
+
+ mOR.p <- as.numeric(mOR.tmp$estimate)
+ mOR.l <- as.numeric(mOR.tmp$conf.int)[1]
+ mOR.u <- as.numeric(mOR.tmp$conf.int)[2]
+
+ c(mOR.p, mOR.l, mOR.u)
+ }
+
+ .funARwald <- function(dat, conf.level, units){
+ N. <- 1 - ((1 - conf.level) / 2)
+ z <- qnorm(N., mean = 0, sd = 1)
+
+ a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
+ N1 <- a + b; N0 <- c + d
+
+ wARisk.p <- ((a / N1) - (c / N0))
+ ## wARisk.var <- (((a * b) / (N1^2 * (N1 - 1))) + ((c * d) / (N0^2 * (N0 - 1))))
+ wARisk.se <- (sqrt(((a * (N1 - a))/N1^3) + ((c * (N0 - c))/N0^3)))
+ ll <- (wARisk.p - (z * wARisk.se))
+ ul <- (wARisk.p + (z * wARisk.se))
+ c(wARisk.p * units, ll * units, ul * units)
+ }
+
+ .funARscore <- function(dat, conf.level, units){
+ N. <- 1 - ((1 - conf.level) / 2)
+ z <- qnorm(N., mean = 0, sd = 1)
+
+ a <- dat[1]; b <- dat[3]; c <- dat[2]; d <- dat[4]
+ N1 <- a + b; N0 <- c + d
+
+ sARisk.p <- ((a / N1) - (c / N0))
+ px = a / N1
+ py = c / N0
+ z = qchisq(conf.level, 1)
+ proot = px - py
+ dp = 1 - proot
+ niter = 1
+ while(niter <= 50){
+ dp = 0.5 * dp
+ up2 = proot + dp
+ score = .z2stat(px, N1, py, N0, up2)
+ if(score < z){proot = up2}
+ niter = niter + 1
+ if((dp < 0.0000001) || (abs(z - score) < 0.000001)){
+ niter = 51
+ ul = up2
+ }
+ }
+
+ proot = px - py
+ dp = 1 + proot
+ niter = 1
+ while(niter <= 50){
+ dp = 0.5 * dp
+ low2 = proot - dp
+ score = .z2stat(px, N1, py, N0, low2)
+ if(score < z){proot = low2}
+ niter = niter + 1
+ if((dp < 0.0000001) || (abs(z - score) < 0.000001)){
+ ll = low2
+ niter = 51
+ }
+ }
+ c(sARisk.p * units, ll * units, ul * units)
+ }
+
+ .z2stat <- function (p1x, nx, p1y, ny, dif){
+ diff = p1x-p1y-dif
+ if (abs(diff) == 0) {
+ fmdiff = 0}
+ else{
+ t = ny / nx
+ a = 1 + t
+ b = -(1 + t + p1x + t * p1y + dif * (t + 2))
+ c = dif * dif + dif * (2 * p1x + t + 1) + p1x + t * p1y
+ d = -p1x * dif * (1 + dif)
+ v = (b / a / 3)^3 - b * c / (6 * a * a) + d / a / 2
+ s = sqrt((b / a / 3)^2 - c / a / 3)
+ if(v > 0){u = s}
+ else{u = -s}
+ w = (3.141592654 + acos(v / u^3)) / 3
+ p1d = 2 * u * cos(w) - b / a / 3
+ p2d = p1d - dif
+ var = p1d * (1 - p1d) / nx + p2d * (1 - p2d) / ny
+ fmdiff = diff^2 / var
+ }
+ return(fmdiff)
+ }
+
+ .funMHRD.Sato0 <- function(dat, conf.level = 0.95, units = units) {
+ if(length(dim(dat)) > 2){
+ ndat <- addmargins(A = dat, margin = 2, FUN = sum, quiet = FALSE)
+ c1 <- ndat[1,1,]; c2 <- ndat[1,3,]; c3 <- ndat[2,1,]; c4 <- ndat[2,3,]
+ dataset <- cbind(c1, c2, c3, c4)
+
+ num <- sum(apply(X = dataset, MARGIN = 1, FUN = function(ro) (ro[1] * ro[4] - ro[3] * ro[2]) / (ro[2] + ro[4])))
+ W <- sum(apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4]))) # Cochrane weights
+ delta.MH <- num / W
+ P <- sum(apply(dataset, 1, function(ro) (ro[2]^2 * ro[3] - ro[4]^2 * ro[1] + 0.5 * ro[2] * ro[4] * (ro[4] - ro[2])) / (ro[2] + ro[4])^2))
+ Q <- sum(apply(dataset,1,function(ro) (ro[1] * (ro[4] - ro[3]) + ro[3] * (ro[2] - ro[1])) / (2 * (ro[2] + ro[4]))))
+
+ delta.Mid <- delta.MH + 0.5 * qchisq(conf.level, df = 1) * (P / W^2)
+ ME <- sqrt(delta.Mid^2 - delta.MH^2 + qchisq(conf.level, df = 1) * Q / W^2)
+ CI <- delta.Mid + cbind(-1,1) * ME
+
+ Sato0ARisk.p <- delta.Mid
+ Sato0ARisk.l <- Sato0ARisk.p - ME
+ Sato0ARisk.u <- Sato0ARisk.p + ME
+ c(Sato0ARisk.p * units, Sato0ARisk.l * units, Sato0ARisk.u * units)
+ }
+ }
+
+ .funMHRD.Sato <- function(dat, conf.level = 0.95, units = units) {
+ if(length(dim(dat)) > 2){
+ ndat <- addmargins(A = dat, margin = 2, FUN = sum, quiet = FALSE)
+ c1 <- ndat[1,1,]; c2 <- ndat[1,3,]; c3 <- ndat[2,1,]; c4 <- ndat[2,3,]
+ dataset <- cbind(c1, c2, c3, c4)
+
+ num <- sum(apply(X = dataset, MARGIN = 1, FUN = function(ro) (ro[1] * ro[4] - ro[3] * ro[2]) / (ro[2] + ro[4])))
+ W <- sum(apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4]))) # Cochrane weights
+ delta.MH <- num / W
+ P <- sum(apply(dataset, 1, function(ro) (ro[2]^2 * ro[3] - ro[4]^2 * ro[1] + 0.5 * ro[2] * ro[4] * (ro[4] - ro[2])) / (ro[2] + ro[4])^2))
+ Q <- sum(apply(dataset,1,function(ro) (ro[1] * (ro[4] - ro[3]) + ro[3] * (ro[2] - ro[1])) / (2 * (ro[2] + ro[4]))))
+ var.delta.MH = (delta.MH * P + Q) / W^2
+
+ SatoARisk.p <- delta.MH
+ SatoARisk.l <- SatoARisk.p - qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
+ SatoARisk.u <- SatoARisk.p + qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
+ c(SatoARisk.p * units, SatoARisk.l * units, SatoARisk.u * units)
+ }
+ }
+
+ .funMHRD.GR <- function(dat, conf.level = 0.95, units = units) {
+ if(length(dim(dat)) > 2){
+ ndat <- addmargins(A = dat, margin = 2, FUN = sum, quiet = FALSE)
+ c1 <- ndat[1,1,]; c2 <- ndat[1,3,]; c3 <- ndat[2,1,]; c4 <- ndat[2,3,]
+ dataset <- cbind(c1, c2, c3, c4)
+
+ num <- sum(apply(X = dataset, MARGIN = 1, FUN = function(ro) (ro[1] * ro[4] - ro[3] * ro[2]) / (ro[2] + ro[4])))
+ W <- sum(apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4]))) # Cochrane weights
+ delta.MH <- num / W
+ P <- sum(apply(dataset, 1, function(ro) (ro[2]^2 * ro[3] - ro[4]^2 * ro[1] + 0.5 * ro[2] * ro[4] * (ro[4] - ro[2])) / (ro[2] + ro[4])^2))
+ Q <- sum(apply(dataset,1,function(ro) (ro[1] * (ro[4] - ro[3]) + ro[3] * (ro[2] - ro[1])) / (2 * (ro[2] + ro[4]))))
+ p1 <- dataset[,1] / dataset[,2]
+ p2 <- dataset[,3] / dataset[,4]
+ denom <- apply(dataset, 1, function(ro) ro[2] * ro[4] / (ro[2] + ro[4])) # Cochrane weights
+ var.delta.MH <- sum (denom^2 * (p1 * (1 - p1) / dataset[,2] + p2 * (1 - p2) / dataset[,4])) / W^2
+
+ GRARisk.p <- delta.MH
+ GRARisk.l <- GRARisk.p - qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
+ GRARisk.u <- GRARisk.p + qnorm(1 - (1 - conf.level) / 2) * sqrt(var.delta.MH)
+ c(GRARisk.p * units, GRARisk.l * units, GRARisk.u * units)
+ }
+ }
+
+
+ ## =================
+ ## DECLARE VARIABLES
+ ## =================
+
+ ## | D+ | D- | Total
+ ## ----------------------------
+ ## Exp + | a | b | N1
+ ## Exp - | c | d | N0
+ ## -------|------|------|------
+ ## Total | M1 | M0 | Total
+
+
+ N. <- 1 - ((1 - conf.level) / 2)
+ z <- qnorm(N., mean = 0, sd = 1)
+
+ ## For large numbers you need to use floating point rather than integer representation. This will avoid "integer overflow" messages:
+ a <- as.numeric(a); A <- as.numeric(A)
+ b <- as.numeric(b); B <- as.numeric(B)
+ c <- as.numeric(c); C <- as.numeric(C)
+ d <- as.numeric(d); D <- as.numeric(D)
+
+ ## Total within strata cases:
+ M1 <- a + c
+ ## Total within strata non-cases:
+ M0 <- b + d
+ ## Total within strata exposed:
+ N1 <- a + b
+ ## Total within strata unexposed:
+ N0 <- c + d
+ ## Total within strata subjects:
+ total <- a + b + c + d
+ ## Number of strata:
+ n.strata <- length(a)
+
+ ## Added 190809:
+ ## If the sums across strata for all cells are greater than 0, use the sums of the crude data (cf the sums of the adjusted values):
+ if(sum(A) > 0 & sum(B) > 0 & sum(C) > 0 & sum(D) > 0){
+ sa <- sum(A); sb <- sum(B); sc <- sum(C); sd <- sum(D)
+ }
+
+ ## If the sums across strata for all cells contain a 0, use the sums of the adjusted data:
+ if(sum(A) == 0 | sum(B) == 0 | sum(C) == 0 | sum(D) == 0){
+ sa <- sum(a); sb <- sum(b); sc <- sum(c); sd <- sum(d)
+ }
+
+ ## sa <- sum(a); sb <- sum(b); sc <- sum(c); sd <- sum(d)
+
+ ## Grand total cases:
+ sM1 <- sa + sc
+ ## Grand total non-cases:
+ sM0 <- sb + sd
+ ## Grand total exposed:
+ sN1 <- sa + sb
+ ## Grand total unexposed:
+ sN0 <- sc + sd
+ ## Grand total:
+ stotal <- sa + sb + sc + sd
+
+ ## Within-strata incidence risk in exposed:
+ .tmp <- .funincrisk(as.matrix(cbind(a, N1)), conf.level = conf.level)
+ IRiske.p <- as.numeric(.tmp[,1]) * units
+ IRiske.l <- as.numeric(.tmp[,2]) * units
+ IRiske.u <- as.numeric(.tmp[,3]) * units
+
+ ## Within-strata incidence risk in unexposed:
+ .tmp <- .funincrisk(as.matrix(cbind(c, N0)), conf.level = conf.level)
+ IRisko.p <- as.numeric(.tmp[,1]) * units
+ IRisko.l <- as.numeric(.tmp[,2]) * units
+ IRisko.u <- as.numeric(.tmp[,3]) * units
+
+ ## Within-strata incidence risk in population:
+ .tmp <- .funincrisk(as.matrix(cbind(M1, total)), conf.level = conf.level)
+ IRiskpop.p <- as.numeric(.tmp[,1]) * units
+ IRiskpop.l <- as.numeric(.tmp[,2]) * units
+ IRiskpop.u <- as.numeric(.tmp[,3]) * units
+
+ ## Within-strata incidence rate in exposed:
+ .tmp <- .funincrate(as.matrix(cbind(a, b)), conf.level = conf.level)
+ IRatee.p <- as.numeric(.tmp[,1]) * units
+ IRatee.l <- as.numeric(.tmp[,2]) * units
+ IRatee.u <- as.numeric(.tmp[,3]) * units
+
+ ## Within-strata incidence rate in unexposed:
+ .tmp <- .funincrate(as.matrix(cbind(c, d)), conf.level = conf.level)
+ IRateo.p <- as.numeric(.tmp[,1]) * units
+ IRateo.l <- as.numeric(.tmp[,2]) * units
+ IRateo.u <- as.numeric(.tmp[,3]) * units
+
+ ## Within-strata incidence rate in population:
+ .tmp <- .funincrate(as.matrix(cbind(M1, M0)), conf.level = conf.level)
+ IRatepop.p <- as.numeric(.tmp[,1]) * units
+ IRatepop.l <- as.numeric(.tmp[,2]) * units
+ IRatepop.u <- as.numeric(.tmp[,3]) * units
+
+ ## Within-strata odds in exposed (based on Ederer F and Mantel N (1974) Confidence limits on the ratio of two Poisson variables.
+ ## American Journal of Epidemiology 100: 165 - 167.
+ ## Cited in Altman, Machin, Bryant, and Gardner (2000) Statistics with Confidence, British Medical Journal, page 69).
+ ## Added 160609.
+ Al <- (qbinom(1 - N., size = a + b, prob = (a / (a + b)))) / (a + b)
+ Au <- (qbinom(N., size = a + b, prob = (a / (a + b)))) / (a + b)
+ Oe.p <- (a / b)
+ Oe.l <- (Al / (1 - Al))
+ Oe.u <- (Au / (1 - Au))
+
+ ## Within-strata odds in unexposed:
+ Al <- (qbinom(1 - N., size = c + d, prob = (c / (c + d)))) / (c + d)
+ Au <- (qbinom(N., size = c + d, prob = (c / (c + d)))) / (c + d)
+ Oo.p <- (c / d)
+ Oo.l <- (Al / (1 - Al))
+ Oo.u <- (Au / (1 - Au))
+
+ ## Within-strata odds in population:
+ Al <- (qbinom(1 - N., size = M1 + M0, prob = (M1 / (M1 + M0)))) / (M1 + M0)
+ Au <- (qbinom(N., size = M1 + M0, prob = (M1 / (M1 + M0)))) / (M1 + M0)
+ Opop.p <- (M1 / M0)
+ Opop.l <- (Al / (1 - Al))
+ Opop.u <- (Au / (1 - Au))
+
+ ## Crude incidence risk in exposed:
+ .tmp <- .funincrisk(as.matrix(cbind(sa, sN1)), conf.level = conf.level)
+ cIRiske.p <- as.numeric(.tmp[,1]) * units
+ cIRiske.l <- as.numeric(.tmp[,2]) * units
+ cIRiske.u <- as.numeric(.tmp[,3]) * units
+
+ ## Crude incidence risk in unexposed:
+ .tmp <- .funincrisk(as.matrix(cbind(sc, sN0)), conf.level = conf.level)
+ cIRisko.p <- as.numeric(.tmp[,1]) * units
+ cIRisko.l <- as.numeric(.tmp[,2]) * units
+ cIRisko.u <- as.numeric(.tmp[,3]) * units
+
+ ## Crude incidence risk in population:
+ .tmp <- .funincrisk(as.matrix(cbind(sM1, stotal)), conf.level = conf.level)
+ cIRiskpop.p <- as.numeric(.tmp[,1]) * units
+ cIRiskpop.l <- as.numeric(.tmp[,2]) * units
+ cIRiskpop.u <- as.numeric(.tmp[,3]) * units
+
+ ## Crude incidence rate in exposed:
+ .tmp <- .funincrate(as.matrix(cbind(sa, sb)), conf.level = conf.level)
+ cIRatee.p <- as.numeric(.tmp[,1]) * units
+ cIRatee.l <- as.numeric(.tmp[,2]) * units
+ cIRatee.u <- as.numeric(.tmp[,3]) * units
+
+ ## Crude incidence rate in unexposed:
+ .tmp <- .funincrate(as.matrix(cbind(sc, sd)), conf.level = conf.level)
+ cIRateo.p <- as.numeric(.tmp[,1]) * units
+ cIRateo.l <- as.numeric(.tmp[,2]) * units
+ cIRateo.u <- as.numeric(.tmp[,3]) * units
+
+ ## Crude incidence risk in population:
+ .tmp <- .funincrate(as.matrix(cbind(sM1, sM0)), conf.level = conf.level)
+ cIRatepop.p <- as.numeric(.tmp[,1]) * units
+ cIRatepop.l <- as.numeric(.tmp[,2]) * units
+ cIRatepop.u <- as.numeric(.tmp[,3]) * units
+
+ ## Crude odds in exposed (based on Ederer F and Mantel N (1974) Confidence limits on the ratio of two Poisson variables.
+ ## American Journal of Epidemiology 100: 165 - 167.
+ ## Cited in Altman, Machin, Bryant, and Gardner (2000) Statistics with Confidence, British Medical Journal, page 69).
+ ## Added 160609
+ Al <- (qbinom(1 - N., size = sa + sb, prob = (sa / (sa + sb)))) / (sa + sb)
+ u <- (qbinom(N., size = sa + sb, prob = (sa / (sa + sb)))) / (sa + sb)
+ cOe.p <- sa / sb
+ cOe.l <- Al / (1 - Al)
+ cOe.u <- Au / (1 - Au)
+
+ ## Crude odds in unexposed:
+ Al <- (qbinom(1 - N., size = sc + sd, prob = (sc / (sc + sd)))) / (sc + sd)
+ u <- (qbinom(N., size = sc + sd, prob = (sc / (sc + sd)))) / (sc + sd)
+ cOo.p <- sc / sd
+ cOo.l <- Al / (1 - Al)
+ cOo.u <- Au / (1 - Au)
+
+ ## Crude odds in population:
+ Al <- (qbinom(1 - N., size = sM1 + sM0, prob = (sM1 / (sM1 + sM0)))) / (sM1 + sM0)
+ u <- (qbinom(N., size = sM1 + sM0, prob = (sM1 / (sM1 + sM0)))) / (sM1 + sM0)
+ cOpop.p <- sM1 / sM0
+ cOpop.l <- Al / (1 - Al)
+ cOpop.u <- Au / (1 - Au)
+
+
+ ## =========================================
+ ## INDIVIDUAL STRATA MEASURES OF ASSOCIATION
+ ## =========================================
+
+ ## Individual strata incidence risk ratio - Wald confidence limits (Rothman p 135 equation 7-3):
+ wRR.ctype <- "Wald"
+ wRR.p <- c(); wRR.l <- c(); wRR.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funRRwald(dat[,,i], conf.level)
+ wRR.p <- c(wRR.p, .tmp[1])
+ wRR.l <- c(wRR.l, .tmp[2])
+ wRR.u <- c(wRR.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funRRwald(dat, conf.level)
+ wRR.p <- .tmp[1]
+ wRR.l <- .tmp[2]
+ wRR.u <- .tmp[3]
+ }
+
+ ## Individual strata incidence risk ratio - score confidence limits:
+ scRR.ctype <- "Score"
+ scRR.p <- c(); scRR.l <- c(); scRR.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funRRscore(dat[,,i], conf.level)
+ scRR.p <- c(scRR.p, .tmp[1])
+ scRR.l <- c(scRR.l, .tmp[2])
+ scRR.u <- c(scRR.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funRRscore(dat, conf.level)
+ scRR.p <- .tmp[1]
+ scRR.l <- .tmp[2]
+ scRR.u <- .tmp[3]
+ }
+
+ ## Individual strata incidence rate ratio (exact confidence intervals from epibasic.xlsx http://ph.au.dk/uddannelse/software/):
+ IRR.ctype <- ""
+ IRR.p <- (a / b) / (c / d)
+ lnIRR <- log(IRR.p)
+ lnIRR.var <- (1 / a) + (1 / c)
+ lnIRR.se <- sqrt((1 / a) + (1 / c))
+ IRR.se <- exp(lnIRR.se)
+ pl <- a / (a + (c + 1) * (1 / qf(1 - N., 2 * a, 2 * c + 2)))
+ ph <- (a + 1) / (a + 1 + c / (1 / qf(1 - N., 2 * c, 2 * a + 2)))
+ IRR.l <- pl * d / ((1 - pl) * b)
+ IRR.u <- ph * d / ((1 - ph) * b)
+ ## lnIRR.l <- lnIRR - (z * lnIRR.se)
+ ## lnIRR.u <- lnIRR + (z * lnIRR.se)
+ ## IRR.l <- exp(lnIRR.l)
+ ## IRR.u <- exp(lnIRR.u)
+ ## Incidence rate ratio weights (equal to precision, the inverse of the variance of the IRR. See Woodward page 168):
+ IRR.w <- 1 / (exp(lnIRR.var))
+
+ ## Individual strata Wald odds ratios (Rothman p 139 equation 7-6):
+ wOR.ctype <- "Wald"
+ wOR.p <- c(); wOR.l <- c(); wOR.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funORwald(dat[,,i], conf.level)
+ wOR.p <- c(wOR.p, .tmp[1])
+ wOR.l <- c(wOR.l, .tmp[2])
+ wOR.u <- c(wOR.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funORwald(dat, conf.level)
+ wOR.p <- .tmp[1]
+ wOR.l <- .tmp[2]
+ wOR.u <- .tmp[3]
+ }
+
+
+ ## Individual strata odds ratio - Cornfield confidence limits:
+ cfOR.ctype <- "Cornfield"
+ cfOR.p <- c(); cfOR.l <- c(); cfOR.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funORcfield(dat[,,i], conf.level)
+ cfOR.p <- c(cfOR.p, .tmp[1])
+ cfOR.l <- c(cfOR.l, .tmp[2])
+ cfOR.u <- c(cfOR.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funORcfield(dat, conf.level)
+ cfOR.p <- .tmp[1]
+ cfOR.l <- .tmp[2]
+ cfOR.u <- .tmp[3]
+ }
+
+ ## Individual strata odds ratio - score confidence limits:
+ scOR.ctype <- "Score"
+ scOR.p <- c(); scOR.l <- c(); scOR.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funORscore(dat[,,i], conf.level)
+ scOR.p <- c(scOR.p, .tmp[1])
+ scOR.l <- c(scOR.l, .tmp[2])
+ scOR.u <- c(scOR.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funORscore(dat, conf.level)
+ scOR.p <- .tmp[1]
+ scOR.l <- .tmp[2]
+ scOR.u <- .tmp[3]
+ }
+
+ ## Individual strata odds ratios - maximum likelihood estimate (using fisher.test function):
+ ## Replaced 130612.
+ mOR.ctype <- "MLE"
+ mOR.p <- c(); mOR.l <- c(); mOR.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funORml(dat[,,i], conf.level)
+ mOR.p <- c(mOR.p, .tmp[1])
+ mOR.l <- c(mOR.l, .tmp[2])
+ mOR.u <- c(mOR.u, .tmp[3])
+ }
+ }
+
+ if(length(dim(dat)) == 2){
+ .tmp <- .funORml(dat, conf.level)
+ mOR.p <- .tmp[1]
+ mOR.l <- .tmp[2]
+ mOR.u <- .tmp[3]
+ }
+
+ ## Individual strata attributable risk (Rothman p 135 equation 7-2):
+ wARisk.ctype <- "Wald"
+ wARisk.p <- c(); wARisk.l <- c(); wARisk.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funARwald(dat[,,i], conf.level, units)
+ wARisk.p <- c(wARisk.p, .tmp[1])
+ wARisk.l <- c(wARisk.l, .tmp[2])
+ wARisk.u <- c(wARisk.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funARwald(dat, conf.level, units)
+ wARisk.p <- .tmp[1]
+ wARisk.l <- .tmp[2]
+ wARisk.u <- .tmp[3]
+ }
+
+ ## Individual strata attributable risk - score confidence limits:
+ scARisk.ctype <- "Score"
+ scARisk.p <- c(); scARisk.l <- c(); scARisk.u <- c()
+ if(length(dim(dat)) == 3){
+ for(i in 1:dim(dat)[3]){
+ .tmp <- .funARscore(dat[,,i], conf.level, units)
+ scARisk.p <- c(scARisk.p, .tmp[1])
+ scARisk.l <- c(scARisk.l, .tmp[2])
+ scARisk.u <- c(scARisk.u, .tmp[3])
+ }
+ }
+ if(length(dim(dat)) == 2){
+ .tmp <- .funARscore(dat, conf.level, units)
+ scARisk.p <- .tmp[1]
+ scARisk.l <- .tmp[2]
+ scARisk.u <- .tmp[3]
+ }
+
+ ## Individual strata attributable rate (Rothman p 137 equation 7-4):
+ ARate.ctype <- ""
+ ARate.p <- ((a / b) - (c / d)) * units
+ ARate.var <- (a / b^2) + (c / d^2)
+ ARate.se <- (sqrt((a / b^2) + (c / d^2))) * units
+ ARate.l <- ARate.p - (z * ARate.se)
+ ARate.u <- ARate.p + (z * ARate.se)
+ ## Attribtable rate weights (equal to precision, the inverse of the variance of the RR. See Woodward page 168):
+ ARate.w <- 1 / (ARate.var)
+
+ ## Individual strata attributable fraction for risk data (from Hanley 2001):
+ AFRisk.ctype <- ""
+ AFRisk.p <- ((wRR.p - 1) / wRR.p)
+ AFRisk.l <- (wRR.l - 1) / wRR.l
+ AFRisk.u <- (wRR.u - 1) / wRR.u
+ ## AFRisk.l <- min((wRR.l - 1) / wRR.l, (wRR.u - 1) / wRR.u)
+ ## AFRisk.u <- max((wRR.l - 1) / wRR.l, (wRR.u - 1) / wRR.u)
+
+ ## Individual strata attributable fraction for rate data (from Hanley 2001):
+ AFRate.ctype <- ""
+ AFRate.p <- (IRR.p - 1) / IRR.p
+ ## Bug found 031013. The following two lines of code replace those on lines 449 and 450.
+ AFRate.l <- (IRR.l - 1) / IRR.l
+ AFRate.u <- (IRR.u - 1) / IRR.u
+ ## AFRate.l <- min((IRR.l - 1) / IRR.l, (IRR.u - 1) / IRR.u)
+ ## AFRate.u <- max((IRR.l - 1) / IRR.l, (IRR.u - 1) / IRR.u)
+
+ ## Individual strata estimated attributable fraction (from Hanley 2001):
+ AFest.ctype <- ""
+ AFest.p <- (mOR.p - 1) / mOR.p
+ AFest.l <- (mOR.l - 1) / mOR.l
+ AFest.u <- (mOR.u - 1) / mOR.u
+ ## Bug found 031013. The following two lines of code replace those on lines 457 and 458.
+ ## AFest.l <- min((OR.l - 1) / OR.l, (OR.u - 1) / OR.u)
+ ## AFest.u <- max((OR.l - 1) / OR.l, (OR.u - 1) / OR.u)
+
+ ## Individual strata population attributable risk (same as Rothman p 135 equation 7-2):
+ wPARisk.ctype <- ""
+ wPARisk.p <- ((M1 / total) - (c / N0)) * units
+ wPARisk.se <- (sqrt(((M1 * (total - M1))/total^3) + ((c * (N0 - c))/N0^3))) * units
+ wPARisk.l <- wPARisk.p - (z * wPARisk.se)
+ wPARisk.u <- wPARisk.p + (z * wPARisk.se)
+
+ ## 270115 Confidence intervals for PAR from Sarah Pirikahu MSc thesis.
+ pPARisk.ctype <- "Pirikahu"
+ pPARisk.p <- ((M1 / total) - (c / N0)) * units
+ pPARisk.d1 <- (1 / total) - ((a + c) / total^2)
+ pPARisk.d2 <- -((a + c) / total^2)
+ pPARisk.d3 <- (c / (c + d)^2) - ((a + c) / total^2) + (1 / total) - (1 / (c + d))
+ pPARisk.d4 <- (c / (c + d)^2) - ((a + c) / total^2)
+ pPARisk.var <- ((pPARisk.d1^2) * a) + ((pPARisk.d2^2) * b) + ((pPARisk.d3^2) * c) + ((pPARisk.d4^2) * d)
+ pPARisk.se <- sqrt(pPARisk.var) * units
+ pPARisk.l <- pPARisk.p - (z * pPARisk.se)
+ pPARisk.u <- pPARisk.p + (z * pPARisk.se)
+
+ ## Individual strata population attributable rate (same as Rothman p 137 equation 7-4):
+ PARate.ctype <- ""
+ PARate.p <- ((M1 / M0) - (c / d)) * units
+ PARate.se <- (sqrt((M1 / M0^2) + (c / d^2))) * units
+ PARate.l <- PARate.p - (z * PARate.se)
+ PARate.u <- PARate.p + (z * PARate.se)
+
+ ## Individual strata population attributable fractions for risk data (from Hanley, 2001):
+ ## PAFRisk.p <- ((wRR.p - 1) / wRR.p) * (a / M1)
+ ## PAFRisk.l <- ((wRR.l - 1) / wRR.l) * (a / M1)
+ ## PAFRisk.u <- ((wRR.u - 1) / wRR.u) * (a / M1)
+
+ ## Individual strata population attributable fractions for risk data (from OpenEpi TwobyTwo):
+ ## PAFRisk.p <- (IRiskpop.p - IRisko.p) / IRiskpop.p
+ ## PAFRisk.l <- min((IRiskpop.l - IRisko.l) / IRiskpop.l, (IRiskpop.u - IRisko.u) / IRiskpop.u)
+ ## PAFRisk.u <- max((IRiskpop.l - IRisko.l) / IRiskpop.l, (IRiskpop.u - IRisko.u) / IRiskpop.u)
+
+ ## Individual strata population attributable fractions for risk data (from Jewell, page 84):
+ PAFRisk.ctype <- "Jewell"
+ PAFRisk.p <- ((a * d) - (b * c)) / ((a + c) * (c + d))
+ PAFRisk.var <- (b + (PAFRisk.p * (a + d))) / (total * c)
+ PAFRisk.l <- 1 - exp(log(1 - PAFRisk.p) + (z * sqrt(PAFRisk.var)))
+ PAFRisk.u <- 1 - exp(log(1 - PAFRisk.p) - (z * sqrt(PAFRisk.var)))
+
+ ## Individual strata population attributable fractions for rate data (from Hanley, 2001):
+ ## PAFRate.p <- ((IRR.p - 1) / IRR.p) * (a / M1)
+ ## PAFRate.l <- ((IRR.l - 1) / IRR.l) * (a / M1)
+ ## PAFRate.u <- ((IRR.u - 1) / IRR.u) * (a / M1)
+
+ ## Individual strata population attributable fractions for rate data (from OpenEpi TwobyTwo - Jewell doesn't provide a method for rate data):
+ PAFRate.ctype <- "Sullivan"
+ PAFRate.p <- (IRatepop.p - IRateo.p) / IRatepop.p
+ PAFRate.l <- min((IRatepop.l - IRateo.l) / IRatepop.l, (IRatepop.u - IRateo.u) / IRatepop.u)
+ PAFRate.u <- max((IRatepop.l - IRateo.l) / IRatepop.l, (IRatepop.u - IRateo.u) / IRatepop.u)
+
+ ## Individual strata estimated population attributable fraction (from Hanley, 2001):
+ ## PAFest.p <- ((OR.p - 1) / OR.p) * (a / M1)
+ ## PAFest.l <- ((OR.l - 1) / OR.l) * (a / M1)
+ ## PAFest.u <- ((OR.u - 1) / OR.u) * (a / M1)
+
+ ## Individual strata estimated population attributable fraction (from OpenEpi TwobyTwo):
+ ## PAFest.p <- (Opop.p - Oo.p) / Opop.p
+ ## PAFest.l <- min((Opop.l - Oo.l) / Opop.l, (Opop.u - Oo.u) / Opop.u)
+ ## PAFest.u <- max((Opop.l - Oo.l) / Opop.l, (Opop.u - Oo.u) / Opop.u)
+
+ ## Individual strata population attributable fractions for risk data (from Jewell, page 84):
+ PAFest.ctype <- "Jewell"
+ PAFest.p <- ((a * d) - (b * c)) / (d * (a + c))
+ PAFest.var <- (a / (c * (a + c))) + (b / (d * (b + d)))
+ PAFest.l <- 1 - exp(log(1 - PAFest.p) + (z * sqrt(PAFest.var)))
+ PAFest.u <- 1 - exp(log(1 - PAFest.p) - (z * sqrt(PAFest.var)))
+
+
+ ## =============================
+ ## CRUDE MEASURES OF ASSOCIATION
+ ## =============================
+
+ ## Crude incidence risk ratio - Wald confidence limits (Rothman p 135 equation 7-3):
+ cwRR.ctype <- "Wald"
+ .tmp <- .funRRwald(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
+ cwRR.p <- .tmp[1]
+ cwRR.l <- .tmp[2]
+ cwRR.u <- .tmp[3]
+
+ ## Crude incidence risk ratio - score confidence limits:
+ csRR.ctype <- "Score"
+ .tmp <- .funRRscore(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
+ csRR.p <- .tmp[1]
+ csRR.l <- .tmp[2]
+ csRR.u <- .tmp[3]
+
+ ## Crude incidence rate ratio (exact confidence intervals from epibasic.xlsx http://ph.au.dk/uddannelse/software/):
+ ceIRR.ctype <- "Exact"
+ ceIRR.p <- (sa / sb) / (sc / sd)
+ celnIRR <- log(ceIRR.p)
+ celnIRR.se <- sqrt((1 / sa) + (1 / sc))
+ ceIRR.se <- exp(celnIRR.se)
+ pl <- sa / (sa + (sc + 1) * (1 / qf(1 - N., 2 * sa, 2 * sc + 2)))
+ ph <- (sa + 1) / (sa + 1 + sc / (1 / qf(1 - N., 2 * sc, 2 * sa + 2)))
+ ceIRR.l <- pl * sd / ((1 - pl) * sb)
+ ceIRR.u <- ph * sd / ((1 - ph) * sb)
+
+ ## Crude odds ratio - Wald confidence limits:
+ cwOR.ctype <- "Wald"
+ .tmp <- .funORwald(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
+ cwOR.p <- .tmp[1]
+ cwOR.l <- .tmp[2]
+ cwOR.u <- .tmp[3]
+
+ ## Crude odds ratio - Cornfield confidence limits:
+ ccfOR.ctype <- "Cornfield"
+ .tmp <- .funORcfield(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
+ ccfOR.p <- .tmp[1]
+ ccfOR.l <- .tmp[2]
+ ccfOR.u <- .tmp[3]
+
+ ## Crude odds ratio - score confidence limits:
+ csOR.ctype <- "Score"
+ .tmp <- .funORscore(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level)
+ csOR.p <- .tmp[1]
+ csOR.l <- .tmp[2]
+ csOR.u <- .tmp[3]
+
+ ## Crude odds ratio - maximum likelihood estimate (using fisher.test function):
+ ## Replaced 130612.
+ cmOR.ctype <- "MLE"
+ cmOR.tmp <- fisher.test(apply(dat, MARGIN = c(1,2), FUN = sum), conf.int = TRUE, conf.level = conf.level)
+ cmOR.p <- as.numeric(cmOR.tmp$estimate)
+ cmOR.l <- as.numeric(cmOR.tmp$conf.int)[1]
+ cmOR.u <- as.numeric(cmOR.tmp$conf.int)[2]
+
+ ## Crude attributable risk - Wald confidence limits (Rothman p 135 equation 7-2):
+ cwARisk.ctype <- "Wald"
+ .tmp <- .funARwald(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level, units)
+ cwARisk.p <- .tmp[1]
+ cwARisk.l <- .tmp[2]
+ cwARisk.u <- .tmp[3]
+
+ ## Crude attributable risk - score confidence limits:
+ cscARisk.ctype <- "Score"
+ .tmp <- .funARscore(apply(dat, MARGIN = c(1,2), FUN = sum), conf.level, units)
+ cscARisk.p <- .tmp[1]
+ cscARisk.l <- .tmp[2]
+ cscARisk.u <- .tmp[3]
+
+ ## Crude attributable rate (Rothman p 137 equation 7-4):
+ cARate.ctype <- "Wald"
+ cARate.p <- ((sa / sb) - (sc / sd)) * units
+ cARate.se <- (sqrt((sa / sb^2) + (sc / sd^2))) * units
+ cARate.l <- cARate.p - (z * cARate.se)
+ cARate.u <- cARate.p + (z * cARate.se)
+
+ ## Crude attributable fraction for risk data (from Hanley 2001):
+ cAFrisk.ctype <- "Score"
+ cAFRisk.p <- (csRR.p - 1) / csRR.p
+ cAFRisk.l <- min((csRR.l - 1) / csRR.l, (csRR.u - 1) / csRR.u)
+ cAFRisk.u <- max((csRR.l - 1) / csRR.l, (csRR.u - 1) / csRR.u)
+
+ ## Crude attributable fraction for rate data (from Hanley 2001):
+ cAFRate.ctype <- "Exact"
+ cAFRate.p <- (ceIRR.p - 1) / ceIRR.p
+ cAFRate.l <- min((ceIRR.l - 1) / ceIRR.l, (ceIRR.u - 1) / ceIRR.u)
+ cAFRate.u <- max((ceIRR.l - 1) / ceIRR.l, (ceIRR.u - 1) / ceIRR.u)
+
+ ## Crude estimated attributable fraction (from Hanley 2001):
+ cAFest.ctype <- "Score"
+ cAFest.p <- (scOR.p - 1) / scOR.p
+ cAFest.l <- min((scOR.l - 1) / scOR.l, (scOR.u - 1) / scOR.u)
+ cAFest.u <- max((scOR.l - 1) / scOR.l, (scOR.u - 1) / scOR.u)
+
+ ## Crude population attributable risk (same as Rothman p 135 equation 7-2):
+ cwPARisk.ctype <- "Wald"
+ cwPARisk.p <- ((sM1 / stotal) - (sc / sN0)) * units
+ cwPARisk.se <- (sqrt(((sM1 * (stotal - sM1))/stotal^3) + ((sc * (sN0 - sc))/sN0^3))) * units
+ cwPARisk.l <- cwPARisk.p - (z * cwPARisk.se)
+ cwPARisk.u <- cwPARisk.p + (z * cwPARisk.se)
+
+ ## 270115 Confidence intervals for PAR from Sarah Pirikahu MSc thesis.
+ cpPARisk.ctype <- "Pirikahu"
+ cpPARisk.p <- ((sM1 / stotal) - (sc / sN0)) * units
+ cpPARisk.d1 <- (1 / stotal) - ((sa + sc) / stotal^2)
+ cpPARisk.d2 <- -((sa + sc) / stotal^2)
+ cpPARisk.d3 <- (sc / (sc + sd)^2) - ((sa + sc) / stotal^2) + (1 / stotal) - (1 / (sc + sd))
+ cpPARisk.d4 <- (sc / (sc + sd)^2) - ((sa + sc) / stotal^2)
+ cpPARisk.var <- ((cpPARisk.d1^2) * sa) + ((cpPARisk.d2^2) * sb) + ((cpPARisk.d3^2) * sc) + ((cpPARisk.d4^2) * sd)
+ cpPARisk.se <- sqrt(cpPARisk.var) * units
+ cpPARisk.l <- cpPARisk.p - (z * cpPARisk.se)
+ cpPARisk.u <- cpPARisk.p + (z * cpPARisk.se)
+
+
+ ## Crude population attributable rate (same as Rothman p 137 equation 7-4):
+ cPARate.ctype <- "Wald"
+ cPARate.p <- ((sM1 / sM0) - (sc / sd)) * units
+ cPARate.se <- (sqrt((sM1 / sM0^2) + (sc / sd^2))) * units
+ cPARate.l <- cPARate.p - (z * cPARate.se)
+ cPARate.u <- cPARate.p + (z * cPARate.se)
+ ## Crude population attributable fractions for risk data (from Hanley 2001):
+ ## cPAFRisk.p <- ((csRR.p - 1) / csRR.p) * (sa / sM1)
+ ## cPAFRisk.l <- ((csRR.l - 1) / csRR.l) * (sa / sM1)
+ ## cPAFRisk.u <- ((csRR.u - 1) / csRR.u) * (sa / sM1)
+
+ ## Crude population attributable fractions for risk data (from OpenEpi TwobyTwo):
+ ## Changed 160609
+ cPAFRisk.ctype <- ""
+ cPAFRisk.p <- (cIRiskpop.p - cIRisko.p) / cIRiskpop.p
+ cPAFRisk.l <- min((cIRiskpop.l - cIRisko.l) / cIRiskpop.l, (cIRiskpop.u - cIRisko.u) / cIRiskpop.u)
+ cPAFRisk.u <- max((cIRiskpop.l - cIRisko.l) / cIRiskpop.l, (cIRiskpop.u - cIRisko.u) / cIRiskpop.u)
+
+ ## Crude population attributable fractions for rate data (from Hanley 2001):
+ ## cPAFRate.ctype <- "Exact"
+ ## cPAFRate.p <- ((ceIRR.p - 1) / ceIRR.p) * (sa / sM1)
+ ## cPAFRate.l <- ((ceIRR.p - 1) / ceIRR.p) * (sa / sM1)
+ ## cPAFRate.u <- ((ceIRR.p - 1) / ceIRR.p) * (sa / sM1)
+
+ ## Crude population attributable fractions for rate data (from OpenEpi TwobyTwo):
+ ## Changed 160609
+ cPAFRate.ctype <- ""
+ cPAFRate.p <- (cIRatepop.p - cIRateo.p) / cIRatepop.p
+ cPAFRate.l <- min((cIRatepop.l - cIRateo.l) / cIRatepop.l, (cIRatepop.u - cIRateo.u) / cIRatepop.u)
+ cPAFRate.u <- max((cIRatepop.l - cIRateo.l) / cIRatepop.l, (cIRatepop.u - cIRateo.u) / cIRatepop.u)
+
+ ## Crude estimated population attributable fraction (from Hanley, 2001):
+ ## cPAFest.p <- ((scOR.p - 1) / scOR.p) * (sa / sM1)
+ ## cPAFest.l <- ((scOR.p - 1) / scOR.p) * (sa / sM1)
+ ## cPAFest.u <- ((scOR.p - 1) / scOR.p) * (sa / sM1)
+
+ ## Crude estimated population attributable fraction (from OpenEpi TwobyTwo):
+ ## Changed 160609
+ cPAFest.ctype <- ""
+ cPAFest.p <- (cOpop.p - cOo.p) / cOpop.p
+ cPAFest.l <- min((cOpop.l - cOo.l) / cOpop.l, (cOpop.u - cOo.u) / cOpop.u)
+ cPAFest.u <- max((cOpop.l - cOo.l) / cOpop.l, (cOpop.u - cOo.u) / cOpop.u)
+
+
+ ## ===============================
+ ## MANTEL-HAENZEL SUMMARY MEASURES
+ ## ===============================
+
+ ## Summary incidence risk ratio (Rothman 2002 p 148 and 152, equation 8-2):
+ sRR.p <- sum((a * N0 / total)) / sum((c * N1 / total))
+ varLNRR.s <- sum(((M1 * N1 * N0) / total^2) - ((a * c)/ total)) /
+ (sum((a * N0)/total) * sum((c * N1)/total))
+ lnRR.s <- log(sRR.p)
+ sRR.se <- (sqrt(varLNRR.s))
+ sRR.l <- exp(lnRR.s - (z * sqrt(varLNRR.s)))
+ sRR.u <- exp(lnRR.s + (z * sqrt(varLNRR.s)))
+
+ ## Summary incidence rate ratio (Rothman 2002 p 153, equation 8-5):
+ sIRR.p <- sum((a * d) / M0) / sum((c * b) / M0)
+ lnIRR.s <- log(sIRR.p)
+ varLNIRR.s <- (sum((M1 * b * d) / M0^2)) / (sum((a * d) / M0) * sum((c * b) / M0))
+ sIRR.se <- sqrt(varLNIRR.s)
+ sIRR.l <- exp(lnIRR.s - (z * sqrt(varLNIRR.s)))
+ sIRR.u <- exp(lnIRR.s + (z * sqrt(varLNIRR.s)))
+
+ ## Summary odds ratio (Cord Heuer 211004):
+ sOR.p <- sum((a * d / total)) / sum((b * c / total))
+ G <- a * d / total
+ H <- b * c / total
+ P <- (a + d) / total
+ Q <- (b + c) / total
+ GQ.HP <- G * Q + H * P
+ sumG <- sum(G)
+ sumH <- sum(H)
+ sumGP <- sum(G * P)
+ sumGH <- sum(G * H)
+ sumHQ <- sum(H * Q)
+ sumGQ <- sum(G * Q)
+ sumGQ.HP <- sum(GQ.HP)
+
+ ## Correction from Richard Bourgon 29 September 2010:
+ varLNOR.s <- sumGP / (2 * sumG^2) + sumGQ.HP / (2 * sumG * sumH) + sumHQ / (2 * sumH^2)
+ ## varLNOR.s <- sumGP / (2 * sumG^2) + sumGQ.HP / (2 * sumGH) + sumHQ / (2 * sumG * sumH)
+ lnOR.s <- log(sOR.p)
+ sOR.se <- sqrt(varLNOR.s)
+ sOR.l <- exp(lnOR.s - z * sqrt(varLNOR.s))
+ sOR.u <- exp(lnOR.s + z * sqrt(varLNOR.s))
+
+ ## Summary attributable risk (Rothman 2002 p 147 and p 152, equation 8-1):
+ sARisk.p <- (sum(((a * N0) - (c * N1)) / total) / sum((N1 * N0) / total)) * units
+ w <- (N1 * N0) / total
+ var.p1 <- (((a * d) / (N1^2 * (N1 - 1))) + ((c * b) / (N0^2 * (N0 - 1))))
+ var.p1[N0 == 1] <- 0
+ var.p1[N1 == 1] <- 0
+ varARisk.s <- sum(w^2 * var.p1) / sum(w)^2
+ sARisk.se <- (sqrt(varARisk.s)) * units
+ sARisk.l <- sARisk.p - (z * sARisk.se)
+ sARisk.u <- sARisk.p + (z * sARisk.se)
+
+ # Summary attributable risk (Klingenberg (2014) Statistics in Medicine 33: 2968 - 2983.
+ SatoARisk.ctype <- "Sato"
+ .tmp <- .funMHRD.Sato(dat, conf.level, units)
+ SatoARisk.p <- .tmp[1]
+ SatoARisk.l <- .tmp[2]
+ SatoARisk.u <- .tmp[3]
+
+ # Summary attributable risk (Klingenberg (2014) Statistics in Medicine 33: 2968 - 2983.
+ GRARisk.ctype <- "Greenland-Robins"
+ .tmp <- .funMHRD.GR(dat, conf.level, units)
+ GRARisk.p <- .tmp[1]
+ GRARisk.l <- .tmp[2]
+ GRARisk.u <- .tmp[3]
+
+ ## Summary attributable rate (Rothman 2002 p 153, equation 8-4):
+ sARate.p <- sum(((a * d) - (c * b)) / M0) / sum((b * d) / M0) * units
+ varARate.s <- sum(((b * d) / M0)^2 * ((a / b^2) + (c / d^2 ))) / sum((b * d) / M0)^2
+ sARate.se <- sqrt(varARate.s) * units
+ sARate.l <- sARate.p - (z * sARate.se)
+ sARate.u <- sARate.p + (z * sARate.se)
+
+
+ ## ===============================
+ ## EFFECT OF CONFOUNDING
+ ## ===============================
+ ## Effect of confounding for risk ratio (Woodward p 172):
+ RR.conf.p <- (csRR.p / sRR.p)
+ RR.conf.l <- (csRR.l / sRR.l)
+ RR.conf.u <- (csRR.u / sRR.u)
+
+ ## Effect of confounding for incidence risk ratio (Woodward p 172):
+ IRR.conf.p <- (ceIRR.p / sIRR.p)
+ IRR.conf.l <- (ceIRR.l / sIRR.l)
+ IRR.conf.u <- (ceIRR.u / sIRR.u)
+
+ ## Effect of confounding for odds ratio (Woodward p 172):
+ OR.conf.p <- (scOR.p / sOR.p)
+ OR.conf.l <- (scOR.l / sOR.l)
+ OR.conf.u <- (scOR.u / sOR.u)
+
+ ## Effect of confounding for attributable risk (Woodward p 172):
+ ARisk.conf.p <- (cscARisk.p / scARisk.p)
+ ARisk.conf.l <- (cscARisk.l / scARisk.l)
+ ARisk.conf.u <- (cscARisk.u / scARisk.u)
+
+ ## Effect of confounding for attributable rate (Woodward p 172):
+ ARate.conf.p <- (cARate.p / sARate.p)
+ ARate.conf.l <- (cARate.l / sARate.l)
+ ARate.conf.u <- (cARate.u / sARate.u)
+
+
+ ## ===========================================
+ ## CHI-SQUARED TESTS OF HOMOGENEITY AND EFFECT
+ ## ===========================================
+
+ ## Chi-squared test statistic for individual strata. See Dawson Saunders and Trapp page 151:
+ exp.a <- (N1 * M1) / total
+ exp.b <- (N1 * M0) / total
+ exp.c <- (N0 * M1) / total
+ exp.d <- (N0 * M0) / total
+ chi2 <- (((a - exp.a)^2)/ exp.a) + (((b - exp.b)^2)/ exp.b) + (((c - exp.c)^2)/ exp.c) + (((d - exp.d)^2)/ exp.d)
+ p.chi2 <- 1 - pchisq(chi2, df = 1)
+
+ ## Crude summary chi-squared test statistic with 1 degree of freedom:
+ exp.sa <- (sN1 * sM1) / stotal
+ exp.sb <- (sN1 * sM0) / stotal
+ exp.sc <- (sN0 * sM1) / stotal
+ exp.sd <- (sN0 * sM0) / stotal
+ chi2s <- (((sa - exp.sa)^2)/ exp.sa) + (((sb - exp.sb)^2)/ exp.sb) + (((sc - exp.sc)^2)/ exp.sc) + (((sd - exp.sd)^2)/ exp.sd)
+ p.chi2s <- 1 - pchisq(chi2s, df = 1)
+
+ ## Mantel-Haenszel chi-squared test:
+ if(length(a) > 1){
+ chi2m <- as.numeric(mantelhaen.test(dat)$statistic)
+ p.chi2m <- as.numeric(mantelhaen.test(dat)$p.value)
+ }
+
+ if(length(a) > 1){
+ if(homogeneity == "woolf"){
+
+ ## Test of homogeneity of risk ratios (Jewell 2004, page 154). First work out the Woolf estimate of the adjusted risk ratio (labelled lnRR.s. here) based on Jewell (2004, page 134):
+ lnRR. <- log((a / (a + b)) / (c / (c + d)))
+ lnRR.var. <- (b / (a * (a + b))) + (d / (c * (c + d)))
+ wRR. <- 1 / lnRR.var.
+ lnRR.s. <- sum(wRR. * lnRR.) / sum(wRR.)
+
+ ## Equation 10.3 from Jewell (2004):
+ RR.homogeneity <- sum(wRR. * (lnRR. - lnRR.s.)^2)
+ RR.homogeneity.p <- 1 - pchisq(RR.homogeneity, df = n.strata - 1)
+ RR.homog <- data.frame(test.statistic = RR.homogeneity, df = n.strata - 1, p.value = RR.homogeneity.p)
+
+ ## Test of homogeneity of odds ratios (Jewell 2004, page 154). First work out the Woolf estimate of the adjusted odds ratio (labelled lnOR.s. here) based on Jewell (2004, page 129):
+ lnOR. <- log(((a + 0.5) * (d + 0.5)) / ((b + 0.5) * (c + 0.5)))
+ lnOR.var. <- (1 / (a + 0.5)) + (1 / (b + 0.5)) + (1 / (c + 0.5)) + (1 / (d + 0.5))
+ wOR. <- 1 / lnOR.var.
+ lnOR.s. <- sum((wOR. * lnOR.)) / sum(wOR.)
+
+ ## Equation 10.3 from Jewell (2004):
+ OR.homogeneity <- sum(wOR. * (lnOR. - lnOR.s.)^2)
+ OR.homogeneity.p <- 1 - pchisq(OR.homogeneity, df = n.strata - 1)
+ OR.homog <- data.frame(test.statistic = OR.homogeneity, df = n.strata - 1, p.value = OR.homogeneity.p)
+ }
+
+ if(homogeneity == "breslow.day"){
+ ## Setup calculations. From Jim Robison-Cox, based on Jewell (2004, page 154).
+ n11k <- dat[1,1,]
+ n21k <- dat[2,1,]
+ n12k <- dat[1,2,]
+ n22k <- dat[2,2,]
+ row1sums <- n11k + n12k
+ row2sums <- n21k + n22k
+ col1sums <- n11k + n21k
+ Amax <- apply(cbind(row1sums, col1sums), 1, min)
+
+ ## Breslow-Day test of homogeneity of risk ratios. Astar must be no more than col1sums and no more than row1sums:
+ bb <- row2sums + row1sums * sRR.p - col1sums * (1 - sRR.p)
+ determ <- sqrt(bb^2 + 4 * (1 - sRR.p) * sRR.p * row1sums * col1sums)
+ Astar <- (-bb + cbind(-determ, determ)) / (2 - 2 * sRR.p)
+ Astar <- ifelse(Astar[,1] <= Amax & Astar[,1] >= 0, Astar[,1], Astar[,2])
+ ## print(Astar)
+ Bstar <- row1sums - Astar
+ Cstar <- col1sums - Astar
+ Dstar <- row2sums - col1sums + Astar
+ Var <- apply(1 / cbind(Astar, Bstar, Cstar, Dstar), 1, sum)^(-1)
+ ## print(Var)
+
+ RR.homogeneity <- sum((dat[1,1,] - Astar)^2 / Var)
+ RR.homogeneity.p <- 1 - pchisq(RR.homogeneity, df = n.strata - 1)
+
+
+ ## Breslow-Day test of homogeneity of odds ratios. Astar must be no more than col1sums and no more than row1sums:
+ bb <- row2sums + row1sums * sOR.p - col1sums * (1 - sOR.p)
+ determ <- sqrt(bb^2 + 4 * (1 - sOR.p) * sOR.p * row1sums * col1sums)
+ Astar <- (-bb + cbind(-determ, determ)) / (2 - 2 * sOR.p)
+ Astar <-ifelse(Astar[,1] <= Amax & Astar[,1] >= 0, Astar[,1], Astar[,2])
+ ## print(Astar)
+ Bstar <-row1sums - Astar
+ Cstar <- col1sums - Astar
+ Dstar <- row2sums - col1sums + Astar
+ Var <- apply(1 / cbind(Astar, Bstar, Cstar, Dstar), 1, sum)^(-1)
+ ## print(Var)
+
+ OR.homogeneity <- sum((dat[1,1,] - Astar)^2 / Var)
+ OR.homogeneity.p <- 1 - pchisq(OR.homogeneity, df = n.strata - 1)
+
+ }
+ }
+
+ ## Test of attributable risk homogeneity (see Woodward p 207):
+ ## AR.homogeneity <- sum(AR.p - AR.s)^2 / SE.AR^2
+ ## Test of effect:
+ ## AR.homogeneity.p <- 1 - pchisq(AR.homogeneity, df = n.strata - 1)
+ ## AR.homog <- data.frame(test.statistic = AR.homogeneity, df = n.strata - 1, p.value = AR.homogeneity.p)
+
+
+ ## ===============================
+ ## RESULTS
+ ## ===============================
+ ## Results are entered in a list
+ res <- list(
+
+ ## Strata incidence risk ratio:
+ RR.strata.wald = data.frame(est = wRR.p, lower = wRR.l, upper = wRR.u),
+ RR.strata.score = data.frame(est = scRR.p, lower = scRR.l, upper = scRR.u),
+
+ ## Crude incidence risk ratio:
+ RR.crude.wald = data.frame(est = cwRR.p, lower = cwRR.l, upper = cwRR.u),
+ RR.crude.score = data.frame(est = csRR.p, lower = csRR.l, upper = csRR.u),
+
+ ## Mantel-Haenszel incidence risk ratio:
+ RR.mh.wald = data.frame(est = sRR.p, lower = sRR.l, upper = sRR.u),
+
+
+ ## Strata incidence rate ratio:
+ IRR.strata.wald = data.frame(est = IRR.p, lower = IRR.l, upper = IRR.u),
+
+ ## Crude incidence rate ratio:
+ IRR.crude.wald = data.frame(est = ceIRR.p, lower = ceIRR.l, upper = ceIRR.u),
+
+ ## Mantel-Haenszel incidence rate ratio:
+ IRR.mh.wald = data.frame(est = sIRR.p, lower = sIRR.l, upper = sIRR.u),
+
+
+ ## Strata odds ratio:
+ OR.strata.wald = data.frame(est = wOR.p, lower = wOR.l, upper = wOR.u),
+ OR.strata.score = data.frame(est = scOR.p, lower = scOR.l, upper = scOR.u),
+ OR.strata.cfield = data.frame(est = cfOR.p, lower = cfOR.l, upper = cfOR.u),
+ OR.strata.mle = data.frame(est = mOR.p, lower = mOR.l, upper = mOR.u),
+
+ ## Crude odds ratio:
+ OR.crude.wald = data.frame(est = cwOR.p, lower = cwOR.l, upper = cwOR.u),
+ OR.crude.score = data.frame(est = csOR.p, lower = csOR.l, upper = csOR.u),
+ OR.crude.cfield = data.frame(est = ccfOR.p, lower = ccfOR.l, upper = ccfOR.u),
+ OR.crude.mle = data.frame(est = cmOR.p, lower = cmOR.l, upper = cmOR.u),
+
+ ## Mantel-Haenszel odds ratio:
+ OR.mh.wald = data.frame(est = sOR.p, lower = sOR.l, upper = sOR.u),
+
+
+ ## Strata attributable risk:
+ ARisk.strata.wald = data.frame(est = wARisk.p, lower = wARisk.l, upper = wARisk.u),
+ ARisk.strata.score = data.frame(est = scARisk.p, lower = scARisk.l, upper = scARisk.u),
+
+ ## Crude attributable risk:
+ ARisk.crude.wald = data.frame(est = cwARisk.p, lower = cwARisk.l, upper = cwARisk.u),
+ ARisk.crude.score = data.frame(est = cscARisk.p, lower = cscARisk.l, upper = cscARisk.u),
+
+ ## Mantel-Haenszel attributable risk:
+ ARisk.mh.wald = data.frame(est = sARisk.p, lower = sARisk.l, upper = sARisk.u),
+ ARisk.mh.sato = data.frame(est = SatoARisk.p, lower = SatoARisk.l, upper = SatoARisk.u),
+ ARisk.mh.green = data.frame(est = GRARisk.p, lower = GRARisk.l, upper = GRARisk.u),
+
+
+ ## Strata attributable rate:
+ ARate.strata.wald = data.frame(est = ARate.p, lower = ARate.l, upper = ARate.u),
+
+ ## Crude attributable rate:
+ ARate.crude.wald = data.frame(est = cARate.p, lower = cARate.l, upper = cARate.u),
+
+ ## Mantel-Haenszel adjusted attributable rate:
+ ARate.mh.wald = data.frame(est = sARate.p, lower = sARate.l, upper = sARate.u),
+
+
+ ## Strata attributable fraction for risk data:
+ AFRisk.strata.wald = data.frame(est = AFRisk.p, lower = AFRisk.l, upper = AFRisk.u),
+
+ ## Crude attributable fraction for risk data:
+ AFRisk.crude.wald = data.frame(est = cAFRisk.p, lower = cAFRisk.l, upper = cAFRisk.u),
+
+
+ ## Strata attributable fraction for rate data:
+ AFRate.strata.wald = data.frame(est = AFRate.p, lower = AFRate.l, upper = AFRate.u),
+
+ ## Crude attributable fraction for rate data:
+ AFRate.crude.wald = data.frame(est = cAFRate.p, lower = cAFRate.l, upper = cAFRate.u),
+
+
+ ## Strata estimated attributable fraction:
+ AFest.strata.wald = data.frame(est = AFest.p, lower = AFest.l, upper = AFest.u),
+
+ ## Crude estimated attributable fraction:
+ AFest.crude.wald = data.frame(est = cAFest.p, lower = cAFest.l, upper = cAFest.u),
+
+
+ ## Strata population attributable risk:
+ PARisk.strata.wald = data.frame(est = wPARisk.p, lower = wPARisk.l, upper = wPARisk.u),
+ PARisk.strata.piri = data.frame(est = pPARisk.p, lower = pPARisk.l, upper = pPARisk.u),
+
+ ## Crude population attributable risk:
+ PARisk.crude.wald = data.frame(est = cwPARisk.p, lower = cwPARisk.l, upper = cwPARisk.u),
+ PARisk.crude.piri = data.frame(est = cpPARisk.p, lower = cpPARisk.l, upper = cpPARisk.u),
+
+
+ ## Strata population attributable rate:
+ PARate.strata.wald = data.frame(est = PARate.p, lower = PARate.l, upper = PARate.u),
+
+ ## Crude population attributable rate:
+ PARate.crude.wald = data.frame(est = cPARate.p, lower = cPARate.l, upper = cPARate.u),
+
+
+ ## Strata population attributable fraction for risk data:
+ PAFRisk.strata.wald = data.frame(est = PAFRisk.p, lower = PAFRisk.l, upper = PAFRisk.u),
+
+ ## Crude population attributable fraction for risk data:
+ PAFRisk.crude.wald = data.frame(est = cPAFRisk.p, lower = cPAFRisk.l, upper = cPAFRisk.u),
+
+
+ ## Strata population attributable fraction for rate data:
+ PAFRate.strata.wald = data.frame(est = PAFRate.p, lower = PAFRate.l, upper = PAFRate.u),
+
+ ## Crude population attributable fraction for rate data:
+ PAFRate.crude.wald = data.frame(est = cPAFRate.p, lower = cPAFRate.l, upper = cPAFRate.u),
+
+
+ ## Strata estimated population attributable fraction:
+ PAFest.strata.wald = data.frame(est = PAFest.p, lower = PAFest.l, upper = PAFest.u),
+
+ ## Crude estimated population attributable fraction:
+ PAFest.crude.wald = data.frame(est = cPAFest.p, lower = cPAFest.l, upper = cPAFest.u),
+
+
+ ## Effect of confounding for risk ratio (Woodward p 172):
+ RR.conf = data.frame(est = RR.conf.p, lower = RR.conf.l, upper = RR.conf.u),
+
+ ## Effect of confounding for rate ratio (Woodward p 172):
+ IRR.conf = data.frame(est = IRR.conf.p, lower = IRR.conf.l, upper = IRR.conf.u),
+
+ ## Effect of confounding for odds ratio (Woodward p 172):
+ OR.conf = data.frame(est = OR.conf.p, lower = OR.conf.l, upper = OR.conf.u),
+
+ ## Effect of confounding for attributable risk (Woodward p 172):
+ ARisk.conf = data.frame(est = ARisk.conf.p, lower = ARisk.conf.l, upper = ARisk.conf.u),
+
+ ## Effect of confounding for attributable rate (Woodward p 172):
+ ARate.conf = data.frame(est = ARate.conf.p, lower = ARate.conf.l, upper = ARate.conf.u),
+
+ ## Labelling for incidence prevalence units:
+ count.units = ifelse(units == 1, "Outcomes per population unit", paste("Outcomes per ", units, " population units", sep = "")),
+
+ time.units = ifelse(units == 1, "Outcomes per unit of population time at risk", paste("Outcomes per ", units, " units of population time at risk", sep = "")),
+
+ chisq.strata = data.frame(test.statistic = chi2, df = 1, p.value = p.chi2),
+
+ chisq.crude = data.frame(test.statistic = chi2s, df = 1, p.value = p.chi2s)
+ )
+
+ if(n.strata > 1){
+ res$chisq.mh = data.frame(test.statistic = chi2m, df = 1, p.value = p.chi2m)
+ res$RR.homog = data.frame(test.statistic = RR.homogeneity, df = n.strata - 1, p.value = RR.homogeneity.p)
+ res$OR.homog = data.frame(test.statistic = OR.homogeneity, df = n.strata - 1, p.value = OR.homogeneity.p)
+ }
+
+
+ ## ===============================
+ ## REPORTING
+ ## ===============================
+
+ ## method = "cohort.count", single strata:
+ if(method == "cohort.count" & n.strata == 1){
+
+ ## Verbose part:
+ massoc <- list(
+ RR.strata.wald = res$RR.strata.wald,
+ RR.strata.score = res$RR.strata.score,
+
+ OR.strata.wald = res$OR.strata.wald,
+ OR.strata.score = res$OR.strata.score,
+ OR.strata.cfield = res$OR.strata.cfield,
+ OR.strata.mle = res$OR.strata.mle,
+
+ ARisk.strata.wald = res$ARisk.strata.wald,
+ ARisk.strata.score = res$ARisk.strata.score,
+
+ PARisk.strata.wald = res$PARisk.strata.wald,
+ PARisk.strata.piri = res$PARisk.strata.piri,
+
+ AFRisk.strata.wald = res$AFRisk.strata.wald,
+ PAFRisk.strata.wald= res$PAFRisk.strata.wald,
+
+ chisq.strata = res$chisq.strata)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(a, b, N1, cIRiske.p, cOe.p)
+ r2 <- c(c, d, N0, cIRisko.p, cOo.p)
+ r3 <- c(M1, M0, M0 + M1, cIRiskpop.p, cOpop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Inc risk *", " Odds")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(a, c, M1)
+ r2 <- c(b, d, M0)
+ r3 <- c(N1, N0, N0 + N1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ ## Output creation part:
+ out <- list(method = "cohort.count", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+ ## method == "cohort.count", multiple strata:
+ if(method == "cohort.count" & n.strata > 1){
+
+ ## Verbose part:
+ massoc <- list(
+ RR.strata.wald = res$RR.strata.wald,
+ RR.strata.score = res$RR.strata.score,
+ RR.crude.wald = res$RR.crude.wald,
+ RR.crude.score = res$RR.crude.score,
+ RR.mh.wald = res$RR.mh.wald,
+
+ OR.strata.wald = res$OR.strata.wald,
+ OR.strata.score = res$OR.strata.score,
+ OR.strata.cfield = res$OR.strata.cfield,
+ OR.strata.mle = res$OR.strata.mle,
+ OR.crude.wald = res$OR.crude.wald,
+ OR.crude.score = res$OR.crude.score,
+ OR.crude.cfield = res$OR.crude.cfield,
+ OR.crude.mle = res$OR.crude.mle,
+ OR.mh.wald = res$OR.mh.wald,
+
+ ARisk.strata.wald = res$ARisk.strata.wald,
+ ARisk.strata.score = res$ARisk.strata.score,
+ ARisk.crude.wald = res$ARisk.crude.wald,
+ ARisk.crude.score = res$ARisk.crude.score,
+ ARisk.mh.wald = res$ARisk.mh.wald,
+ ARisk.mh.sato = res$ARisk.mh.sato,
+ ARisk.mh.green = res$ARisk.mh.green,
+
+ PARisk.strata.wald = res$PARisk.strata.wald,
+ PARisk.strata.piri = res$PARisk.strata.piri,
+ PARisk.crude.wald = res$PARisk.crude.wald,
+ PARisk.crude.piri = res$PARisk.crude.piri,
+
+ AFRisk.strata.wald = res$AFRisk.strata.wald,
+ AFRisk.crude.wald = res$AFRisk.crude.wald,
+
+ PAFRisk.strata.wald= res$PAFRisk.strata.wald,
+ PAFRisk.crude.wald = res$PAFRisk.crude.wald,
+
+ chisq.strata = res$chisq.strata,
+ chisq.crude = res$chisq.crude,
+ chisq.mh = res$chisq.mh,
+
+ RR.homog = res$RR.homog,
+ OR.homog = res$OR.homog)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(sa, sb, sN1, cIRiske.p, cOe.p)
+ r2 <- c(sc, sd, sN0, cIRisko.p, cOo.p)
+ r3 <- c(sM1, sM0, sM0 + sM1, cIRiskpop.p, cOpop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Inc risk *", " Odds")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(sa, sc, sM1)
+ r2 <- c(sb, sd, sM0)
+ r3 <- c(sN1, sN0, sN0 + sN1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ ## Output creation part:
+ out <- list(method = "cohort.count", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+
+ ## method = "cohort.time", single strata:
+ if(method == "cohort.time" & n.strata == 1){
+
+ ## Verbose part:
+ massoc <- list(
+ IRR.strata.wald = res$IRR.strata.wald,
+
+ ARate.strata.wald = res$ARate.strata.wald,
+ PARate.strata.wald = res$PARate.strata.wald,
+
+ AFRate.strata.wald = res$AFRate.strata.wald,
+ PAFRate.strata.wald = res$PAFRate.strata.wald,
+
+ chisq.strata = res$chisq.strata)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(a, b, cIRatee.p)
+ r2 <- c(c, d, cIRateo.p)
+ r3 <- c(M1, M0, cIRatepop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Time at risk", " Inc rate *")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(a, c, M1)
+ r2 <- c(b, d, M0)
+ r3 <- c(N1, N0, N0 + N1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Time at risk", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ ## Output creation part:
+ out <- list(method = "cohort.time", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+ ## method = "cohort.time", multiple strata:
+ if(method == "cohort.time" & n.strata > 1){
+
+ ## Verbose part:
+ massoc <- list(
+ IRR.strata.wald = res$IRR.strata.wald,
+ IRR.crude.wald = res$IRR.crude.wald,
+ IRR.mh.wald = res$IRR.mh.wald,
+
+ ARate.strata.wald = res$ARate.strata.wald,
+ ARate.crude.wald = res$ARate.crude.wald,
+ ARate.mh.wald = res$ARate.mh.wald,
+
+ PARate.strata.wald = res$PARate.strata.wald,
+ PARate.crude.wald = res$PARate.crude.wald,
+
+ AFRate.strata.wald = res$AFRate.strata.wald,
+ AFRate.crude.wald = res$AFRate.crude.wald,
+
+ PAFRate.strata.wald = res$PAFRate.strata.wald,
+ PAFRate.crude.wald = res$PAFRate.crude.wald,
+
+ chisq.strata = res$chisq.strata,
+ chisq.crude = res$chisq.crude,
+ chisq.mh = res$chisq.mh)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(sa, sb, cIRatee.p)
+ r2 <- c(sc, sd, cIRateo.p)
+ r3 <- c(sM1, sM0, cIRatepop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Time at risk", " Inc rate *")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(sa, sc)
+ r2 <- c(sb, sd)
+ r3 <- c(sN1, sN0)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
+ }
+
+ ## Output creation part:
+ out <- list(method = "cohort.time", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+
+ ## method == "case.control", single strata:
+ if(method == "case.control" & n.strata == 1){
+
+ ## Verbose part:
+ massoc <- list(
+ OR.strata.wald = res$OR.strata.wald,
+ OR.strata.score = res$OR.strata.score,
+ OR.strata.cfield = res$OR.strata.cfield,
+ OR.strata.mle = res$OR.strata.mle,
+
+ ARisk.strata.wald = res$ARisk.strata.wald,
+ ARisk.strata.score = res$ARisk.strata.score,
+
+ PARisk.strata.wald = res$PARisk.strata.wald,
+ PARisk.strata.piri = res$PARisk.strata.piri,
+
+ AFest.strata.wald = res$AFest.strata.wald,
+ PAFest.strata.wald = res$PAFest.strata.wald,
+ chisq.strata = res$chisq.strata)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(a, b, N1, cIRiske.p, cOe.p)
+ r2 <- c(c, d, N0, cIRisko.p, cOo.p)
+ r3 <- c(M1, M0, M0 + M1, cIRiskpop.p, cOpop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
- ## method == "cohort.count", multiple strata:
- if(method == "cohort.count" & n.strata > 1){
-
- ## Verbose part:
- massoc <- list(
- RR.strata.wald = res$RR.strata.wald,
- RR.strata.score = res$RR.strata.score,
- RR.crude.wald = res$RR.crude.wald,
- RR.crude.score = res$RR.crude.score,
- RR.mh.wald = res$RR.mh.wald,
-
- OR.strata.wald = res$OR.strata.wald,
- OR.strata.score = res$OR.strata.score,
- OR.strata.cfield = res$OR.strata.cfield,
- OR.strata.mle = res$OR.strata.mle,
- OR.crude.wald = res$OR.crude.wald,
- OR.crude.score = res$OR.crude.score,
- OR.crude.cfield = res$OR.crude.cfield,
- OR.crude.mle = res$OR.crude.mle,
- OR.mh.wald = res$OR.mh.wald,
-
- ARisk.strata.wald = res$ARisk.strata.wald,
- ARisk.strata.score = res$ARisk.strata.score,
- ARisk.crude.wald = res$ARisk.crude.wald,
- ARisk.crude.score = res$ARisk.crude.score,
- ARisk.mh.wald = res$ARisk.mh.wald,
- ARisk.mh.sato = res$ARisk.mh.sato,
- ARisk.mh.green = res$ARisk.mh.green,
-
- PARisk.strata.wald = res$PARisk.strata.wald,
- PARisk.strata.piri = res$PARisk.strata.piri,
- PARisk.crude.wald = res$PARisk.crude.wald,
- PARisk.crude.piri = res$PARisk.crude.piri,
-
- AFRisk.strata.wald = res$AFRisk.strata.wald,
- AFRisk.crude.wald = res$AFRisk.crude.wald,
-
- PAFRisk.strata.wald= res$PAFRisk.strata.wald,
- PAFRisk.crude.wald = res$PAFRisk.crude.wald,
-
- chisq.strata = res$chisq.strata,
- chisq.crude = res$chisq.crude,
- chisq.mh = res$chisq.mh,
-
- RR.homog = res$RR.homog,
- OR.homog = res$OR.homog)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(sa, sb, sN1, cIRiske.p, cOe.p)
- r2 <- c(sc, sd, sN0, cIRisko.p, cOo.p)
- r3 <- c(sM1, sM0, sM0 + sM1, cIRiskpop.p, cOpop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Inc risk *", " Odds")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(sa, sc, sM1)
- r2 <- c(sb, sd, sM0)
- r3 <- c(sN1, sN0, sN0 + sN1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "cohort.count", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(a, c, M1)
+ r2 <- c(b, d, M0)
+ r3 <- c(N1, N0, N0 + N1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## method = "cohort.time", single strata:
- if(method == "cohort.time" & n.strata == 1){
-
- ## Verbose part:
- massoc <- list(
- IRR.strata.wald = res$IRR.strata.wald,
-
- ARate.strata.wald = res$ARate.strata.wald,
- PARate.strata.wald = res$PARate.strata.wald,
-
- AFRate.strata.wald = res$AFRate.strata.wald,
- PAFRate.strata.wald = res$PAFRate.strata.wald,
-
- chisq.strata = res$chisq.strata)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(a, b, cIRatee.p)
- r2 <- c(c, d, cIRateo.p)
- r3 <- c(M1, M0, cIRatepop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Time at risk", " Inc rate *")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(a, c, M1)
- r2 <- c(b, d, M0)
- r3 <- c(N1, N0, N0 + N1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Time at risk", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "cohort.time", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ ## Output creation part:
+ out <- list(method = "case.control", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+ ## method == "case.control", multiple strata:
+ if(method == "case.control" & n.strata > 1){
+
+ ## Verbose part:
+ massoc <- list(
+ OR.strata.wald = res$OR.strata.wald,
+ OR.strata.score = res$OR.strata.score,
+ OR.strata.cfield = res$OR.strata.cfield,
+ OR.strata.mle = res$OR.strata.mle,
+
+ OR.crude.wald = res$OR.crude.wald,
+ OR.crude.score = res$OR.crude.score,
+ OR.crude.cfield = res$OR.crude.cfield,
+ OR.crude.mle = res$OR.crude.mle,
+ OR.mh.wald = res$OR.mh.wald,
+
+ ARisk.strata.wald = res$ARisk.strata.wald,
+ ARisk.strata.score = res$ARisk.strata.score,
+ ARisk.crude.wald = res$ARisk.crude.wald,
+ ARisk.crude.score = res$ARisk.crude.score,
+ ARisk.mh.wald = res$ARisk.mh.wald,
+ ARisk.mh.sato = res$ARisk.mh.sato,
+ ARisk.mh.green = res$ARisk.mh.green,
+
+ PARisk.strata.wald = res$PARisk.strata.wald,
+ PARisk.strata.piri = res$PARisk.strata.piri,
+ PARisk.crude.wald = res$PARisk.crude.wald,
+ PARisk.crude.piri = res$PARisk.crude.piri,
+
+ AFest.strata.wald = res$AFest.strata.wald,
+ AFest.crude.wald = res$AFest.crude.wald,
+
+ PAFest.strata.wald = res$PAFest.strata.wald,
+ PAFest.crude.wald = res$PAFest.crude.wald,
+
+ chisq.strata = res$chisq.strata,
+ chisq.crude = res$chisq.crude,
+ chisq.mh = res$chisq.mh,
+ OR.homog = res$OR.homog)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(sa, sb, sN1, cIRiske.p, cOe.p)
+ r2 <- c(sc, sd, sN0, cIRisko.p, cOo.p)
+ r3 <- c(sM1, sM0, sM0 + sM1, cIRiskpop.p, cOpop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## method = "cohort.time", multiple strata:
- if(method == "cohort.time" & n.strata > 1){
-
- ## Verbose part:
- massoc <- list(
- IRR.strata.wald = res$IRR.strata.wald,
- IRR.crude.wald = res$IRR.crude.wald,
- IRR.mh.wald = res$IRR.mh.wald,
-
- ARate.strata.wald = res$ARate.strata.wald,
- ARate.crude.wald = res$ARate.crude.wald,
- ARate.mh.wald = res$ARate.mh.wald,
-
- PARate.strata.wald = res$PARate.strata.wald,
- PARate.crude.wald = res$PARate.crude.wald,
-
- AFRate.strata.wald = res$AFRate.strata.wald,
- AFRate.crude.wald = res$AFRate.crude.wald,
-
- PAFRate.strata.wald = res$PAFRate.strata.wald,
- PAFRate.crude.wald = res$PAFRate.crude.wald,
-
- chisq.strata = res$chisq.strata,
- chisq.crude = res$chisq.crude,
- chisq.mh = res$chisq.mh)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(sa, sb, cIRatee.p)
- r2 <- c(sc, sd, cIRateo.p)
- r3 <- c(sM1, sM0, cIRatepop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Time at risk", " Inc rate *")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(sa, sc)
- r2 <- c(sb, sd)
- r3 <- c(sN1, sN0)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "cohort.time", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(sa, sc, sM1)
+ r2 <- c(sb, sd, sM0)
+ r3 <- c(sN1, sN0, sN0 + sN1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## method == "case.control", single strata:
- if(method == "case.control" & n.strata == 1){
-
- ## Verbose part:
- massoc <- list(
- OR.strata.wald = res$OR.strata.wald,
- OR.strata.score = res$OR.strata.score,
- OR.strata.cfield = res$OR.strata.cfield,
- OR.strata.mle = res$OR.strata.mle,
-
- ARisk.strata.wald = res$ARisk.strata.wald,
- ARisk.strata.score = res$ARisk.strata.score,
-
- PARisk.strata.wald = res$PARisk.strata.wald,
- PARisk.strata.piri = res$PARisk.strata.piri,
-
- AFest.strata.wald = res$AFest.strata.wald,
- PAFest.strata.wald = res$PAFest.strata.wald,
- chisq.strata = res$chisq.strata)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(a, b, N1, cIRiske.p, cOe.p)
- r2 <- c(c, d, N0, cIRisko.p, cOo.p)
- r3 <- c(M1, M0, M0 + M1, cIRiskpop.p, cOpop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(a, c, M1)
- r2 <- c(b, d, M0)
- r3 <- c(N1, N0, N0 + N1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "case.control", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+
+ ## Output creation part:
+ out <- list(method = "case.control", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+
+ ## method == "cross.sectional", single strata:
+ if(method == "cross.sectional" & n.strata == 1){
+
+ ## Verbose part:
+ massoc <- list(
+ PR.strata.wald = res$RR.strata.wald,
+ PR.strata.score = res$RR.strata.score,
+
+ OR.strata.wald = res$OR.strata.wald,
+ OR.strata.score = res$OR.strata.score,
+ OR.strata.cfield = res$OR.strata.cfield,
+ OR.strata.mle = res$OR.strata.mle,
+
+ ARisk.strata.wald = res$ARisk.strata.wald,
+ ARisk.strata.score = res$ARisk.strata.score,
+
+ PARisk.strata.wald = res$PARisk.strata.wald,
+ PARisk.strata.piri = res$PARisk.strata.piri,
+
+ AFRisk.strata.wald = res$AFRisk.strata.wald,
+ PAFRisk.strata.wald= res$PAFRisk.strata.wald,
+
+ chisq.strata = res$chisq.strata)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(a, b, N1, cIRiske.p, cOe.p)
+ r2 <- c(c, d, N0, cIRisko.p, cOo.p)
+ r3 <- c(M1, M0, M0 + M1, cIRiskpop.p, cOpop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## method == "case.control", multiple strata:
- if(method == "case.control" & n.strata > 1){
-
- ## Verbose part:
- massoc <- list(
- OR.strata.wald = res$OR.strata.wald,
- OR.strata.score = res$OR.strata.score,
- OR.strata.cfield = res$OR.strata.cfield,
- OR.strata.mle = res$OR.strata.mle,
-
- OR.crude.wald = res$OR.crude.wald,
- OR.crude.score = res$OR.crude.score,
- OR.crude.cfield = res$OR.crude.cfield,
- OR.crude.mle = res$OR.crude.mle,
- OR.mh.wald = res$OR.mh.wald,
-
- ARisk.strata.wald = res$ARisk.strata.wald,
- ARisk.strata.score = res$ARisk.strata.score,
- ARisk.crude.wald = res$ARisk.crude.wald,
- ARisk.crude.score = res$ARisk.crude.score,
- ARisk.mh.wald = res$ARisk.mh.wald,
- ARisk.mh.sato = res$ARisk.mh.sato,
- ARisk.mh.green = res$ARisk.mh.green,
-
- PARisk.strata.wald = res$PARisk.strata.wald,
- PARisk.strata.piri = res$PARisk.strata.piri,
- PARisk.crude.wald = res$PARisk.crude.wald,
- PARisk.crude.piri = res$PARisk.crude.piri,
-
- AFest.strata.wald = res$AFest.strata.wald,
- AFest.crude.wald = res$AFest.crude.wald,
-
- PAFest.strata.wald = res$PAFest.strata.wald,
- PAFest.crude.wald = res$PAFest.crude.wald,
-
- chisq.strata = res$chisq.strata,
- chisq.crude = res$chisq.crude,
- chisq.mh = res$chisq.mh,
- OR.homog = res$OR.homog)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(sa, sb, sN1, cIRiske.p, cOe.p)
- r2 <- c(sc, sd, sN0, cIRisko.p, cOo.p)
- r3 <- c(sM1, sM0, sM0 + sM1, cIRiskpop.p, cOpop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(sa, sc, sM1)
- r2 <- c(sb, sd, sM0)
- r3 <- c(sN1, sN0, sN0 + sN1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
-
- ## Output creation part:
- out <- list(method = "case.control", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(a, c, M1)
+ r2 <- c(b, d, M0)
+ r3 <- c(N1, N0, N0 + N1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## method == "cross.sectional", single strata:
- if(method == "cross.sectional" & n.strata == 1){
-
- ## Verbose part:
- massoc <- list(
- PR.strata.wald = res$RR.strata.wald,
- PR.strata.score = res$RR.strata.score,
-
- OR.strata.wald = res$OR.strata.wald,
- OR.strata.score = res$OR.strata.score,
- OR.strata.cfield = res$OR.strata.cfield,
- OR.strata.mle = res$OR.strata.mle,
-
- ARisk.strata.wald = res$ARisk.strata.wald,
- ARisk.strata.score = res$ARisk.strata.score,
-
- PARisk.strata.wald = res$PARisk.strata.wald,
- PARisk.strata.piri = res$PARisk.strata.piri,
-
- AFRisk.strata.wald = res$AFRisk.strata.wald,
- PAFRisk.strata.wald= res$PAFRisk.strata.wald,
-
- chisq.strata = res$chisq.strata)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(a, b, N1, cIRiske.p, cOe.p)
- r2 <- c(c, d, N0, cIRisko.p, cOo.p)
- r3 <- c(M1, M0, M0 + M1, cIRiskpop.p, cOpop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(a, c, M1)
- r2 <- c(b, d, M0)
- r3 <- c(N1, N0, N0 + N1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "cross.sectional", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ ## Output creation part:
+ out <- list(method = "cross.sectional", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+ ## method == "cross.sectional", multiple strata:
+ if(method == "cross.sectional" & n.strata > 1){
+
+ ## Verbose part:
+ massoc <- list(
+ PR.strata.wald = res$RR.strata.wald,
+ PR.strata.score = res$RR.strata.score,
+ PR.crude.wald = res$RR.crude.wald,
+ PR.crude.score = res$RR.crude.score,
+ PR.mh.wald = res$RR.mh.wald,
+
+ OR.strata.wald = res$OR.strata.wald,
+ OR.strata.score = res$OR.strata.score,
+ OR.strata.cfield = res$OR.strata.cfield,
+ OR.strata.mle = res$OR.strata.mle,
+ OR.crude.wald = res$OR.crude.wald,
+ OR.crude.score = res$OR.crude.score,
+ OR.crude.cfield = res$OR.crude.cfield,
+ OR.crude.mle = res$OR.crude.mle,
+ OR.mh.wald = res$OR.mh.wald,
+
+ ARisk.strata.wald = res$ARisk.strata.wald,
+ ARisk.strata.score = res$ARisk.strata.score,
+ ARisk.crude.wald = res$ARisk.crude.wald,
+ ARisk.crude.score = res$ARisk.crude.score,
+ ARisk.mh.wald = res$ARisk.mh.wald,
+ ARisk.mh.sato = res$ARisk.mh.sato,
+ ARisk.mh.green = res$ARisk.mh.green,
+
+ PARisk.strata.wald = res$PARisk.strata.wald,
+ PARisk.strata.piri = res$PARisk.strata.piri,
+ PARisk.crude.wald = res$PARisk.crude.wald,
+ PARisk.crude.piri = res$PARisk.crude.piri,
+
+ AFRisk.strata.wald = res$AFRisk.strata.wald,
+ AFRisk.crude.wald = res$AFRisk.crude.wald,
+
+ PAFRisk.strata.wald= res$PAFRisk.strata.wald,
+ PAFRisk.crude.wald = res$PAFRisk.crude.wald,
+
+ chisq.strata = res$chisq.strata,
+ chisq.crude = res$chisq.crude,
+ chisq.mh = res$chisq.mh,
+
+ PR.homog = res$RR.homog,
+ OR.homog = res$OR.homog)
+
+ ## Define tab:
+ if(outcome == "as.columns"){
+ r1 <- c(sa, sb, sN1, cIRiske.p, cOe.p)
+ r2 <- c(sc, sd, sN0, cIRisko.p, cOo.p)
+ r3 <- c(sM1, sM0, sM1 + sM0, cIRiskpop.p, cOpop.p)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
+ rownames(tab) <- c("Exposed +", "Exposed -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## method == "cross.sectional", multiple strata:
- if(method == "cross.sectional" & n.strata > 1){
-
- ## Verbose part:
- massoc <- list(
- PR.strata.wald = res$RR.strata.wald,
- PR.strata.score = res$RR.strata.score,
- PR.crude.wald = res$RR.crude.wald,
- PR.crude.score = res$RR.crude.score,
- PR.mh.wald = res$RR.mh.wald,
-
- OR.strata.wald = res$OR.strata.wald,
- OR.strata.score = res$OR.strata.score,
- OR.strata.cfield = res$OR.strata.cfield,
- OR.strata.mle = res$OR.strata.mle,
- OR.crude.wald = res$OR.crude.wald,
- OR.crude.score = res$OR.crude.score,
- OR.crude.cfield = res$OR.crude.cfield,
- OR.crude.mle = res$OR.crude.mle,
- OR.mh.wald = res$OR.mh.wald,
-
- ARisk.strata.wald = res$ARisk.strata.wald,
- ARisk.strata.score = res$ARisk.strata.score,
- ARisk.crude.wald = res$ARisk.crude.wald,
- ARisk.crude.score = res$ARisk.crude.score,
- ARisk.mh.wald = res$ARisk.mh.wald,
- ARisk.mh.sato = res$ARisk.mh.sato,
- ARisk.mh.green = res$ARisk.mh.green,
-
- PARisk.strata.wald = res$PARisk.strata.wald,
- PARisk.strata.piri = res$PARisk.strata.piri,
- PARisk.crude.wald = res$PARisk.crude.wald,
- PARisk.crude.piri = res$PARisk.crude.piri,
-
- AFRisk.strata.wald = res$AFRisk.strata.wald,
- AFRisk.crude.wald = res$AFRisk.crude.wald,
-
- PAFRisk.strata.wald= res$PAFRisk.strata.wald,
- PAFRisk.crude.wald = res$PAFRisk.crude.wald,
-
- chisq.strata = res$chisq.strata,
- chisq.crude = res$chisq.crude,
- chisq.mh = res$chisq.mh,
-
- PR.homog = res$RR.homog,
- OR.homog = res$OR.homog)
-
- ## Define tab:
- if(outcome == "as.columns"){
- r1 <- c(sa, sb, sN1, cIRiske.p, cOe.p)
- r2 <- c(sc, sd, sN0, cIRisko.p, cOo.p)
- r3 <- c(sM1, sM0, sM1 + sM0, cIRiskpop.p, cOpop.p)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Outcome +", " Outcome -", " Total", " Prevalence *", " Odds")
- rownames(tab) <- c("Exposed +", "Exposed -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- if(outcome == "as.rows"){
- ## Non verbose part - define tab:
- r1 <- c(sa, sc, sM1)
- r2 <- c(sb, sd, sM0)
- r3 <- c(sN1, sN0, sN0 + sN1)
- tab <- as.data.frame(rbind(r1, r2, r3))
- colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
- rownames(tab) <- c("Outcome +", "Outcome -", "Total")
- tab <- format.data.frame(tab, digits = 3, justify = "right")
- }
-
- ## Output creation part:
- out <- list(method = "cross.sectional", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+
+ if(outcome == "as.rows"){
+ ## Non verbose part - define tab:
+ r1 <- c(sa, sc, sM1)
+ r2 <- c(sb, sd, sM0)
+ r3 <- c(sN1, sN0, sN0 + sN1)
+ tab <- as.data.frame(rbind(r1, r2, r3))
+ colnames(tab) <- c(" Exposed +", " Exposed -", " Total")
+ rownames(tab) <- c("Outcome +", "Outcome -", "Total")
+ tab <- format.data.frame(tab, digits = 3, justify = "right")
}
-
- ## Set the class of the output object:
- class(out) <- "epi.2by2"
- ## Return it as the output:
- return(out)
+ ## Output creation part:
+ out <- list(method = "cross.sectional", n.strata = n.strata, conf.level = conf.level, res = res, massoc = massoc, tab = tab)
+ }
+
+ ## Set the class of the output object:
+ class(out) <- "epi.2by2"
+
+ ## Return it as the output:
+ return(out)
}
## Print method for epi.2by2:
print.epi.2by2 <- function(x, ...) {
-
- ## cohort.count --- single strata
- if(x$method == "cohort.count" & x$n.strata == 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nInc risk ratio %.2f (%.2f, %.2f)",
- RR.strata.wald[1],
- RR.strata.wald[2],
- RR.strata.wald[3]
- ))
-
- cat(sprintf("\nOdds ratio %.2f (%.2f, %.2f)",
- OR.strata.wald[1],
- OR.strata.wald[2],
- OR.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib risk * %.2f (%.2f, %.2f)",
- ARisk.strata.wald[1],
- ARisk.strata.wald[2],
- ARisk.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib risk in population * %.2f (%.2f, %.2f)",
- PARisk.strata.wald[1],
- PARisk.strata.wald[2],
- PARisk.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib fraction in exposed (%%) %.2f (%.2f, %.2f)",
- AFRisk.strata.wald[1] * 100,
- AFRisk.strata.wald[2] * 100,
- AFRisk.strata.wald[3] * 100
- ))
-
- cat(sprintf("\nAttrib fraction in population (%%) %.2f (%.2f, %.2f)",
- PAFRisk.strata.wald[1] * 100,
- PAFRisk.strata.wald[2] * 100,
- PAFRisk.strata.wald[3] * 100
- ))
- })
- cat("\n-------------------------------------------------------------------")
- p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
- cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
- cat("\n", "Wald confidence limits")
- cat("\n", "*", x$res$count.units, "\n")
- }
-
- ## cohort.count --- multiple strata
- if(x$method == "cohort.count" & x$n.strata > 1){
-
- print(x$tab)
- cat("\n")
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nInc risk ratio (crude) %.2f (%.2f, %.2f)",
- RR.crude.wald[1],
- RR.crude.wald[2],
- RR.crude.wald[3]
- ))
-
- cat(sprintf("\nInc risk ratio (M-H) %.2f (%.2f, %.2f)",
- RR.mh.wald$est,
- RR.mh.wald$lower,
- RR.mh.wald$upper
- ))
-
- cat(sprintf("\nInc risk ratio (crude:M-H) %.2f",
- round(RR.crude.wald[1] / RR.mh.wald[1], digits = 2)
- ))
-
- cat(sprintf("\nOdds ratio (crude) %.2f (%.2f, %.2f)",
- OR.crude.wald[1],
- OR.crude.wald[2],
- OR.crude.wald[3]
- ))
-
- cat(sprintf("\nOdds ratio (M-H) %.2f (%.2f, %.2f)",
- OR.mh.wald$est,
- OR.mh.wald$lower,
- OR.mh.wald$upper
- ))
-
- cat(sprintf("\nOdds ratio (crude:M-H) %.2f",
- round(OR.crude.wald[1] / OR.mh.wald[1], digits = 2)
- ))
-
- cat(sprintf("\nAttrib risk (crude) * %.2f (%.2f, %.2f)",
- ARisk.crude.wald[1],
- ARisk.crude.wald[2],
- ARisk.crude.wald[3]
- ))
-
- cat(sprintf("\nAttrib risk (M-H) * %.2f (%.2f, %.2f)",
- ARisk.mh.wald$est,
- ARisk.mh.wald$lower,
- ARisk.mh.wald$upper
- ))
-
- cat(sprintf("\nAttrib risk (crude:M-H) %.2f",
- round(ARisk.crude.wald[1] / ARisk.mh.wald[1], digits = 2)
- ))
- })
- cat("\n-------------------------------------------------------------------")
- rrp <- ifelse(as.numeric(x$res$RR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$RR.homog)[3], digits = 3))
- cat("\n", "Test of homogeneity of IRR: X2 test statistic:", as.numeric(round(x$res$RR.homog[1], digits = 3)), "p-value:", rrp)
-
- orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
- cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
- cat("\n", "Wald confidence limits")
- cat("\n", "M-H: Mantel-Haenszel")
- cat("\n", "*", x$res$count.units, "\n")
- }
-
+
+ ## cohort.count --- single strata
+ if(x$method == "cohort.count" & x$n.strata == 1){
- ## cohort.time --- single strata
- if(x$method == "cohort.time" & x$n.strata == 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nInc rate ratio %.2f (%.2f, %.2f)",
- IRR.crude.wald[1],
- IRR.crude.wald[2],
- IRR.crude.wald[3]
- ))
-
- cat(sprintf("\nAttrib rate * %.2f (%.2f, %.2f)",
- ARate.crude.wald[1],
- ARate.crude.wald[2],
- ARate.crude.wald[3]
- ))
-
- cat(sprintf("\nAttrib rate in population * %.2f (%.2f, %.2f)",
- PARate.crude.wald[1],
- PARate.crude.wald[2],
- PARate.crude.wald[3]
- ))
-
- cat(sprintf("\nAttrib fraction in exposed (%%) %.2f (%.2f, %.2f)",
- AFRate.crude.wald[1] * 100,
- AFRate.crude.wald[2] * 100,
- AFRate.crude.wald[3] * 100
- ))
-
- cat(sprintf("\nAttrib fraction in population (%%) %.2f (%.2f, %.2f)",
- PAFRate.crude.wald[1] * 100,
- PAFRate.crude.wald[2] * 100,
- PAFRate.crude.wald[3] * 100
- ))
-
- })
- cat("\n-------------------------------------------------------------------")
- p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
- cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
- cat("\n", "Wald confidence limits")
- cat("\n", "*", x$res$time.units, "\n")
- }
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+
+ with(x$res, {
+
+ cat(sprintf("\nInc risk ratio %.2f (%.2f, %.2f)",
+ RR.strata.wald[1],
+ RR.strata.wald[2],
+ RR.strata.wald[3]
+ ))
+
+ cat(sprintf("\nOdds ratio %.2f (%.2f, %.2f)",
+ OR.strata.wald[1],
+ OR.strata.wald[2],
+ OR.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib risk * %.2f (%.2f, %.2f)",
+ ARisk.strata.wald[1],
+ ARisk.strata.wald[2],
+ ARisk.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib risk in population * %.2f (%.2f, %.2f)",
+ PARisk.strata.wald[1],
+ PARisk.strata.wald[2],
+ PARisk.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib fraction in exposed (%%) %.2f (%.2f, %.2f)",
+ AFRisk.strata.wald[1] * 100,
+ AFRisk.strata.wald[2] * 100,
+ AFRisk.strata.wald[3] * 100
+ ))
+
+ cat(sprintf("\nAttrib fraction in population (%%) %.2f (%.2f, %.2f)",
+ PAFRisk.strata.wald[1] * 100,
+ PAFRisk.strata.wald[2] * 100,
+ PAFRisk.strata.wald[3] * 100
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
+ cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "*", x$res$count.units, "\n")
+ }
+ ## cohort.count --- multiple strata
+ if(x$method == "cohort.count" & x$n.strata > 1){
- ## cohort.time --- multiple strata
- if(x$method == "cohort.time" & x$n.strata > 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
- with(x$res, {
-
- cat(sprintf("\nInc rate ratio (crude) %.2f (%.2f, %.2f)",
- IRR.crude.wald[1],
- IRR.crude.wald[2],
- IRR.crude.wald[3]
- ))
-
- cat(sprintf("\nInc rate ratio (M-H) %.2f (%.2f, %.2f)",
- IRR.mh.wald[1],
- IRR.mh.wald[2],
- IRR.mh.wald[3]
- ))
-
- cat(sprintf("\nInc rate ratio (crude:M-H) %.2f",
- round(IRR.crude.wald[1] / IRR.mh.wald[1], digits = 2)
- ))
-
- cat(sprintf("\nAttrib rate (crude) * %.2f (%.2f, %.2f)",
- ARate.crude.wald[1],
- ARate.crude.wald[2],
- ARate.crude.wald[3]
- ))
-
- cat(sprintf("\nAttrib rate (M-H) * %.2f (%.2f, %.2f)",
- ARate.mh.wald[1],
- ARate.mh.wald[2],
- ARate.mh.wald[3]
- ))
-
- cat(sprintf("\nAttrib rate (crude:M-H) %.2f",
- ARate.conf$est
- ))
- })
- cat("\n-------------------------------------------------------------------")
- # rrp <- ifelse(as.numeric(x$res$RR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$RR.homog)[3], digits = 3))
- # cat("\n", "Test of homogeneity of IRR: X2 test statistic:", as.numeric(round(x$res$RR.homog[1], digits = 3)), "p-value:", rrp)
-
- # orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
- # cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
- cat("\n", "Wald confidence limits")
- cat("\n", "M-H: Mantel-Haenszel")
- cat("\n", "*", x$res$time.units, "\n")
- }
-
+ print(x$tab)
+ cat("\n")
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
- ## case.control --- single strata
- if(x$method == "case.control" & x$n.strata == 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nOdds ratio (W) %.2f (%.2f, %.2f)",
- OR.strata.wald[1],
- OR.strata.wald[2],
- OR.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib prevalence * %.2f (%.2f, %.2f)",
- ARisk.strata.wald[1],
- ARisk.strata.wald[2],
- ARisk.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib prevalence in population * %.2f (%.2f, %.2f)",
- PARisk.strata.wald[1],
- PARisk.strata.wald[2],
- PARisk.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib fraction (est) in exposed (%%) %.2f (%.2f, %.2f)",
- AFest.strata.wald[1] * 100,
- AFest.strata.wald[2] * 100,
- AFest.strata.wald[3] * 100
- ))
-
- cat(sprintf("\nAttrib fraction (est) in population (%%) %.2f (%.2f, %.2f)",
- PAFest.strata.wald[1] * 100,
- PAFest.strata.wald[2] * 100,
- PAFest.strata.wald[3] * 100
- ))
- })
- cat("\n-------------------------------------------------------------------")
- p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
- cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
- cat("\n", "Wald confidence limits")
- cat("\n", "*", x$res$count.units, "\n")
- }
-
+ with(x$res, {
+
+ cat(sprintf("\nInc risk ratio (crude) %.2f (%.2f, %.2f)",
+ RR.crude.wald[1],
+ RR.crude.wald[2],
+ RR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nInc risk ratio (M-H) %.2f (%.2f, %.2f)",
+ RR.mh.wald$est,
+ RR.mh.wald$lower,
+ RR.mh.wald$upper
+ ))
+
+ cat(sprintf("\nInc risk ratio (crude:M-H) %.2f",
+ round(RR.crude.wald[1] / RR.mh.wald[1], digits = 2)
+ ))
+
+ cat(sprintf("\nOdds ratio (crude) %.2f (%.2f, %.2f)",
+ OR.crude.wald[1],
+ OR.crude.wald[2],
+ OR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nOdds ratio (M-H) %.2f (%.2f, %.2f)",
+ OR.mh.wald$est,
+ OR.mh.wald$lower,
+ OR.mh.wald$upper
+ ))
+
+ cat(sprintf("\nOdds ratio (crude:M-H) %.2f",
+ round(OR.crude.wald[1] / OR.mh.wald[1], digits = 2)
+ ))
+
+ cat(sprintf("\nAttrib risk (crude) * %.2f (%.2f, %.2f)",
+ ARisk.crude.wald[1],
+ ARisk.crude.wald[2],
+ ARisk.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib risk (M-H) * %.2f (%.2f, %.2f)",
+ ARisk.mh.wald$est,
+ ARisk.mh.wald$lower,
+ ARisk.mh.wald$upper
+ ))
+
+ cat(sprintf("\nAttrib risk (crude:M-H) %.2f",
+ round(ARisk.crude.wald[1] / ARisk.mh.wald[1], digits = 2)
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ rrp <- ifelse(as.numeric(x$res$RR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$RR.homog)[3], digits = 3))
+ cat("\n", "Test of homogeneity of IRR: X2 test statistic:", as.numeric(round(x$res$RR.homog[1], digits = 3)), "p-value:", rrp)
- ## case.control --- multiple strata
- if(x$method == "case.control" & x$n.strata > 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nOdds ratio (crude) %.2f (%.2f, %.2f)",
- OR.crude.wald[1],
- OR.crude.wald[2],
- OR.crude.wald[3]
- ))
-
- cat(sprintf("\nOdds ratio (M-H) %.2f (%.2f, %.2f)",
- OR.mh.wald[1],
- OR.mh.wald[2],
- OR.mh.wald[3]
- ))
-
- cat(sprintf("\nOdds ratio (crude:M-H) %.2f",
- round(OR.crude.wald[1] / OR.mh.wald[1], digits = 2)
- ))
-
- cat(sprintf("\nAttrib prevalence (crude) * %.2f (%.2f, %.2f)",
- ARisk.crude.wald[1],
- ARisk.crude.wald[2],
- ARisk.crude.wald[3]
- ))
-
- cat(sprintf("\nAttrib prevalence (M-H) * %.2f (%.2f, %.2f)",
- ARisk.mh.wald[1],
- ARisk.mh.wald[2],
- ARisk.mh.wald[3]
- ))
-
- cat(sprintf("\nAttrib prevalence (crude:M-H) %.2f",
- round(ARisk.crude.wald[1] / ARisk.mh.wald[1], digits = 2)
- ))
- })
- cat("\n-------------------------------------------------------------------")
- orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
- cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
- cat("\n", "Wald confidence limits")
- cat("\n", "M-H: Mantel-Haenszel")
- cat("\n", "*", x$res$count.units, "\n")
- }
-
-
- ## cross.sectional -- single strata
- if(x$method == "cross.sectional" & x$n.strata == 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nPrevalence ratio %.2f (%.2f, %.2f)",
- RR.strata.wald[1],
- RR.strata.wald[2],
- RR.strata.wald[3]
- ))
-
- cat(sprintf("\nOdds ratio %.2f (%.2f, %.2f)",
- OR.strata.wald[1],
- OR.strata.wald[2],
- OR.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib prevalence * %.2f (%.2f, %.2f)",
- ARisk.strata.wald[1],
- ARisk.strata.wald[2],
- ARisk.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib prevalence in population * %.2f (%.2f, %.2f)",
- PARisk.strata.wald[1],
- PARisk.strata.wald[2],
- PARisk.strata.wald[3]
- ))
-
- cat(sprintf("\nAttrib fraction in exposed (%%) %.2f (%.2f, %.2f)",
- AFRisk.strata.wald[1] * 100,
- AFRisk.strata.wald[2] * 100,
- AFRisk.strata.wald[3] * 100
- ))
-
- cat(sprintf("\nAttrib fraction in population (%%) %.2f (%.2f, %.2f)",
- PAFRisk.strata.wald[1] * 100,
- PAFRisk.strata.wald[2] * 100,
- PAFRisk.strata.wald[3] * 100
- ))
- })
- cat("\n-------------------------------------------------------------------")
- p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
- cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
- cat("\n", "Wald confidence limits")
- cat("\n", "*", x$res$count.units, "\n")
- }
-
+ orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
+ cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "M-H: Mantel-Haenszel")
+ cat("\n", "*", x$res$count.units, "\n")
+ }
+
+
+ ## cohort.time --- single strata
+ if(x$method == "cohort.time" & x$n.strata == 1){
- ## cross.sectional --- multiple strata
- if(x$method == "cross.sectional" & x$n.strata > 1){
-
- print(x$tab)
- cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
- cat("\n-------------------------------------------------------------------")
-
- with(x$res, {
-
- cat(sprintf("\nPrevalence ratio (crude) %.2f (%.2f, %.2f)",
- RR.crude.wald[1],
- RR.crude.wald[2],
- RR.crude.wald[3]
- ))
-
- cat(sprintf("\nPrevalence ratio (M-H) %.2f (%.2f, %.2f)",
- RR.mh.wald[1],
- RR.mh.wald[2],
- RR.mh.wald[3]
- ))
-
- cat(sprintf("\nPrevalence ratio (crude:M-H) %.2f",
- round(RR.crude.wald[1] / RR.mh.wald[1], digits = 2)
- ))
-
- cat(sprintf("\nOdds ratio (crude) %.2f (%.2f, %.2f)",
- OR.crude.wald[1],
- OR.crude.wald[2],
- OR.crude.wald[3]
- ))
-
- cat(sprintf("\nOdds ratio (M-H) %.2f (%.2f, %.2f)",
- OR.mh.wald$est,
- OR.mh.wald$lower,
- OR.mh.wald$upper
- ))
-
- cat(sprintf("\nOdds ratio (crude:M-H) %.2f",
- round(OR.crude.wald[1] / OR.mh.wald[1], digits = 2)
- ))
-
- cat(sprintf("\nAtributable prevalence (crude) * %.2f (%.2f, %.2f)",
- ARisk.crude.wald[1],
- ARisk.crude.wald[2],
- ARisk.crude.wald[3]
- ))
-
- cat(sprintf("\nAtributable prevalence (M-H) * %.2f (%.2f, %.2f)",
- ARisk.mh.wald[1],
- ARisk.mh.wald[2],
- ARisk.mh.wald[3]
- ))
-
- cat(sprintf("\nAtributable prevalence (crude:M-H) %.2f",
- round(ARisk.crude.wald[1] /ARisk.mh.wald[1], digits = 2)
- ))
- })
- cat("\n-------------------------------------------------------------------")
- rrp <- ifelse(as.numeric(x$res$RR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$RR.homog)[3], digits = 3))
- cat("\n", "Test of homogeneity of IRR: X2 test statistic:", as.numeric(round(x$res$RR.homog[1], digits = 3)), "p-value:", rrp)
-
- orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
- cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
- cat("\n", "Wald confidence limits")
- cat("\n", "M-H: Mantel-Haenszel")
- cat("\n", "*", x$res$count.units, "\n")
- }
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+
+ with(x$res, {
+
+ cat(sprintf("\nInc rate ratio %.2f (%.2f, %.2f)",
+ IRR.crude.wald[1],
+ IRR.crude.wald[2],
+ IRR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib rate * %.2f (%.2f, %.2f)",
+ ARate.crude.wald[1],
+ ARate.crude.wald[2],
+ ARate.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib rate in population * %.2f (%.2f, %.2f)",
+ PARate.crude.wald[1],
+ PARate.crude.wald[2],
+ PARate.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib fraction in exposed (%%) %.2f (%.2f, %.2f)",
+ AFRate.crude.wald[1] * 100,
+ AFRate.crude.wald[2] * 100,
+ AFRate.crude.wald[3] * 100
+ ))
+
+ cat(sprintf("\nAttrib fraction in population (%%) %.2f (%.2f, %.2f)",
+ PAFRate.crude.wald[1] * 100,
+ PAFRate.crude.wald[2] * 100,
+ PAFRate.crude.wald[3] * 100
+ ))
+
+ })
+ cat("\n-------------------------------------------------------------------")
+ p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
+ cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "*", x$res$time.units, "\n")
+ }
+
+
+ ## cohort.time --- multiple strata
+ if(x$method == "cohort.time" & x$n.strata > 1){
+
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+ with(x$res, {
+
+ cat(sprintf("\nInc rate ratio (crude) %.2f (%.2f, %.2f)",
+ IRR.crude.wald[1],
+ IRR.crude.wald[2],
+ IRR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nInc rate ratio (M-H) %.2f (%.2f, %.2f)",
+ IRR.mh.wald[1],
+ IRR.mh.wald[2],
+ IRR.mh.wald[3]
+ ))
+
+ cat(sprintf("\nInc rate ratio (crude:M-H) %.2f",
+ round(IRR.crude.wald[1] / IRR.mh.wald[1], digits = 2)
+ ))
+
+ cat(sprintf("\nAttrib rate (crude) * %.2f (%.2f, %.2f)",
+ ARate.crude.wald[1],
+ ARate.crude.wald[2],
+ ARate.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib rate (M-H) * %.2f (%.2f, %.2f)",
+ ARate.mh.wald[1],
+ ARate.mh.wald[2],
+ ARate.mh.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib rate (crude:M-H) %.2f",
+ ARate.conf$est
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ # rrp <- ifelse(as.numeric(x$res$RR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$RR.homog)[3], digits = 3))
+ # cat("\n", "Test of homogeneity of IRR: X2 test statistic:", as.numeric(round(x$res$RR.homog[1], digits = 3)), "p-value:", rrp)
+
+ # orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
+ # cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "M-H: Mantel-Haenszel")
+ cat("\n", "*", x$res$time.units, "\n")
+ }
+
+
+ ## case.control --- single strata
+ if(x$method == "case.control" & x$n.strata == 1){
+
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+
+ with(x$res, {
+
+ cat(sprintf("\nOdds ratio (W) %.2f (%.2f, %.2f)",
+ OR.strata.wald[1],
+ OR.strata.wald[2],
+ OR.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib prevalence * %.2f (%.2f, %.2f)",
+ ARisk.strata.wald[1],
+ ARisk.strata.wald[2],
+ ARisk.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib prevalence in population * %.2f (%.2f, %.2f)",
+ PARisk.strata.wald[1],
+ PARisk.strata.wald[2],
+ PARisk.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib fraction (est) in exposed (%%) %.2f (%.2f, %.2f)",
+ AFest.strata.wald[1] * 100,
+ AFest.strata.wald[2] * 100,
+ AFest.strata.wald[3] * 100
+ ))
+
+ cat(sprintf("\nAttrib fraction (est) in population (%%) %.2f (%.2f, %.2f)",
+ PAFest.strata.wald[1] * 100,
+ PAFest.strata.wald[2] * 100,
+ PAFest.strata.wald[3] * 100
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
+ cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "*", x$res$count.units, "\n")
+ }
+
+
+ ## case.control --- multiple strata
+ if(x$method == "case.control" & x$n.strata > 1){
+
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+
+ with(x$res, {
+
+ cat(sprintf("\nOdds ratio (crude) %.2f (%.2f, %.2f)",
+ OR.crude.wald[1],
+ OR.crude.wald[2],
+ OR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nOdds ratio (M-H) %.2f (%.2f, %.2f)",
+ OR.mh.wald[1],
+ OR.mh.wald[2],
+ OR.mh.wald[3]
+ ))
+
+ cat(sprintf("\nOdds ratio (crude:M-H) %.2f",
+ round(OR.crude.wald[1] / OR.mh.wald[1], digits = 2)
+ ))
+
+ cat(sprintf("\nAttrib prevalence (crude) * %.2f (%.2f, %.2f)",
+ ARisk.crude.wald[1],
+ ARisk.crude.wald[2],
+ ARisk.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib prevalence (M-H) * %.2f (%.2f, %.2f)",
+ ARisk.mh.wald[1],
+ ARisk.mh.wald[2],
+ ARisk.mh.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib prevalence (crude:M-H) %.2f",
+ round(ARisk.crude.wald[1] / ARisk.mh.wald[1], digits = 2)
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
+ cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "M-H: Mantel-Haenszel")
+ cat("\n", "*", x$res$count.units, "\n")
+ }
+
+
+ ## cross.sectional -- single strata
+ if(x$method == "cross.sectional" & x$n.strata == 1){
+
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+
+ with(x$res, {
+
+ cat(sprintf("\nPrevalence ratio %.2f (%.2f, %.2f)",
+ RR.strata.wald[1],
+ RR.strata.wald[2],
+ RR.strata.wald[3]
+ ))
+
+ cat(sprintf("\nOdds ratio %.2f (%.2f, %.2f)",
+ OR.strata.wald[1],
+ OR.strata.wald[2],
+ OR.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib prevalence * %.2f (%.2f, %.2f)",
+ ARisk.strata.wald[1],
+ ARisk.strata.wald[2],
+ ARisk.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib prevalence in population * %.2f (%.2f, %.2f)",
+ PARisk.strata.wald[1],
+ PARisk.strata.wald[2],
+ PARisk.strata.wald[3]
+ ))
+
+ cat(sprintf("\nAttrib fraction in exposed (%%) %.2f (%.2f, %.2f)",
+ AFRisk.strata.wald[1] * 100,
+ AFRisk.strata.wald[2] * 100,
+ AFRisk.strata.wald[3] * 100
+ ))
+
+ cat(sprintf("\nAttrib fraction in population (%%) %.2f (%.2f, %.2f)",
+ PAFRisk.strata.wald[1] * 100,
+ PAFRisk.strata.wald[2] * 100,
+ PAFRisk.strata.wald[3] * 100
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ p <- ifelse(as.numeric(x$res$chisq.strata)[3] < 0.001, "< 0.001", round(as.numeric(x$res$chisq.strata)[3], digits = 3))
+ cat("\n", "X2 test statistic:", as.numeric(round(x$res$chisq.strata[1], digits = 3)), "p-value:", p)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "*", x$res$count.units, "\n")
+ }
+
+
+ ## cross.sectional --- multiple strata
+ if(x$method == "cross.sectional" & x$n.strata > 1){
+
+ print(x$tab)
+ cat("\nPoint estimates and", x$conf.level * 100, "%", "CIs:")
+ cat("\n-------------------------------------------------------------------")
+
+ with(x$res, {
+
+ cat(sprintf("\nPrevalence ratio (crude) %.2f (%.2f, %.2f)",
+ RR.crude.wald[1],
+ RR.crude.wald[2],
+ RR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nPrevalence ratio (M-H) %.2f (%.2f, %.2f)",
+ RR.mh.wald[1],
+ RR.mh.wald[2],
+ RR.mh.wald[3]
+ ))
+
+ cat(sprintf("\nPrevalence ratio (crude:M-H) %.2f",
+ round(RR.crude.wald[1] / RR.mh.wald[1], digits = 2)
+ ))
+
+ cat(sprintf("\nOdds ratio (crude) %.2f (%.2f, %.2f)",
+ OR.crude.wald[1],
+ OR.crude.wald[2],
+ OR.crude.wald[3]
+ ))
+
+ cat(sprintf("\nOdds ratio (M-H) %.2f (%.2f, %.2f)",
+ OR.mh.wald$est,
+ OR.mh.wald$lower,
+ OR.mh.wald$upper
+ ))
+
+ cat(sprintf("\nOdds ratio (crude:M-H) %.2f",
+ round(OR.crude.wald[1] / OR.mh.wald[1], digits = 2)
+ ))
+
+ cat(sprintf("\nAtributable prevalence (crude) * %.2f (%.2f, %.2f)",
+ ARisk.crude.wald[1],
+ ARisk.crude.wald[2],
+ ARisk.crude.wald[3]
+ ))
+
+ cat(sprintf("\nAtributable prevalence (M-H) * %.2f (%.2f, %.2f)",
+ ARisk.mh.wald[1],
+ ARisk.mh.wald[2],
+ ARisk.mh.wald[3]
+ ))
+
+ cat(sprintf("\nAtributable prevalence (crude:M-H) %.2f",
+ round(ARisk.crude.wald[1] /ARisk.mh.wald[1], digits = 2)
+ ))
+ })
+ cat("\n-------------------------------------------------------------------")
+ rrp <- ifelse(as.numeric(x$res$RR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$RR.homog)[3], digits = 3))
+ cat("\n", "Test of homogeneity of IRR: X2 test statistic:", as.numeric(round(x$res$RR.homog[1], digits = 3)), "p-value:", rrp)
+
+ orp <- ifelse(as.numeric(x$res$OR.homog)[3] < 0.001, "< 0.001", round(as.numeric(x$res$OR.homog)[3], digits = 3))
+ cat("\n", "Test of homogeneity of OR: X2 test statistic:", as.numeric(round(x$res$OR.homog[1], digits = 3)), "p-value:", orp)
+ cat("\n", "Wald confidence limits")
+ cat("\n", "M-H: Mantel-Haenszel")
+ cat("\n", "*", x$res$count.units, "\n")
+ }
}
## Summary method for epi.2by2:
summary.epi.2by2 <- function(object, ...) {
- return(object$massoc)
+ return(object$massoc)
}
\ No newline at end of file
diff --git a/R/epi.ccc.R b/R/epi.ccc.R
index 3afea08..d86789e 100644
--- a/R/epi.ccc.R
+++ b/R/epi.ccc.R
@@ -1,68 +1,107 @@
-epi.ccc = function(x, y, ci = "z-transform", conf.level = 0.95){
-
- dat <- data.frame(x, y)
- id <- complete.cases(dat)
- nmissing <- sum(!complete.cases(dat))
- dat <- dat[id,]
-
-
- N. <- 1 - ((1 - conf.level) / 2)
- zv <- qnorm(N., mean = 0, sd = 1)
- lower <- "lower"
- upper <- "upper"
-
- k <- length(dat$y)
- yb <- mean(dat$y)
- sy2 <- var(dat$y) * (k - 1) / k
- sd1 <- sd(dat$y)
+epi.ccc = function(x, y, ci = "z-transform", conf.level = 0.95, rep.measure = FALSE, subjectid){
+
+ N. <- 1 - ((1 - conf.level) / 2)
+ zv <- qnorm(N., mean = 0, sd = 1)
- xb <- mean(dat$x)
- sx2 <- var(dat$x) * (k - 1) / k
- sd2 <- sd(dat$x)
+ dat <- data.frame(x, y)
+ id <- complete.cases(dat)
+ nmissing <- sum(!complete.cases(dat))
+ dat <- dat[id,]
+
+ k <- length(dat$y)
+ yb <- mean(dat$y)
+ sy2 <- var(dat$y) * (k - 1) / k
+ sd1 <- sd(dat$y)
+
+ xb <- mean(dat$x)
+ sx2 <- var(dat$x) * (k - 1) / k
+ sd2 <- sd(dat$x)
+
+ r <- cor(dat$x, dat$y)
+ sl <- r * sd1 / sd2
+
+ sxy <- r * sqrt(sx2 * sy2)
+ p <- 2 * sxy / (sx2 + sy2 + (yb - xb)^2)
+
+ delta <- (dat$x - dat$y)
+ rmean <- apply(dat, MARGIN = 1, FUN = mean)
+ blalt <- data.frame(mean = rmean, delta)
+
+ # Scale shift:
+ v <- sd1 / sd2
+ # Location shift relative to the scale:
+ u <- (yb - xb) / ((sx2 * sy2)^0.25)
+ # Variable C.b is a bias correction factor that measures how far the best-fit line deviates from a line at 45 degrees (a measure of accuracy).
+ # No deviation from the 45 degree line occurs when C.b = 1. See Lin (1989 page 258).
+ # C.b <- (((v + 1) / (v + u^2)) / 2)^-1
+
+ # The following taken from the Stata code for function "concord" (changed 290408):
+ C.b <- p / r
+
+ # Variance, test, and CI for asymptotic normal approximation (per Lin [March 2000] Biometrics 56:325-5):
+ sep <- sqrt(((1 - ((r)^2)) * (p)^2 * (1 - ((p)^2)) / (r)^2 + (2 * (p)^3 * (1 - p) * (u)^2 / r) - 0.5 * (p)^4 * (u)^4 / (r)^2 ) / (k - 2))
+ ll <- p - (zv * sep)
+ ul <- p + (zv * sep)
+
+ # Statistic, variance, test, and CI for inverse hyperbolic tangent transform to improve asymptotic normality:
+ t <- log((1 + p) / (1 - p)) / 2
+ set = sep / (1 - ((p)^2))
+ llt = t - (zv * set)
+ ult = t + (zv * set)
+ llt = (exp(2 * llt) - 1) / (exp(2 * llt) + 1)
+ ult = (exp(2 * ult) - 1) / (exp(2 * ult) + 1)
- r <- cor(dat$x, dat$y)
- sl <- r * sd1 / sd2
+ # Calculate delta.sd if repeated measures:
+ if(rep.measure == TRUE){
+ # Make sure subject is a factor:
+ dat$sub <- subjectid
+ if(!is.factor(dat$sub)) dat$sub <- as.factor(dat$sub)
- sxy <- r * sqrt(sx2 * sy2)
- p <- 2 * sxy / (sx2 + sy2 + (yb - xb)^2)
+ # Number of subjects:
+ nsub <- length(levels(dat$sub))
+
+ # One way analysis of variance:
+ model <- aov(delta ~ dat$sub)
+
+ # Degrees of freedom:
+ MSB <- anova(model)[[3]][1]
+
+ # Sums of squares:
+ MSW <- anova(model)[[3]][2]
+
+ # Calculate number of complete pairs for each subject:
+ pairs <- NULL
+
+ for(i in 1:nsub){
+ pairs[i] <- sum(is.na(delta[dat$sub == levels(dat$sub)[i]]) == FALSE)
+ }
+
+ sig.dl <- (MSB - MSW) / ((sum(pairs)^2 - sum(pairs^2)) / ((nsub - 1) * sum(pairs)))
+ delta.sd <- sqrt(sig.dl + MSW)
+ }
- delta <- (dat$x - dat$y)
- rmean <- apply(dat, MARGIN = 1, FUN = mean)
- blalt <- data.frame(mean = rmean, delta)
+ # Calculate delta.sd if no repeated measures:
+ if(rep.measure == FALSE){
+ delta.sd <- sqrt(var(delta, na.rm = TRUE))
+ }
+
+ # Upper and lower bounds for Bland Altmann plot:
+ ba.p <- mean(delta)
+ ba.l <- ba.p - (zv * delta.sd)
+ ba.u <- ba.p + (zv * delta.sd)
+ sblalt <- data.frame("est" = ba.p, "lower" = ba.l, "upper" = ba.u)
- # Scale shift:
- v <- sd1 / sd2
- # Location shift relative to the scale:
- u <- (yb - xb) / ((sx2 * sy2)^0.25)
- # Variable C.b is a bias correction factor that measures how far the best-fit line deviates from a line at 45 degrees (a measure of accuracy). No deviation from the 45 degree line occurs when C.b = 1. See Lin (1989 page 258).
- # C.b <- (((v + 1) / (v + u^2)) / 2)^-1
-
- # The following taken from the Stata code for function "concord" (changed 290408):
- C.b <- p / r
+ if(ci == "asymptotic"){
+ rho.c <- data.frame(p, ll, ul)
+ names(rho.c) <- c("est", "lower", "upper")
+ rval <- list(rho.c = rho.c, s.shift = v, l.shift = u, C.b = C.b, blalt = blalt, sblalt = sblalt, nmissing = nmissing)
+ }
+
+ else if(ci == "z-transform"){
+ rho.c <- data.frame(p, llt, ult)
+ names(rho.c) <- c("est", "lower", "upper")
+ rval <- list(rho.c = rho.c, s.shift = v, l.shift = u, C.b = C.b, blalt = blalt, sblalt = sblalt, nmissing = nmissing)
+ }
- # Variance, test, and CI for asymptotic normal approximation (per Lin (March 2000) Biometrics 56:325-5):
- sep = sqrt(((1 - ((r)^2)) * (p)^2 * (1 - ((p)^2)) / (r)^2 + (2 * (p)^3 * (1 - p) * (u)^2 / r) - 0.5 * (p)^4 * (u)^4 / (r)^2 ) / (k - 2))
- ll = p - zv * sep
- ul = p + zv * sep
-
- # Statistic, variance, test, and CI for inverse hyperbolic tangent transform to improve asymptotic normality:
- t <- log((1 + p) / (1 - p)) / 2
- set = sep / (1 - ((p)^2))
- llt = t - zv * set
- ult = t + zv * set
- llt = (exp(2 * llt) - 1) / (exp(2 * llt) + 1)
- ult = (exp(2 * ult) - 1) / (exp(2 * ult) + 1)
-
- if(ci == "asymptotic"){
- rho.c <- as.data.frame(cbind(p, ll, ul))
- names(rho.c) <- c("est", lower, upper)
- rval <- list(rho.c = rho.c, s.shift = v, l.shift = u, C.b = C.b, blalt = blalt, nmissing = nmissing)
- }
-
- else if(ci == "z-transform"){
- rho.c <- as.data.frame(cbind(p, llt, ult))
- names(rho.c) <- c("est", lower, upper)
- rval <- list(rho.c = rho.c, s.shift = v, l.shift = u, C.b = C.b, blalt = blalt, nmissing = nmissing)
- }
- return(rval)
-}
+ return(rval)
+}
\ No newline at end of file
diff --git a/R/epi.ccsize.R b/R/epi.ccsize.R
index cfa3c50..974d31c 100644
--- a/R/epi.ccsize.R
+++ b/R/epi.ccsize.R
@@ -42,8 +42,7 @@
n1 <- ceiling(n1 * design)
n2 <- ceiling(r * n1)
- n.total <- n1 + n2
- rval <- list(n.total = n.total, n.case = n1, n.control = n2)
+ rval <- list(n.total = n1 + n2, n.case = n1, n.control = n2, power = power, OR = OR)
}
# Unmatched case-control - power:
@@ -61,15 +60,54 @@
z.beta <- sqrt((n1 * r * (p1 - p0)^2) / (pbar * qbar * (r + 1))) - z.alpha
power <- pnorm(z.beta, mean = 0, sd = 1)
- rval <- list(power = power)
+
+ # Account for the design effect:
+ n1 <- ceiling(n1 * design)
+ n2 <- ceiling(r * n1)
+
+ rval <- list(n.total = n1 + n2, n.case = n1, n.control = n2, power = power, OR = OR)
}
# Unmatched case-control - effect:
- # else
- # if(method == "unmatched" & is.na(OR) & !is.na(n) & !is.na(power)){
- #
- # }
+ else
+ if(method == "unmatched" & is.na(OR) & !is.na(n) & !is.na(power)){
+
+ n1 <- n / (r + 1) * r
+ n1 <- ceiling(n1 * design)
+ n2 <- ceiling(r * n1)
+ Pfun <- function(OR, power, p0, r, n, design, z.alpha){
+ q0 <- 1 - p0
+ p1 <- (p0 * OR) / (1 + p0 * (OR - 1))
+ q1 <- 1 - p1
+
+ pbar <- (p1 + (r * p0)) / (r + 1)
+ qbar <- 1 - pbar
+
+ # Account for the design effect:
+ n1 <- n / (r + 1) * r
+ n1 <- ceiling(n1 * design)
+ n2 <- ceiling(r * n1)
+
+ z.beta <- sqrt((n1 * r * (p1 - p0)^2) / (pbar * qbar * (r + 1))) - z.alpha
+
+ # Take the calculated value of the power and subtract the power entered by the user:
+ pnorm(z.beta, mean = 0, sd = 1) - power
+ }
+
+ # Find the value of OR that matches the power entered by the user:
+ OR.up <- uniroot(Pfun, power = power, p0 = p0, r = r, n = n, design = design, z.alpha = z.alpha, interval = c(1,1E06))$root
+ OR.lo <- uniroot(Pfun, power = power, p0 = p0, r = r, n = n, design = design, z.alpha = z.alpha, interval = c(0.0001,1))$root
+
+ # x = seq(from = 0.01, to = 100, by = 0.01)
+ # y = Pfun(x, power = 0.8, p0 = 0.15, r = 1, n = 150, design = 1, z.alpha = 1.96)
+ # windows(); plot(x, y, xlim = c(0,5)); abline(h = 0, lty = 2)
+ # Two possible values for OR meet the conditions of Pfun. So hence we set the lower bound of the search interval to 1.
+
+ rval <- list(n.total = n1 + n2, n.case = n1, n.control = n2, power = power, OR = c(OR.lo, OR.up))
+ }
+
+
# ------------------------------------------------------------------------------------------------------
# Matched case-control - sample size:
@@ -112,8 +150,9 @@
n.treat <- ceiling(n.treat)
n.control <- ceiling(n.control)
n.total <- n.treat + n.control
- rval <- list(n.crude = n.crude, n.total = n.total, n.case = n.treat, n.control = n.control)
- }
+
+ rval <- list(n.total = n.total, n.case = n.treat, n.control = n.control, power = power, OR = OR)
+ }
# Matched case-control - power:
else
@@ -152,15 +191,67 @@
z.beta <- (sqrt(n.treat * ((ee.one - ee.psi)^2)) - z.alpha * sqrt(nu.one)) / sqrt(nu.psi)
power <- 1 - pnorm(q = z.beta, lower.tail = FALSE)
- rval <- list(power = power)
+
+ rval <- list(n.total = n.treat + n.control, n.case = n.treat, n.control = n.control, power = power, OR = OR)
}
# Matched case-control - effect:
- # else
- # if(method == "matched" & is.na(OR) & !is.na(n) & !is.na(power)){
- #
- # }
+ else
+ if(method == "matched" & is.na(OR) & !is.na(n) & !is.na(power)){
+ n1 <- n / (r + 1) * r
+ n1 <- ceiling(n1 * design)
+ n2 <- ceiling(r * n1)
+
+ Pfun <- function(OR, power, p0, r, n, design, z.alpha){
+ odds0 = p0 / (1 - p0)
+ odds1 = odds0 * OR
+ p1 = odds1 / (1 + odds1)
+ delta.p = p1 - p0
+
+ psi <- OR
+ beta <- 1 - power
+ z.beta <- qnorm(p = beta, lower.tail = FALSE)
+ pq <- p1 * (1 - p1) * p0 * (1 - p0)
+ p0.p <- (p1 * p0 + rho * sqrt(pq)) / p1
+ p0.n <- (p0 * (1 - p1) - rho * sqrt(pq)) / (1 - p1)
+
+ tm <- ee.psi <- ee.one <- nu.psi <- nu.one <- rep(NA, r)
+ for(m in 1:r){
+ tm[m] <- p1 * choose(r, m - 1) * ((p0.p)^(m - 1)) * ((1 - p0.p)^(r - m + 1)) + (1 - p1) * choose(r,m) * ((p0.n)^m) * ((1 - p0.n))^(r - m)
+ ee.psi[m] <- m * tm[m] * psi / (m * psi + r - m + 1)
+ ee.one[m] <- m * tm[m] / (r + 1)
+ nu.psi[m] <- m * tm[m] * psi * (r - m + 1) / ((m * psi + r - m + 1)^2)
+ nu.one[m] <- m * tm[m] * (r - m + 1) / ((r + 1)^2)
+ }
+
+ ee.psi <- sum(ee.psi)
+ ee.one <- sum(ee.one)
+ nu.psi <- sum(nu.psi)
+ nu.one <- sum(nu.one)
+
+ # Account for the design effect:
+ n <- n / design
+ n1 <- ceiling(n / (r + 1)) * r
+ n2 <- ceiling(n / (r + 1)) * 1
+
+ z.beta <- (sqrt(n1 * ((ee.one - ee.psi)^2)) - z.alpha * sqrt(nu.one)) / sqrt(nu.psi)
+
+ # Take the calculated value of the power and subtract the power entered by the user:
+ pnorm(z.beta, mean = 0, sd = 1) - power
+ }
+
+ # Find the value of OR that matches the power entered by the user:
+ OR.up <- uniroot(Pfun, power = power, p0 = p0, r = r, n = n, design = design, z.alpha = z.alpha, interval = c(1,1E06))$root
+ OR.lo <- uniroot(Pfun, power = power, p0 = p0, r = r, n = n, design = design, z.alpha = z.alpha, interval = c(0.0001,1))$root
+
+ # x = seq(from = 0.01, to = 100, by = 0.01)
+ # y = Pfun(x, power = 0.8, p0 = 0.15, r = 1, n = 150, design = 1, z.alpha = 1.96)
+ # windows(); plot(x, y, xlim = c(0,5)); abline(h = 0, lty = 2)
+ # Two possible values for OR meet the conditions of Pfun. So hence we set the lower bound of the search interval to 1.
+
+ rval <- list(n.total = n1 + n2, n.case = n1, n.control = n2, power = power, OR = c(OR.lo, OR.up))
+ }
# ------------------------------------------------------------------------------------------------------
rval
diff --git a/R/epi.conf.R b/R/epi.conf.R
index 221fcf0..0652fcf 100644
--- a/R/epi.conf.R
+++ b/R/epi.conf.R
@@ -167,22 +167,28 @@ if(ctype == "inc.risk" | ctype == "prevalence"){
stop("Error: dat must be a two-column matrix")
if(method == "exact"){
- # Exact method (see http://www.folkesundhed.au.dk/uddannelse/software):
- a <- dat[,1]
- n <- dat[,2]
- b <- n - a
- p <- a / n
+ # Exact binomial confidence limits from function binom::binom.confint. Changed 190716.
+ alpha <- 1 - conf.level
+ alpha2 <- 0.5 * alpha
+ x <- dat[,1]; n <- dat[,2]
- # Exact binomial confidence limits (D. Collett (1999): Modelling binary data. Chapman & Hall/CRC, Boca Raton Florida, p. 24).
- a. <- ifelse(a == 0, a + 1, a)
- b. <- ifelse(b == 0, b + 1, b)
- low <- a. /(a. + (b. + 1) * (1 / qf(1 - N., 2 * a., 2 * b. + 2)))
- up <- (a. + 1) / (a. + 1 + b. / (1 / qf(1 - N., 2 * b., 2 * a. + 2)))
- low <- ifelse(a == 0, 0, low)
- up <- ifelse(a == n, 1, up)
-
- rval <- data.frame(est = p, lower = low, upper = up)
- }
+ p <- x/n
+ x1 <- x == 0; x2 <- x == n
+ lb <- ub <- x
+ lb[x1] <- 1
+ ub[x2] <- n[x2] - 1
+ lcl <- 1 - qbeta(1 - alpha2, n + 1 - x, lb)
+ ucl <- 1 - qbeta(alpha2, n - ub, x + 1)
+
+ if (any(x1))
+ lcl[x1] <- rep(0, sum(x1))
+
+ if (any(x2))
+ ucl[x2] <- rep(1, sum(x2))
+
+ rval <- data.frame(est = p, lower = lcl, upper = ucl)
+ rval
+ }
if(method == "wilson"){
# Wilson's method (see Rothman, Epidemiology An Introduction, page 132):
@@ -237,7 +243,10 @@ if(ctype == "inc.rate"){
p <- a / n
# If numerator equals zero set lower bound of confidence limit to zero:
low <- ifelse(a == 0, 0, (0.5 * qchisq(p = N., df = 2 * a + 2, lower.tail = FALSE) / n))
- up <- 0.5 * qchisq(p = 1 - N., df = 2 * a + 2, lower.tail = FALSE) / n
+
+ # Changed 020617.
+ up <- 0.5 * qchisq(p = 1 - N., df = 2 * a, lower.tail = FALSE) / n
+ # up <- 0.5 * qchisq(p = 1 - N., df = 2 * a + 2, lower.tail = FALSE) / n
rval <- data.frame(est = p, lower = low, upper = up)
}
@@ -278,7 +287,7 @@ else if(ctype == "smr"){
rval <- data.frame(est = smr, se = se.smr, lower = low, upper = up)
}
-else if(ctype == "odds"){
+else if(ctype == "odds" | ctype == "ratio"){
## Ederer F and Mantel N (1974) Confidence limits on the ratio of two Poisson variables. American Journal of Epidemiology 100: 165 - 167
## Cited in Altman, Machin, Bryant, and Gardner (2000) Statistics with Confidence, British Medical Journal, page 69.
## Added 161214
diff --git a/R/epi.dsl.R b/R/epi.dsl.R
index 8546193..9d9a3ec 100644
--- a/R/epi.dsl.R
+++ b/R/epi.dsl.R
@@ -95,19 +95,19 @@
p.effect <- switch(alternative, two.sided = 2 * pnorm(abs(effect.z), lower.tail = FALSE), less = pnorm(effect.z), greater = pnorm(effect.z, lower.tail = FALSE))
# Results:
- OR <- as.data.frame(cbind(OR.i, SE.OR.i, lower.OR.i, upper.OR.i))
- names(OR) <- c("est", "se", "lower", "upper")
+ OR <- data.frame(OR.i, lower.OR.i, upper.OR.i)
+ names(OR) <- c("est", "lower", "upper")
- OR.summary <- as.data.frame(cbind(OR.dsl, SE.OR.dsl, lower.OR.dsl, upper.OR.dsl))
- names(OR.summary) <- c("est", "se", "lower", "upper")
+ OR.summary <- data.frame(OR.dsl, lower.OR.dsl, upper.OR.dsl)
+ names(OR.summary) <- c("est", "lower", "upper")
- weights <- as.data.frame(cbind(w.iv.i, w.dsl.i))
+ weights <- data.frame(w.iv.i, w.dsl.i)
names(weights) <- c("inv.var", "dsl")
- Hsq <- as.data.frame(cbind(Hsq, Hsq.l, Hsq.u))
+ Hsq <- data.frame(Hsq, Hsq.l, Hsq.u)
names(Hsq) <- c("est", "lower", "upper")
- Isq <- as.data.frame(cbind(Isq, Isq.l, Isq.u))
+ Isq <- data.frame(Isq, Isq.l, Isq.u)
names(Isq) <- c("est", "lower", "upper")
rval <- list(OR = OR, OR.summary = OR.summary, weights = weights,
@@ -186,19 +186,19 @@
p.effect <- switch(alternative, two.sided = 2 * pnorm(abs(effect.z), lower.tail = FALSE), less = pnorm(effect.z), greater = pnorm(effect.z, lower.tail = FALSE))
# Results:
- RR <- as.data.frame(cbind(RR.i, SE.RR.i, lower.RR.i, upper.RR.i))
- names(RR) <- c("est", "se", "lower", "upper")
+ RR <- data.frame(RR.i, lower.RR.i, upper.RR.i)
+ names(RR) <- c("est", "lower", "upper")
- RR.summary <- as.data.frame(cbind(RR.dsl, SE.RR.dsl, lower.RR.dsl, upper.RR.dsl))
- names(RR.summary) <- c("est", "se", "lower", "upper")
+ RR.summary <- data.frame(RR.dsl, lower.RR.dsl, upper.RR.dsl)
+ names(RR.summary) <- c("est", "lower", "upper")
- weights <- as.data.frame(cbind(w.iv.i, w.dsl.i))
+ weights <- data.frame(w.iv.i, w.dsl.i)
names(weights) <- c("inv.var", "dsl")
- Hsq <- as.data.frame(cbind(Hsq, Hsq.l, Hsq.u))
+ Hsq <- data.frame(Hsq, Hsq.l, Hsq.u)
names(Hsq) <- c("est", "lower", "upper")
- Isq <- as.data.frame(cbind(Isq, Isq.l, Isq.u))
+ Isq <- data.frame(Isq, Isq.l, Isq.u)
names(Isq) <- c("est", "lower", "upper")
rval <- list(RR = RR, RR.summary = RR.summary, weights = weights,
diff --git a/R/epi.equivb.R b/R/epi.equivb.R
index 3b9dfd5..f97c5a4 100644
--- a/R/epi.equivb.R
+++ b/R/epi.equivb.R
@@ -1,33 +1,51 @@
epi.equivb <- function(treat, control, delta, n, r = 1, power, alpha){
- # alpha <- (1 - conf.level)
- beta <- (1 - power)
-
- z.alpha <- qnorm(1 - alpha, mean = 0, sd = 1)
- z.beta <- qnorm(1 - beta / 2, mean = 0, sd = 1)
-
+ # Sample size:
if (!is.na(treat) & !is.na(control) & !is.na(delta) & !is.na(power) & is.na(n)) {
- # http://powerandsamplesize.com/Calculators/Test-1-Proportion/1-Sample-Equivalence:
- n.control <- (((treat * (1 - treat)) / r) + (control * (1 - control))) * ((z.alpha + z.beta) / (abs(treat - control) - delta))^2
- n.treat <- n.control * r
-
- # r = n.treat / n.control
- n.control <- ceiling(n.control)
- n.treat <- ceiling(n.treat)
-
- rval <- list(n.treat = n.treat, n.control = n.control, n.total = n.treat + n.control)
+ beta <- (1 - power)
+ z.beta <- qnorm(1 - beta / 2, mean = 0, sd = 1)
+ z.alpha <- qnorm(1 - alpha, mean = 0, sd = 1)
+ pA <- treat; pB <- control
+ qA <- 1 - pA; qB <- 1 - pB
+ epsilon <- pA - pB
+
+ # Chow et al page 89, Equation 4.2.4:
+ # nB <- (z.alpha + z.beta)^2 / (delta - abs(epsilon))^2 * (((pA * qA) / r) + (pB * qB))
+
+ # http://powerandsamplesize.com/Calculators/Compare-2-Proportions/2-Sample-Equivalence:
+ nB <- (pA * qA / r + pB * qB) * ((z.alpha + z.beta) / (abs(pA - pB) - delta))^2
+
+ nA <- nB * r
+ nB <- ceiling(nB)
+ nA <- ceiling(nA)
+
+ rval <- list(n.treat = nA, n.control = nB, n.total = nA + nB, power = power)
}
-
- if (!is.na(treat) & !is.na(control) & !is.na(delta) & !is.na(n) & is.na(power) & !is.na(r) & !is.na(alpha)) {
- # Work out the number of subjects in the control group. r equals the number in the treatment group divided by
- # the number in the control group.
- n.control <- ceiling(1 / (r + 1) * (n))
- n.treat <- n - n.control
-
- z <- (abs(treat - control) - delta) / sqrt((treat * (1 - treat) / n.treat) + (control * (1 - control) / n.control))
- power = 2 * (pnorm(z - qnorm(1 - alpha)) + pnorm(-z - qnorm(1 - alpha))) - 1
-
- rval <- list(n.treat = n.treat, n.control = n.control, n.total = n.treat + n.control, power = power)
+
+ # Power:
+ if (!is.na(treat) & !is.na(control) & !is.na(delta) & !is.na(n) & is.na(power) & !is.na(r) & !is.na(alpha)) {
+ z.alpha <- qnorm(1 - alpha, mean = 0, sd = 1)
+ pA <- treat; pB <- control
+ qA <- 1 - pA; qB <- 1 - pB
+ nA <- n - ceiling(1 / (r + 1) * (n))
+ nB <- ceiling(1 / (r + 1) * (n))
+ epsilon <- pA - pB
+
+ # Chow et al. page 89, second equation from top of page:
+ # z <- (delta - abs(epsilon)) / sqrt((pA * qA / nA) + (pB * qB / nB))
+ # power <- 2 * pnorm(z - z.alpha, mean = 0, sd = 1) - 1
+
+ # http://powerandsamplesize.com/Calculators/Test-1-Proportion/1-Sample-Equivalence:
+ z = (abs(pA - pB) - delta) / sqrt((pA * qA / nA) + (pB * qB / nB))
+ power = 2 * (pnorm(z - z.alpha) + pnorm(-z - z.alpha)) - 1
+ power
+
+ # From user (Wu et al. 2008, page 433):
+ # z1 <- (delta - abs(pA - pB)) / sqrt((pA * qA / nA) + (pB * qB / nB))
+ # z2 <- (delta + abs(pA - pB)) / sqrt((pA * qA / nA) + (pB * qB / nB))
+ # power <- 1 - pnorm(-z1 + z.alpha) - pnorm(-z2 + z.alpha)
+
+ rval <- list(n.treat = nA, n.control = nB, n.total = nA + nB, power = power)
}
rval
}
diff --git a/R/epi.iv.R b/R/epi.iv.R
index 48e9146..c817361 100644
--- a/R/epi.iv.R
+++ b/R/epi.iv.R
@@ -75,19 +75,19 @@
p.effect <- switch(alternative, two.sided = 2 * pnorm(abs(effect.z), lower.tail = FALSE), less = pnorm(effect.z), greater = pnorm(effect.z, lower.tail = FALSE))
# Results:
- OR <- as.data.frame(cbind(OR.i, SE.OR.i, lower.OR.i, upper.OR.i))
- names(OR) <- c("est", "se", "lower", "upper")
+ OR <- data.frame(OR.i, lower.OR.i, upper.OR.i)
+ names(OR) <- c("est", "lower", "upper")
- OR.summary <- as.data.frame(cbind(OR.iv, SE.OR.iv, lower.OR.iv, upper.OR.iv))
- names(OR.summary) <- c("est", "se", "lower", "upper")
+ OR.summary <- data.frame(OR.iv, lower.OR.iv, upper.OR.iv)
+ names(OR.summary) <- c("est", "lower", "upper")
- weights <- as.data.frame(cbind(w.i, w.iv.i))
+ weights <- data.frame(w.i, w.iv.i)
names(weights) <- c("raw", "inv.var")
- Hsq <- as.data.frame(cbind(Hsq, Hsq.l, Hsq.u))
+ Hsq <- data.frame(Hsq, Hsq.l, Hsq.u)
names(Hsq) <- c("est", "lower", "upper")
- Isq <- as.data.frame(cbind(Isq, Isq.l, Isq.u))
+ Isq <- data.frame(Isq, Isq.l, Isq.u)
names(Isq) <- c("est", "lower", "upper")
rval <- list(OR = OR, OR.summary = OR.summary, weights = weights,
@@ -150,19 +150,19 @@
p.effect <- switch(alternative, two.sided = 2 * pnorm(abs(effect.z), lower.tail = FALSE), less = pnorm(effect.z), greater = pnorm(effect.z, lower.tail = FALSE))
# Results:
- RR <- as.data.frame(cbind(RR.i, SE.RR.i, lower.RR.i, upper.RR.i))
- names(RR) <- c("est", "se", "lower", "upper")
+ RR <- data.frame(RR.i, lower.RR.i, upper.RR.i)
+ names(RR) <- c("est", "lower", "upper")
- RR.summary <- as.data.frame(cbind(RR.iv, SE.RR.iv, lower.RR.iv, upper.RR.iv))
- names(RR.summary) <- c("est", "se", "lower", "upper")
+ RR.summary <- data.frame(RR.iv, lower.RR.iv, upper.RR.iv)
+ names(RR.summary) <- c("est", "lower", "upper")
- weights <- as.data.frame(cbind(w.i, w.iv.i))
+ weights <- data.frame(w.i, w.iv.i)
names(weights) <- c("raw", "inv.var")
- Hsq <- as.data.frame(cbind(Hsq, Hsq.l, Hsq.u))
+ Hsq <- data.frame(Hsq, Hsq.l, Hsq.u)
names(Hsq) <- c("est", "lower", "upper")
- Isq <- as.data.frame(cbind(Isq, Isq.l, Isq.u))
+ Isq <- data.frame(Isq, Isq.l, Isq.u)
names(Isq) <- c("est", "lower", "upper")
rval <- list(RR = RR, RR.summary = RR.summary, weights = weights,
diff --git a/R/epi.kappa.R b/R/epi.kappa.R
index e92a179..f609fe0 100644
--- a/R/epi.kappa.R
+++ b/R/epi.kappa.R
@@ -6,23 +6,28 @@
n <- sum(dat)
- # Function to return confidene intervals for a proportion:
+ ## Exact binomial confidence limits from function binom::binom.confint. Changed 190716.
.funincrisk <- function(ndat, nconf.level){
- ## Exact binomial confidence limits from D. Collett (1999) Modelling binary data. Chapman & Hall/CRC, Boca Raton Florida, p. 24.
- N. <- 1 - ((1 - nconf.level) / 2)
- a <- ndat[,1]
- n <- ndat[,2]
- b <- n - a
- p <- a / n
-
- a. <- ifelse(a == 0, a + 1, a); b. <- ifelse(b == 0, b + 1, b)
- low <- a. /(a. + (b. + 1) * (1 / qf(1 - N., 2 * a., 2 * b. + 2)))
- up <- (a. + 1) / (a. + 1 + b. / (1 / qf(1 - N., 2 * b., 2 * a. + 2)))
- low <- ifelse(a == 0, 0, low)
- up <- ifelse(a == n, 1, up)
- rval <- data.frame(p, low, up)
- names(rval) <- c("est", "lower", "upper")
- rval
+ alpha <- 1 - conf.level
+ alpha2 <- 0.5 * alpha
+ x <- ndat[,1]; n <- ndat[,2]
+
+ p <- x/n
+ x1 <- x == 0; x2 <- x == n
+ lb <- ub <- x
+ lb[x1] <- 1
+ ub[x2] <- n[x2] - 1
+ lcl <- 1 - qbeta(1 - alpha2, n + 1 - x, lb)
+ ucl <- 1 - qbeta(alpha2, n - ub, x + 1)
+
+ if (any(x1))
+ lcl[x1] <- rep(0, sum(x1))
+
+ if (any(x2))
+ ucl[x2] <- rep(1, sum(x2))
+
+ rval <- data.frame(est = p, lower = lcl, upper = ucl)
+ rval
}
if(method == "fleiss"){
diff --git a/R/epi.mh.R b/R/epi.mh.R
index a628a44..b876a2c 100644
--- a/R/epi.mh.R
+++ b/R/epi.mh.R
@@ -101,19 +101,19 @@
p.effect <- switch(alternative, two.sided = 2 * pnorm(abs(effect.z), lower.tail = FALSE), less = pnorm(effect.z), greater = pnorm(effect.z, lower.tail = FALSE))
# Results:
- OR <- as.data.frame(cbind(OR.i, SE.OR.i, lower.OR.i, upper.OR.i))
- names(OR) <- c("est", "se", "lower", "upper")
+ OR <- data.frame(OR.i, lower.OR.i, upper.OR.i)
+ names(OR) <- c("est", "lower", "upper")
- OR.summary <- as.data.frame(cbind(OR.mh, SE.OR.mh, lower.OR.mh, upper.OR.mh))
- names(OR.summary) <- c("est", "se", "lower", "upper")
+ OR.summary <- data.frame(OR.mh, lower.OR.mh, upper.OR.mh)
+ names(OR.summary) <- c("est", "lower", "upper")
- weights <- as.data.frame(cbind(w.i, w.iv.i))
+ weights <- data.frame(w.i, w.iv.i)
names(weights) <- c("raw", "inv.var")
- Hsq <- as.data.frame(cbind(Hsq, Hsq.l, Hsq.u))
+ Hsq <- data.frame(Hsq, Hsq.l, Hsq.u)
names(Hsq) <- c("est", "lower", "upper")
- Isq <- as.data.frame(cbind(Isq, Isq.l, Isq.u))
+ Isq <- data.frame(Isq, Isq.l, Isq.u)
names(Isq) <- c("est", "lower", "upper")
rval <- list(OR = OR, OR.summary = OR.summary, weights = weights,
@@ -177,19 +177,19 @@
p.effect <- switch(alternative, two.sided = 2 * pnorm(abs(effect.z), lower.tail = FALSE), less = pnorm(effect.z), greater = pnorm(effect.z, lower.tail = FALSE))
# Results:
- RR <- as.data.frame(cbind(RR.i, SE.RR.i, lower.RR.i, upper.RR.i))
- names(RR) <- c("est", "se", "lower", "upper")
+ RR <- data.frame(RR.i, lower.RR.i, upper.RR.i)
+ names(RR) <- c("est", "lower", "upper")
- RR.summary <- as.data.frame(cbind(RR.mh, SE.RR.mh, lower.RR.mh, upper.RR.mh))
- names(RR.summary) <- c("est", "se", "lower", "upper")
+ RR.summary <- data.frame(RR.mh, lower.RR.mh, upper.RR.mh)
+ names(RR.summary) <- c("est", "lower", "upper")
- weights <- as.data.frame(cbind(w.i, w.iv.i))
+ weights <- data.frame(w.i, w.iv.i)
names(weights) <- c("raw", "inv.var")
- Hsq <- as.data.frame(cbind(Hsq, Hsq.l, Hsq.u))
+ Hsq <- data.frame(Hsq, Hsq.l, Hsq.u)
names(Hsq) <- c("est", "lower", "upper")
- Isq <- as.data.frame(cbind(Isq, Isq.l, Isq.u))
+ Isq <- data.frame(Isq, Isq.l, Isq.u)
names(Isq) <- c("est", "lower", "upper")
rval <- list(RR = RR, RR.summary = RR.summary, weights = weights,
diff --git a/R/epi.nomogram.R b/R/epi.nomogram.R
index 10cc926..119f5a7 100644
--- a/R/epi.nomogram.R
+++ b/R/epi.nomogram.R
@@ -31,7 +31,7 @@ epi.nomogram <- function(se, sp, lr, pre.pos, verbose = FALSE){
if(verbose == FALSE){
post.prob.pos <- ifelse(post.prob.pos < 0.01, round(post.prob.pos, digits = 4), round(post.prob.pos, digits = 2))
post.prob.neg <- ifelse(post.prob.neg < 0.01, round(post.prob.neg, digits = 4), round(post.prob.neg, digits = 2))
- cat("The post-test probability of being disease positive is", post.prob.pos, "\n")
- cat("The post-test probability of being disease negative is", post.prob.neg, "\n")
+ cat("Given a positive test result, the post-test probability of being disease positive is", post.prob.pos, "\n")
+ cat("Given a negative test result, the post-test probability of being disease negative is", post.prob.neg, "\n")
}
}
\ No newline at end of file
diff --git a/R/epi.smd.R b/R/epi.smd.R
index 31e392a..33f023f 100644
--- a/R/epi.smd.R
+++ b/R/epi.smd.R
@@ -57,12 +57,15 @@
upper.MD.dsl <- MD.dsl + (z * SE.MD.dsl)
# Results:
- md <- as.data.frame(cbind(MD.i, SE.MD.i, lower.MD.i, upper.MD.i))
- names(md) <- c("est", "se", "lower", "upper")
- md.invar <- as.data.frame(cbind(MD.iv, SE.MD.iv, lower.MD.iv, upper.MD.iv))
- names(md.invar) <- c("est", "se", "lower", "upper")
- md.dsl <- as.data.frame(cbind(MD.dsl, lower.MD.dsl, upper.MD.dsl))
+ md <- data.frame(MD.i, lower.MD.i, upper.MD.i)
+ names(md) <- c("est", "lower", "upper")
+
+ md.invar <- data.frame(MD.iv, lower.MD.iv, upper.MD.iv)
+ names(md.invar) <- c("est", "lower", "upper")
+
+ md.dsl <- data.frame(MD.dsl, lower.MD.dsl, upper.MD.dsl)
names(md.dsl) <- c("est", "lower", "upper")
+
heterogeneity = c(Q = Q, df = df, p.value = p.heterogeneity)
rval <- list(md = md, md.invar = md.invar, md.dsl = md.dsl, heterogeneity = heterogeneity)
diff --git a/R/epi.tests.R b/R/epi.tests.R
index 700bd4c..f406c79 100644
--- a/R/epi.tests.R
+++ b/R/epi.tests.R
@@ -8,22 +8,30 @@
N. <- 1 - ((1 - conf.level) / 2)
z <- qnorm(N., mean = 0, sd = 1)
- ## Exact binomial confidence limits from D. Collett (1999) Modelling binary data. Chapman & Hall/CRC, Boca Raton Florida, p. 24.
+ ## Exact binomial confidence limits from function binom::binom.confint. Changed 190716.
.funincrisk <- function(cdat, conf.level){
- N. <- 1 - ((1 - conf.level) / 2)
- a <- cdat[,1]
- n <- cdat[,2]
- b <- n - a
- p <- a / n
-
- a. <- ifelse(a == 0, a + 1, a); b. <- ifelse(b == 0, b + 1, b)
- low <- a. /(a. + (b. + 1) * (1 / qf(1 - N., 2 * a., 2 * b. + 2)))
- up <- (a. + 1) / (a. + 1 + b. / (1 / qf(1 - N., 2 * b., 2 * a. + 2)))
- low <- ifelse(a == 0, 0, low)
- up <- ifelse(a == n, 1, up)
- rval <- data.frame(est = p, lower = low, upper = up)
- rval
- }
+
+ alpha <- 1 - conf.level
+ alpha2 <- 0.5 * alpha
+ x <- cdat[,1]; n <- cdat[,2]
+
+ p <- x/n
+ x1 <- x == 0; x2 <- x == n
+ lb <- ub <- x
+ lb[x1] <- 1
+ ub[x2] <- n[x2] - 1
+ lcl <- 1 - qbeta(1 - alpha2, n + 1 - x, lb)
+ ucl <- 1 - qbeta(alpha2, n - ub, x + 1)
+
+ if (any(x1))
+ lcl[x1] <- rep(0, sum(x1))
+
+ if (any(x2))
+ ucl[x2] <- rep(1, sum(x2))
+
+ rval <- data.frame(est = p, lower = lcl, upper = ucl)
+ rval
+ }
## From Greg Snow, R-sig-Epi, 3 Mar 2008:
## My prefered approach (not the only one), is to use the Bayesian interval using a uniform prior (beta(1,1) distribution)
diff --git a/man/epi.2by2.Rd b/man/epi.2by2.Rd
index 6fb4fcf..f70922f 100644
--- a/man/epi.2by2.Rd
+++ b/man/epi.2by2.Rd
@@ -9,7 +9,7 @@ Summary measures for count data presented in a 2 by 2 table
}
\description{
-Computes summary measures of risk and a chi-squared test for difference in the observed proportions from count data presented in a 2 by 2 table. Multiple strata may be represented by additional rows of count data. With multiple strata the function returns crude and Mantel-Haenszel adjusted measures of association and chi-squared tests of homogeneity.
+Computes summary measures of risk and a chi-squared test for difference in the observed proportions from count data presented in a 2 by 2 table. With multiple strata the function returns crude and Mantel-Haenszel adjusted measures of association and chi-squared tests of homogeneity.
}
\usage{
@@ -23,9 +23,9 @@ epi.2by2(dat, method = "cohort.count", conf.level = 0.95, units = 100,
\arguments{
\item{dat}{an object of class \code{table} containing the individual cell frequencies. See the examples, below, for details.}
- \item{method}{a character string indicating the experimental design on which the tabular data has been based. Options are \code{cohort.count}, \code{cohort.time}, \code{case.control}, or \code{cross.sectional}.}
+ \item{method}{a character string indicating the study design on which the tabular data has been based. Options are \code{cohort.count}, \code{cohort.time}, \code{case.control}, or \code{cross.sectional}. Based on the study design specified by the user, appropriate measures of association, measures of effect in the exposed and measures of effect in the population are returned by the function.}
\item{conf.level}{magnitude of the returned confidence intervals. Must be a single number between 0 and 1.}
- \item{units}{multiplier for prevalence and incidence estimates.}
+ \item{units}{multiplier for prevalence and incidence (risk or rate) estimates.}
\item{homogeneity}{a character string indicating the type of homogeneity test to perform. Options are \code{breslow.day} or \code{woolf}.}
\item{outcome}{a character string indicating how the outcome variable is represented in the contingency table. Options are \code{as.columns} (outcome as columns) or \code{as.rows} (outcome as rows).}
\item{x, object}{an object of class \code{epi.2by2}.}
@@ -65,17 +65,17 @@ A summary of the methods used for each of the confidence interval calculations i
\value{
An object of class \code{epi.2by2} comprised of:
- \item{method}{character string specifying the experimental design on which the tabular data has been based.}
+ \item{method}{character string returning the study design specified by the user.}
\item{n.strata}{number of strata.}
\item{conf.level}{magnitude of the returned confidence intervals.}
- \item{massoc}{a list comprised of the computed measures of association. See below for details.}
+ \item{massoc}{a list comprised of the computed measures of association, measures of effect in the exposed and measures of effect in the population. See below for details.}
\item{tab}{a data frame comprised of of the contingency table data.}
-When method equals \code{cohort.count} the following measures of association and effect are returned:
+When method equals \code{cohort.count} the following measures of association, measures of effect in the exposed and measures of effect in the population are returned:
\item{\code{RR}}{Wald and score confidence intervals for the incidence risk ratios for each strata. Wald and score confidence intervals for the crude incidence risk ratio. Wald confidence interval for the Mantel-Haenszel adjusted incidence risk ratio.}
\item{\code{OR}}{Wald, score, Cornfield and maximum likelihood confidence intervals for the odds ratios for each strata. Wald, score, Cornfield and maximum likelihood confidence intervals for the crude odds ratio. Wald confidence interval for the Mantel-Haenszel adjusted odds ratio.}
- \item{\code{ARisk}}{Wald and score confidence intervals for the attributable risk for each strata. Wald and score confidence intervals for the crude attributable risk. Wald, Sato and Greenland-Robins confidence intervals for the Mantel-Haenszel adjusted attributable risk.}
+ \item{\code{ARisk}}{Wald and score confidence intervals for the attributable risk (risk difference) for each strata. Wald and score confidence intervals for the crude attributable risk. Wald, Sato and Greenland-Robins confidence intervals for the Mantel-Haenszel adjusted attributable risk.}
\item{\code{PARisk}}{Wald and Pirikahu confidence intervals for the population attributable risk for each strata. Wald and Pirikahu confidence intervals for the crude population attributable risk. The Pirikahu confidence intervals are calculated using the delta method.}
\item{\code{AFRisk}}{Wald confidence intervals for the attributable fraction for each strata. Wald confidence intervals for the crude attributable fraction.}
\item{\code{PAFRisk}}{Wald confidence intervals for the population attributable fraction for each strata. Wald confidence intervals for the crude population attributable fraction.}
@@ -121,6 +121,8 @@ When method equals \code{cross.sectional} the following measures of association
\item{\code{chisq.mh}}{Mantel-Haenszel chi-squared test.}
\item{\code{PR.homog}}{test of homogeneity of the individual strata prevalence ratios.}
\item{\code{OR.homog}}{test of homogeneity of the individual strata odds ratios.}
+
+The point estimates of the \code{wald}, \code{score} and \code{cfield} odds ratios are calculated using the cross product method. Method \code{mle} computes the conditional maximum likelihood estimate of the odds ratio.
}
@@ -180,21 +182,19 @@ Zhang J, Yu KF (1998). What's the relative risk? A method for correcting the odd
}
\author{
-Mark Stevenson (Faculty of Veterinary and Agricultural Sciences, The University of Melbourne, Australia), Cord Heuer (EpiCentre, IVABS, Massey University, Palmerston North, New Zealand), Jim Robison-Cox (Department of Math Sciences, Montana State University, Montana, USA) and Kazuki Yoshida (Brigham and Women's Hospital, Boston Massachusetts, USA). Thanks to Ian Dohoo for numerous helpful suggestions to improve the documentation for this function.
+Mark Stevenson (Faculty of Veterinary and Agricultural Sciences, The University of Melbourne, Australia), Cord Heuer (EpiCentre, IVABS, Massey University, Palmerston North, New Zealand), Jim Robison-Cox (Department of Math Sciences, Montana State University, Montana, USA), Kazuki Yoshida (Brigham and Women's Hospital, Boston Massachusetts, USA) and Simon Firestone (Faculty of Veterinary and Agricultural Sciences, The University of Melbourne, Australia). Thanks to Ian Dohoo for numerous h [...]
}
-\note{Measures of strength of association include the prevalence ratio, the incidence risk ratio, the incidence rate ratio and the odds ratio. The incidence risk ratio is the ratio of the incidence risk of disease in the exposed group to the incidence risk of disease in the unexposed group. The odds ratio (also known as the cross-product ratio) is an estimate of the incidence risk ratio. When the incidence of an outcome in the study population is low (say, less than 5\%) the odds ratio w [...]
+\note{Measures of association include the prevalence ratio, the incidence risk ratio, the incidence rate ratio and the odds ratio. The incidence risk ratio is the ratio of the incidence risk of disease in the exposed group to the incidence risk of disease in the unexposed group. The odds ratio (also known as the cross-product ratio) is an estimate of the incidence risk ratio. When the incidence of an outcome in the study population is low (say, less than 5\%) the odds ratio will provide [...]
-Measures of effect include the attributable risk (or prevalence) and the attributable fraction. The attributable risk is the risk of disease in the exposed group minus the risk of disease in the unexposed group. The attributable risk provides a measure of the absolute increase or decrease in risk associated with exposure. The attributable fraction is the proportion of disease in the exposed group attributable to exposure.
+Measures of effect in the exposed include the attributable risk (or prevalence) and the attributable fraction. The attributable risk is the risk of disease in the exposed group minus the risk of disease in the unexposed group. The attributable risk provides a measure of the absolute increase or decrease in risk associated with exposure. The attributable fraction is the proportion of study outcomes in the exposed group that is attributable to exposure.
-Measures of total effect include the population attributable risk (or prevalence) and the population attributable fraction (also known as the aetiologic fraction). The population attributable risk is the risk of disease in the population that may be attributed to exposure. The population attributable fraction is the proportion of the disease in the population that is attributable to exposure.
+Measures of effect in the population include the population attributable risk (or prevalence) and the population attributable fraction (also known as the aetiologic fraction). The population attributable risk is the risk of the study outcome in the population that may be attributed to exposure. The population attributable fraction is the proportion of the study outcomes in the population that is attributable to exposure.
Point estimates and confidence intervals for the prevalence ratio and incidence risk ratio are calculated using Wald (Wald 1943) and score methods (Miettinen and Nurminen 1985). Point estimates and confidence intervals for the incidence rate ratio are calculated using the exact method described by Kirkwood and Sterne (2003) and Juul (2004). Point estimates and confidence intervals the odds ratio are calculated using Wald (Wald 1943), score (Miettinen and Nurminen 1985) and maximum likeli [...]
Wald confidence intervals are provided in the summary table simply because they are widely used and would be familiar to most users.
-The function checks each strata for cells with zero frequencies. If a zero frequency is found in any cell, 0.5 is added to all cells within the strata.
-
The Mantel-Haenszel adjusted measures of association are valid when the measures of association across the different strata are similar (homogenous), that is when the test of homogeneity of the odds (risk) ratios is not significant.
The tests of homogeneity of the odds (risk) ratio where \code{homogeneity = "breslow.day"} and \code{homogeneity = "woolf"} are based on Jewell (2004, p 152 - 158). Thanks to Jim Robison-Cox for sharing his implementation of these functions.
@@ -229,11 +229,11 @@ epi.2by2(dat = as.table(dat), method = "cross.sectional",
## The prevalence of FUS in DCF exposed cats is 4.01 (95\% CI 1.43 to 11.23)
## times greater than the prevalence of FUS in non-DCF exposed cats.
-## Attributable fraction:
+## Attributable fraction in the exposed:
## In DCF exposed cats, 75\% of FUS is attributable to DCF (95\% CI 30\% to
## 91\%).
-## Population attributable fraction:
+## Attributable fraction in the population:
## Fifty-four percent of FUS cases in the cat population are attributable
## to DCF (95\% CI 4\% to 78\%).
@@ -277,8 +277,8 @@ rval <- epi.2by2(dat = tab2, method = "cohort.count",
outcome = "as.columns")
print(rval)
-## After adjusting for the confounding effect of race, the odds of
-## having a low birth weight child for smokers is 2.15 (95\% CI 1.29 to 3.58)
+## After accounting for the confounding effect of race, the odds of
+## having a low birth weight child for smokers is 3.09 (95\% CI 1.49 to 6.39)
## times that of non-smokers.
## Compare the Greenland-Robins confidence intervals for the Mantel-Haenszel
@@ -315,9 +315,9 @@ rval$massoc$OR.crude.cfield
rval$massoc$OR.crude.mle
rval$massoc$OR.crude.score
-## Cornfield: 2.20 (95\% CI 1.07 to 3.79)
+## Cornfield: 2.02 (95\% CI 1.07 to 3.79)
## Maximum likelihood: 2.01 (1.03 to 3.96)
-# Score: 2.20 (95\% CI 2.84 to 5.17)
+# Score: 2.02 (95\% CI 1.08 to 3.77)
## Plot the individual strata-level odds ratios and compare them with the
## Mantel-Haenszel adjusted odds ratio.
@@ -353,20 +353,51 @@ ggplot(dat, aes(or.p, y.at)) +
## 136/22050 person-years among the blind compared with 1709/127650 person-
## years among those who were visually impaired but not blind.
+\dontrun{
dat <- as.table(matrix(c(136,22050,1709,127650), nrow = 2, byrow = TRUE))
-rval <- epi.2by2(dat = dat, method = "cohort.time", conf.level = 0.90,
+rval <- epi.2by2(dat = dat, method = "cohort.time", conf.level = 0.95,
units = 1000, homogeneity = "breslow.day", outcome = "as.columns")
summary(rval)$ARate.strata.wald
## The incidence rate of cancer was 7.22 cases per 1000 person-years less in the
## blind, compared with those who were not blind but had severe visual impairment
-## (90\% CI 6.20 to 8.24 cases per 1000 person-years).
+## (90\% CI 6.00 to 8.43 cases per 1000 person-years).
round(summary(rval)$IRR.strata.wald, digits = 2)
+}
## The incidence rate of cancer in the blind group was less than half that of the
-## comparison group (incidence rate ratio 0.46, 90\% CI 0.40 to 0.53).
+## comparison group (incidence rate ratio 0.46, 90\% CI 0.38 to 0.55).
+
+## EXAMPLE 4:
+## A study has been conducted to assess the effect of a new treatment for
+## mastitis in dairy cows. Eight herds took part in the study. The following
+## data were obtained. The vectors ai, bi, ci and di list (for each herd) the
+## number of cows in the E+D+, E+D-, E-D+ and E-D- groups, respectively.
+\dontrun{
+hid <- 1:8
+ai <- c(23,10,20,5,14,6,10,3)
+bi <- c(10,2,1,2,2,2,3,0)
+ci <- c(3,2,3,2,1,3,3,2)
+di <- c(6,4,3,2,6,3,1,1)
+dat <- data.frame(hid, ai, bi, ci, di)
+print(dat)
+
+## Re-format data frame dat into a format suitable for epi.2by2:
+hid <- rep(1:8, times = 4)
+exp <- factor(rep(c(1,1,0,0), each = 8), levels = c(1,0))
+out <- factor(rep(c(1,0,1,0), each = 8), levels = c(1,0))
+dat <- data.frame(hid, exp, out, n = c(ai,bi,ci,di))
+dat <- xtabs(n ~ exp + out + hid, data = dat)
+print(dat)
+
+epi.2by2(dat = dat, method = "cohort.count", homogeneity = "breslow.day",
+ outcome= "as.columns")
+
+## After adjusting for the effect of herd, compared to untreated cows, treatment
+## increased the odds of recovery by a factor of 5.97 (95\% CI 2.72 to 13.13).
+ }
}
\keyword{univar}
diff --git a/man/epi.betabuster.Rd b/man/epi.betabuster.Rd
index 45d9341..55f9d34 100644
--- a/man/epi.betabuster.Rd
+++ b/man/epi.betabuster.Rd
@@ -71,13 +71,20 @@ r <- rval$shape1 - 1; r
## from 10 trials, n:
n <- rval$shape2 + rval$shape1 - 2; n
+dat <- data.frame(x = seq(from = 0, to = 1, by = 0.001),
+ y = dbeta(x = seq(from = 0, to = 1,by = 0.001),
+ shape1 = rval$shape1, shape2 = rval$shape2))
+
## Density plot of the estimated beta distribution:
-plot(seq(from = 0, to = 1, by = 0.001),
- dbeta(x = seq(from = 0, to = 1,by = 0.001), shape1 = rval$shape1,
- shape2 = rval$shape2), type = "l", xlab = "Test sensitivity",
- ylab = "Density")
-
+\dontrun{
+library(ggplot2)
+
+windows(); ggplot(data = dat, aes(x = x, y = y)) +
+ geom_line() +
+ xlab("Test sensitivity") +
+ ylab("Density")
+}
}
\keyword{univar}% at least one, from doc/KEYWORDS
\keyword{univar}% __ONLY ONE__ keyword per line
diff --git a/man/epi.ccc.Rd b/man/epi.ccc.Rd
index 8d621a1..c836228 100644
--- a/man/epi.ccc.Rd
+++ b/man/epi.ccc.Rd
@@ -11,7 +11,8 @@ Calculates Lin's (1989, 2000) concordance correlation coefficient for agreement
}
\usage{
-epi.ccc(x, y, ci = "z-transform", conf.level = 0.95)
+epi.ccc(x, y, ci = "z-transform", conf.level = 0.95, rep.measure = FALSE,
+ subjectid)
}
\arguments{
@@ -19,6 +20,8 @@ epi.ccc(x, y, ci = "z-transform", conf.level = 0.95)
\item{y}{a vector, representing the second set of measurements.}
\item{ci}{a character string, indicating the method to be used. Options are \code{z-transform} or \code{asymptotic}.}
\item{conf.level}{magnitude of the returned confidence interval. Must be a single number between 0 and 1.}
+ \item{rep.measure}{logical. If \code{TRUE} there are repeated observations across \code{subject}.}
+ \item{subjectid}{a factor providing details of the observer identifier if \code{rep.measure == TRUE}.}
}
\details{
@@ -34,14 +37,21 @@ A list containing the following:
\item{l.shift}{the location shift.}
\item{C.b}{a bias correction factor that measures how far the best-fit line deviates from a line at 45 degrees. No deviation from the 45 degree line occurs when C.b = 1. See Lin (1989, page 258).}
\item{blalt}{a data frame with two columns: \code{mean} the mean of each pair of measurements, \code{delta} vector \code{y} minus vector \code{x}.}
+ \item{sblalt}{a data frame listing the average difference between the two sets of measurements and the lower and upper confidence limits of the difference between the two sets of measurements. If \code{rep.measure == TRUE} the confidence interval of the difference is adjusted to account for repeated observations across individual subjects.}
\item{nmissing}{a count of the number of measurement pairs ignored due to missingness.}
}
\references{
Bland J, Altman D (1986). Statistical methods for assessing agreement between two methods of clinical measurement. The Lancet 327: 307 - 310.
+Bland J, Altman D (1999). Measuring agreement in method comparison studies. Statistical Methods in Medical Research 8: 135 - 160.
+
+Bland J, Altman D (2007). Agreement between methods of measurement with multiple observations per individual. Journal of Biopharmaceutical Statistics 17: 571 - 582. (Corrects the formula quoted in the 1999 paper).
+
Bradley E, Blackwood L (1989). Comparing paired data: a simultaneous test for means and variances. American Statistician 43: 234 - 235.
+Burdick RK, Graybill FA (1992). Confidence Intervals on Variance Components. New York: Dekker.
+
Dunn G (2004). Statistical Evaluation of Measurement Errors: Design and Analysis of Reliability Studies. London: Arnold.
Hsu C (1940). On samples from a normal bivariate population. Annals of Mathematical Statistics 11: 410 - 426.
@@ -64,31 +74,48 @@ Snedecor G, Cochran W (1989). Statistical Methods. Ames: Iowa State University P
}
\examples{
-## Concordance correlation plot:
set.seed(seed = 1234)
method1 <- rnorm(n = 100, mean = 0, sd = 1)
-method2 <- method1 + runif(n = 100, min = 0, max = 1)
+method2 <- method1 + runif(n = 100, min = -0.25, max = 0.25)
## Introduce some missing values:
method1[50] <- NA
method2[75] <- NA
-tmp.ccc <- epi.ccc(method1, method2, ci = "z-transform",
- conf.level = 0.95)
+tmp <- data.frame(method1, method2)
+tmp.ccc <- epi.ccc(method1, method2, ci = "z-transform", conf.level = 0.95,
+ rep.measure = FALSE)
-lab <- paste("CCC: ", round(tmp.ccc$rho.c[,1], digits = 2), " (95\% CI ",
+tmp.lab <- data.frame(lab = paste("CCC: ",
+ round(tmp.ccc$rho.c[,1], digits = 2), " (95\% CI ",
round(tmp.ccc$rho.c[,2], digits = 2), " - ",
- round(tmp.ccc$rho.c[,3], digits = 2), ")", sep = "")
+ round(tmp.ccc$rho.c[,3], digits = 2), ")", sep = ""))
+
z <- lm(method2 ~ method1)
+alpha <- summary(z)$coefficients[1,1]
+beta <- summary(z)$coefficients[2,1]
+tmp.lm <- data.frame(alpha, beta)
-par(pty = "s")
-plot(method1, method2, xlim = c(0, 5), ylim = c(0,5), xlab = "Method 1",
- ylab = "Method 2", pch = 16)
-abline(a = 0, b = 1, lty = 2)
-abline(z, lty = 1)
-legend(x = "topleft", legend = c("Line of perfect concordance",
- "Reduced major axis"), lty = c(2,1), lwd = c(1,1), bty = "n")
-text(x = 1.55, y = 3.8, labels = lab)
+## Concordance correlation plot:
+
+\dontrun{
+library(ggplot2)
+
+ggplot(tmp, aes(x = method1, y = method2)) +
+ geom_point() +
+ geom_abline(intercept = 0, slope = 1) +
+ geom_abline(data = tmp.lm, aes(intercept = alpha, slope = beta),
+ linetype = "dashed") +
+ xlim(0, 3) +
+ ylim(0, 3) +
+ xlab("Method 1") +
+ ylab("Method 2") +
+ geom_text(data = tmp.lab, x = 0.5, y = 2.95, label = tmp.lab$lab) +
+ coord_fixed(ratio = 1 / 1)
+
+## In this plot the dashed line represents the line of perfect concordance.
+## The solid line represents the reduced major axis.
+}
## Bland and Altman plot (Figure 2 from Bland and Altman 1986):
x <- c(494,395,516,434,476,557,413,442,650,433,417,656,267,
@@ -97,21 +124,23 @@ x <- c(494,395,516,434,476,557,413,442,650,433,417,656,267,
y <- c(512,430,520,428,500,600,364,380,658,445,432,626,260,
477,259,350,451)
-tmp.ccc <- epi.ccc(x, y, ci = "z-transform", conf.level = 0.95)
-tmp.mean <- mean(tmp.ccc$blalt$delta)
-tmp.sd <- sqrt(var(tmp.ccc$blalt$delta))
-
-plot(tmp.ccc$blalt$mean, tmp.ccc$blalt$delta, pch = 16,
- xlab = "Average PEFR by two meters (L/min)",
- ylab = "Difference in PEFR (L/min)", xlim = c(0,800),
- ylim = c(-140,140))
-abline(h = tmp.mean, lty = 1, col = "gray")
-abline(h = tmp.mean - (2 * tmp.sd), lty = 2, col = "gray")
-abline(h = tmp.mean + (2 * tmp.sd), lty = 2, col = "gray")
-legend(x = "topleft", legend = c("Mean difference",
- "Mean difference +/ 2SD"), lty = c(1,2), bty = "n")
-legend(x = 0, y = 125, legend = c("Difference"), pch = 16,
- bty = "n")
+tmp.ccc <- epi.ccc(x, y, ci = "z-transform", conf.level = 0.95,
+ rep.measure = FALSE)
+tmp <- data.frame(mean = tmp.ccc$blalt[,1], delta = tmp.ccc$blalt[,2])
+
+\dontrun{
+library(ggplot2)
+
+ggplot(tmp.ccc$blalt, aes(x = mean, y = delta)) +
+ geom_point() +
+ geom_hline(data = tmp.ccc$sblalt, aes(yintercept = lower), linetype = 2) +
+ geom_hline(data = tmp.ccc$sblalt, aes(yintercept = upper), linetype = 2) +
+ geom_hline(data = tmp.ccc$sblalt, aes(yintercept = est), linetype = 1) +
+ xlab("Average PEFR by two meters (L/min)") +
+ ylab("Difference in PEFR (L/min)") +
+ xlim(0,800) +
+ ylim(-150,150)
+}
}
\keyword{univar}
diff --git a/man/epi.ccsize.Rd b/man/epi.ccsize.Rd
index 7ce557a..03e935c 100644
--- a/man/epi.ccsize.Rd
+++ b/man/epi.ccsize.Rd
@@ -29,13 +29,18 @@ epi.ccsize(OR, p0, n, power, r = 1, rho = 0, design = 1, sided.test = 2,
\item{fleiss}{logical, indicating whether or not the Fleiss correction should be applied. This argument is ignored when \code{method = "matched"}.}
}
+\details{
+This function implements the methodology described by Dupont (1988). A detailed description of sample size calculations for case-control studies (with numerous worked examples, many of them reproduced below) is provided by Woodward (2005), pp. 381 to 426.
+}
+
\value{
-A list containing one or more of the following:
+A list containing the following:
- \item{n.total}{the total number of subjects required for the specified level of confidence and power (i.e. the number of cases plus the number of controls).}
- \item{n.case}{the total number of case subjects required to estimate the specified odds ratio, level of confidence and power.}
- \item{n.control}{the total number of control subjects required to estimate the specified odds ratio, level of confidence and power.}
- \item{power}{the power of the study given the number of study subjects, the expected odds ratio and level of confidence.}
+ \item{n.total}{the total number of subjects required to estimate the specified odds ratio at the desired level of confidence and power (i.e. the number of cases plus the number of controls).}
+ \item{n.case}{the total number of case subjects required to estimate the specified odds ratio at the desired level of confidence and power.}
+ \item{n.control}{the total number of control subjects required to estimate the specified odds ratio at the desired level of confidence and power.}
+ \item{power}{the power of the study given the number of study subjects, the specified odds ratio and the desired level of confidence.}
+ \item{OR}{the expected detectable odds ratio given the number of study subjects, the desired power and desired level of confidence.}
}
\references{
@@ -44,10 +49,14 @@ Dupont WD (1988) Power calculations for matched case-control studies. Biometrics
Fleiss JL (1981). Statistical Methods for Rates and Proportions. Wiley, New York.
Kelsey JL, Thompson WD, Evans AS (1986). Methods in Observational Epidemiology. Oxford University Press, London, pp. 254 - 284.
+
+Woodward M (2005). Epidemiology Study Design and Data Analysis. Chapman & Hall/CRC, New York, pp. 381 - 426.
}
\note{
The power of a study is its ability to demonstrate the presence of an association, given that an association actually exists.
+
+See the documentation for \code{\link{epi.cohortsize}} which provides an example using the \code{design} facility implemented in this function.
}
\examples{
@@ -66,7 +75,7 @@ epi.ccsize(OR = 2.0, p0 = 0.30, n = NA, power = 0.90, r = 1, rho = 0,
## A total of 376 men need to be sampled: 188 cases and 188 controls.
-## EXAMPLE 2 (from Woodward p 414):
+## EXAMPLE 2 (from Woodward 2005 p. 414):
## Suppose we wish to determine the power to detect an odds ratio of 2.0
## using a two-sided 0.05 test when 188 cases and 940 controls
## are available (that is, the ratio of controls to cases is 5:1). Assume
@@ -79,14 +88,13 @@ epi.ccsize(OR = 2.0, p0 = 0.30, n = n, power = NA, r = 5, rho = 0,
## The power of this study, with the given sample size allocation is 0.99.
-
## EXAMPLE 3:
## The following statement appeared in a study proposal to identify risk
## factors for campylobacteriosis in humans:
## `We will prospectively recruit 300 culture-confirmed Campylobacter cases
## reported under the Public Health Act. We will then recruit one control per
-## case from General Practices of the enrolled cases, using frequency matching
+## case from general practices of the enrolled cases, using frequency matching
## by age and sex. With exposure levels of 10% (thought to be realistic
## given past foodborne disease case control studies) this sample size
## will provide 80\% power to detect an odds ratio of 2 at the 5\% alpha
@@ -111,7 +119,8 @@ epi.ccsize(OR = 2.0, p0 = 0.10, n = 600, power = NA, r = 1, rho = 0.01,
## patients with bladder cancer and controls will be patients hospitalised
## for injury. It is assumed that 20\% of controls will be smokers or past
## smokers, and we wish to detect an odds ratio of 2 with power 90\%.
-## Three controls will be recruited for every case.
+## Three controls will be recruited for every case. How many subjects need
+## to be enrolled in the study?
epi.ccsize(OR = 2.0, p0 = 0.20, n = NA, power = 0.90, r = 3, rho = 0,
design = 1, sided.test = 2, conf.level = 0.95, method = "unmatched",
@@ -123,8 +132,8 @@ epi.ccsize(OR = 2.0, p0 = 0.20, n = NA, power = 0.90, r = 3, rho = 0,
## An alternative is to conduct a matched case-control study rather than the
## unmatched design outlined above. One case will be matched to one control
## and the correlation between case and control exposures for matched pairs
-## (rho) is estimated to be 0.01 (low). With all other parameters equal to
-## above specified, how many study subjects will be required?
+## (rho) is estimated to be 0.01 (low). Using the same assumptions as those
+## described above, how many study subjects will be required?
epi.ccsize(OR = 2.0, p0 = 0.20, n = NA, power = 0.90, r = 1, rho = 0.01,
design = 1, sided.test = 2, conf.level = 0.95, method = "matched",
@@ -133,6 +142,60 @@ epi.ccsize(OR = 2.0, p0 = 0.20, n = NA, power = 0.90, r = 1, rho = 0.01,
## A total of 456 subjects need to be enrolled in the study: 228 cases and
## 228 controls.
+
+## EXAMPLE 5:
+## Code to reproduce the isograph shown in Figure 2 in Dupont (1988):
+r <- 1
+p0 <- seq(from = 0.05, to = 0.95, length = 50)
+OR <- seq(from = 1.05, to = 6, length = 100)
+vals <- expand.grid(p0, OR)
+names(vals) <- c("p0", "OR")
+
+vals$n.case <- NA; vals$n.control <- NA; vals$n.total <- NA
+
+for(i in 1:nrow(vals)){
+ trval <- epi.ccsize(OR = vals$OR[i], p0 = vals$p0[i], power = 0.80,
+ n = NA, rho = 0, design = 1, sided.test = 2, conf.level = 0.95,
+ method = "matched")
+ vals$n.case[i] <- trval$n.case
+ vals$n.control[i] <- trval$n.control
+ vals$n.total[i] <- trval$n.total
+}
+
+grid.n <- matrix(vals$n.case, nrow = length(p0))
+lev <- c(22:30,32,34,36,40,45,50,55,60,70,80,90,100,125,150,175,
+ 200,300,500,1000)
+
+par(mar = c(5,5,0,5), bty = "n")
+contour(x = p0, y = OR, z = log10(grid.n), add = FALSE, levels = log10(lev),
+ labels = lev, xlim = c(0,1), ylim = c(1,6), las = 1, method = "flattest",
+ xlab = 'Proportion of controls exposed', ylab = "Minimum OR to detect")
+
+
+## EXAMPLE 6:
+## From page 1164 of Dupont (1988). A matched case control study is to be
+## carried out to quantify the association between exposure A and an outcome B.
+## Assume the prevalence of exposure in controls is 0.60 and the
+## correlation between case and control exposures for matched pairs (rho) is
+## 0.20 (moderate). Assuming an equal number of cases and controls, how many
+## subjects need to be enrolled into the study to detect an odds ratio of 3.0
+## with 0.80 power using a two-sided 0.05 test?
+
+epi.ccsize(OR = 3.0, p0 = 0.60, n = NA, power = 0.80, r = 1, rho = 0.2,
+ design = 1, sided.test = 2, conf.level = 0.95, method = "matched",
+ fleiss = FALSE)
+
+## A total of 162 subjects need to be enrolled in the study: 81 cases and
+## 81 controls. How many cases and controls are required if we select three
+## controls per case?
+
+epi.ccsize(OR = 3.0, p0 = 0.60, n = NA, power = 0.80, r = 3, rho = 0.2,
+ design = 1, sided.test = 2, conf.level = 0.95, method = "matched",
+ fleiss = FALSE)
+
+## A total of 204 subjects need to be enrolled in the study: 51 cases and
+## 153 controls (204 subjects in total).
+
}
\keyword{univar}
diff --git a/man/epi.cohortsize.Rd b/man/epi.cohortsize.Rd
index 47ce2e3..6040a2c 100644
--- a/man/epi.cohortsize.Rd
+++ b/man/epi.cohortsize.Rd
@@ -27,7 +27,7 @@ epi.cohortsize(exposed, unexposed, n, power, r = 1, design = 1, sided.test = 2,
}
\details{
-The methodology in this function follows the approach described in Chapter 8 of Woodward (2005), pp 405 - 410.
+The methodology in this function follows the approach described in Chapter 8 of Woodward (2005), pp. 381 - 426.
}
\value{
diff --git a/man/epi.conf.Rd b/man/epi.conf.Rd
index ab136f2..3ed6629 100644
--- a/man/epi.conf.Rd
+++ b/man/epi.conf.Rd
@@ -16,7 +16,7 @@ epi.conf(dat, ctype = "mean.single", method, N, design = 1,
\arguments{
\item{dat}{the data, either a vector or a matrix depending on the method chosen.}
- \item{ctype}{a character string indicating the type of confidence interval to calculate. Options are \code{mean.single}, \code{mean.unpaired}, \code{mean.paired}, \code{prop.single}, \code{prop.unpaired}, \code{prop.paired}, \code{prevalence}, \code{inc.risk}, \code{inc.rate}, \code{odds} and \code{smr}.}
+ \item{ctype}{a character string indicating the type of confidence interval to calculate. Options are \code{mean.single}, \code{mean.unpaired}, \code{mean.paired}, \code{prop.single}, \code{prop.unpaired}, \code{prop.paired}, \code{prevalence}, \code{inc.risk}, \code{inc.rate}, \code{odds}, \code{ratio} and \code{smr}.}
\item{method}{a character string indicating the method to use. Where \code{ctype = "inc.risk"} or \code{ctype = "prevalence"} options are \code{exact}, \code{wilson} and \code{fleiss}. Where \code{ctype = "inc.rate"} options are \code{exact} and \code{byar}.}
\item{N}{scalar, representing the population size.}
\item{design}{scalar, representing the design effect.}
@@ -24,7 +24,7 @@ epi.conf(dat, ctype = "mean.single", method, N, design = 1,
}
\details{
-Method mean.single requires a vector as input. Method \code{mean.unpaired} requires a two-column data frame; the first column defining the groups must be a factor. Method \code{mean.paired} requires a two-column data frame; one column for each group. Method \code{prop.single} requires a two-column matrix; the first column specifies the number of positives, the second column specifies the number of negatives. Methods \code{prop.unpaired} and \code{prop.paired} require a four-column matrix [...]
+Method mean.single requires a vector as input. Method \code{mean.unpaired} requires a two-column data frame; the first column defining the groups must be a factor. Method \code{mean.paired} requires a two-column data frame; one column for each group. Method \code{prop.single} requires a two-column matrix; the first column specifies the number of positives, the second column specifies the number of negatives. Methods \code{prop.unpaired} and \code{prop.paired} require a four-column matrix [...]
The methodology implemented here follows Altman, Machin, Bryant, and Gardner (2000). Where method is \code{inc.risk}, \code{prevalence} or \code{inc.rate} if the numerator equals zero the lower bound of the confidence interval estimate is set to zero. Where method is \code{smr} the method of Dobson et al. (1991) is used. A summary of the methods used for each of the confidence interval calculations in this function is as follows:
@@ -47,6 +47,7 @@ The methodology implemented here follows Altman, Machin, Bryant, and Gardner (20
\code{inc.rate, exact} \tab Collett (1999) \cr
\code{inc.rate, byar} \tab Rothman (2002) \cr
\code{odds} \tab Ederer and Mantel (1974) \cr
+\code{ratio} \tab Ederer and Mantel (1974) \cr
\code{smr} \tab Dobson et al. (1991) \cr
----------------------------------- \tab ------------------------ \cr
}
diff --git a/man/epi.dsl.Rd b/man/epi.dsl.Rd
index 55deb2e..46d2778 100644
--- a/man/epi.dsl.Rd
+++ b/man/epi.dsl.Rd
@@ -31,10 +31,10 @@ epi.dsl(ev.trt, n.trt, ev.ctrl, n.ctrl, names, method = "odds.ratio",
\value{
A list containing the following:
- \item{OR}{the odds ratio for each trial, the standard error of the odds ratio for each trial, and the lower and upper bounds of the confidence interval of the odds ratio for each trial.}
- \item{RR}{the risk ratio for each trial, the standard error of the risk ratio for each trial, and the lower and upper bounds of the confidence interval of the risk ratio for each trial.}
- \item{OR.summary}{the DerSimonian and Laird summary odds ratio, the standard error of the DerSimonian and Laird summary odds ratio, the lower and upper bounds of the confidence interval of the DerSimonian and Laird summary odds ratio.}
- \item{RR.summary}{the DerSimonian and Laird summary risk ratio, the standard error of the DerSimonian and Laird summary risk ratio, the lower and upper bounds of the confidence interval of the DerSimonian and Laird summary risk ratio.}
+ \item{OR}{the odds ratio for each trial and the lower and upper bounds of the confidence interval of the odds ratio for each trial.}
+ \item{RR}{the risk ratio for each trial and the lower and upper bounds of the confidence interval of the risk ratio for each trial.}
+ \item{OR.summary}{the DerSimonian and Laird summary odds ratio and the lower and upper bounds of the confidence interval of the DerSimonian and Laird summary odds ratio.}
+ \item{RR.summary}{the DerSimonian and Laird summary risk ratio and the lower and upper bounds of the confidence interval of the DerSimonian and Laird summary risk ratio.}
\item{weights}{the inverse variance and DerSimonian and Laird weights for each trial.}
\item{heterogeneity}{a vector containing \code{Q} the heterogeneity test statistic, \code{df} the degrees of freedom and its associated P-value.}
\item{Hsq}{the relative excess of the heterogeneity test statistic \code{Q} over the degrees of freedom \code{df}.}
diff --git a/man/epi.edr.Rd b/man/epi.edr.Rd
index e3ee2a3..e621368 100644
--- a/man/epi.edr.Rd
+++ b/man/epi.edr.Rd
@@ -38,19 +38,39 @@ Miller W (1976). A state-transition model of epidemic foot-and-mouth disease. In
Morris R, Sanson R, Stern M, Stevenson M, Wilesmith J (2002). Decision-support tools for foot-and-mouth disease control. Revue Scientifique et Technique de l'Office International des Epizooties 21, 557 - 567.
}
-
\examples{
set.seed(123)
dat <- rpois(n = 50, lambda = 2)
edr.04 <- epi.edr(dat, n = 4, conf.level = 0.95, nsim = 99, na.zero = TRUE)
-
-## Plot:
-plot(1:50, 1:50, xlim = c(0,25), ylim = c(0, 10), xlab = "Days",
- ylab = "Estimated dissemination ratio", type = "n", main = "")
-lines(1:50, edr.04[,1], type = "l", lwd = 2, lty = 1, col = "blue")
-lines(1:50, edr.04[,2], type = "l", lwd = 1, lty = 2, col = "blue")
-lines(1:50, edr.04[,3], type = "l", lwd = 1, lty = 2, col = "blue")
-
+sdate <- as.Date(x = "31/12/2015", format = "\%d/\%m/\%Y")
+
+dat.04 <- data.frame(idate = sdate + 1:50, est = edr.04$est,
+ low = edr.04$lower, upp = edr.04$upper)
+
+## Line plot of EDR (and its 95\% confidence interval) as a function of
+## calendar time:
+
+\dontrun{
+library(ggplot2)
+
+ggplot(dat.04, aes(x = as.integer(idate), y = est)) +
+ geom_line() +
+ geom_line(dat = dat.04, aes(x = as.integer(idate), y = upp),
+ lty = 3, size = 0.5) +
+ geom_line(dat = dat.04, aes(x = as.integer(idate), y = low),
+ lty = 3, size = 0.5) +
+ scale_x_continuous(name = "Date",
+ breaks = seq(from = min(as.integer(dat.04$idate)),
+ to = max(as.integer(dat.04$idate)), by = 7),
+ labels = seq(from = min(dat.04$idate),
+ to = max(dat.04$idate), by = 7),
+ limits = c(min(as.integer(dat.04$idate)),
+ max(as.integer(dat.04$idate)))) +
+ scale_y_continuous(name = "Estimated disemination ratio (EDR)",
+ limits = c(0,10)) +
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, size = 10)) +
+ geom_hline(yintercept = 1, lty = 2)
+ }
}
\keyword{univar}
diff --git a/man/epi.empbayes.Rd b/man/epi.empbayes.Rd
index 84bd38b..2906f9b 100644
--- a/man/epi.empbayes.Rd
+++ b/man/epi.empbayes.Rd
@@ -40,16 +40,30 @@ data(epi.SClip)
obs <- epi.SClip$cases; pop <- epi.SClip$population
est <- epi.empbayes(obs, pop)
-empbayes.prop <- (obs + est[4]) / (pop + est[3])
-raw.prop <- (obs) / (pop)
-rank <- rank(raw.prop)
-dat <- data.frame(rank, raw.prop, empbayes.prop)
-
-plot(dat$rank, dat$raw.prop, type = "n", xlab = "Rank", ylab = "Risk")
-points(dat$rank, dat$raw.prop, pch = 16, col = "red")
-points(dat$rank, dat$empbayes.prop, pch = 16, col = "blue")
-legend(x = "topleft", legend = c("Raw estimate", "Bayes adjusted estimate"),
- col = c("red","blue"), pch = c(16,16), bty = "n")
+crude.p <- ((obs) / (pop)) * 100000
+crude.r <- rank(crude.p)
+ebay.p <- ((obs + est[4]) / (pop + est[3])) * 100000
+dat <- data.frame(rank = c(crude.r, crude.r),
+ Method = c(rep("Crude", times = length(crude.r)),
+ rep("Empirical Bayes", times = length(crude.r))),
+ est = c(crude.p, ebay.p))
+
+## Scatter plot showing the crude and empirical Bayes adjusted lip cancer
+## incidence rates as a function of district rank for the crude lip
+## cancer incidence rates:
+
+\dontrun{
+library(ggplot2)
+
+ggplot(dat, aes(x = rank, y = est, colour = Method)) +
+ geom_point() +
+ ylab("Lip cancer incidence rates (cases per 100,000 person years)") +
+ scale_x_continuous(name = "District rank",
+ breaks = seq(from = 0, to = 60, by = 10),
+ labels = seq(from = 0, to = 60, by = 10),
+ limits = c(0,60)) +
+ ylim(0,30)
+}
}
\keyword{univar}% at least one, from doc/KEYWORDS
diff --git a/man/epi.iv.Rd b/man/epi.iv.Rd
index b378434..058d6c7 100644
--- a/man/epi.iv.Rd
+++ b/man/epi.iv.Rd
@@ -34,10 +34,10 @@ Using this method, the inverse variance weights are used to compute the pooled o
\value{
A list containing:
- \item{OR}{the odds ratio for each trial, the standard error of the odds ratio for each trial, and the lower and upper bounds of the confidence interval of the odds ratio for each trial.}
- \item{RR}{the risk ratio for each trial, the standard error of the risk ratio for each trial, and the lower and upper bounds of the confidence interval of the risk ratio for each trial.}
- \item{OR.summary}{the inverse variance summary odds ratio, the standard error of the inverse variance summary odds ratio, the lower and upper bounds of the confidence interval of the inverse variance summary odds ratio.}
- \item{RR.summary}{the inverse variance summary risk ratio, the standard error of the inverse variance summary risk ratio, the lower and upper bounds of the confidence interval of the inverse variance summary risk ratio.}
+ \item{OR}{the odds ratio for each trial and the lower and upper bounds of the confidence interval of the odds ratio for each trial.}
+ \item{RR}{the risk ratio for each trial and the lower and upper bounds of the confidence interval of the risk ratio for each trial.}
+ \item{OR.summary}{the inverse variance summary odds ratio and the lower and upper bounds of the confidence interval of the inverse variance summary odds ratio.}
+ \item{RR.summary}{the inverse variance summary risk ratio and the lower and upper bounds of the confidence interval of the inverse variance summary risk ratio.}
\item{weights}{the raw and inverse variance weights assigned to each trial.}
\item{heterogeneity}{a vector containing \code{Q} the heterogeneity test statistic, \code{df} the degrees of freedom and its associated P-value.}
\item{Hsq}{the relative excess of the heterogeneity test statistic \code{Q} over the degrees of freedom \code{df}.}
diff --git a/man/epi.meansize.Rd b/man/epi.meansize.Rd
index c5482be..3ad70a7 100644
--- a/man/epi.meansize.Rd
+++ b/man/epi.meansize.Rd
@@ -28,7 +28,7 @@ epi.meansize(treat, control, n, sigma, power, r = 1, design = 1,
}
\details{
-The methodology in this function follows closely the approach described in Chapter 8 of Woodward (2005).
+The methodology in this function follows the approach described in Chapter 8 of Woodward (2005), pp. 381 - 426.
}
\value{
@@ -47,6 +47,10 @@ Woodward M (2005). Epidemiology Study Design and Data Analysis. Chapman & Hall/C
\note{
The power of a study is its ability to demonstrate the presence of an association, given that an association actually exists.
+
+A detailed description of sample size calculations for case-control studies (with numerous worked examples, many of them reproduced below) is provided by Woodward (2005), pages 381 to 426.
+
+See the documentation for \code{\link{epi.cohortsize}} which provides an example using the \code{design} facility implemented in this function.
}
\examples{
diff --git a/man/epi.mh.Rd b/man/epi.mh.Rd
index 7e541b1..14e59b1 100644
--- a/man/epi.mh.Rd
+++ b/man/epi.mh.Rd
@@ -32,10 +32,10 @@ epi.mh(ev.trt, n.trt, ev.ctrl, n.ctrl, names, method = "odds.ratio",
\value{
A list containing the following:
- \item{OR}{the odds ratio for each trial, the standard error of the odds ratio for each trial, and the lower and upper bounds of the confidence interval of the odds ratio for each trial.}
- \item{RR}{the risk ratio for each trial, the standard error of the risk ratio for each trial, and the lower and upper bounds of the confidence interval of the risk ratio for each trial.}
- \item{OR.summary}{the Mantel-Haenszel summary odds ratio, the standard error of the Mantel-Haenszel summary odds ratio, the lower and upper bounds of the confidence interval of the Mantel-Haenszel summary odds ratio.}
- \item{RR.summary}{the Mantel-Haenszel summary risk ratio, the standard error of the Mantel-Haenszel summary risk ratio, the lower and upper bounds of the confidence interval of the Mantel-Haenszel summary risk ratio.}
+ \item{OR}{the odds ratio for each trial and the lower and upper bounds of the confidence interval of the odds ratio for each trial.}
+ \item{RR}{the risk ratio for each trial and the lower and upper bounds of the confidence interval of the risk ratio for each trial.}
+ \item{OR.summary}{the Mantel-Haenszel summary odds ratio and the lower and upper bounds of the confidence interval of the Mantel-Haenszel summary odds ratio.}
+ \item{RR.summary}{the Mantel-Haenszel summary risk ratio and the lower and upper bounds of the confidence interval of the Mantel-Haenszel summary risk ratio.}
\item{weights}{the raw and inverse variance weights assigned to each trial.}
\item{heterogeneity}{a vector containing \code{Q} the heterogeneity test statistic, \code{df} the degrees of freedom and its associated P-value.}
\item{Hsq}{the relative excess of the heterogeneity test statistic \code{Q} over the degrees of freedom \code{df}.}
diff --git a/man/epi.nomogram.Rd b/man/epi.nomogram.Rd
index 63a85e8..48416bd 100644
--- a/man/epi.nomogram.Rd
+++ b/man/epi.nomogram.Rd
@@ -27,6 +27,8 @@ A list containing the following:
}
\references{
+Caraguel C, Vanderstichel R (2013). The two-step Fagan's nomogram: ad hoc interpretation of a diagnostic test result without calculation. Evidence Based Medicine 18: 125 - 128.
+
Hunink M, Glasziou P (2001). Decision Making in Health and Medicine - Integrating Evidence and Values. Cambridge University Press, pp. 128 - 156.
}
@@ -46,7 +48,11 @@ Hunink M, Glasziou P (2001). Decision Making in Health and Medicine - Integratin
epi.nomogram(se = 0.89, sp = 0.85, lr = NA, pre.pos = 0.05, verbose = FALSE)
-## The post-test probability that this dog is hypothyroid is 24\%.
+## Given a positive test result, the post-test probability of being
+## disease positive is 0.24.
+
+## Given a negative test result, the post-test probability of being
+## disease negative is 0.0068.
## EXAMPLE 2:
## A dog is presented to you with severe pruritis. You suspect sarcoptic
@@ -61,7 +67,7 @@ epi.nomogram(se = NA, sp = NA, lr = c(9000, 0.1), pre.pos = pre.pos,
verbose = FALSE)
## If the skin scraping is negative the post-test probability that this dog
-## has sarcoptic mange is 0.2\%.
+## has sarcoptic mange is 0.002.
}
\keyword{univar}% at least one, from doc/KEYWORDS
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-epir.git
More information about the debian-med-commit
mailing list