Add saveObject function

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: jmpost
 Title: Joint Models for Predicting Overall Survival Trajectories
-Version: 0.0.1
+Version: 0.0.1.9000
 Authors@R: c(
     person("Craig", "Gower-Page", email = "craig.gower-page@roche.com", role = c("aut", "cre")),
     person("Francois", "Mercier", email = "francois.mercier@roche.com", role = "aut"),

NAMESPACE

@@ -162,6 +162,7 @@ S3method(sampleSubjects,SimLongitudinalGSF)
 S3method(sampleSubjects,SimLongitudinalRandomSlope)
 S3method(sampleSubjects,SimLongitudinalSteinFojo)
 S3method(sampleSubjects,SimSurvival)
+S3method(saveObject,JointModelSamples)
 S3method(set_limits,Prior)
 S3method(size,Parameter)
 S3method(size,ParameterList)
@@ -255,6 +256,7 @@ export(resolvePromise)
 export(sampleObservations)
 export(sampleStanModel)
 export(sampleSubjects)
+export(saveObject)
 export(set_limits)
 export(show)
 export(write_stan)

NEWS.md

@@ -1,3 +1,14 @@
+
+# jmpost (development version)
+
+- Introduced the `saveObject()` method for `JointModelSample` objects in order to serialise them to disk (#431).
+- Added support for truncated prior distributions e.g. you can now apply a normal prior to a strictly positive parameter and jmpost will take care of adjusting the density accordingly (#429).
+- Included new Gamma distribution survival model (#411).
+- Reworked LOO calculations to apply to each individual submodel and disabled LOO calculations for the overall joint model (#402).
+- Added support for additive variance (#403).
+- Added support for independent variances per study/arm (#389).
+- Miscellaneous bug fixes.
+
 # jmpost 0.0.1
 
 - Initial Release

R/JointModelSamples.R

@@ -144,3 +144,26 @@ setMethod(
 as.CmdStanMCMC.JointModelSamples <- function(object, ...) {
     return(object@results)
 }
+
+
+#' Save a `JointModelSamples` object to a file.
+#'
+#' This function is just a wrapper around `saveRDS` that saves the object to a file
+#' ensuring that all of the Stan samples are correctly stored. Note that as
+#' `cmdstanr` objects store their samples as a csv file the samples may be lost
+#' if you call `saveRDS` directly on the object.
+#'
+#' @param object ([`JointModelSamples`])\cr the object to save.
+#' @param file (`character`)\cr the file to save the object to.
+#' @param ... (`ANY`)\cr additional arguments to [`saveRDS`].
+#'
+#' @family saveObject
+#'
+#' @export
+saveObject.JointModelSamples <- function(object, file, ...) {
+    object@results$draws()
+    try(object@results$sampler_diagnostics(), silent = TRUE)
+    try(object@results$init(), silent = TRUE)
+    try(object@results$profiles(), silent = TRUE)
+    saveRDS(object, file, ...)
+}

R/generics.R

@@ -471,3 +471,17 @@ as_formula.default <- function(x, ...) {
 set_limits <- function(object, lower = -Inf, upper = Inf) {
     UseMethod("set_limits")
 }
+
+
+
+#' Save Object to File
+#'
+#' @param object (`ANY`) \cr object to save.
+#' @param file (`character`) \cr file to save object to.
+#' @param ... (`ANY`) \cr additional arguments.
+#'
+#' @family saveObject
+#' @export
+saveObject <- function(object, file, ...) {
+    UseMethod("saveObject")
+}

_pkgdown.yml

@@ -168,6 +168,8 @@ reference:
       - as.list.StanModule
       - as.list.Link
       - as.list.LinkComponent
+      - saveObject
+      - saveObject.JointModelSamples
       - length.Link
       - subset.DataJoint
       - extractVariableNames.DataLongitudinal

design/examples/quantity_plots.R

@@ -3,6 +3,7 @@ library(jmpost)
 library(dplyr)
 library(ggplot2)
 library(tidyr)
+library(cmdstanr)
 
 
 ############################

inst/WORDLIST

@@ -142,3 +142,7 @@ du
 int
 pk
 LogitNormal
+csv
+saveObject
+submodel
+serialise

tests/testthat/test-JointModelSamples.R

@@ -6,3 +6,30 @@ test_that("print works as expected for JointModelSamples", {
         print(test_data_1$jsamples)
     })
 })
+
+
+
+test_that("saving and restoring samples from disk works as expected", {
+    samps <- test_data_1$jsamples
+
+    tfile <- tempfile(fileext = ".Rds")
+    saveObject(samps, file = tfile)
+
+    samps2 <- readRDS(tfile)
+
+    # Can't compare entire object as some components contain formulas
+    # whose environment component will be different no matter what
+    expect_equal(
+        samps@data@survival@data,
+        samps2@data@survival@data
+    )
+    expect_equal(
+        samps@data@longitudinal@data,
+        samps2@data@longitudinal@data
+    )
+    # Key bit is that the retieved samples are identical
+    expect_equal(
+        posterior::as_draws_df(samps@results),
+        posterior::as_draws_df(samps2@results)
+    )
+})