script for saving Rcpp inputs used in package examples

[tdhock]

Hi @akhikolla here is an R script that you can use to compute and save all of the inputs that are passed to Rcpp functions during example code.

relative <- commandArgs(trailingOnly=TRUE)
path <- normalizePath(relative, mustWork=TRUE)
Rcpp::compileAttributes(path)
RcppExports.R <- file.path(path, "R", "RcppExports.R")
fun.env <- new.env()
source(RcppExports.R, fun.env)
con <- file(RcppExports.R, "w")
fun.name.vec <- ls(fun.env)
for(fun.name in fun.name.vec){
  fun <- fun.env[[fun.name]]
  arg.list <- formals(fun)
  rhs <- as.call(c(substitute(list), sapply(names(arg.list), as.symbol)))
  code <- body(fun)
  call.line <- code[[2]]
  call.line[[2]] <- sub("`", "'", call.line[[2]])
  body(fun) <- substitute({
    e <- get("data.env", .GlobalEnv)
    e[[NAME]][[length(e[[NAME]])+1]] <- RHS
    CALL
  }, list(NAME=fun.name, RHS=rhs, CALL=call.line))
  writeLines(paste(fun.name, "<-"), con)
  dput(fun, con)
}
close(con)
install.packages(path, repos=NULL)
pkg <- basename(relative)
data.env <- new.env()
library(pkg, character.only=TRUE)
export.vec <- getNamespaceExports(pkg)
for(obj.name in export.vec){
  example(obj.name, package=pkg, character.only = TRUE)
}
sapply(data.env, length)
saveRDS(data.env, paste0(path, "_examples.rds"))

You can save it in save_example_data.R then run it on the command line (give the path to the package after --args)

(base) tdhock@maude-MacBookPro:~/R$ R --vanilla --args path/to/LOPART < save_example_data.R 
...
LOPART_interface 
               2 
> saveRDS(data.env, paste0(path, "_examples.rds"))

The last lines of output indicate that in the LOPART package, the LOPART_interface function was run two times in all package examples.

> ex.env <- readRDS("~/R/LOPART_examples.rds")
> str(ex.env$LOPART_interface)
List of 2
 $ :List of 7
  ..$ input_data         : num [1:100] 9.1 10.18 11.59 8.87 9.92 ...
  ..$ input_label_start  : num(0) 
  ..$ input_label_end    : num(0) 
  ..$ input_label_changes: num(0) 
  ..$ n_updates          : int 100
  ..$ penalty_unlabeled  : num 10
  ..$ penalty_labeled    : num 10
 $ :List of 7
  ..$ input_data         : num [1:100] 9.1 10.18 11.59 8.87 9.92 ...
  ..$ input_label_start  : num [1:3] 19 44 79
  ..$ input_label_end    : num [1:3] 29 54 89
  ..$ input_label_changes: num [1:3] 1 1 0
  ..$ n_updates          : int 100
  ..$ penalty_unlabeled  : num 10
  ..$ penalty_labeled    : num 10

so this is an automatic method for determining sets of "expected" inputs to Rcpp functions.
when you are doing your analysis of all packages/functions please keep track of

• which Rcpp functions are used in examples (as above) vs not used. (the ones not used in examples may have valgrind issues with "expected" inputs as well but we don't know what the expected inputs look like)
• which Rcpp functions are exported vs un-exported. (exported functions are more likely to receive unexpected inputs from the user)
• which Rcpp functions result in valgrind issues using deepstate random inputs. (vs no issues)
  We are most interested in the exported ones which are used in examples, with valgrind issues using deepstate random inputs. These are the ones which may result in "real" problems. But for comparison it will be useful to keep track of all of this information so we can make statements like "25% of all Rcpp functions are used in package examples" and "90% of all Rcpp functions are exported in the package NAMESPACE" and "deepstate was useful for finding issues in 10% of all exported functions" etc

[tdhock]

here is a better version that also runs tests then re-runs all the inputs and saves another file "noerr" containing all the inputs that do not cause errors.

• "all" file useful for comparison with deepstate inputs (we dont expect any valgrind issues with "all" inputs, even those that cause R errors)
• "noerr" file useful for analysis of invariants/constraints/implicit types

relative <- commandArgs(trailingOnly=TRUE)
path <- normalizePath(relative, mustWork=TRUE)
Rcpp::compileAttributes(path)
RcppExports.R <- file.path(path, "R", "RcppExports.R")
fun.env <- new.env()
source(RcppExports.R, fun.env)
con <- file(RcppExports.R, "w")
fun.name.vec <- ls(fun.env)
for(fun.name in fun.name.vec){
  fun <- fun.env[[fun.name]]
  arg.list <- formals(fun)
  rhs <- as.call(c(substitute(list), sapply(names(arg.list), as.symbol)))
  code <- body(fun)
  call.line <- code[[2]]
  call.line[[2]] <- sub("`", "'", call.line[[2]])
  body(fun) <- substitute({
    e <- get("data.env", .GlobalEnv)
    e[[NAME]][[length(e[[NAME]])+1]] <- RHS
    CALL
  }, list(NAME=fun.name, RHS=rhs, CALL=call.line))
  writeLines(paste(fun.name, "<-"), con)
  dput(fun, con)
}
close(con) 
install.packages(path, repos=NULL)
pkg <- basename(relative)
data.env <- new.env()
library(pkg, character.only=TRUE)
export.vec <- getNamespaceExports(pkg)
for(obj.name in export.vec){
  example(obj.name, package=pkg, character.only = TRUE)
}
test.R.vec <- Sys.glob(file.path(path, "tests", "*.[Rr]"))
try(devtools::test(path))##testthat only.
for(test.R in test.R.vec)try(source(test.R))#non-testthat.
sapply(data.env, length)
saveRDS(as.list(data.env), paste0(path, "_inputs_all.rds"))
noerr.list <- list()
for(fun.name in ls(data.env)){
  fun.input.lists <- data.env[[fun.name]]
  fun <- get(fun.name, getNamespace(pkg))
  fun.noerr.lists <- list()
  for(input.list in fun.input.lists){
    result <- try(do.call(fun, input.list))
    if(!is(result, "try-error")){
      fun.noerr.lists[[length(fun.noerr.lists)+1]] <- input.list
    }
  }
  noerr.list[[fun.name]] <- fun.noerr.lists
}
sapply(noerr.list, length)
saveRDS(noerr.list, paste0(path, "_inputs_noerr.rds"))

[akhikolla]

That's great @tdhock. I'll implement that in the package. Thanks for the solution.

[tdhock]

I don't think you can directly use this inside RcppDeepState, because it assumes you are writing to data.env in the global environment, .GlobalEnv
so if you want to do this inside a RcppDeepState function you may have to make some changes to how the data or stored.
for now I would suggest just running this script outside of RcppDeepState, on the cluster.

[akhikolla]

Saved the tests, example outputs for the packages that are tested under RcppDeepState so far
https://raw.githubusercontent.com/akhikolla/RcppDeepStateTest/master/example_run/save_example_outputs.txt