R/odin_package.R

In odin: ODE Generation and Integration

##' Create an odin model within an existing package.
##'
##' I am resisting the urge to actually create the package here.
##' There are better options than I can come up with; for example
##' `devtools::create`, `pkgkitten::kitten`, `mason::mason`, or
##' creating `DESCRIPTION` files using `desc`.  What is required here
##' is that your package:
##'
##' * Lists `odin` in `Imports:`
##' * Includes `useDynLib(<your package name>)` in
##'   `NAMESPACE` (possibly via a roxygen comment `@useDynLib
##'   <your package name>`
##' * To avoid a NOTE in `R CMD check`, import something from
##'   `odin` in your namespace (e.g., `importFrom("odin", "odin")`s
##'   or roxygen `@importFrom(odin, odin)`
##'
##' Point this function at the package root (the directory containing
##' `DESCRIPTION` and it will write out files `src/odin.c`
##' and `odin.R`.  These files will be overwritten without
##' warning by running this again.
##'
##' @title Create odin model in a package
##'
##' @param path_package Path to the package root (the directory that
##'   contains `DESCRIPTION`)
##'
##' @export
##' @examples
##' path <- tempfile()
##' dir.create(path)
##'
##' src <- system.file("examples/package", package = "odin", mustWork = TRUE)
##' file.copy(src, path, recursive = TRUE)
##' pkg <- file.path(path, "package")
##'
##' # The package is minimal:
##' dir(pkg)
##'
##' # But contains odin files in inst/odin
##' dir(file.path(pkg, "inst/odin"))
##'
##' # Compile the odin code in the package
##' odin::odin_package(pkg)
##'
##' # Which creates the rest of the package structure
##' dir(pkg)
##' dir(file.path(pkg, "R"))
##' dir(file.path(pkg, "src"))
odin_package <- function(path_package) {
  desc <- file.path(path_package, "DESCRIPTION")
  if (!file.exists(desc)) {
    stop("Did not find package at ", path_package)
  }
  package <- as.vector(read.dcf(desc, "Package"))
  if (is.na(package)) {
    stop("Failed to get package name from DESCRIPTION")
  }

  inst_odin <- file.path(path_package, "inst/odin")
  if (!is_directory(inst_odin)) {
    stop("Did not find inst/odin within your package")
  }
  filenames <- dir(inst_odin, pattern = "\\.[Rr]", full.names = TRUE)

  if (length(filenames) == 0L) {
    stop("Did not find any files in inst/odin")
  }

  options <- odin_options(target = "c")
  template <- read_lines(odin_file("template/odin_c.R"))

  f <- function(path) {
    ir <- odin_parse_(path, options)
    dat <- ir_deserialise(ir)
    path_json <- file.path(path_package, "inst", "odin",
                           sprintf("%s.json", dat$config$base))
    writeLines(ir, path_json)
    ret <- generate_c_code(dat, options, package)
    data <- wrapper_substitutions(dat, ret, package)
    ret$r <- glue_whisker(template, data)
    ret
  }

  dat <- lapply(filenames, f)

  ring <- drop_null(lapply(dat, "[[", "ring"))
  if (length(ring) > 0L) {
    ring <- ring[[1L]]
  }

  interpolate <- drop_null(lapply(dat, "[[", "interpolate"))
  if (length(interpolate) > 0L) {
    interpolate <- interpolate[[1L]]
  }

  include <- drop_null(lapply(dat, "[[", "include"))
  if (length(include) > 0L) {
    include <- combine_include(include)
  }

  lib <- list(declarations = character(0), definitions = character(0))
  for (i in seq_along(dat)) {
    lib_i <- dat[[i]]$lib
    used <- lib_i$used
    msg <- setdiff(used, names(lib$declarations))
    if (length(msg) > 0L) {
      lib$declarations <- c(lib$declarations, lib_i$lib$declarations[msg])
      lib$definitions <- c(lib$definitions, lib_i$lib$definitions[msg])
    }
  }

  header <- sprintf("Automatically generated by odin %s - do not edit",
                    as.character(utils::packageVersion("odin")))

  code_c <- c(
    paste("//", header),
    dat[[1]]$headers,
    c_flatten_eqs(ring$declarations),
    c_flatten_eqs(interpolate$declarations),
    c_flatten_eqs(lapply(dat, "[[", "struct")),
    c_flatten_eqs(lapply(dat, function(x) x$code$declaration)),
    unname(lib$declarations),
    c_flatten_eqs(include$declarations),
    c_flatten_eqs(lapply(dat, function(x) x$code$definition)),
    c_flatten_eqs(strsplit(lib$definitions, "\n")),
    c_flatten_eqs(ring$definitions),
    c_flatten_eqs(interpolate$definitions),
    c_flatten_eqs(include$definitions))

  code_r <- c(paste("##", header), c_flatten_eqs(lapply(dat, "[[", "r")))

  dir.create(file.path(path_package, "R"), FALSE)
  dir.create(file.path(path_package, "src"), FALSE)
  writeLines(code_c, file.path(path_package, "src", "odin.c"))
  writeLines(code_r, file.path(path_package, "R", "odin.R"))

  path_reg <- file.path(path_package, "src/registration.c")
  tools::package_native_routine_registration_skeleton(path_package, path_reg)
}