Creating Function To Generate List of Contingency tables-CodePudding

I am trying to write a function that would generate a list of contingency tables from an imported data.frame (tibble). I could use a for loop to do so; however, because of the number of rows within the file, I would rather use the apply family.

library(dplyr)
set.seed(01142022)
df <- tibble('MLST' = sample(1000:9999, 5, replace = F), 
             '2018(n)' = sample(1:25, 5, replace = T), 
             '2019(n)' = sample(1:25, 5, replace = T))

df <- rbind(df, c('Total', colSums(df[, 2:3])))
df %<>% 
  mutate(across(.cols = MLST, as.factor)) %>% 
  mutate(across(.cols = c(`2018(n)`, `2019(n)`), as.numeric))
# Contigency Table
C1 <- matrix(
data = c(df[1,2],
         df[nrow(df), 2] - df[1,2],
         df[1,3],
         df[nrow(df), 3] - df[1,3]),
nrow = 2,
ncol = 2,
dimnames = list(c("MLST", "Non-Typed"), c("2018", "2019")))

The above code provides the reprex df of what the imported file would look like, with counts for each MLST type and a row totaling those counts. C1 is an example of how I would like each contingency table to appear for each MLST type.

Any suggestions on how to write a function that would generate a list of contingency tables for each MLST type that I could then use within one of the apply functions?

CodePudding user response：

library(dplyr)

set.seed(01142022)

df <- tibble('MLST' = sample(1000:9999, 5, replace = F), 
             '2018(n)' = sample(1:25, 5, replace = T), 
             '2019(n)' = sample(1:25, 5, replace = T))

ctab <- function(x){
  matrix(
    data = c(df[x,2],
             sum(df[-x,2]),
             df[x,3],
             sum(df[-x,3])),
    nrow = 2,
    ncol = 2,
    dimnames = list(c("MLST", "Non-Typed"), c(names(df)[2], names(df)[3])))
}

lapply(1:nrow(df), ctab)  
#> [[1]]
#>           2018(n) 2019(n)
#> MLST      6       10     
#> Non-Typed 33      43     
#> 
#> [[2]]
#>           2018(n) 2019(n)
#> MLST      14      14     
#> Non-Typed 25      39     
#> 
#> [[3]]
#>           2018(n) 2019(n)
#> MLST      12      8      
#> Non-Typed 27      45     
#> 
#> [[4]]
#>           2018(n) 2019(n)
#> MLST      1       13     
#> Non-Typed 38      40     
#> 
#> [[5]]
#>           2018(n) 2019(n)
#> MLST      6       8      
#> Non-Typed 33      45
Created on 2022-01-14 by the reprex package (v2.0.1)

CodePudding user response：

Here is another option using tidyverse, where you could just skip using a function and return a list of matrices. Here, I first remove the total row, then split each row into its own dataframe. Then, use purrr::map to bind the total row to all the dataframes. Then, I change the names in the first column, then make those the rownames. Then, I mutate across all columns and subtract MLST from the Non-Typed (i.e., the total). Then, return as a matrix.

library(tidyverse)

df %>%
  filter(MLST != "Total") %>%
  split(., row(.)[, 1]) %>%
  map(
    function(x)
      bind_rows(x, df %>%
                  filter(MLST == "Total")) %>%
      mutate(MLST = c("MLST", "Non-Typed")) %>%
      tibble::column_to_rownames("MLST") %>%
      mutate(across(everything(),  ~ c(first(.), diff(.)))) %>%
      as.matrix()
  )

Output

$`1`
          2018(n) 2019(n)
MLST            6      10
Non-Typed      33      43

$`2`
          2018(n) 2019(n)
MLST           14      14
Non-Typed      25      39

$`3`
          2018(n) 2019(n)
MLST           12       8
Non-Typed      27      45

$`4`
          2018(n) 2019(n)
MLST            1      13
Non-Typed      38      40

$`5`
          2018(n) 2019(n)
MLST            6       8
Non-Typed      33      45