Merge pull request #838 from nlmixr2/689-digest

Create a rxUi method for digest

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rxode2
-Version: 3.0.3
+Version: 3.0.3.9000
 Title: Facilities for Simulating from ODE-Based Models
 Authors@R: c(
    person("Matthew L.","Fidler", role = c("aut", "cre"), email = "[email protected]", comment=c(ORCID="0000-0001-8538-6691")),

NAMESPACE

@@ -208,6 +208,7 @@ S3method(rxUiGet,dvidLine)
 S3method(rxUiGet,errParams)
 S3method(rxUiGet,etaLhs)
 S3method(rxUiGet,fun)
+S3method(rxUiGet,funPartsDigest)
 S3method(rxUiGet,funPrint)
 S3method(rxUiGet,funTxt)
 S3method(rxUiGet,ini)
@@ -229,6 +230,7 @@ S3method(rxUiGet,mvFromExpression)
 S3method(rxUiGet,omega)
 S3method(rxUiGet,paramsLine)
 S3method(rxUiGet,props)
+S3method(rxUiGet,sha1)
 S3method(rxUiGet,simulationIniModel)
 S3method(rxUiGet,simulationModel)
 S3method(rxUiGet,simulationSigma)

NEWS.md

@@ -1,3 +1,7 @@
+# rxode2 (development version)
+
+- Add stable hashes for rxUi objects (#838, #689)
+
 # rxode2 3.0.3
 
 - Add `logit`/`expit` named expressions, that is `logit(x, high=20)`

R/rxUiGet.R

@@ -366,10 +366,47 @@ rxUiGet.fun <- function(x, ...) {
 }
 attr(rxUiGet.fun, "desc") <- "Normalized model function"
 
+#' @export
+#' @rdname rxUiGet
+rxUiGet.funPartsDigest <- function(x, ...) {
+  .ui <- x[[1]]
+  rxSyncOptions()
+  list(
+    normModel = .ui$mv0$model["normModel"],
+    iniDf = .ui$iniDf,
+    errLinesI = .ui$predDf$line,
+    errLines = vapply(.ui$predDf$line, function(l) {
+      deparse1(.ui$lstExpr[[l]])
+    }, character(1), USE.NAMES=FALSE),
+    # Now get environment specific differences in the model
+    # This changes how models can be expressed (and their output)
+    allow.ini=rxode2.syntax.allow.ini,
+    # Defined lower level functions and udf functions
+    definedFuns=  ls(.udfEnv$symengineFs, all.names=TRUE),
+    # Defined rxUdfUi methods
+    uiFuns=as.character(utils::methods("rxUdfUi")),
+    # Add version of rxode2
+    rxVersion=rxode2::rxVersion()
+  )
+}
+
 #' @export
 #' @rdname rxUiGet
 rxUiGet.md5 <- function(x, ...) {
-  digest::digest(rxUiGet.funPrint(x, ...))
+  digest::digest(rxUiGet.funPartsDigest(x, ...), algo="md5")
+}
+attr(rxUiGet.md5, "desc") <- "MD5 hash of the UI model"
+
+#' @export
+#' @rdname rxUiGet
+rxUiGet.sha1 <- function(x, ...) {
+  digest::digest(rxUiGet.funPartsDigest(x, ...), algo="sha1")
+}
+attr(rxUiGet.sha1, "desc") <- "SHA1 hash of the UI model"
+
+sha1.rxUi <- function(x, digits = 14L, zapsmall = 7L, ..., algo = "sha1")  {
+  digest::sha1(rxUiGet.funPartsDigest(list(x)),
+               digits=digits, zapsmall=zapsmall, ..., algo=algo)
 }
 
 #' @export

R/rxode-options.R

@@ -50,7 +50,6 @@
     .s3register("dplyr::rename", "rxUi")
     .s3register("dplyr::rename", "function")
   }
-
   if (requireNamespace("nlme", quietly=TRUE)) {
     .s3register("nlme::fixef", "rxUi")
     .s3register("nlme::fixef", "function")
@@ -65,6 +64,9 @@
   } else {
     assignInMyNamespace(".hasUnits", FALSE)
   }
+  if (requireNamespace("digest", quietly = TRUE)) {
+    .s3register("digest::sha1", "rxUi")
+  }
   backports::import(pkgname)
   ## Setup rxode2.prefer.tbl
   .Call(`_rxode2_setRstudio`, Sys.getenv("RSTUDIO") == "1")