简体   繁体   中英

How to replace values of several columns based on/ another column in R?

I am a new R user and I am trying to make a code more efficient.

I have a very huge dataframe that counts several columns. I am trying to replace the values of several columns based on the value of another columns.

I know how to do it with a conditional statement or a loop but I would like to optimize as much as possible as my data is big.

Lets have some test data:

# 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

I would like to have my columns from ...

  • if col1 is equal to 0 col5 to col9 equal to 0
  • if col1 is equal to 3 col2 to col9 equal to 0
  • if col1 is equal to 2 col7 and col9 equal to 0

What I tried so far was not very efficient. I was not able to do several columns simultaneously or to avoid 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

If I understand it right, is this what you are looking for?

Speedup: ~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

A base solution:

# 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))

What is in there:

  • switch evaluates a set of cases and returns a corresponding set of results, depending on a given set of rules. In our case, we're returning the indexes of the columns you want as zero, depending on which value we find at column 1.
  • replace , well... it puts a value (0 in our case) in a given positions ( cols ) in a vector x .
  • The replacer function turns a row vector and does what you want, so now we need to scale that to the full data.frame.
  • That's what the apply function is for: it applies a function ( replacer ) on a data.frame over a dimension ( 1 for row wise).
  • As for the t , it transposes the output, but in all honesty, I don't fully understand why I needed it there. Explanations, suggestions and edits from more knowledgeable people are most welcome!

Total Speedup: 2.3x

Using ifelse() instead of if_else() I could speed it up by factor ~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

Modifying each column only once brought another ~1.3x speedup.

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

My last idea was to compute each logical vector only once providing another ~1.4x speedup.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM