Migrate processing

.github/workflows/models.install.yaml

@@ -3,6 +3,8 @@ name: model-install
 on:
   push:
     branches: [ main ]
+  pull_request:
+    branches: main
 
 jobs:
   build:
@@ -35,6 +37,7 @@ jobs:
         run: |
           devtools::install("./allometric", reload = FALSE);
           library(allometric)
+          devtools::load_all(".")
           models <- ingest_models(FALSE, pub_path = "./publications", params_path = "./parameters");
           warnings();
           saveRDS(models, "./models.RDS")

DESCRIPTION

@@ -9,6 +9,8 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 Imports:
     devtools
+Remotes:
+    allometric/allometric
 Depends: 
     R (>= 2.10)
 Suggests: 
@@ -17,3 +19,4 @@ Config/testthat/edition: 3
 LazyData: true
 BugReports: https://github.com/allometric/models/issues
 Contact: bfrank70@gmail.com
+RoxygenNote: 7.3.1

NAMESPACE

@@ -0,0 +1,7 @@
+# Generated by roxygen2: do not edit by hand
+
+export(get_params_path)
+export(ingest_models)
+export(load_parameter_frame)
+export(map_publications)
+export(set_params_path)

R/boilerplate.R

@@ -0,0 +1,98 @@
+find_pub_dir <- function(pub_id) {
+  pub_dir <- system.file("publications", package = "allometric")
+  pub_dir_names <- list.files(pub_dir)
+
+  pub_char <- substr(pub_id, 1, 1)
+  matched_dir <- ""
+
+  for(dir_name in pub_dir_names) {
+    first_char <- substr(dir_name, 1, 1)
+    second_char <- substr(dir_name, 3, 3)
+    seq <- letters[(letters >= first_char) & (letters <= second_char)]
+
+    if(any(grepl(pub_char, seq, fixed = TRUE))) {
+      return(dir_name)
+    }
+  }
+
+  stop(paste("No matching directory found for pub_id:"), pub_id)
+}
+
+
+generate_pub_obj <- function(pub_id, bibtype) {
+  pub_id_quo <- paste("\"", pub_id, "\"", sep = "")
+  bibtype_quo <- paste("\"", bibtype, "\"", sep = "")
+
+  pub_obj <- paste(c(
+    paste(pub_id, "<-", "Publication("),
+    "  citation = RefManageR::BibEntry(",
+    paste("    key = ", pub_id_quo, ",", sep = ""),
+    paste("    bibtype = ", bibtype_quo, ",", sep = ""),
+    paste("    title = ", "<title>", ",", sep = ""),
+    paste("    author = ", "<author>", ",", sep = ""),
+    paste("    year = ", "<year>", ",", sep = ""),
+    "  )",
+    ")"
+  ), collapse = "\n")
+
+  pub_obj
+
+}
+
+generate_fixef_model <- function() {
+  fixef_model <- paste(c(
+    "<model> <- FixedEffectsModel(",
+    "  response = list(",
+    "    <res> = units::as_units(<res_unit>)",
+    "  )",
+    "  covariates = list(",
+    "    <covt_unit1> = units::as_units(<covt_unit>)",
+    "  )",
+    "  parameters = list(",
+    "    <parameters>",
+    "  )",
+    "  predict_fn = function(<covts>) {",
+    "    <predict_fn>",
+    "  }",
+    ")"
+  ), collapse = "\n")
+
+  fixef_model
+}
+
+generate_footer <- function(pub_id, n_fixef_models) {
+  out <- c(
+    paste(pub_id, "%>%")
+  )
+
+  for(i in 1:n_fixef_models) {
+    out <- c(
+      out,
+      paste("  add_model(<model_", i, ">)", sep="")
+    )
+  }
+
+  out
+}
+
+generate_pub <- function(models_dir, pub_id, bibtype, n_fixef_models = 0) {
+  pub_obj <- generate_pub_obj(pub_id, bibtype)
+  text <- c(pub_obj, "")
+
+  if (n_fixef_models > 0) {
+    for (i in 1:n_fixef_models) {
+      text <- c(text, generate_fixef_model(), "")
+    }
+
+    text <- c(text, generate_footer(pub_id, n_fixef_models))
+  }
+
+  pub_dir <- find_pub_dir(pub_id)
+  pub_file_name <- paste(pub_id, ".R", sep = "")
+
+  out_path <- file.path(
+    models_dir, "/publications/", pub_dir, pub_file_name
+  )
+
+  write(text, out_path)
+}

R/params.R

@@ -0,0 +1,52 @@
+#' Load a parameter frame from the models/parameters directory
+#'
+#' This is a convenience function that allows a user to easily load parameter
+#' files from a directory, and is typically used when creating
+#' `FixedEffectsSet`. By default the function will load parameter frames
+#' from an existing `allometric` installation. For the purposes of testing
+#' publication files locally, refer to `set_params_path`.
+#'
+#' @param name The name of the file, excluding the extension
+#' @return A tibble::tbl_df of the parameter data.
+#' @export
+load_parameter_frame <- function(name) {
+  csv_name <- paste(name, ".csv", sep = "")
+  param_search_path <- get_params_path()
+
+  if(param_search_path == "package") {
+    file_path <- system.file(
+      "models-main/parameters", csv_name,
+      package = "allometric"
+    )
+  } else {
+    file_path <- file.path(param_search_path, csv_name)
+  }
+
+  table <- utils::read.csv(file_path, na.strings = "")
+  tibble::as_tibble(table)
+}
+
+#' Set the parameter search path
+#'
+#' The parameter search path is where `allometric` looks for parameter frames.
+#' By default, the package searches the local installation, however it is
+#' useful when testing publication files to search a local directory, which
+#' can be set here.
+#'
+#' @param params_path The file path containing parameter files
+#' @export
+set_params_path <- function(params_path) {
+  params_path <- list(params_path = params_path)
+  rds_path <- file.path(system.file("extdata", package = "allometric"), "params_path.RDS")
+  saveRDS(params_path, rds_path)
+}
+
+#' Get the parameter search path
+#'
+#' @return A string containing the currently set parameter search path
+#' @export
+get_params_path <- function() {
+  rds_path <- file.path(system.file("extdata", package = "allometric"), "params_path.RDS")
+  rds <- readRDS(rds_path)
+  rds$params_path
+}