使用樣本進行逐行變異的有效方法

Question

對於x每個0 ，我想在 1:10 之間隨機插入一個數字，但我正在尋找一種在dplyr和/或data.table執行此操作的有效方法，因為我有一個非常大的數據集（10m 行）。

library(tidyverse)
df <- data.frame(x = 1:10)
df[4, 1] = 0
df[6, 1] = 0
df
#     x
# 1   1
# 2   2
# 3   3
# 4   0
# 5   5
# 6   0
# 7   7
# 8   8
# 9   9
# 10 10

這不起作用，因為它每年都用相同的值替換：

set.seed(1)
df %>% 
  mutate(x2 = ifelse(x == 0, sample(1:10, 1), x))
#     x x2
# 1   1  1
# 2   2  2
# 3   3  3
# 4   0  9
# 5   5  5
# 6   0  9
# 7   7  7
# 8   8  8
# 9   9  9
# 10 10 10

雖然可以通過rowwise實現，但在大型數據集上速度很慢：

set.seed(1)
#use rowwise
df %>% 
  rowwise() %>% 
  mutate(x2 = ifelse(x == 0, sample(1:10, 1), x))
#        x    x2
#    <dbl> <dbl>
#  1     1     1
#  2     2     2
#  3     3     3
#  4     0     9
#  5     5     5
#  6     0     4
#  7     7     7
#  8     8     8
#  9     9     9
# 10    10    10

有什么建議可以加快速度嗎？

謝謝

Answer 1

不在 tidyverse 中，但您可以執行以下操作：

is_zero <- (df$x == 0)
replacements <- sample(1:10, sum(is_zero))

df$x[is_zero] <- replacements

當然，如果你願意，你可以把它折疊起來。

df$x[df$x == 0] <- sample(1:10, sum(df$x == 0))

Answer 2

使用上述解決方案和微microbenchmark並對數據集稍作修改以進行設置：

library(data.table)
library(tidyverse)
df <- data.frame(x = 1:100000, y = rbinom(100000, size = 1, 0.5)) %>% 
  mutate(x = ifelse(y == 0, 0, x)) %>% 
  dplyr::select(-y)
dt <- setDT(df)


test <- microbenchmark::microbenchmark(
  base1 = {
    df$x[df$x == 0] <- sample(1:10, sum(df$x == 0), replace = T)
  },
  dplyr1 = {
     df %>% 
      mutate(x2 = replace(x, which(x == 0), sample(1:10, sum(x == 0), replace = T)))
  },
  dplyr2 = {
    df %>% group_by(id=row_number()) %>%
      mutate(across(c(x),.fns = list(x2 = ~ ifelse(.==0, sample(1:10, 1, replace = T), .)) )) %>%
      ungroup() %>% select(-id)
  },
  data.table = {
    dt[x == 0, x := sample(1:10, .N, replace = T)]
  },
  times = 500L
)
test
# Unit: microseconds
#        expr        min         lq          mean      median         uq        max neval cld
#       base1      733.7      785.9      979.0938      897.25     1137.0     1839.4   500  a 
#      dplyr1     5207.1     5542.1     6129.2276     5967.85     6476.0    21790.7   500  a 
#      dplyr2 15963406.4 16156889.2 16367969.8704 16395715.00 16518252.9 19276215.5   500  b
#  data.table     1547.4     2229.3     2422.1278     2455.60     2573.7    15076.0   500  a 

我認為data.table會最快，但基本解決方案似乎是最好的（假設我已經正確設置了mircobenchmark ？）。

根據@chinsoon12 評論進行編輯

1e5行：

Unit: microseconds
       expr    min      lq     mean  median      uq     max neval cld
      base1  730.4  839.30 1380.465 1238.00 1322.85 28977.3   500  a 
 data.table 1394.8 1831.85 2030.215 1946.95 2060.40 29821.9   500  b

1e6行：

Unit: milliseconds
       expr    min      lq      mean   median       uq      max neval cld
      base1 9.8703 11.6596 16.030715 11.76195 12.04145 326.0118   500  b
 data.table 2.3772  2.7939  3.855672  3.04700  3.25900  61.4083   500  a 

data.table是最快的

Answer 3

這是一個data.table選項，使用與 Adam 的答案類似的邏輯。 這將過濾符合您條件的行： x == 0 ，然后采樣1:10 .N次（沒有分組變量，這是過濾后的data.table的行數）。

library(data.table)

set.seed(1)

setDT(df)[x == 0, x := sample(1:10, .N)]
df
     x
 1:  1
 2:  2
 3:  3
 4:  9
 5:  5
 6:  4
 7:  7
 8:  8
 9:  9
10: 10

Answer 4

也許以這種方式嘗試從dplyr across() ：

library(tidyverse)
#Data
df <- data.frame(x = 1:10)
df[4, 1] = 0
df[6, 1] = 0
#Code
df %>% group_by(id=row_number()) %>%
  mutate(across(c(x),.fns = list(x2 = ~ ifelse(.==0, sample(1:10, 1), .)) )) %>%
  ungroup() %>% select(-id)

輸出：

# A tibble: 10 x 2
       x  x_x2
   <dbl> <dbl>
 1     1     1
 2     2     2
 3     3     3
 4     0     5
 5     5     5
 6     0     6
 7     7     7
 8     8     8
 9     9     9
10    10    10

Answer 5

我添加了一個不同的答案，因為我提供的基本選項已經有了投票。 但這里可以是使用replace的dplyr方式。

library(dplyr)

df %>% 
  mutate(x2 = replace(x, which(x == 0), sample(1:10, sum(x == 0))))