Merge pull request #56 from nlmixr2/fix-52

switch extract_eq to knit_print

DESCRIPTION

@@ -31,9 +31,9 @@ Imports:
     crayon,
     data.table,
     digest,
-    equatiomatic,
     ggplot2,
     ggtext,
+    knitr,
     lotri,
     methods,
     nlme,
@@ -45,7 +45,6 @@ Imports:
     utils
 Suggests: 
     brms,
-    knitr,
     nlmixr2data,
     testthat (>= 3.0.0),
     withr,

NAMESPACE

@@ -1,8 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(bootplot,nlmixr2FitCore)
-S3method(extract_eq,nlmixr2FitCore)
-S3method(extract_eq,rxUi)
+S3method(knit_print,nlmixr2FitCore)
+S3method(knit_print,rxUi)
 S3method(print,nlmixr2BoostrapSummary)
 export(adaptivelassoCoefficients)
 export(addCatCovariates)
@@ -14,11 +14,11 @@ export(bootstrapFit)
 export(buildcovInfo)
 export(buildupatedUI)
 export(covarSearchAuto)
-export(extract_eq)
 export(foldgen)
 export(forwardSearch)
 export(horseshoeSummardf)
 export(ini)
+export(knit_print)
 export(lassoCoefficients)
 export(lassoSummardf)
 export(model)
@@ -32,8 +32,8 @@ export(regularmodel)
 import(lotri)
 import(utils)
 importFrom(Rcpp,evalCpp)
-importFrom(equatiomatic,extract_eq)
 importFrom(ggplot2,.data)
+importFrom(knitr,knit_print)
 importFrom(nlmixr2est,nlmixr)
 importFrom(nlmixr2est,nlmixr2)
 importFrom(nlmixr2est,nlmixrWithTiming)

NEWS.md

@@ -1,7 +1,7 @@
 # nlmixr2extra 2.0.9
 
-* New function `extract_eq()` will generate model equations for LaTeX reporting
-  automatically.
+* New method for `knit_print()` will generate model equations for LaTeX
+  reporting automatically.
 
 # nlmixr2extra 2.0.8
 

R/extract_eq.R → R/knit_printEquation.R

@@ -1,90 +1,34 @@
-#' @importFrom equatiomatic extract_eq
+#' @importFrom knitr knit_print
 #' @export
-equatiomatic::extract_eq
+knitr::knit_print
 
 #' Extract the equations from an nlmixr2/rxode2 model to produce a 'LaTeX'
 #' equation.
 #'
-#' @param model The model to extract equations from
-#' @param intercept,greek,greek_colors,subscript_colors,var_colors,var_subscript_colors,raw_tex,swap_var_names,swap_subscript_names,ital_vars,label,index_factors,show_distribution,wrap,terms_per_line,operator_location,align_env,use_coefs,coef_digits,fix_signs,font_size,mean_separate,return_variances,se_subscripts Ignored
+#' @param x The model to extract equations from
+#' @param ... Ignored
+#' @param output The type of output to request (currently, just "equations")
 #' @export
