inst/doc/opt-constant-folding.R

## ----echo=FALSE, message=FALSE------------------------------------------------
library("rco")
library("microbenchmark")
library("ggplot2")
autoplot.microbenchmark <- function(obj) {
  levels(obj$expr) <- paste0("Expr_", seq_along(levels(obj$expr)))
  microbenchmark:::autoplot.microbenchmark(obj)
}
speed_up <- function(obj) {
  levels(obj$expr) <- paste0("Expr_", seq_along(levels(obj$expr)))
  obj <- as.data.frame(obj)
  summaries <- do.call(rbind, by(obj$time, obj$expr, summary))
  res <- c()
  for (i in seq_len(nrow(summaries) - 1) + 1) {
    res <- rbind(res, summaries[1, ] / summaries[i, ])
  }
  rownames(res) <- levels(obj$expr)[-1]
  return(res)
}

## -----------------------------------------------------------------------------
code <- paste(
  "hours_vector <- runif(1000, 0, 24)",
  "ms_vector <- numeric(1000)",
  "# of course it would be much efficient to do vectorized operations xP",
  "for (i in seq_along(hours_vector)) {",
  "  ms_vector[i] <- 1000 * 60 * 60 * hours_vector[i]",
  "}",
  sep = "\n"
)
cat(code)

## -----------------------------------------------------------------------------
opt_code <- opt_constant_folding(list(code))
cat(opt_code$codes[[1]])

## ----message=FALSE------------------------------------------------------------
bmark_res <- microbenchmark({
  eval(parse(text = code))
}, {
  eval(parse(text = opt_code))
})
autoplot(bmark_res)
speed_up(bmark_res)

## ----echo=FALSE---------------------------------------------------------------
rco:::ops
rco:::constants
rco:::precedence_ops

## -----------------------------------------------------------------------------
x <- 1 / (2 + 1)
y <- 1 / (2 + 1)
z <- 1 / (2 + 1)
x + y + z == 1

## -----------------------------------------------------------------------------
code <- paste(
  "x <- 1/(2+1)",
  "y <- 1/(2+1)",
  "z <- 1/(2+1)",
  "x + y + z == 1",
  sep = "\n"
)
opt_code <- opt_constant_folding(list(code), fold_floats = TRUE)$codes[[1]]
cat(opt_code)

## -----------------------------------------------------------------------------
eval(parse(text = code))

## -----------------------------------------------------------------------------
eval(parse(text = opt_code))

## -----------------------------------------------------------------------------
opt_code <- opt_constant_folding(list(code), fold_floats = FALSE)$codes[[1]]
cat(opt_code)

## -----------------------------------------------------------------------------
opt_code <- opt_constant_folding(list(paste(
  "x <- 1/(2+1)", # will not fold it because we lose precision
  "y <- 1/(2+1) > 3", # however, folded or not, it is not > 3, so folds it
  sep = "\n"
)), fold_floats = FALSE)$codes[[1]]
cat(opt_code)

Try the rco package in your browser

Any scripts or data that you put into this service are public.

rco documentation built on April 17, 2021, 5:06 p.m.