Как заменить значения нескольких столбцов на основе / другого столбца в R?

Question

Я новый пользователь R и пытаюсь сделать код более эффективным.

У меня очень большой массив данных, который насчитывает несколько столбцов.Я пытаюсь заменить значения нескольких столбцов на основе значения других столбцов.

Я знаю, как это сделать с помощью условного оператора или цикла , но я хотел бы оптимизировать как можно больше данных, поскольку мои данные велики.

Позвольтеданные теста:

# data.frame creation function
make_d <- 
  function(n_rows = 5000000){
    d <- 
      data.frame(
        "col_1" = sample(   0:3, n_rows, replace = TRUE), 
        "col_2" = sample(1:1000, n_rows, replace = TRUE), 
        "col_3" = sample(1:1000, n_rows, replace = TRUE), 
        "col_4" = sample(1:1000, n_rows, replace = TRUE), 
        "col_5" = sample(1:1000, n_rows, replace = TRUE), 
        "col_6" = sample(1:1000, n_rows, replace = TRUE), 
        "col_7" = sample(1:1000, n_rows, replace = TRUE), 
        "col_8" = sample(1:1000, n_rows, replace = TRUE), 
        "col_9" = sample(1:1000, n_rows, replace = TRUE)
      )
    # return
    d
  }

# create data.frame
d <- make_d()

# first lines of data.frame
head(d)
##   col_1 col_2 col_3 col_4 col_5 col_6 col_7 col_8 col_9
## 1     3    94   802   960   460   346   212   387   665
## 2     0   637   443   249     0     0     0     0     0
## 3     2    26   192   438   562   487   623   604   853
## 4     0   421   667   511     0     0     0     0     0
## 5     3   726   994    58   384   700   307   885   832
## 6     1   567   798   185   117   394   894   745   134

Я хотел бы, чтобы мои столбцы были из ...

• , если col1 равно от 0 col5 до col9, равно 0
• если col1 равно 3 col2 - col9 равно 0
• , если col1 равно 2 col7 и col9 равно 0

То, что я пробовал до сих пор, было не очень эффективным.Мне не удалось сделать несколько столбцов одновременно или избежать if_else().

library(microbenchmark)
library(dplyr)

microbenchmark(
  setup = { d <- make_d() },
  dplyr_mutate = {
      d <- 
        d %>% 
        mutate(
          col_5 = if_else(col_1 == 0, 0L, col_5),
          col_6 = if_else(col_1 == 0, 0L, col_6),
          col_7 = if_else(col_1 == 0, 0L, col_7),
          col_8 = if_else(col_1 == 0, 0L, col_8),
          col_9 = if_else(col_1 == 0, 0L, col_9), 


          col_2 = if_else(col_1 == 3, 0L, col_2),
          col_3 = if_else(col_1 == 3, 0L, col_3),
          col_4 = if_else(col_1 == 3, 0L, col_4),
          col_5 = if_else(col_1 == 3, 0L, col_5),
          col_6 = if_else(col_1 == 3, 0L, col_6),
          col_7 = if_else(col_1 == 3, 0L, col_7),
          col_8 = if_else(col_1 == 3, 0L, col_8),
          col_9 = if_else(col_1 == 3, 0L, col_9),

          col_7 = if_else(col_1 == 2, 0L, col_7), 
          col_9 = if_else(col_1 == 2, 0L, col_9)
        )},
  times = 10
)

## Unit: milliseconds
##          expr      min       lq    mean   median       uq      max neval
##  dplyr_mutate 412.3384 429.2278 531.884 538.8701 562.7804 793.9565    10

Answer 1

Если я правильно понимаю, это то, что вы ищете?

Ускорение: ~ 1,3x

library(microbenchmark)
library(dplyr)

microbenchmark(
  setup = { d <- make_d() },
  dplyr_mutate_at = 
  {
    d %>%
      mutate_at(vars(col_5:col_9) , funs(ifelse(col_1 == 0, 0,. ))) %>%
      mutate_at(vars(col_2:col_9) , funs(ifelse(col_1 == 3, 0,. ))) %>%
      mutate_at(vars(col_7,col_9) , funs(ifelse(col_1 == 2, 0,. )))
  },

  times = 10
)

##    Unit: milliseconds
##                  expr      min       lq     mean   median       uq      max neval
##          dplyr_mutate 395.5998 423.7178 496.1036 436.8839 551.8601 859.9627    10
##       dplyr_mutate_at 365.0635 378.3087 404.1069 392.1462 400.7426 551.8507    10

Answer 2

Общее ускорение: 2,3x

Используя ifelse() вместо if_else(), я мог бы ускорить его на фактор ~ 1.6x .

library(microbenchmark)
library(dplyr)

microbenchmark(
  setup = { d <- make_d() },
  dplyr_mutate_ifelse = 
    {
      d <-  d %>% 
        mutate(
          col_5 = ifelse(col_1 == 0, 0L, col_5),
          col_6 = ifelse(col_1 == 0, 0L, col_6),
          col_7 = ifelse(col_1 == 0, 0L, col_7),
          col_8 = ifelse(col_1 == 0, 0L, col_8),
          col_9 = ifelse(col_1 == 0, 0L, col_9), 

          col_2 = ifelse(col_1 == 3, 0L, col_2),
          col_3 = ifelse(col_1 == 3, 0L, col_3),
          col_4 = ifelse(col_1 == 3, 0L, col_4),
          col_5 = ifelse(col_1 == 3, 0L, col_5),
          col_6 = ifelse(col_1 == 3, 0L, col_6),
          col_7 = ifelse(col_1 == 3, 0L, col_7),
          col_8 = ifelse(col_1 == 3, 0L, col_8),
          col_9 = ifelse(col_1 == 3, 0L, col_9),

          col_7 = ifelse(col_1 == 2, 0L, col_7), 
          col_9 = ifelse(col_1 == 2, 0L, col_9)
        )
    },

  times = 10
)
## Unit: milliseconds
## expr                min      lq       mean     median   uq       max         neval
## dplyr_mutate        370.8031 375.8326 496.1825 481.8754 555.9229 762.9057    10
## dplyr_mutate_ifelse 226.3609 294.5468 317.6726 331.6935 356.0460 364.1252    10