-extract_eq.nlmixr2FitCore <- function(model, intercept = "alpha", greek = "beta",
-                                      greek_colors = NULL, subscript_colors = NULL,
-                                      var_colors = NULL, var_subscript_colors = NULL,
-                                      raw_tex = FALSE,
-                                      swap_var_names = NULL, swap_subscript_names = NULL,
-                                      ital_vars = FALSE, label = NULL,
-                                      index_factors = FALSE, show_distribution = FALSE,
-                                      wrap = FALSE, terms_per_line = 4,
-                                      operator_location = "end", align_env = "aligned",
-                                      use_coefs = FALSE, coef_digits = 2,
-                                      fix_signs = TRUE, font_size = NULL,
-                                      mean_separate, return_variances = FALSE,
-                                      se_subscripts = FALSE, ...) {
-  stopifnot(identical(intercept, "alpha"))
-  stopifnot(identical(greek, "beta"))
-  stopifnot(is.null(greek_colors))
-  stopifnot(is.null(subscript_colors))
-  stopifnot(is.null(var_colors))
-  stopifnot(is.null(var_subscript_colors))
-  stopifnot(identical(raw_tex, FALSE))
-  stopifnot(is.null(swap_var_names))
-  stopifnot(is.null(swap_subscript_names))
-  stopifnot(identical(ital_vars, FALSE))
-  stopifnot(is.null(label))
-  stopifnot(identical(index_factors, FALSE))
-  stopifnot(identical(show_distribution, FALSE))
-  stopifnot(identical(wrap, FALSE))
-  stopifnot(identical(terms_per_line, 4))
-  stopifnot(identical(operator_location, "end"))
-  stopifnot(identical(align_env, "aligned"))
-  stopifnot(identical(use_coefs, FALSE))
-  stopifnot(identical(coef_digits, 2))
-  stopifnot(identical(fix_signs, TRUE))
-  stopifnot(is.null(font_size))
-  stopifnot(missing(mean_separate))
-  stopifnot(identical(return_variances, FALSE))
-  stopifnot(identical(se_subscripts, FALSE))
-  ret <-
-    paste0(
-      "\\begin{align*}\n",
-      paste(
-        extractEqHelper(x = model, ...),
-        collapse = " \\\\\n"
-      ),
-      "\n\\end{align*}\n"
-    )
+knit_print.nlmixr2FitCore <- function(x,  ..., output = "equations") {
+  output <- match.arg(output)
+  if ("equations" %in% output) {
+    ret <-
+      paste0(
+        "\\begin{align*}\n",
+        paste(
+          extractEqHelper(x = x, ...),
+          collapse = " \\\\\n"
+        ),
+        "\n\\end{align*}\n"
+      )
+  }
   knitr::asis_output(ret)
 }
 
-#' @rdname extract_eq.nlmixr2FitCore
+#' @rdname knit_print.nlmixr2FitCore
 #' @export
-extract_eq.rxUi <- function(model, intercept = "alpha", greek = "beta",
-                            greek_colors = NULL, subscript_colors = NULL,
-                            var_colors = NULL, var_subscript_colors = NULL,
-                            raw_tex = FALSE,
-                            swap_var_names = NULL, swap_subscript_names = NULL,
-                            ital_vars = FALSE, label = NULL,
-                            index_factors = FALSE, show_distribution = FALSE,
-                            wrap = FALSE, terms_per_line = 4,
-                            operator_location = "end", align_env = "aligned",
-                            use_coefs = FALSE, coef_digits = 2,
-                            fix_signs = TRUE, font_size = NULL,
-                            mean_separate, return_variances = FALSE,
-                            se_subscripts = FALSE, ...) {
-  extract_eq.nlmixr2FitCore(model, intercept = intercept, greek = greek,
-                            greek_colors = greek_colors, subscript_colors = subscript_colors,
-                            var_colors = var_colors, var_subscript_colors = var_colors,
-                            raw_tex = raw_tex,
-                            swap_var_names = swap_var_names, swap_subscript_names = swap_subscript_names,
-                            ital_vars = ital_vars, label = label,
-                            index_factors = index_factors, show_distribution = show_distribution,
-                            wrap = wrap, terms_per_line = terms_per_line,
-                            operator_location = operator_location, align_env = align_env,
-                            use_coefs = use_coefs, coef_digits = coef_digits,
-                            fix_signs = fix_signs, font_size = font_size,
-                            mean_separate = mean_separate, return_variances = return_variances,
-                            se_subscripts = se_subscripts, ...)
+knit_print.rxUi <- function(x, ...) {
+  knit_print.nlmixr2FitCore(x, ...)
 }
 
 extractEqHelper <- function(x, ..., inModel) {

tests/testthat/test-extract_eq.R → tests/testthat/test-knit_printEquation.R

@@ -1,4 +1,4 @@
-test_that("extract_eq, simple version", {
+test_that("knit_print, simple version", {
   mod <- function() {
     ini({
       lka <- 0.45
@@ -17,20 +17,20 @@ test_that("extract_eq, simple version", {
   }
   ui <- rxode2::rxode(mod)
   expect_equal(
-    extract_eq(ui),
+    knit_print(ui),
     knitr::asis_output("\\begin{align*}\nka & = \\exp\\left(lka\\right) \\\\\ncl & = \\exp\\left(lcl\\right) \\\\\nvc & = \\exp\\left(lvc\\right) \\\\\ncp & = linCmt() \\\\\ncp & \\sim prop(propSd)\n\\end{align*}\n")
   )
 
   suppressMessages(
     fit <- nlmixr2est::nlmixr(mod, data = nlmixr2data::theo_sd, est = "focei", control = nlmixr2est::foceiControl(eval.max = 1, print = 0))
   )
   expect_equal(
-    extract_eq(fit),
+    knit_print(fit),
     knitr::asis_output("\\begin{align*}\nka & = \\exp\\left(lka\\right) \\\\\ncl & = \\exp\\left(lcl\\right) \\\\\nvc & = \\exp\\left(lvc\\right) \\\\\ncp & = linCmt() \\\\\ncp & \\sim prop(propSd)\n\\end{align*}\n")
   )
 })
 
-test_that("extract_eq, less common models", {
+test_that("knit_print, less common models", {
   mod <- function() {
     ini({
       lka <- 0.45
@@ -65,12 +65,12 @@ test_that("extract_eq, less common models", {
   }
   ui <- rxode2::rxode(mod)
   expect_equal(
-    extract_eq(ui),
+    knit_print(ui),
     knitr::asis_output("\\begin{align*}\nka & = \\exp\\left(lka\\right)<1 \\\\\ncl & = \\exp\\left(lcl\\right)\\leq2 \\\\\nvc & = \\exp\\left(lvc\\right)\\equiv3 \\\\\nvc4 & = vc\\geq4 \\\\\nvc5 & = vc>5 \\\\\nvc6 & = vc\\land6 \\\\\nvc7 & = vc\\land7 \\\\\nvc8 & = vc\\lor8 \\\\\nvc9 & = vc\\lor9 \\\\\nvc10 & = vc\\ne10 \\\\\nvc11 & = \\lnot vc \\\\\n\\mathrm{if} & \\left(vc>11\\right) \\{ \\\\\n & cl  = 12 \\\\\n\\}  \\quad & \\mathrm{else} \\: \\mathrm{if}  \\left(vc>13\\right) \\{ \\\\\n & cl  = 14 \\\\\n & cl  = 15 \\\\\n\\}  \\quad & \\mathrm{else} \\: cl  = 16 \\\\\ncp & = linCmt() \\\\\ncp & \\sim c(p0=0, p1=1, p2=2, 3)\n\\end{align*}\n")
   )
 })
 
-test_that("extract_eq, model with 'if' and a character string", {
+test_that("knit_print, model with 'if' and a character string", {
   mod <- function() {
     ini({
       lka <- 0.45
@@ -94,7 +94,7 @@ test_that("extract_eq, model with 'if' and a character string", {
   }
   ui <- rxode2::rxode(mod)
   expect_equal(
-    extract_eq(ui),
+    knit_print(ui),
     knitr::asis_output("\\begin{align*}\nka & = \\exp\\left(lka\\right)<1 \\\\\ncl & = \\exp\\left(lcl\\right)\\leq2 \\\\\nvc & = \\exp\\left(lvc\\right)\\equiv3 \\\\\n\\mathrm{if} & \\left(vc\\equiv\\text{\"a\"}\\right) \\{ \\\\\n & cl  = 12 \\\\\n\\}  \\quad & \\mathrm{else} \\: cl  = 16 \\\\\ncp & = linCmt() \\\\\ncp & \\sim c(p0=0, p1=1, p2=2, 3)\n\\end{align*}\n")
   )
 })