计算具有 R 中条件的组的均值

Calculating mean of means by groups with conditions in R

我有这个数据...

   Scientificname               Level Zone  levelmean
   <chr>                        <int> <chr>     <dbl>
 1 Acanthostracion polygonius       3 B         0.135
 2 Acanthostracion quadricornis     1 B         0.286
 3 Acanthostracion quadricornis     1 D         0.228
 4 Acanthostracion quadricornis     2 B         0.212
 5 Acanthostracion quadricornis     2 D         0.181
 6 Acanthostracion quadricornis     3 B         0.247
 7 Acanthostracion quadricornis     3 D         0.222
 8 Acanthostracion quadricornis     4 B         0.151
 9 Acanthostracion quadricornis     4 D         0.202
10 Acanthostracion spp.             2 B         0.225
11 Achirus lineatus                 1 B         0.204
12 Achirus lineatus                 1 D         0.202
13 Achirus lineatus                 2 B         0.219
14 Achirus lineatus                 2 D         0.181
15 Achirus lineatus                 3 B         0.145
16 Achirus lineatus                 3 D         0.172
17 Achirus lineatus                 4 B         0.135
18 Achirus lineatus                 4 D         0.142
structure(list(Scientificname = c("Acanthostracion polygonius", 
"Acanthostracion quadricornis", "Acanthostracion quadricornis", 
"Acanthostracion quadricornis", "Acanthostracion quadricornis", 
"Acanthostracion quadricornis", "Acanthostracion quadricornis", 
"Acanthostracion quadricornis", "Acanthostracion quadricornis", 
"Acanthostracion spp.", "Achirus lineatus", "Achirus lineatus", 
"Achirus lineatus", "Achirus lineatus", "Achirus lineatus", "Achirus lineatus", 
"Achirus lineatus", "Achirus lineatus"), Level = c(3L, 1L, 1L, 
2L, 2L, 3L, 3L, 4L, 4L, 2L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L), 
    Zone = c("B", "B", "D", "B", "D", "B", "D", "B", "D", "B", 
    "B", "D", "B", "D", "B", "D", "B", "D"), levelmean = c(0.134916351861846, 
    0.286175876741544, 0.228368580556262, 0.21169261421555, 0.181497972824247, 
    0.247241190981072, 0.221534021013127, 0.151406128200516, 
    0.201513319317781, 0.224860586436409, 0.204040161766372, 
    0.201884774621553, 0.219239071775499, 0.18121539764963, 0.144981540016618, 
    0.172393116267914, 0.134916351861846, 0.141662169454938)), row.names = c(NA, 
-18L), groups = structure(list(Scientificname = c("Acanthostracion polygonius", 
"Acanthostracion quadricornis", "Acanthostracion quadricornis", 
"Acanthostracion quadricornis", "Acanthostracion quadricornis", 
"Acanthostracion spp.", "Achirus lineatus", "Achirus lineatus", 
"Achirus lineatus", "Achirus lineatus"), Level = c(3L, 1L, 2L, 
3L, 4L, 2L, 1L, 2L, 3L, 4L), .rows = structure(list(1L, 2:3, 
    4:5, 6:7, 8:9, 10L, 11:12, 13:14, 15:16, 17:18), ptype = integer(0), class = c("vctrs_list_of", 
"vctrs_vctr", "list"))), row.names = c(NA, -10L), class = c("tbl_df", 
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"))

这些是物种名称、排放水平(4 最低,1 最高)和 CPUE(每单位努力的捕获量,即捕获的鱼数)。

我想做的是对放电敏感度进行量化测量。所以我能想到的唯一方法是取每个区域每个物种的每对排放水平值之间的差异。例如,对于区域 B 中的 Acanthostracion quadricornis,我将取组 1 和 2、1 和 3、1 和 4、2 和 3、2 和 4 以及 3 和 4 之间的差异,然后取所有这些值的平均值。

它变得更加复杂,因为我只想对每个区域至少出现 2 个级别的物种执行此操作。我还有大约 130 个物种,它们在每个区域显示的级别不同。

我的理想输出是...

                Scientificname Zone Sensitivity
1 Acanthostracion quadricornis    B  0.06367512
2 Acanthostracion quadricornis    D  0.02399275
3             Achirus lineatus    B  0.05164523
4             Achirus lineatus    D  0.03447407

理想输出中的值可能已四舍五入。

我们可以使用 pivot_wider 重塑为 'wide' 格式,然后使用 combn 获得两两差异,并使用 meanrowMeans

library(dplyr)
library(tidyr)
tmp <- df1 %>%
    filter(n() > 1) %>%
    ungroup %>%
    pivot_wider(names_from = Level, values_from = levelmean, values_fill = 0)
Sensitivity <- rowMeans(do.call(cbind, combn(tmp[-(1:2)], 2, 
     FUN = function(x) abs(x[1]-x[2]), simplify = FALSE)))
out <- tmp %>%
          select(1:2) %>%
          mutate(Sensitivity = Sensitivity)

-ouptutu

out
# A tibble: 4 x 3
  Scientificname               Zone  Sensitivity
  <chr>                        <chr>       <dbl>
1 Acanthostracion quadricornis B          0.0733
2 Acanthostracion quadricornis D          0.0268
3 Achirus lineatus             B          0.0520
4 Achirus lineatus             D          0.0316

或不整形

library(purrr)
df1 %>% 
   filter(n() > 1) %>%
   ungroup %>% 
   nest_by(Scientificname, Zone) %>% 
   ungroup %>% 
   transmute(Scientificname, Zone, 
     Sensitivity = map_dbl(data,
     ~ mean(abs(combn(.x$levelmean, 2, FUN = \(x) x[1]- x[2])))))

-输出

# A tibble: 4 x 3
  Scientificname               Zone  Sensitivity
  <chr>                        <chr>       <dbl>
1 Acanthostracion quadricornis B          0.0733
2 Acanthostracion quadricornis D          0.0268
3 Achirus lineatus             B          0.0520
4 Achirus lineatus             D          0.0316

这里有一个 base R 解决方案供您使用:

do.call(rbind, lapply(split(df, ~ Scientificname + Zone, drop = TRUE), function(x) {
  if(nrow(x) >= 2) {
    combs <- as.data.frame(t(combn(x$Level, m = 2)))
    x[["Sensitivity"]] <- 
      mean(abs(mapply(function(a, b) {
        x$levelmean[x$Level == a] - x$levelmean[x$Level == b]
      }, combs$V1, combs$V2)))
    head(x, 1)[, -which(names(x) %in% c("Level", "levelmean"))]
  }
}))

# A tibble: 4 x 3
# Groups:   Scientificname [2]
  Scientificname               Zone  Sensitivity
  <chr>                        <chr>       <dbl>
1 Acanthostracion quadricornis B          0.0733
2 Achirus lineatus             B          0.0520
3 Acanthostracion quadricornis D          0.0268
4 Achirus lineatus             D          0.0316

data.table 选项使用 combn

setDT(df)[
  ,
  .SD[.N > 1],
  .(Scientificname, Zone)
][
  , 
  .(Sensitivity = mean(abs(combn(levelmean,2,diff))))
  ,
  .(Scientificname, Zone)
]

或更短的一个(因为 df 已经是一个分组 data.frame)

setDT(df %>%
  filter(n() > 1))[
  , 
  .(Sensitivity = mean(abs(combn(levelmean,2,diff))))
  ,
  .(Scientificname, Zone)
]

给予

                 Scientificname Zone Sensitivity
1: Acanthostracion quadricornis    B  0.07330964
2: Acanthostracion quadricornis    D  0.02677209
3:             Achirus lineatus    B  0.05200446
4:             Achirus lineatus    D  0.03158168