R/sim_s3.R

In ldmppr: Estimate and Simulate from Location Dependent Marked Point Processes

#' Simulated marked point process object
#'
#' \code{ldmppr_sim} objects are returned by \code{\link{simulate_mpp}}. They contain the simulated
#' realization, an associated marked point pattern object, and metadata used to
#' reproduce or inspect the simulation.
#'
#' @details
#' An \code{ldmppr_sim} is a list with at least:
#' \itemize{
#'   \item \code{process}: process name (e.g. \code{"self_correcting"})
#'   \item \code{mpp}: a marked point pattern object
#'   \item \code{realization}: data.frame with columns \code{time}, \code{x}, \code{y}, \code{marks}
#'   \item \code{params}, \code{bounds}, and other metadata
#' }
#'
#' @return For methods:
#' \describe{
#'   \item{\code{print()}}{prints a summary of the simulation.}
#'   \item{\code{summary()}}{returns a \code{summary.ldmppr_sim} object.}
#'   \item{\code{plot()}}{returns a ggplot visualization of the marked point pattern.}
#'   \item{\code{as.data.frame()}}{returns the simulated realization as a data.frame.}
#'   \item{\code{nobs()}}{returns the number of points in the realization.}
#'   \item{\code{mpp()}}{returns the marked point pattern object.}
#' }
#'
#' @name ldmppr_sim
#' @rdname ldmppr_sim
#' @docType class
NULL


#' @describeIn ldmppr_sim Print a brief summary of the simulation.
#' @param x a \code{ldmppr_sim} object.
#' @param ... additional arguments (not used).
#' @export
print.ldmppr_sim <- function(x, ...) {
  n <- if (is.data.frame(x$realization)) nrow(x$realization) else NA_integer_
  cat("ldmppr Simulation\n")
  .cat_wrapped_field("  process:          ", x$process %||% NA_character_)
  cat("  n_points:         ", n, "\n", sep = "")
  cat("  thinning:         ", x$thinning %||% NA, "\n", sep = "")
  .cat_wrapped_field("  edge_correction:  ", x$edge_correction %||% NA_character_)
  if (!is.null(x$bounds$t_min) && !is.null(x$bounds$t_max)) {
    .cat_wrapped_field("  time_bounds:      ", paste0("[", x$bounds$t_min, ", ", x$bounds$t_max, "]"))
  }
  if (!is.null(x$bounds$xy_bounds)) {
    .cat_wrapped_field("  xy_bounds:        ", paste0("[", paste(x$bounds$xy_bounds, collapse = ", "), "]"))
  }
  invisible(x)
}

#' @describeIn ldmppr_sim Summarize a simulated realization.
#' @param object a \code{ldmppr_sim} object.
#' @param ... additional arguments (not used).
#' @export
summary.ldmppr_sim <- function(object, ...) {
  r <- object$realization
  marks <- if (is.data.frame(r) && "marks" %in% names(r)) as.numeric(r$marks) else numeric(0)
  times <- if (is.data.frame(r) && "time" %in% names(r)) as.numeric(r$time) else numeric(0)

  out <- list(
    process = object$process,
    n_points = if (is.data.frame(r)) nrow(r) else NA_integer_,
    mark_range = if (length(marks)) range(marks, na.rm = TRUE) else c(NA_real_, NA_real_),
    time_range = if (length(times)) range(times, na.rm = TRUE) else c(NA_real_, NA_real_),
    thinning = object$thinning,
    edge_correction = object$edge_correction,
    bounds = object$bounds
  )
  class(out) <- "summary.ldmppr_sim"
  out
}

#' @describeIn ldmppr_sim Print a summary produced by \code{\link{summary.ldmppr_sim}}.
#' @param x an object of class \code{summary.ldmppr_sim}.
#' @param ... additional arguments (not used).
#' @export
print.summary.ldmppr_sim <- function(x, ...) {
  cat("Summary: ldmppr Simulation\n")
  .cat_wrapped_field("  process:          ", x$process %||% NA_character_)
  cat("  n_points:         ", x$n_points %||% NA_integer_, "\n", sep = "")
  .cat_wrapped_field("  mark_range:       ", paste0("[", paste(signif(x$mark_range, 6), collapse = ", "), "]"))
  .cat_wrapped_field("  time_range:       ", paste0("[", paste(signif(x$time_range, 6), collapse = ", "), "]"))
  cat("  thinning:         ", x$thinning %||% NA, "\n", sep = "")
  .cat_wrapped_field("  edge_correction:  ", x$edge_correction %||% NA_character_)
  if (!is.null(x$bounds$xy_bounds)) {
    .cat_wrapped_field("  xy_bounds:        ", paste0("[", paste(x$bounds$xy_bounds, collapse = ", "), "]"))
  }
  invisible(x)
}

#' @describeIn ldmppr_sim Coerce to a data.frame of the simulated realization.
#' @param x a \code{ldmppr_sim} object.
#' @param ... additional arguments (not used).
#' @export
as.data.frame.ldmppr_sim <- function(x, ...) {
  x$realization
}

#' @describeIn ldmppr_sim Number of simulated points.
#' @importFrom stats nobs
#' @param object a \code{ldmppr_sim} object.
#' @param ... additional arguments (not used).
#' @export
nobs.ldmppr_sim <- function(object, ...) {
  nrow(object$realization)
}

#' @describeIn ldmppr_sim Plot the simulated marked point pattern.
#' @param x a \code{ldmppr_sim} object.
#' @param pattern_type type of pattern to plot \code{"simulated"} (default).
#' @param ... additional arguments passed to \code{plot_mpp}.
#' @export
plot.ldmppr_sim <- function(x, pattern_type = "simulated", ...) {
  plot_mpp(x$mpp, pattern_type = pattern_type, ...)
}

#' @describeIn ldmppr_sim Extract the underlying marked point pattern object.
#' @param x a \code{ldmppr_sim} object.
#' @param ... additional arguments (not used).
#' @export
mpp.ldmppr_sim <- function(x, ...) x$mpp