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是dat2的每个列（它们被视为向量）。下面的代码速度是你的50倍。

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，mapply）]

注意：由于转换为矩阵，apply()很难处理具有字符和数字的data.frame。因此，如果您使用apply()，则需要删除位置列。

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时，下面的代码几乎与上面的代码一样快。（注意：如果它在一行中，您可以省略{}的{{1}}，例如if(...) { A } else { B }。

if(...) A else B

R：使用apply family而不是for循环来构建数据框

2 个答案: