From c8a2a56677b300966dfdf5425a0513b3b4537d8b Mon Sep 17 00:00:00 2001
From: Rich FitzJohn <r.fitzjohn@imperial.ac.uk>
Date: Fri, 25 Oct 2024 21:02:41 +0100
Subject: [PATCH] Use in print methods

---
 NAMESPACE     |  2 ++
 R/interface.R | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+)

diff --git a/NAMESPACE b/NAMESPACE
index e685b30b..72b404d8 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(coef,dust_system)
+S3method(coef,dust_system_generator)
 S3method(dim,dust_system)
 S3method(print,dust_likelihood)
 S3method(print,dust_system)
diff --git a/R/interface.R b/R/interface.R
index 97609b52..c3d9af7c 100644
--- a/R/interface.R
+++ b/R/interface.R
@@ -88,6 +88,11 @@ dust_system_create <- function(generator, pars, n_particles = 1, n_groups = 1,
   res <- methods$alloc(pars, time, time_control, n_particles,
                        n_groups, seed, deterministic, n_threads)
 
+  parameters <- coef(generator)
+  if (!is.null(parameters$constant)) {
+    parameters <- parameters[!parameters$constant, ]
+  }
+
   ## Here, we augment things slightly
   res$name <- attr(generator, "name")
   res$packer_state <- monty::monty_packer(array = res$packing_state)
@@ -101,6 +106,7 @@ dust_system_create <- function(generator, pars, n_particles = 1, n_groups = 1,
   res$deterministic <- deterministic
   res$methods <- methods
   res$properties <- attr(generator, "properties")
+  res$parameters <- parameters
   res$preserve_particle_dimension <- preserve_particle_dimension
   res$preserve_group_dimension <- preserve_group_dimension
   res$time_control <- time_control
@@ -549,6 +555,15 @@ print.dust_system <- function(x, ...) {
     cli::cli_bullets(c(
       i = "This system runs in continuous time"))
   }
+  n_pars <- NROW(x$parameters)
+  cli::cli_alert_info(paste(
+    "This system has {cli::no(n_pars)} parameter{?s} that can",
+    "be updated via {.run dust_system_update_pars}"))
+  if (n_pars > 0) {
+    cli::cli_bullets(c(">" = "{squote(x$parameters$name)}"))
+  }
+  cli::cli_alert_info(
+    "Use 'coef()' to get more information on parameters")
   invisible(x)
 }
 
@@ -558,6 +573,7 @@ print.dust_system_generator <- function(x, ...) {
   name <- attr(x, "name")
   properties <- attr(x, "properties")
   default_dt <- attr(x, "default_dt")
+  parameters <- attr(x, "parameters")$name
   cli::cli_h1("<dust_system_generator: {name}>")
   cli::cli_alert_info(
     "Use 'dust2::dust_system_create()' to create a system with this generator")
@@ -583,9 +599,22 @@ print.dust_system_generator <- function(x, ...) {
     cli::cli_bullets(c(
       i = "This system runs in continuous time"))
   }
+  n_pars <- length(parameters)
+  cli::cli_alert_info("This system has {cli::no(n_pars)} parameter{?s}")
+  if (n_pars > 0) {
+    cli::cli_bullets(c(">" = "{squote(parameters)}"))
+  }
+  cli::cli_alert_info(
+    "Use 'coef()' to get more information on parameters")
+
   invisible(x)
 }
 
+##' @export
+coef.dust_system_generator <- function(object, ...) {
+  attr(object, "parameters")
+}
+
 
 ##' @export
 dim.dust_system <- function(x, ...) {
@@ -594,6 +623,11 @@ dim.dust_system <- function(x, ...) {
     if (x$preserve_group_dimension) x$n_groups)
 }
 
+##' @export
+coef.dust_system <- function(x, ...) {
+  x$parameters
+}
+
 
 check_is_dust_system_generator <- function(generator, called_as,
                                            call = parent.frame()) {