R：计算矩阵的频率表，给定截止值的数据框

Question

continue

Answer 1

这样的东西？在这里，所有单元格的总和均为100。

library(tidyverse)

set.seed(123)
mymat <- matrix(rnorm(300), nrow = 30)
rownames(mymat) <- paste0("id", rep(1:3, each = 10))
colnames(mymat) <- letters[1:10]
cutoff_df <- data.frame(
  id = paste0("id", rep(1:3, each = 10)),
  marker = rep(letters[1:10], 3), min = runif(30, 0, 2), max = runif(30, 5, 7)
)

mymat %>%
  as_tibble(rownames = "id") %>%
  pivot_longer(-id, names_to = "marker") %>%
  left_join(cutoff_df) %>%
  filter(value <= max & value >= min) %>%
  count(id, marker) %>%
  # group_by(marker) %>% # e.g. to make sum of 100 per marker
  mutate(n = n / sum(n) * 100) %>%
  pivot_wider(names_from = marker, values_from = n, values_fill = list(n = 0))
#> Joining, by = c("id", "marker")
#> # A tibble: 3 × 11
#>   id        a     c     d     e     g     h     i     j     b     f
#>   <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 id1    3.77  3.77  7.55  1.89  5.66  1.89  3.77  5.66  0     0   
#> 2 id2    1.89  5.66  0     3.77  1.89  0     0    13.2   5.66  1.89
#> 3 id3    0     0     0     5.66  5.66  1.89  5.66 11.3   0     1.89

^{在2022-03-30创建的 reprex package （v2.0.0）}

Answer 2

这是一个基于 purrr 包的解决方案。我不确定它是否更干净，但它更短。

library(purrr)
asplit(mymat,2) |>
  imap(~{
    with(filter(cutoff_df, marker == .y),
         outer(.x, min, ">=") &
         outer(.x, max, "<") &
         outer(names(.x), id, "=="))
  }) |>
  map(rowSums) |>
  map_dfr(~tapply(.x, names(.x), FUN = sum),
          .id = "marker")

##> + # A tibble: 10 × 4
##>    marker   id1   id2   id3
##>    <chr>  <dbl> <dbl> <dbl>
##>  1 a          2     1     0
##>  2 b          0     3     0
##>  3 c          2     3     0
##>  4 d          4     0     0
##>  5 e          1     2     3
##>  6 f          0     1     1
##>  7 g          3     1     3
##>  8 h          1     0     1
##>  9 i          2     0     3
##> 10 j          3     7     6

Answer 3

基于dplyr的另一个可能的解决方案：

library(dplyr)

data.frame(id = rownames(mymat), mymat) %>% 
 group_by(id) %>% 
 summarise(across(everything(),
 ~ sum(.x >= cutoff_df[(cutoff_df$id == cur_group()$id[1]) & (cur_column() == cutoff_df$marker), 3] &
      .x <= cutoff_df[(cutoff_df$id == cur_group()$id[1]) & (cur_column() == cutoff_df$marker), 4]))) %>% 
 mutate(aux = sum(cur_data()[,-1]), across(-id, ~ .x*100/aux[1]), aux = NULL)

#> # A tibble: 3 x 11
#>   id        a     b     c     d     e     f     g     h     i     j
#>   <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 id1    3.77  0     3.77  7.55  1.89  0     5.66  1.89  3.77  5.66
#> 2 id2    1.89  5.66  5.66  0     3.77  1.89  1.89  0     0    13.2 
#> 3 id3    0     0     0     0     5.66  1.89  5.66  1.89  5.66 11.3