profiling alternatives to lapply R if/else functions

gistfile1.r

#credits/inspiration to:
#http://alyssafrazee.com/vectorization.html
#http://www.johnmyleswhite.com/notebook/2013/12/22/the-relationship-between-vectorized-and-devectorized-code/
#http://r-de-jeu.blogspot.com/2013/01/search-and-replace-are-you-tired-of.html

time <- function (n, test_function, test_args) {
  timings <- rep(NA, n)

  for (itr in 1:n) {
    start <- Sys.time()
    do.call(
      what=test_function, 
      args=test_args
    )
    end <- Sys.time()
    timings[itr] <- end - start
  }

  return(timings)
}


n_timings <- function(n, test_function, test_args) {
  timings <- time(n, test_function, test_args)
  
  result <- paste0(
    n, " trials of ", test_function, " with mean time of ", 
    round(mean(timings), 4), " seconds.\n", 
    "min of ", round(min(timings), 4), " and max of ",
    round(max(timings), 4), " seconds."
  )
  
  cat(result)
}
  


using_join <- function(x) {
  
  to_join <- data.frame(
    index_col=c(1:5),
    fake_data=base::sample(letters, 5, replace = TRUE)
  )
  
  dplyr::left_join(
    x, to_join, by=c("index_col") 
  )
}



using_if <- function(x) {
  
  if (x==1) {
    return('a')
  } else if (x==2) {
    return('d')
  } else if (x==3) {
    return('f')
  } else if (x==4) {
    return('w')
  } else if (x==5) {
    return('z')
  }
}


using_if_lapply <- function(x) {
  unlist(lapply(X=x$index_col, FUN="using_if"))
}



using_rowwise <- function(x) {
  x %>%
    rowwise() %>%
    mutate(
      transformed = using_if(index_col)  
    )
}


#via https://gist.github.com/aammd/ba73669e90ea27b8af2f
using_dplyr_ifelse <- function(x) {
  x %>%
    data.frame %>%
    setNames("input") %>%
    tbl_df %>%
    mutate(
      munge = input %>% equals(1) %>% ifelse("a", input),
      munge = munge %>% equals(2) %>% ifelse("b", munge),
      munge = munge %>% equals(3) %>% ifelse("c", munge),
      munge = munge %>% equals(4) %>% ifelse("d", munge),
      munge = munge %>% equals(5) %>% ifelse("e", munge)      
    ) %>%
    select(munge)
}


using_mapvalues <- function(x) {
  mapvalues(
    x = x,
    from = c(1,  2,   3,   4,   5),
    to = c('a', 'd', 'e', 'j', 'z')
  )  
}


#http://stackoverflow.com/a/14168183/561698
decode <- function(x, search, replace, default = NULL) {

   # build a nested ifelse function by recursion
   decode.fun <- function(search, replace, default = NULL)
      if (length(search) == 0) {
         function(x) if (is.null(default)) x else rep(default, length(x))
      } else {
         function(x) ifelse(x == search[1], replace[1],
                                            decode.fun(tail(search, -1),
                                                       tail(replace, -1),
                                                       default)(x))
      }

   return(decode.fun(search, replace, default)(x))
}


using_so_decode <- function(x) {
  decode(
    x = x,
    search = c(1, 2, 3, 4, 5),
    replace = c("f", "i", "r", "v", "r")
  )
}




using_ifelse_chain <- function(x) {
  
  ifelse(x==1, 'a', 
    ifelse(x==2, 'b',
      ifelse(x==3, 'c',
        ifelse(x==4, 'd',
          ifelse(x==5, 'e', x)       
        )     
      )        
    )    
  )  
}


df_test <- data.frame(
  index_col=base::sample(c(1:5), 750000, replace = TRUE)
)