library(tidyverse)
#> -- Attaching packages ---------------------------------------------------------------------------------------------------------- tidyverse 1.2.1 --
#> v ggplot2 2.2.1 v purrr 0.2.4
#> v tibble 1.4.2 v dplyr 0.7.4
#> v tidyr 0.8.0 v stringr 1.3.0
#> v readr 1.1.1 v forcats 0.2.0
#> -- Conflicts ------------------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
#> x dplyr::filter() masks stats::filter()
#> x dplyr::lag() masks stats::lag()
options(tibble.width = Inf)
OR_tab <- function(dat, strat, grp, decision ){
strat <- enquo(strat)
grp <- enquo(grp)
decision <- enquo(decision)
tab <- dat %>% count(!!strat, !!grp, !!decision) %>% unite(cat, c(!!grp, !!decision)) %>%
spread(cat, n, fill = 0)
nm <- names(tab)[2:5]
tab <- tab %>% mutate(OR = (tab$`!!`(nm[1]) * tab$`!!`(nm[4])) / (tab$`!!`(nm[2]) * (tab$`!!`(nm[3]))))
}
df <- structure(list(strata = c("Manager", "Worker", "Manager", "Manager",
"Worker", "Manager", "Manager", "Manager", "Worker", "Worker",
"Worker", "Worker", "Worker", "Worker", "Manager", "Worker",
"Worker", "Manager", "Manager", "Manager", "Worker", "Worker",
"Manager", "Manager", "Manager", "Manager", "Worker", "Worker",
"Worker", "Worker"), group = c("A_Group", "A_Group", "A_Group",
"A_Group", "B_Group", "A_Group", "B_Group", "A_Group", "A_Group",
"A_Group", "A_Group", "A_Group", "B_Group", "B_Group", "A_Group",
"A_Group", "A_Group", "A_Group", "A_Group", "B_Group", "A_Group",
"A_Group", "B_Group", "B_Group", "A_Group", "A_Group", "B_Group",
"A_Group", "A_Group", "A_Group"), select = c("Chosen", "Chosen",
"Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen",
"Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen",
"Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen",
"Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen", "Not_Chosen",
"Not_Chosen", "Chosen", "Not_Chosen", "Not_Chosen", "Chosen",
"Not_Chosen", "Not_Chosen", "Not_Chosen")),
.Names = c("strata", "group", "select"), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -30L))
result <- OR_tab(df,strata, group, select)
result
#> # A tibble: 2 x 6
#> strata A_Group_Chosen A_Group_Not_Chosen B_Group_Chosen
#> <chr> <dbl> <dbl> <dbl>
#> 1 Manager 1.00 9.00 1.00
#> 2 Worker 1.00 11.0 1.00
#> B_Group_Not_Chosen OR
#> <dbl> <dbl>
#> 1 3.00 0.333
#> 2 3.00 0.273
Session info
devtools::session_info()
#> Session info -------------------------------------------------------------
#> setting value
#> version R version 3.4.3 (2017-11-30)
#> system x86_64, mingw32
#> ui RTerm
#> language (EN)
#> collate English_United States.1252
#> tz America/New_York
#> date 2018-02-22
#> Packages -----------------------------------------------------------------
#> package * version date source
#> assertthat 0.2.0 2017-04-11 CRAN (R 3.4.1)
#> backports 1.1.1 2017-09-25 CRAN (R 3.4.1)
#> base * 3.4.3 2017-12-06 local
#> bindr 0.1 2016-11-13 CRAN (R 3.4.1)
#> bindrcpp * 0.2 2017-06-17 CRAN (R 3.4.1)
#> broom 0.4.3 2017-11-20 CRAN (R 3.4.3)
#> cellranger 1.1.0 2016-07-27 CRAN (R 3.4.1)
#> cli 1.0.0 2017-11-05 CRAN (R 3.4.2)
#> colorspace 1.3-2 2016-12-14 CRAN (R 3.4.1)
#> compiler 3.4.3 2017-12-06 local
#> crayon 1.3.4 2017-09-16 CRAN (R 3.4.1)
#> datasets * 3.4.3 2017-12-06 local
#> devtools 1.13.5 2018-02-18 CRAN (R 3.4.3)
#> digest 0.6.12 2017-01-27 CRAN (R 3.4.1)
#> dplyr * 0.7.4 2017-09-28 CRAN (R 3.4.2)
#> evaluate 0.10.1 2017-06-24 CRAN (R 3.4.1)
#> forcats * 0.2.0 2017-01-23 CRAN (R 3.4.1)
#> foreign 0.8-69 2017-06-22 CRAN (R 3.4.3)
#> ggplot2 * 2.2.1 2016-12-30 CRAN (R 3.4.1)
#> glue 1.2.0 2017-10-29 CRAN (R 3.4.3)
#> graphics * 3.4.3 2017-12-06 local
#> grDevices * 3.4.3 2017-12-06 local
#> grid 3.4.3 2017-12-06 local
#> gtable 0.2.0 2016-02-26 CRAN (R 3.4.1)
#> haven 1.1.1 2018-01-18 CRAN (R 3.4.3)
#> hms 0.3 2016-11-22 CRAN (R 3.4.1)
#> htmltools 0.3.6 2017-04-28 CRAN (R 3.4.1)
#> httr 1.3.1 2017-08-20 CRAN (R 3.4.1)
#> jsonlite 1.5 2017-06-01 CRAN (R 3.4.1)
#> knitr 1.20 2018-02-20 CRAN (R 3.4.3)
#> lattice 0.20-35 2017-03-25 CRAN (R 3.4.3)
#> lazyeval 0.2.1 2017-10-29 CRAN (R 3.4.2)
#> lubridate 1.7.2 2018-02-06 CRAN (R 3.4.3)
#> magrittr 1.5 2014-11-22 CRAN (R 3.4.1)
#> memoise 1.1.0 2017-04-21 CRAN (R 3.4.1)
#> methods * 3.4.3 2017-12-06 local
#> mnormt 1.5-5 2016-10-15 CRAN (R 3.4.1)
#> modelr 0.1.1 2017-07-24 CRAN (R 3.4.1)
#> munsell 0.4.3 2016-02-13 CRAN (R 3.4.1)
#> nlme 3.1-131 2017-02-06 CRAN (R 3.4.3)
#> parallel 3.4.3 2017-12-06 local
#> pillar 1.1.0 2018-01-14 CRAN (R 3.4.3)
#> pkgconfig 2.0.1 2017-03-21 CRAN (R 3.4.1)
#> plyr 1.8.4 2016-06-08 CRAN (R 3.4.1)
#> psych 1.7.8 2017-09-09 CRAN (R 3.4.1)
#> purrr * 0.2.4 2017-10-18 CRAN (R 3.4.2)
#> R6 2.2.2 2017-06-17 CRAN (R 3.4.1)
#> Rcpp 0.12.15 2018-01-20 CRAN (R 3.4.3)
#> readr * 1.1.1 2017-05-16 CRAN (R 3.4.1)
#> readxl 1.0.0 2017-04-18 CRAN (R 3.4.1)
#> reshape2 1.4.3 2017-12-11 CRAN (R 3.4.3)
#> rlang 0.2.0 2018-02-20 CRAN (R 3.4.3)
#> rmarkdown 1.8 2017-11-17 CRAN (R 3.4.3)
#> rprojroot 1.2 2017-01-16 CRAN (R 3.4.1)
#> rstudioapi 0.7 2017-09-07 CRAN (R 3.4.1)
#> rvest 0.3.2 2016-06-17 CRAN (R 3.4.1)
#> scales 0.5.0 2017-08-24 CRAN (R 3.4.1)
#> stats * 3.4.3 2017-12-06 local
#> stringi 1.1.6 2017-11-17 CRAN (R 3.4.2)
#> stringr * 1.3.0 2018-02-19 CRAN (R 3.4.3)
#> tibble * 1.4.2 2018-01-22 CRAN (R 3.4.3)
#> tidyr * 0.8.0 2018-01-29 CRAN (R 3.4.3)
#> tidyselect 0.2.3 2017-11-06 CRAN (R 3.4.2)
#> tidyverse * 1.2.1 2017-11-14 CRAN (R 3.4.3)
#> tools 3.4.3 2017-12-06 local
#> utf8 1.1.3 2018-01-03 CRAN (R 3.4.3)
#> utils * 3.4.3 2017-12-06 local
#> withr 2.0.0 2017-07-28 CRAN (R 3.4.1)
#> xml2 1.2.0 2018-01-24 CRAN (R 3.4.3)
#> yaml 2.1.16 2017-12-12 CRAN (R 3.4.3)