Back to Index

R6 Object RR

library(Wu)
library(R6)
library(sloop)
library(epitools)

dt <- data.table(
  outcome = sample(c(0,1), 100, replace = TRUE)
, treatment = factor(rep(c("case", "control"), 50), levels = c("case", "control"))
, sex = factor(sample(c("F", "M"), 100, replace = TRUE), levels = c("F", "M"))
)


RR <- R6Class(
  "RR"
, list(binary = NA
     , groups = NA
     , data = NULL
     , groups_nlevels = NULL
     , tables = NULL
     , freqs = NULL
     , ors_str = NULL
     , oddsratios = NULL
     , riskratios = NULL
     , fx_or = function(x) epitools::epitab(x, method = "oddsratio", oddsratio = "wald")
     , fx_rr = function(x) epitools::epitab(x, method = "riskratio", oddsratio = "wald")
     , initialize = function(binary, groups, data) {
       self$binary <- binary
       self$groups <- groups
       vars <- c(binary, groups)
       self$data <- data[, ..vars]
       self$groups_nlevels <- lapply(groups, function(x) length(levels(self$data[[x]])))
       self$tables <- lapply(self$groups, function(x) table(self$data[[x]], self$data[[self$binary]]))
       self$freqs <- lapply(self$groups, function(x) Wu::tab_freq(self$binary, x, self$data))
       self$ors_str <- Wu::get_ors(self$binary, self$groups, self$data)
       self$oddsratios <- lapply(self$tables, self$fx_or)
       self$riskratios <- lapply(self$tables, self$fx_rr)
     }
     ))



RR1 <- RR$new(binary = "outcome", groups = c("treatment", "sex"), data = dt)

RR1$oddsratios[[2]]$tab %>% prt()

R sessionInfo

sessionInfo()

R version 4.1.2 (2021-11-01) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 20.04.3 LTS

Matrix products: default BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale: [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
[4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
[7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] epitools_0.5-10.1 sloop_1.0.1 R6_2.5.1
[4] Wu_0.0.0.9000 flexdashboard_0.5.2 lme4_1.1-27.1
[7] Matrix_1.4-0 mgcv_1.8-38 nlme_3.1-152
[10] png_0.1-7 scales_1.1.1 nnet_7.3-16
[13] labelled_2.8.0 kableExtra_1.3.4 plotly_4.9.4.1
[16] gridExtra_2.3 ggplot2_3.3.5 DT_0.18
[19] tableone_0.13.0 magrittr_2.0.3 lubridate_1.7.10
[22] dplyr_1.0.9 plyr_1.8.6 data.table_1.14.2
[25] rmdformats_1.0.2 knitr_1.39

loaded via a namespace (and not attached): [1] httr_1.4.2 sass_0.4.0 tidyr_1.1.3 jsonlite_1.7.2
[5] viridisLite_0.4.0 splines_4.1.2 bslib_0.2.5.1 assertthat_0.2.1 [9] highr_0.9 yaml_2.3.5 pillar_1.7.0 lattice_0.20-45
[13] glue_1.6.2 digest_0.6.29 rvest_1.0.0 minqa_1.2.4
[17] colorspace_2.0-2 htmltools_0.5.2 survey_4.0 pkgconfig_2.0.3
[21] haven_2.4.1 bookdown_0.22 purrr_0.3.4 webshot_0.5.2
[25] svglite_2.0.0 tibble_3.1.7 generics_0.1.2 ellipsis_0.3.2
[29] withr_2.4.3 klippy_0.0.0.9500 lazyeval_0.2.2 cli_3.3.0
[33] survival_3.2-13 crayon_1.5.1 evaluate_0.15 fansi_1.0.3
[37] MASS_7.3-54 forcats_0.5.1 xml2_1.3.3 tools_4.1.2
[41] hms_1.1.0 mitools_2.4 lifecycle_1.0.1 stringr_1.4.0
[45] munsell_0.5.0 compiler_4.1.2 jquerylib_0.1.4 systemfonts_1.0.2 [49] rlang_1.0.2 grid_4.1.2 nloptr_1.2.2.2 rstudioapi_0.13
[53] htmlwidgets_1.5.4 rmarkdown_2.10 boot_1.3-28 gtable_0.3.0
[57] DBI_1.1.1 performance_0.7.2 fastmap_1.1.0 utf8_1.2.2
[61] insight_0.14.2 stringi_1.7.6 Rcpp_1.0.8.3 vctrs_0.4.1
[65] tidyselect_1.1.2 xfun_0.31