R：对数据框使用应用系列而不是 for 循环

Question

首先，一些示例数据：

location <- c("A","B","C","D","E")
mat <- as.data.frame(matrix(runif(1825),nrow=5,ncol=365))
t1<- c(258,265,306,355)
t2<- c(258,270,302,352)
t3<- c(258,275,310,353)
t4<- c(258,280,303,355)
t5<- c(258,285,312,356)
ts<-rbind(t1,t2,t3,t4,t5)
dat <-as.data.frame(cbind(location,mat,ts))
names(dat)[367:370] <- c("pl","vg","re","me")

location 是网站的名称。 V1 到 V365 是每日降雨量（V1 为 一年的第一天）。我想做的是：

对于每一行 (location)，我想根据最后一行生成三个降雨值 四列pl,vg,re,me（指定一年中的日子）

例如，对于位置A，最后四列是：

pl = 258 vg = 265 re = 306 me= 355

因此，对于位置A，我想生成三个降雨量值，它们是来自以下的降雨量之和：

V258 到 V264

V265 到 V305 和

V306 到 V355

并为所有五个位置执行此操作。

我所做的是：

 for(j in unique(dat$location)){

    loc <- dat[dat$location == j,]

    pl.val <- loc$pl + 1 # have to add + 1 since the rainfall starts from the second column
   vg.val <- loc$vg + 1
   re.val <- loc$re + 1
   me.val <- loc$me + 1

   rain1 <- sum(loc[,pl.val:vg.val]) 
   rain2 <- sum(loc[,(vg.val+ 1):re.val]) 
   rain3 <- sum(loc[,(re.val + 1):me.val]) 
}     

我想避免使用for 循环并改用apply 函数。不过，我是 不熟悉如何使用apply函数对所有行进行计算 （位置）一口气。谁能告诉我该怎么做？

谢谢

编辑

如果我有一个降雨值为 NA 且其他日期为 NA 的位置，我该如何修改以下被接受为答案的代码。这是示例数据

location <- c("A","B","C")
mat <- as.data.frame(matrix(runif(365*3),nrow=3,ncol=365))
t1<- c(258,265,306,355)
t2<- c(258,NA,NA,NA)
t3<- c(258,275,310,353)
ts<-rbind(t1,t2,t3)
dat <-as.data.frame(cbind(location,mat,ts))
names(dat)[367:370] <- c("pl","vg","re","me")
dat[2,-c( 367:370)] <- NA

Answer 1

我假设你想要速度。

我觉得你数据的形式不好计算，因为只有col1是字符，col367:370是不同的，而且很宽。也许逐行计算不是一个好主意。基本上 R 擅长按 col 计算 col。

如果我是你，我会准备如下表格的数据；

library(tidyverse)

dat1 <- dat[, -c(1, 367:370)] %>% 
  t() %>% 
  as.tibble() %>% 
  set_names(location)

dat2 <- dat[, 367:370] %>% 
  t() %>% 
  as.tibble() %>% 
  set_names(location)

我推荐map2() 来计算每对列。 .x 是 dat1 的每个列，.y 是 dat2 的每个列（它们被视为向量）。下面的代码比你的快五十倍。

map2(dat1, dat2, ~ {
  pl.val <- .y[1]
  vg.val <- .y[2]
  re.val <- .y[3]
  me.val <- .y[4]

  rain1 <- sum(.x[pl.val:vg.val]) 
  rain2 <- sum(.x[(vg.val+ 1):re.val]) 
  rain3 <- sum(.x[(re.val + 1):me.val]) 
  c(rain1 = rain1, rain2 = rain2, rain3 = rain3)
  }
)

[additionnl（应用，映射）]

注意：apply() 很难将data.frame 视为具有字符和数字的，因为要转换为矩阵。所以如果你使用apply()，需要删除一个位置col。

apply(dat[,-1], MARGIN = 1, function(x){
  pl.val <- x[367 - 1]
  vg.val <- x[368 - 1]
  re.val <- x[369 - 1]
  me.val <- x[370 - 1]

  rain1 <- sum(x[pl.val:vg.val]) 
  rain2 <- sum(x[(vg.val+ 1):re.val]) 
  rain3 <- sum(x[(re.val + 1):me.val]) 
  c(rain1 = rain1, rain2 = rain2, rain3 = rain3)
})

