R：使用Apply系列代替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

我不確定您想如何返回雨天？ 是否將它們綁定為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

Answer 2

我以為你要速度。

我認為您的數據形式不好計算，因為只有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()計算每對cols。 .x是每個山口dat1和.y是每個COL 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  

[additional2（錯誤處理）]

如果沒有NA，則下面的代碼幾乎與上面的代碼一樣快。 （注意：如果在一行中，則可以省略{} of 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)