Изменение каждого столбца только один раз привело к ускорению ~ 1.3x .

library(microbenchmark)
library(dplyr)

microbenchmark(
  setup = { d <- make_d() },
  dplyr_mutate_ifelse2 = 
    {
      d <-  
        d %>% 
        mutate(
          col_2 = ifelse(col_1 == 3, 0L, col_2),
          col_3 = ifelse(col_1 == 3, 0L, col_3),
          col_4 = ifelse(col_1 == 3, 0L, col_4),
          col_5 = ifelse(col_1 == 3 | col_1 == 0, 0L, col_5),
          col_6 = ifelse(col_1 == 3 | col_1 == 0, 0L, col_6),
          col_7 = ifelse(col_1 == 3 | col_1 == 0 | col_1 == 2, 0L, col_7),
          col_8 = ifelse(col_1 == 3, 0L, col_8),
          col_9 = ifelse(col_1 == 3 | col_1 == 0 | col_1 == 2, 0L, col_9)
        )
    },

  times = 10
)

## Unit: milliseconds
## expr                 min      lq       mean     median   uq       max         neval
## dplyr_mutate         343.0100 420.2813 466.6023 470.1078 541.2145 549.5641    10
## dplyr_mutate_ifelse  216.8928 240.0308 350.4044 338.7416 480.7032 494.0995    10
## dplyr_mutate_ifelse2 156.2432 159.2615 238.6914 265.6903 300.9932 312.6007    10

Моя последняя идея состояла в том, чтобы вычислять каждый логический вектор только один раз, обеспечивая еще одно ~ 1.4x ускорение.

library(microbenchmark)
library(dplyr)

microbenchmark(
  setup = { d <- make_d() },
  dplyr_mutate_ifelse3 = 
    {
      iffer_1 <- d$col_1 == 3
      iffer_2 <- iffer_1 | d$col_1 == 0
      iffer_3 <- iffer_2 | d$col_1 == 2

      d <-  
        d %>% 
        mutate(
          col_2 = ifelse(iffer_1, 0L, col_2),
          col_3 = ifelse(iffer_1, 0L, col_3),
          col_4 = ifelse(iffer_1, 0L, col_4),
          col_5 = ifelse(iffer_2, 0L, col_5),
          col_6 = ifelse(iffer_2, 0L, col_6),
          col_7 = ifelse(iffer_3, 0L, col_7),
          col_8 = ifelse(iffer_1, 0L, col_8),
          col_9 = ifelse(iffer_3, 0L, col_9)
        )
    },

  times = 10
)

## Unit: milliseconds
##                  expr      min       lq     mean   median       uq      max neval
##          dplyr_mutate 393.9980 415.1171 489.2011 439.3474 538.9772 754.3425    10
##   dplyr_mutate_ifelse 245.5530 341.7405 372.2182 360.2816 374.5953 505.7168    10
##  dplyr_mutate_ifelse2 154.9945 168.6646 235.9066 271.3282 290.0135 299.2681    10
##  dplyr_mutate_ifelse3 120.1260 122.4131 221.2445 188.9764 252.7045 590.2163    10

Answer 3

Базовое решение:

# Define data (meaningful values for the example included in column 1):
d <- structure(list(col1 = c(0, 3, 2), col2 = c(25, 26, 14), col3 = c(45, 86, 74), col4 = c(10, 5, 4), col5 = c(87, 69, 4), col6 = c(47, 12, 13), col7 = c(84, 41, 21), col8 = c(74, 45, 78), col9 = c(74, 45, 96)), row.names = c(NA, -3L), class = "data.frame")

# define a function that will do the replacing:
replacer <- function(x){
   cols <- switch(EXPR = as.character(x[1]), 
                  "0" = 5:9, 
                  "3" = 2:9, 
                  "2" = c(7, 9))
   replace(x, cols, 0)
}

# Use apply to do the actual replacing:
newD <- t(apply(d, 1, replacer))

Что там:

• switch оценивает набор случаев и возвращает соответствующий набор результатов в зависимости от заданного набора правил. В нашем случае мы возвращаем индексы столбцов, которые вы хотите, как ноль, в зависимости от того, какое значение мы находим в столбце 1.
• replace, хорошо ... он помещает значение (в нашем случае 0) в заданные позиции (cols) в векторе x.
• Функция replacer превращает вектор строки и делает то, что вы хотите, так что теперь нам нужно масштабировать это до полного data.frame.
• Для этого и предназначена функция apply: она применяет функцию (replacer) к фрейму данных над измерением (1 для строки).
• Что касается t, он транспонирует выходные данные, но, честно говоря, я не до конца понимаю, зачем мне это было нужно. Разъяснения, предложения и правки от более знающих людей приветствуются!