将函数应用于数据框中的分组行

Question

我已经创建了一个计算生物统计数量（如物种范围边缘）的函数。下面是函数的简化版本：

range_stats <- function(rangedf, lat, lon, weighting, na.rm=T){ 
    cent_lat <- weighted.mean(x=rangedf[,lat], w=rangedf[,weighting], na.rm=T) 
    cent_lon <- weighted.mean(x=rangedf[,lon], w=rangedf[,weighting], na.rm=T) 
out <- data.frame(cent_lat, cent_lon)  
return(out) 
} 

我想这适用于的大数据帧，每一个行是一个物种的观察。因此，我希望函数按指定的一组列对行进行分组，然后为每个组计算这些统计信息。下面是测试数据框：

LATITUDE <- c(27.91977, 21.29066, 26.06340, 28.38918, 25.97517, 27.96313) 
LONGITUDE <- c(-175.8617, -157.8645, -173.9593, -178.3571, -173.9679, -175.7837) 
BIOMASS <- c(4.3540488, 0.2406332, 0.2406332, 2.1419699, 0.3451426, 1.0946017) 
SPECIES <- c('Abudefduf abdominalis','Abudefduf abdominalis','Abudefduf abdominalis','Chaetodon lunulatus','Chaetodon lunulatus','Chaetodon lunulatus') 
YEAR <- c('2005', '2005', '2014', '2009', '2009', '2015') 
testdf <- data.table(LATITUDE, LONGITUDE, BIOMASS, SPECIES, YEAR) 

我想这个功能适用于物种和每一年的独特组合来计算汇总统计，即以下几点：

testresult <- testdf %>% 
    group_by(SPECIES, YEAR) %>% 
    range_stats(lat="LATITUDE",lon="LONGITUDE",weighting="BIOMASS",na.rm=T) 

然而，上面的代码呢不工作（我得到一个(list) object cannot be coerced to type 'double'错误），我不知道如何解决这个问题。

Answer 1

由于您添加了dplyr和purrr的标签，我假设您对tidyverse解决方案感兴趣。所以下面我将演示一个基于tidyverse的解决方案。

首先，您的range_stats有问题。这就是你收到错误信息的原因。 weighted.mean正在等待x和w参数的向量。但是，如果rangedf是tibble，则子集tibble的方式（例如rangedf[,lat]）仍将返回一列tibble。更好的方法是使用dplyr软件包中的pull。

library(tidyverse) 
range_stats <- function(rangedf, lat, lon, weighting, na.rm=T){ 
    cent_lat <- weighted.mean(x = rangedf %>% pull(lat), 
          w = rangedf %>% pull(weighting), na.rm=T) 
    cent_lon <- weighted.mean(x = rangedf %>% pull(lon), 
          w = rangedf %>% pull(weighting), na.rm=T) 
    out <- data.frame(cent_lat, cent_lon)  
    return(out) 
} 

接下来，我们创建了数据帧的方式是确定的，但data.table距离data.table包，您将创建一个data.table，而不是一个tibble。我以为你想要使用tidyverse的方法，所以我将data.table更改为data_frame，如下所示。现在

LATITUDE <- c(27.91977, 21.29066, 26.06340, 28.38918, 25.97517, 27.96313) 
LONGITUDE <- c(-175.8617, -157.8645, -173.9593, -178.3571, -173.9679, -175.7837) 
BIOMASS <- c(4.3540488, 0.2406332, 0.2406332, 2.1419699, 0.3451426, 1.0946017) 
SPECIES <- c('Abudefduf abdominalis','Abudefduf abdominalis','Abudefduf abdominalis','Chaetodon lunulatus','Chaetodon lunulatus','Chaetodon lunulatus') 
YEAR <- c('2005', '2005', '2014', '2009', '2009', '2015') 
testdf <- data_frame(LATITUDE, LONGITUDE, BIOMASS, SPECIES, YEAR) 

，你说你想要的range_stats功能适用于SPECIES和YEAR每个组合。一种方法是将数据帧拆分为数据帧列表，并使用lapply家族功能。但在这里，我想告诉你如何使用map家庭功能来实现此任务，因为map来自purrr程序包，它是tidyverse的一部分。