mapply() 与map2() 基本相同。在这个问题中，mapply() 的表现最好。

mapply(function(.x, .y){
  pl.val <- .y[1]
  vg.val <- .y[2]
  re.val <- .y[3]
  me.val <- .y[4]

  rain1 <- sum(.x[pl.val:vg.val]) 
  rain2 <- sum(.x[(vg.val+ 1):re.val]) 
  rain3 <- sum(.x[(re.val + 1):me.val]) 
  c(rain1 = rain1, rain2 = rain2, rain3 = rain3)
  }, dat1, dat2)

[基准]

Unit: microseconds
             expr       min        lq       mean     median        uq       max neval cld
 forloop_method() 14154.075 15074.555 17110.4060 16588.1200 18416.387 25869.836   100   c
    map2_method()   205.586   234.263   325.8762   313.9395   333.633  2072.911   100 a  
   apply_method()  1617.443  1684.812  1913.9187  1783.2480  1933.216  4189.687   100  b 
  mapply_method()   154.972   185.079   213.9370   210.2300   225.978   468.690   100 a  

[附加2（错误处理）]

当没有 NA 时，下面的代码几乎和上面的代码一样快。 （注：如果是在一行，可以省略if(...) { A } else { B }的{}，如if(...) A else B。）

results <- map2(dat1, dat2, ~ {
  pl.val <- .y[1]
  vg.val <- .y[2]
  re.val <- .y[3]
  me.val <- .y[4]

  rain1 <- if(is.na(pl.val) | is.na(vg.val)) NA else sum(.x[pl.val:vg.val], na.rm = T)
  rain2 <- if(is.na(vg.val) | is.na(re.val)) NA else sum(.x[(vg.val+ 1):re.val], na.rm = T)
  rain3 <- if(is.na(re.val) | is.na(me.val)) NA else sum(.x[(re.val + 1):me.val], na.rm = T)
  c(rain1 = rain1, rain2 = rain2, rain3 = rain3)
  }
)

# If you want data.frame instead of list
invoke("rbind", results)

Answer 2

我不确定您希望返回的雨天如何？它们是否要绑定为 3 个新列？

基本上，这里是代码...我将逐步介绍： 对于dat data.frame 中的每一行，选择代表天数的列，然后构建这些数字对应值的序列，但降低下一个值，以便我们每次都能获得正确的列。由于我们现在对数据的每个位置slice 进行操作，因此将值转换为数字，并在我们的apply 步骤中对相应的列求和。使用?sprintf 将V 附加到我们从序列创建中获得的每个列号，并作为列表返回。然后我简单地用相应位置的 ID 命名列表向量......如果你想将它附加到 data.frame 它也很简单。

lapply(1:nrow(dat), function(i){
    d_idx <- dat[i,] %>% dplyr::select(dplyr::matches("pl|vg|re|me"))
    a_idx <- data.frame(
        s = as.numeric(d_idx[,1:3]), 
        e = c(as.numeric(d_idx[,2:3]) - 1, as.numeric(d_idx[[4]]))
    )
    as.list(apply(a_idx, 1, function(j){
        rowSums(dat[i, sprintf('V%s', seq(min(j),max(j)))])
    })) %>% setNames(sprintf('rain%s', 1:length(.)))
}) %>% setNames(dat$location)


$A
$A$rain1
[1] 2.391448

$A$rain2
[1] 21.58306

$A$rain3
[1] 27.805


$B
$B$rain1
[1] 5.339885

$B$rain2
[1] 16.57476

$B$rain3
[1] 26.37708


$C
$C$rain1
[1] 7.929777

$C$rain2
[1] 17.81324

$C$rain3
[1] 20.12217


$D
$D$rain1
[1] 9.715258

$D$rain2
[1] 11.2547

$D$rain3
[1] 25.93332


$E
$E$rain1
[1] 12.81343

$E$rain2
[1] 15.41595

$E$rain3
[1] 21.79217