创建函数以生成应急表列表

Question

我正在尝试编写一个函数，该函数将从导入的data.frame (tibble)中生成一个应急表列表。我可以使用for循环来做到这一点；但是，由于文件中的行数，我宁愿使用apply系列。

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")))

上面的代码提供了导入文件外观的reprex df，每种MLST类型的计数和总计这些计数的行。C1是一个示例，说明我希望为每种MLST类型显示每个应急表。

对于如何编写一个函数来为每个MLST类型生成一个应急表列表，然后我可以在其中一个apply函数中使用，有什么建议吗？

Answer 1

下面是使用tidyverse的另一个选项，您可以跳过使用函数并返回矩阵列表。在这里，我首先删除整个行，然后将每一行split放入它自己的dataframe。然后，使用purrr::map将total行绑定到所有数据文件。然后，更改第一列中的名称，然后生成行名。然后，我对所有列进行mutate，并从MLST中减去Non-Typed (即总计)。然后，返回为一个矩阵。

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()
  )

输出

$`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

Answer 2

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)