Question

我有一个数据框，其中包含两个长度为5且变量为的向量：

x <- seq(1:5)
y <- rep(0,5)
df <- data.frame(x, y)
z <- 10

我需要遍历数据帧并根据与x相关的条件使用z更新y，并且我需要在每次迭代时更新z。使用for循环，我会这样做：

for (i in seq(2,nrow(df))){
  if(df$x[i] %% 2 == 0){
    df$y[i] <- df$y[i-1] + z
    z <- z - df$x[i]
  } else{
    df$y[i] <- df$y[i-1]
  }
}

使用数据帧很慢并且必须使用df $ x [i]访问第i个项目效率不高，但我不确定如何对其进行矢量化，因为y和z都会根据每次迭代而改变。

有没有人有关于迭代此方法的最佳方法的建议？我想完全避免使用数据帧，只是使用向量来简化查找，或者使用tidyverse和purrr包使用tidyverse，但似乎没什么好容易实现的。谢谢！

Answer 1

您可以使用sapply功能：

y=0
z=10
sapply(df$x,function(x)ifelse(x%%2==0,{y<<-y+z;z<<-z-x;y},y<<-y))
[1]  0 10 10 18 18

Answer 2

这是一个矢量化版本

vec_fun <- function(x, z) {
    L <- length(x)

    vec_z <- rep(0, L)
    I <- seq(2, L, by=2)
    vec_z[I] <- head(z-c(0, cumsum(I)), length(I))

    cumsum(vec_z)
}

替代版本 - sapply＆amp; tidyverse

sapply_fun <- function(x, z) {
    y=0
    sapply(df$x,function(x)ifelse(x%%2==0,{y<<-y+z;z<<-z-x;y},y<<-y))
}

library(tidyverse)
library(tidyverse)
tidy_fun <- function(df) {
    df %>% 
      filter(x %% 2 != 0) %>%
      mutate(z = accumulate(c(z, x[-1] - 1), `-`)) %>%
      right_join(df, by = c("x", "y")) %>%
      mutate(z = lag(z), z = ifelse(is.na(z), 0, z)) %>%
      mutate(y = cumsum(z)) %>%
      select(-z) %>%
      pluck("y")
}

您的数据

df <- data.frame(x=1:5, y=0)
z <- 10

让我们确保所有返回相同的结果

identical(vec_fun(df$x, z), sapply_fun(df$x, z), tidy_fun(df))
# TRUE

使用小型数据集

基准 - sapply_fun似乎稍快一点

library(microbenchmark)
microbenchmark(vec_fun(df$x, z), sapply_fun(df$x, z), tidy_fun(df), times=100L, unit="relative")

# Unit: relative
                # expr        min         lq       mean     median         uq      max neval
    # vec_fun(df$x, z)   1.349053   1.316664   1.256691   1.359864   1.348181 1.146733   100
 # sapply_fun(df$x, z)   1.000000   1.000000   1.000000   1.000000   1.000000 1.000000   100
        # tidy_fun(df) 411.409355 378.459005 168.689084 301.029545 270.519170 4.244833   100

现在有更大的data.frame

df <- data.frame(x=1:1000, y=0)
z <- 10000

结果相同 - 是的

identical(vec_fun(df$x, z), sapply_fun(df$x, z), tidy_fun(df))
# TRUE

使用更大的数据集

基准 - 现在很明显vec_fun更快

library(microbenchmark)
microbenchmark(vec_fun(df$x, z), sapply_fun(df$x, z), tidy_fun(df), times=100L, unit="relative")

# Unit: relative
                # expr       min        lq      mean    median        uq     max neval
    # vec_fun(df$x, z)   1.00000   1.00000   1.00000   1.00000   1.00000   1.000   100
 # sapply_fun(df$x, z)  42.69696  37.00708  32.19552  35.19225  27.82914  27.285   100
        # tidy_fun(df) 259.87893 228.06417 201.43230 218.92552 172.45386 380.484   100

Answer 3

由于您的数据仅包含数字，因此您可以使用矩阵而不是数据帧，但速度要快一些。

mx <- matrix(c(x, y), ncol = 2, dimnames = list(1:length(x), c("x", "y")))

for (i in seq(2, nrow(mx))){
  if(mx[i, 1] %% 2 == 0){
    mx[i, 2] <- mx[i-1, 2] + z
    z <- z - mx[i, 1]
    } else {
      mx[i, 2]  <- mx[i-1, 2] 
    }
  }

mx
# x  y
# 1 1  0
# 2 2 10
# 3 3 10
# 4 4 18
# 5 5 18

microbenchmark()结果：

# Unit: milliseconds
#  expr       min        lq     mean    median       uq       max neval
#    mx  8.675346  9.542153 10.71271  9.925953 11.02796  89.35088  1000
#    df 10.363204 11.249255 12.85973 11.785933 13.59802 106.99920  1000

Answer 4

如果我们可以对数据帧进行矢量化操作，那就太好了。我的策略是计算每行的z值，然后使用cumsum计算y值。 purrr包中的accumulate函数用于计算z值。来自dplyr函数的right_join函数和来自tidyr函数的fill函数用于进一步处理格式。

library(tidyverse)

df2 <- df %>% 
  filter(x %% 2 != 0) %>%
  mutate(z = accumulate(c(z, x[-1] - 1), `-`)) %>%
  right_join(df, by = c("x", "y")) %>%
  mutate(z = lag(z), z = ifelse(is.na(z), 0, z)) %>%
  mutate(y = cumsum(z)) %>%
  select(-z)
df2
#   x  y
# 1 1  0
# 2 2 10
# 3 3 10
# 4 4 18
# 5 5 18

迭代数据帧，其中每次迭代有效地依赖于R中的前一项

4 个答案: