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 ...
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
. replacer
function turns a row vector and does what you want, so now we need to scale that to the full data.frame. apply
function is for: it applies a function ( replacer
) on a data.frame over a dimension ( 1
for row wise).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.