我们可以先创建一个基于SPECIES和YEAR的组指数。

testdf2 <- testdf %>% 
    mutate(Group = group_indices(., SPECIES, YEAR)) 
testdf2 
# A tibble: 6 x 6 
    LATITUDE LONGITUDE BIOMASS    SPECIES YEAR Group 
    <dbl>  <dbl>  <dbl>     <chr> <chr> <int> 
1 27.91977 -175.8617 4.3540488 Abudefduf abdominalis 2005  1 
2 21.29066 -157.8645 0.2406332 Abudefduf abdominalis 2005  1 
3 26.06340 -173.9593 0.2406332 Abudefduf abdominalis 2014  2 
4 28.38918 -178.3571 2.1419699 Chaetodon lunulatus 2009  3 
5 25.97517 -173.9679 0.3451426 Chaetodon lunulatus 2009  3 
6 27.96313 -175.7837 1.0946017 Chaetodon lunulatus 2015  4 

正如您所看到的，Group是显示索引编号的新列。现在我们可以根据Group分割数据帧，然后使用map_dfr来应用range_stats函数。

testresult <- testdf2 %>% 
    split(.$Group) %>% 
    map_dfr(range_stats, lat = "LATITUDE",lon = "LONGITUDE", 
      weighting = "BIOMASS", na.rm = TRUE, .id = "Group") 
testresult 
    Group cent_lat cent_lon 
1  1 27.57259 -174.9191 
2  2 26.06340 -173.9593 
3  3 28.05418 -177.7480 
4  4 27.96313 -175.7837 

注意map_dfr罐自动绑定数据帧的输出列表，以一个单一的数据帧。 .id = "Group"表示我们想要根据列表元素的名称创建一个名为Group的列。

我把这个过程分成了两个步骤，但是当然它们可以全部在一个管道中，如下所示。

testresult <- testdf %>% 
    mutate(Group = group_indices(., SPECIES, YEAR)) %>% 
    split(.$Group) %>% 
    map_dfr(range_stats, lat = "LATITUDE",lon = "LONGITUDE", 
      weighting = "BIOMASS", na.rm = TRUE, .id = "Group") 

如果你想，testresult可以使用left_jointestdf合并，但我会在这里停止为testresult可能已经你想所需的输出。我希望这有帮助。

Answer 2

基本上，主要问题涉及weighted.mean()您传递数据框对象的位置，而不是可强制加倍的矢量。要方法中解决，只需更改：

x=rangedf[,lat] 

到双括号：

x=rangedf[[lat]] 

调整方法：

range_stats <- function(rangedf, lat, lon, weighting, na.rm=T){ 
    cent_lat <- weighted.mean(x=rangedf[[lat]], w=rangedf[[weighting]], na.rm=T) 
    cent_lon <- weighted.mean(x=rangedf[[lon]], w=rangedf[[weighting]], na.rm=T) 
    out <- data.frame(cent_lat, cent_lon)  
    return(out) 
} 

---

至于通过切片计算总体组，就原谅我绕过，dplyr和data.table你使用和考虑基地R的未充分利用，但你安全的方法，by()。

与目前设定的挑战是range_stats输出方法的返回是两列的data.frame和dplyr的group_by()预计一个聚集矢量运算。然而，by通过数据框对象（因素切片）到一个定义函数返回data.frames然后你就可以rbind一个最终数据框的列表：

df_List <- by(testdf, testdf[, c("SPECIES", "YEAR")], FUN=function(df) 
       data.frame(species=df$SPECIES[1], 
          year=df$YEAR[1], 
          range_stats(df,"LATITUDE","LONGITUDE","BIOMASS")) 
      ) 

finaldf <- do.call(rbind, df_List) 
finaldf 
#     species year cent_lat cent_lon 
# 1 Abudefduf abdominalis 2005 27.57259 -174.9191 
# 2 Chaetodon lunulatus 2009 28.05418 -177.7480 
# 3 Abudefduf abdominalis 2014 26.06340 -173.9593 
# 4 Chaetodon lunulatus 2015 27.96313 -175.7837