From 2ef911fa6d9d1eb2f0b51845be5de75cacc1e2dc Mon Sep 17 00:00:00 2001 From: Aman Raj Date: Sun, 2 Aug 2026 03:37:44 +0530 Subject: [PATCH 1/3] feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs Introduces `R/edm.R` with fully documented roxygen2 skeletons for the primary user-facing EDM functions. - `fit_edm()`: high-level wrapper for configuring and fitting Simplex, S-Map, and GP-EDM models using a `FIMSFrame` and delay embedding configuration. - `edm_forecast()`: high-level interface for generating empirical forecasts from a fitted `EDMFit` object. Both functions include complete parameter documentation, `@seealso` cross-references, and example usage to establish the public R API. --- NAMESPACE | 2 + R/edm.R | 99 +++++++++++++++++++++++++++++++++++++ man/create_edm_embedding.Rd | 12 +++++ man/edm_forecast.Rd | 37 ++++++++++++++ man/fit_edm.Rd | 72 +++++++++++++++++++++++++++ 5 files changed, 222 insertions(+) create mode 100644 R/edm.R create mode 100644 man/edm_forecast.Rd create mode 100644 man/fit_edm.Rd diff --git a/NAMESPACE b/NAMESPACE index e1c1c2b2d..1f3bfc453 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,8 @@ export(clear) export(create_default_configurations) export(create_default_parameters) export(create_edm_embedding) +export(edm_forecast) +export(fit_edm) export(fit_fims) export(get_ages) export(get_data) diff --git a/R/edm.R b/R/edm.R new file mode 100644 index 000000000..4cc7be5cf --- /dev/null +++ b/R/edm.R @@ -0,0 +1,99 @@ +# EDM User-Facing R Interface +# This file contains high-level R wrapper functions for fitting and +# forecasting with Empirical Dynamic Modeling (EDM) methods in FIMS. +# These wrappers simplify interaction with the underlying C++ prediction +# framework implemented in previous phases (#1528, #1561, #1620). + +# fit_edm ---------------------------------------------------------------- + +#' Fit an EDM model to a time series +#' +#' @description +#' High-level interface for fitting an Empirical Dynamic Modeling (EDM) +#' prediction model to a univariate or multivariate time series stored in a +#' `FIMSFrame` object. Supports Simplex Projection, S-Map, and GP-EDM methods. +#' +#' @param data A `FIMSFrame` object containing the time series data. +#' @param method Character string specifying the EDM method to use. One of +#' `"simplex"`, `"smap"`, or `"gp"`. Default is `"simplex"`. +#' @param embedding_name A single string matching one of the named delay +#' embeddings in `data` (created via [create_edm_embedding()]). If `NULL`, +#' uses the first available embedding. +#' @param E Positive integer. Embedding dimension (number of lagged +#' coordinates). Ignored if `embedding_name` is specified. +#' @param tau Positive integer. Time lag between successive coordinates. +#' Ignored if `embedding_name` is specified. +#' @param theta Numeric. Nonlinearity parameter for S-Map. Larger values +#' weight nearby library points more strongly. Only used when +#' `method = "smap"`. Default is `1.0`. +#' @param n_neighbors Positive integer. Number of nearest neighbors for +#' Simplex Projection. Defaults to `E + 1` when set to `0`. +#' Only used when `method = "simplex"`. Default is `0`. +#' @param forecast_horizon Positive integer. Number of steps ahead to forecast. +#' Default is `1`. +#' @param ... Additional arguments passed to the underlying EDM C++ interface. +#' +#' @return An object of class `EDMFit` containing: +#' \describe{ +#' \item{method}{The EDM method used.} +#' \item{predictions}{Numeric vector of one-step-ahead predictions.} +#' \item{embedding}{The `DelayEmbeddingMatrix` used for fitting.} +#' \item{parameters}{List of method-specific hyperparameters.} +#' } +#' +#' @seealso [edm_forecast()], [create_edm_embedding()], [FIMSFrame()] +#' @export +#' @examples +#' \dontrun{ +#' data("data_big") +#' ff <- FIMSFrame(data_big) +#' ff <- create_edm_embedding(ff, type = "landings", fleet = "fishery1", E = 3, tau = 1) +#' fit <- fit_edm(ff, method = "simplex", embedding_name = "fishery1_landings") +#' } +fit_edm <- function(data, + method = c("simplex", "smap", "gp"), + embedding_name = NULL, + E = 3L, + tau = 1L, + theta = 1.0, + n_neighbors = 0L, + forecast_horizon = 1L, + ...) { + method <- match.arg(method) + stopifnot(inherits(data, "FIMSFrame")) + # TODO: Implement method dispatch to C++ EDM interfaces + stop("fit_edm() is not yet implemented. Coming in Phase 4 (GSoC 2026).") +} + +# edm_forecast ----------------------------------------------------------- + +#' Generate forecasts from a fitted EDM model +#' +#' @description +#' Generates out-of-sample empirical forecasts from a fitted `EDMFit` object +#' returned by [fit_edm()]. +#' +#' @param fit An `EDMFit` object returned by [fit_edm()]. +#' @param n_ahead Positive integer. Number of time steps to forecast ahead. +#' Default is `1`. +#' @param ... Additional arguments passed to underlying prediction methods. +#' +#' @return A tibble with columns: +#' \describe{ +#' \item{time}{Forecast time index.} +#' \item{forecast}{Point forecast value.} +#' \item{se}{Standard error of the forecast (if available).} +#' } +#' +#' @seealso [fit_edm()] +#' @export +#' @examples +#' \dontrun{ +#' fit <- fit_edm(ff, method = "smap", embedding_name = "fishery1_landings") +#' forecasts <- edm_forecast(fit, n_ahead = 5) +#' } +edm_forecast <- function(fit, n_ahead = 1L, ...) { + stopifnot(inherits(fit, "EDMFit")) + # TODO: Implement forecast generation from EDMFit object + stop("edm_forecast() is not yet implemented. Coming in Phase 4 (GSoC 2026).") +} diff --git a/man/create_edm_embedding.Rd b/man/create_edm_embedding.Rd index 38bbf997f..a85425be2 100644 --- a/man/create_edm_embedding.Rd +++ b/man/create_edm_embedding.Rd @@ -21,7 +21,11 @@ create_edm_embedding( \item{series_type}{A single string giving the \code{type} value to filter on, e.g. \code{"index"} or \code{"landings"}.} +<<<<<<< HEAD \item{series_name}{A single string giving the \code{fleet} (fleet / survey) value +======= +\item{series_name}{A single string giving the \code{name} (fleet / survey) value +>>>>>>> 5fde931e (feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs) to filter on, e.g. \code{"survey1"}.} \item{E}{A positive integer — the embedding dimension (number of lagged @@ -33,7 +37,11 @@ coordinates per row).} the FIMS missing-value sentinel \code{-999} are dropped from the embedding matrix.} +<<<<<<< HEAD \item{uncertainty_name}{A single string giving the \code{fleet} column value for +======= +\item{uncertainty_name}{A single string giving the \code{name} column value for +>>>>>>> 5fde931e (feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs) an uncertainty series in the data slot (e.g. \code{"survey1_sd"}), or \code{NULL} (default) to skip uncertainty propagation. The uncertainty series must have the same length as the value series after filtering on @@ -55,7 +63,11 @@ stored in the \code{edm_embeddings} slot under \code{embedding_name}. } \details{ The time series is extracted by filtering \code{get_data(x)} on \code{type} and +<<<<<<< HEAD \code{fleet} (fleet / survey name). Values encoded as \code{-999} are treated as the +======= +\code{name} (fleet / survey name). Values encoded as \code{-999} are treated as the +>>>>>>> 5fde931e (feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs) FIMS missing-data sentinel. When \code{drop_missing = TRUE}, \code{construct_drop_missing()} is called so that rows containing \code{-999} are removed from the embedding matrix; when \code{FALSE}, \code{construct()} is called diff --git a/man/edm_forecast.Rd b/man/edm_forecast.Rd new file mode 100644 index 000000000..c43ba7cc5 --- /dev/null +++ b/man/edm_forecast.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/edm.R +\name{edm_forecast} +\alias{edm_forecast} +\title{Generate forecasts from a fitted EDM model} +\usage{ +edm_forecast(fit, n_ahead = 1L, ...) +} +\arguments{ +\item{fit}{An \code{EDMFit} object returned by \code{\link[=fit_edm]{fit_edm()}}.} + +\item{n_ahead}{Positive integer. Number of time steps to forecast ahead. +Default is \code{1}.} + +\item{...}{Additional arguments passed to underlying prediction methods.} +} +\value{ +A tibble with columns: +\describe{ +\item{time}{Forecast time index.} +\item{forecast}{Point forecast value.} +\item{se}{Standard error of the forecast (if available).} +} +} +\description{ +Generates out-of-sample empirical forecasts from a fitted \code{EDMFit} object +returned by \code{\link[=fit_edm]{fit_edm()}}. +} +\examples{ +\dontrun{ +fit <- fit_edm(ff, method = "smap", embedding_name = "fishery1_landings") +forecasts <- edm_forecast(fit, n_ahead = 5) +} +} +\seealso{ +\code{\link[=fit_edm]{fit_edm()}} +} diff --git a/man/fit_edm.Rd b/man/fit_edm.Rd new file mode 100644 index 000000000..f40506cea --- /dev/null +++ b/man/fit_edm.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/edm.R +\name{fit_edm} +\alias{fit_edm} +\title{Fit an EDM model to a time series} +\usage{ +fit_edm( + data, + method = c("simplex", "smap", "gp"), + embedding_name = NULL, + E = 3L, + tau = 1L, + theta = 1, + n_neighbors = 0L, + forecast_horizon = 1L, + ... +) +} +\arguments{ +\item{data}{A \code{FIMSFrame} object containing the time series data.} + +\item{method}{Character string specifying the EDM method to use. One of +\code{"simplex"}, \code{"smap"}, or \code{"gp"}. Default is \code{"simplex"}.} + +\item{embedding_name}{A single string matching one of the named delay +embeddings in \code{data} (created via \code{\link[=create_edm_embedding]{create_edm_embedding()}}). If \code{NULL}, +uses the first available embedding.} + +\item{E}{Positive integer. Embedding dimension (number of lagged +coordinates). Ignored if \code{embedding_name} is specified.} + +\item{tau}{Positive integer. Time lag between successive coordinates. +Ignored if \code{embedding_name} is specified.} + +\item{theta}{Numeric. Nonlinearity parameter for S-Map. Larger values +weight nearby library points more strongly. Only used when +\code{method = "smap"}. Default is \code{1.0}.} + +\item{n_neighbors}{Positive integer. Number of nearest neighbors for +Simplex Projection. Defaults to \code{E + 1} when set to \code{0}. +Only used when \code{method = "simplex"}. Default is \code{0}.} + +\item{forecast_horizon}{Positive integer. Number of steps ahead to forecast. +Default is \code{1}.} + +\item{...}{Additional arguments passed to the underlying EDM C++ interface.} +} +\value{ +An object of class \code{EDMFit} containing: +\describe{ +\item{method}{The EDM method used.} +\item{predictions}{Numeric vector of one-step-ahead predictions.} +\item{embedding}{The \code{DelayEmbeddingMatrix} used for fitting.} +\item{parameters}{List of method-specific hyperparameters.} +} +} +\description{ +High-level interface for fitting an Empirical Dynamic Modeling (EDM) +prediction model to a univariate or multivariate time series stored in a +\code{FIMSFrame} object. Supports Simplex Projection, S-Map, and GP-EDM methods. +} +\examples{ +\dontrun{ +data("data_big") +ff <- FIMSFrame(data_big) +ff <- create_edm_embedding(ff, type = "landings", fleet = "fishery1", E = 3, tau = 1) +fit <- fit_edm(ff, method = "simplex", embedding_name = "fishery1_landings") +} +} +\seealso{ +\code{\link[=edm_forecast]{edm_forecast()}}, \code{\link[=create_edm_embedding]{create_edm_embedding()}}, \code{\link[=FIMSFrame]{FIMSFrame()}} +} From 99b1b44b64197adcd33aa9fe40c38b4bf333292c Mon Sep 17 00:00:00 2001 From: Aman Raj Date: Sat, 8 Aug 2026 00:05:42 +0530 Subject: [PATCH 2/3] feat(edm): add EDMFit S4 class with validity checks, show/print, and get_* accessors Introduces the EDMFit S4 return class for fit_edm() with slot accessors and validity checks following FIMS standards. --- NAMESPACE | 6 + R/edm.R | 263 +++++++++++++++++++++++++++++++++--- man/EDMFit-class.Rd | 46 +++++++ man/create_edm_embedding.Rd | 12 -- man/edm_forecast.Rd | 8 +- man/fit_edm.Rd | 12 +- man/get_EDMFit.Rd | 54 ++++++++ man/is.EDMFit.Rd | 18 +++ 8 files changed, 377 insertions(+), 42 deletions(-) create mode 100644 man/EDMFit-class.Rd create mode 100644 man/get_EDMFit.Rd create mode 100644 man/is.EDMFit.Rd diff --git a/NAMESPACE b/NAMESPACE index 1f3bfc453..91c829e4a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,7 @@ export(fit_fims) export(get_ages) export(get_data) export(get_edm_embeddings) +export(get_embedding_name) export(get_end_year) export(get_estimates) export(get_fit_metrics) @@ -53,6 +54,7 @@ export(get_log) export(get_log_errors) export(get_log_warnings) export(get_max_gradient) +export(get_method) export(get_model_output) export(get_n_ages) export(get_n_fleets) @@ -62,6 +64,8 @@ export(get_number_of_parameters) export(get_obj) export(get_opt) export(get_parameter_names) +export(get_parameters) +export(get_predictions) export(get_random) export(get_random_names) export(get_report) @@ -75,6 +79,7 @@ export(initialize_fims) export(initialize_process_distribution) export(initialize_process_structure) export(inv_logit) +export(is.EDMFit) export(is.FIMSFit) export(log_error) export(log_info) @@ -93,6 +98,7 @@ export(set_fixed) export(set_log_throw_on_error) export(set_random) export(tidy) +exportClasses(EDMFit) exportMethods(Math) exportMethods(Ops) exportMethods(Summary) diff --git a/R/edm.R b/R/edm.R index 4cc7be5cf..916a42b64 100644 --- a/R/edm.R +++ b/R/edm.R @@ -1,9 +1,240 @@ # EDM User-Facing R Interface -# This file contains high-level R wrapper functions for fitting and -# forecasting with Empirical Dynamic Modeling (EDM) methods in FIMS. -# These wrappers simplify interaction with the underlying C++ prediction +# This file defines the EDMFit S4 class and high-level R wrapper functions +# for fitting and forecasting with Empirical Dynamic Modeling (EDM) in FIMS. +# These interfaces simplify interaction with the underlying C++ prediction # framework implemented in previous phases (#1528, #1561, #1620). +# EDMFit S4 class -------------------------------------------------------- + +# methods::setClass: ---- + +# Register S3 classes used as slots (mirrors fimsfit.R pattern) +methods::setOldClass("package_version") + +#' The EDMFit class +#' +#' @description +#' An S4 class storing the results of a fitted Empirical Dynamic Modeling (EDM) +#' model. Objects of this class are returned by [fit_edm()] and are the primary +#' input to [edm_forecast()]. +#' +#' Slots are accessed using `get_*()` accessor functions rather than the `@` +#' operator directly. +#' +#' @slot method Character. The EDM prediction method used. One of +#' `"simplex"`, `"smap"`, or `"gp"`. +#' @slot predictions Numeric vector. In-library (fitted) one-step-ahead +#' predictions for each row of the delay embedding library. +#' @slot embedding_name Character. Name of the delay embedding used, as stored +#' in the source `FIMSFrame`. +#' @slot embedding_dimension Integer. The embedding dimension \eqn{E} used. +#' @slot time_lag Integer. The time lag \eqn{\tau} used. +#' @slot n_library Integer. Number of library points (rows) in the embedding. +#' @slot parameters List. Method-specific hyperparameters: +#' \describe{ +#' \item{simplex}{\code{n_neighbors} — number of nearest neighbours used.} +#' \item{smap}{\code{theta} — nonlinearity weighting parameter.} +#' \item{gp}{\code{phi}, \code{sigma2}, \code{ve} — ARD length-scales, +#' signal variance, and process noise variance.} +#' } +#' @slot version A \code{package_version}. The version of FIMS used. +#' +#' @seealso [fit_edm()], [edm_forecast()], [get_EDMFit] +#' @export +methods::setClass( + Class = "EDMFit", + slots = c( + method = "character", + predictions = "numeric", + embedding_name = "character", + embedding_dimension = "integer", + time_lag = "integer", + n_library = "integer", + parameters = "list", + version = "package_version" + ) +) + +# methods::setValidity: ---- + +methods::setValidity("EDMFit", function(object) { + errors <- character(0) + + valid_methods <- c("simplex", "smap", "gp") + if (!object@method %in% valid_methods) { + errors <- c( + errors, + paste0( + "Invalid method '", object@method, "'. ", + "Must be one of: ", paste(valid_methods, collapse = ", "), "." + ) + ) + } + + if (length(object@predictions) == 0) { + errors <- c(errors, "predictions slot must not be empty.") + } + + if (object@embedding_dimension < 1L) { + errors <- c(errors, "embedding_dimension must be >= 1.") + } + + if (object@time_lag < 1L) { + errors <- c(errors, "time_lag must be >= 1.") + } + + if (object@n_library < 2L) { + errors <- c(errors, "n_library must be >= 2.") + } + + if (length(errors) == 0) TRUE else errors +}) + +# methods::setMethod: show ---- + +methods::setMethod( + f = "show", + signature = "EDMFit", + definition = function(object) { + cli::cli_inform(c( + "i" = "An {.cls EDMFit} object (FIMS v.{object@version})", + "i" = "Access slots with {.fn get_*} functions, e.g.,", + "*" = "{.fn get_method}", + "*" = "{.fn get_predictions}", + "*" = "{.fn get_parameters}", + "i" = "Use {.fn print} for a formatted summary." + )) + } +) + +# methods::setMethod: print ---- + +methods::setMethod( + f = "print", + signature = "EDMFit", + definition = function(x, ...) { + n_pred <- length(x@predictions) + rho <- if (n_pred > 1) { + stats::cor( + x@predictions[-n_pred], + x@predictions[-1], + use = "complete.obs" + ) + } else { + NA_real_ + } + + # Format method-specific parameter string + param_str <- switch(x@method, + simplex = paste0( + "n_neighbors = ", x@parameters[["n_neighbors"]] + ), + smap = paste0( + "theta = ", x@parameters[["theta"]] + ), + gp = paste0( + "sigma2 = ", round(x@parameters[["sigma2"]], 4), + ", ve = ", round(x@parameters[["ve"]], 4) + ) + ) + + cli::cli_inform(c( + "i" = "EDM Fit Summary (FIMS v.{x@version})", + "-" = "Method : {.strong {toupper(x@method)}}", + "-" = "Embedding : {x@embedding_name}", + "-" = "Dimension (E) : {x@embedding_dimension}", + "-" = "Time lag (tau) : {x@time_lag}", + "-" = "Library size : {x@n_library}", + "-" = "Parameters : {param_str}", + "-" = "Predictions : {n_pred} fitted values" + )) + invisible(x) + } +) + +# methods::setMethod: accessors ---- + +#' Get a slot from an EDMFit object +#' +#' Accessor functions for each slot of the [EDMFit-class] S4 class returned +#' by [fit_edm()]. These are the preferred way to access stored results. +#' +#' @param x An [EDMFit-class] object returned by [fit_edm()]. +#' @name get_EDMFit +#' @seealso [fit_edm()], [edm_forecast()], [EDMFit-class] +NULL + +#' @return +#' [get_method()] returns a character string: one of `"simplex"`, +#' `"smap"`, or `"gp"`. +#' @export +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setGeneric("get_method", function(x) standardGeneric("get_method")) + +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setMethod("get_method", "EDMFit", function(x) x@method) + +#' @return +#' [get_predictions()] returns a numeric vector of in-library one-step-ahead +#' predictions, one per library row of the delay embedding. +#' @export +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setGeneric( + "get_predictions", + function(x) standardGeneric("get_predictions") +) + +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setMethod("get_predictions", "EDMFit", function(x) x@predictions) + +#' @return +#' [get_parameters()] returns a named list of method-specific +#' hyperparameters used during fitting. +#' @export +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setGeneric( + "get_parameters", + function(x) standardGeneric("get_parameters") +) + +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setMethod("get_parameters", "EDMFit", function(x) x@parameters) + +#' @return +#' [get_embedding_name()] returns the character name of the delay +#' embedding used. +#' @export +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setGeneric( + "get_embedding_name", + function(x) standardGeneric("get_embedding_name") +) + +#' @rdname get_EDMFit +#' @keywords fit_edm +methods::setMethod( + "get_embedding_name", + "EDMFit", + function(x) x@embedding_name +) + +# is.EDMFit ---------------------------------------------------------------- + +#' Test whether an object is an EDMFit +#' +#' @param x Any R object. +#' @return Logical. `TRUE` if `x` is an [EDMFit-class] object. +#' @export +#' @keywords fit_edm +is.EDMFit <- function(x) methods::is(x, "EDMFit") + # fit_edm ---------------------------------------------------------------- #' Fit an EDM model to a time series @@ -11,7 +242,8 @@ #' @description #' High-level interface for fitting an Empirical Dynamic Modeling (EDM) #' prediction model to a univariate or multivariate time series stored in a -#' `FIMSFrame` object. Supports Simplex Projection, S-Map, and GP-EDM methods. +#' [FIMSFrame()] object. Supports Simplex Projection, S-Map, and GP-EDM +#' methods. #' #' @param data A `FIMSFrame` object containing the time series data. #' @param method Character string specifying the EDM method to use. One of @@ -33,13 +265,7 @@ #' Default is `1`. #' @param ... Additional arguments passed to the underlying EDM C++ interface. #' -#' @return An object of class `EDMFit` containing: -#' \describe{ -#' \item{method}{The EDM method used.} -#' \item{predictions}{Numeric vector of one-step-ahead predictions.} -#' \item{embedding}{The `DelayEmbeddingMatrix` used for fitting.} -#' \item{parameters}{List of method-specific hyperparameters.} -#' } +#' @return An object of class [EDMFit-class]. #' #' @seealso [edm_forecast()], [create_edm_embedding()], [FIMSFrame()] #' @export @@ -49,6 +275,7 @@ #' ff <- FIMSFrame(data_big) #' ff <- create_edm_embedding(ff, type = "landings", fleet = "fishery1", E = 3, tau = 1) #' fit <- fit_edm(ff, method = "simplex", embedding_name = "fishery1_landings") +#' print(fit) #' } fit_edm <- function(data, method = c("simplex", "smap", "gp"), @@ -61,7 +288,7 @@ fit_edm <- function(data, ...) { method <- match.arg(method) stopifnot(inherits(data, "FIMSFrame")) - # TODO: Implement method dispatch to C++ EDM interfaces + # TODO: Implement method dispatch to C++ EDM interfaces (Commit 3) stop("fit_edm() is not yet implemented. Coming in Phase 4 (GSoC 2026).") } @@ -70,10 +297,10 @@ fit_edm <- function(data, #' Generate forecasts from a fitted EDM model #' #' @description -#' Generates out-of-sample empirical forecasts from a fitted `EDMFit` object -#' returned by [fit_edm()]. +#' Generates out-of-sample empirical forecasts from a fitted [EDMFit-class] +#' object returned by [fit_edm()]. #' -#' @param fit An `EDMFit` object returned by [fit_edm()]. +#' @param fit An [EDMFit-class] object returned by [fit_edm()]. #' @param n_ahead Positive integer. Number of time steps to forecast ahead. #' Default is `1`. #' @param ... Additional arguments passed to underlying prediction methods. @@ -85,7 +312,7 @@ fit_edm <- function(data, #' \item{se}{Standard error of the forecast (if available).} #' } #' -#' @seealso [fit_edm()] +#' @seealso [fit_edm()], [EDMFit-class] #' @export #' @examples #' \dontrun{ @@ -93,7 +320,7 @@ fit_edm <- function(data, #' forecasts <- edm_forecast(fit, n_ahead = 5) #' } edm_forecast <- function(fit, n_ahead = 1L, ...) { - stopifnot(inherits(fit, "EDMFit")) - # TODO: Implement forecast generation from EDMFit object + stopifnot(is.EDMFit(fit)) + # TODO: Implement forecast generation from EDMFit object (Commit 4) stop("edm_forecast() is not yet implemented. Coming in Phase 4 (GSoC 2026).") } diff --git a/man/EDMFit-class.Rd b/man/EDMFit-class.Rd new file mode 100644 index 000000000..b17f0c3b8 --- /dev/null +++ b/man/EDMFit-class.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/edm.R +\docType{class} +\name{EDMFit-class} +\alias{EDMFit-class} +\title{The EDMFit class} +\description{ +An S4 class storing the results of a fitted Empirical Dynamic Modeling (EDM) +model. Objects of this class are returned by \code{\link[=fit_edm]{fit_edm()}} and are the primary +input to \code{\link[=edm_forecast]{edm_forecast()}}. + +Slots are accessed using \verb{get_*()} accessor functions rather than the \code{@} +operator directly. +} +\section{Slots}{ + +\describe{ +\item{\code{method}}{Character. The EDM prediction method used. One of +\code{"simplex"}, \code{"smap"}, or \code{"gp"}.} + +\item{\code{predictions}}{Numeric vector. In-library (fitted) one-step-ahead +predictions for each row of the delay embedding library.} + +\item{\code{embedding_name}}{Character. Name of the delay embedding used, as stored +in the source \code{FIMSFrame}.} + +\item{\code{embedding_dimension}}{Integer. The embedding dimension \eqn{E} used.} + +\item{\code{time_lag}}{Integer. The time lag \eqn{\tau} used.} + +\item{\code{n_library}}{Integer. Number of library points (rows) in the embedding.} + +\item{\code{parameters}}{List. Method-specific hyperparameters: +\describe{ +\item{simplex}{\code{n_neighbors} — number of nearest neighbours used.} +\item{smap}{\code{theta} — nonlinearity weighting parameter.} +\item{gp}{\code{phi}, \code{sigma2}, \code{ve} — ARD length-scales, +signal variance, and process noise variance.} +}} + +\item{\code{version}}{A \code{package_version}. The version of FIMS used.} +}} + +\seealso{ +\code{\link[=fit_edm]{fit_edm()}}, \code{\link[=edm_forecast]{edm_forecast()}}, \link{get_EDMFit} +} diff --git a/man/create_edm_embedding.Rd b/man/create_edm_embedding.Rd index a85425be2..38bbf997f 100644 --- a/man/create_edm_embedding.Rd +++ b/man/create_edm_embedding.Rd @@ -21,11 +21,7 @@ create_edm_embedding( \item{series_type}{A single string giving the \code{type} value to filter on, e.g. \code{"index"} or \code{"landings"}.} -<<<<<<< HEAD \item{series_name}{A single string giving the \code{fleet} (fleet / survey) value -======= -\item{series_name}{A single string giving the \code{name} (fleet / survey) value ->>>>>>> 5fde931e (feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs) to filter on, e.g. \code{"survey1"}.} \item{E}{A positive integer — the embedding dimension (number of lagged @@ -37,11 +33,7 @@ coordinates per row).} the FIMS missing-value sentinel \code{-999} are dropped from the embedding matrix.} -<<<<<<< HEAD \item{uncertainty_name}{A single string giving the \code{fleet} column value for -======= -\item{uncertainty_name}{A single string giving the \code{name} column value for ->>>>>>> 5fde931e (feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs) an uncertainty series in the data slot (e.g. \code{"survey1_sd"}), or \code{NULL} (default) to skip uncertainty propagation. The uncertainty series must have the same length as the value series after filtering on @@ -63,11 +55,7 @@ stored in the \code{edm_embeddings} slot under \code{embedding_name}. } \details{ The time series is extracted by filtering \code{get_data(x)} on \code{type} and -<<<<<<< HEAD \code{fleet} (fleet / survey name). Values encoded as \code{-999} are treated as the -======= -\code{name} (fleet / survey name). Values encoded as \code{-999} are treated as the ->>>>>>> 5fde931e (feat(edm): add skeleton R interface with fit_edm() and edm_forecast() stubs) FIMS missing-data sentinel. When \code{drop_missing = TRUE}, \code{construct_drop_missing()} is called so that rows containing \code{-999} are removed from the embedding matrix; when \code{FALSE}, \code{construct()} is called diff --git a/man/edm_forecast.Rd b/man/edm_forecast.Rd index c43ba7cc5..2e22ef01f 100644 --- a/man/edm_forecast.Rd +++ b/man/edm_forecast.Rd @@ -7,7 +7,7 @@ edm_forecast(fit, n_ahead = 1L, ...) } \arguments{ -\item{fit}{An \code{EDMFit} object returned by \code{\link[=fit_edm]{fit_edm()}}.} +\item{fit}{An \linkS4class{EDMFit} object returned by \code{\link[=fit_edm]{fit_edm()}}.} \item{n_ahead}{Positive integer. Number of time steps to forecast ahead. Default is \code{1}.} @@ -23,8 +23,8 @@ A tibble with columns: } } \description{ -Generates out-of-sample empirical forecasts from a fitted \code{EDMFit} object -returned by \code{\link[=fit_edm]{fit_edm()}}. +Generates out-of-sample empirical forecasts from a fitted \linkS4class{EDMFit} +object returned by \code{\link[=fit_edm]{fit_edm()}}. } \examples{ \dontrun{ @@ -33,5 +33,5 @@ forecasts <- edm_forecast(fit, n_ahead = 5) } } \seealso{ -\code{\link[=fit_edm]{fit_edm()}} +\code{\link[=fit_edm]{fit_edm()}}, \linkS4class{EDMFit} } diff --git a/man/fit_edm.Rd b/man/fit_edm.Rd index f40506cea..d62bc0b02 100644 --- a/man/fit_edm.Rd +++ b/man/fit_edm.Rd @@ -46,18 +46,13 @@ Default is \code{1}.} \item{...}{Additional arguments passed to the underlying EDM C++ interface.} } \value{ -An object of class \code{EDMFit} containing: -\describe{ -\item{method}{The EDM method used.} -\item{predictions}{Numeric vector of one-step-ahead predictions.} -\item{embedding}{The \code{DelayEmbeddingMatrix} used for fitting.} -\item{parameters}{List of method-specific hyperparameters.} -} +An object of class \linkS4class{EDMFit}. } \description{ High-level interface for fitting an Empirical Dynamic Modeling (EDM) prediction model to a univariate or multivariate time series stored in a -\code{FIMSFrame} object. Supports Simplex Projection, S-Map, and GP-EDM methods. +\code{\link[=FIMSFrame]{FIMSFrame()}} object. Supports Simplex Projection, S-Map, and GP-EDM +methods. } \examples{ \dontrun{ @@ -65,6 +60,7 @@ data("data_big") ff <- FIMSFrame(data_big) ff <- create_edm_embedding(ff, type = "landings", fleet = "fishery1", E = 3, tau = 1) fit <- fit_edm(ff, method = "simplex", embedding_name = "fishery1_landings") +print(fit) } } \seealso{ diff --git a/man/get_EDMFit.Rd b/man/get_EDMFit.Rd new file mode 100644 index 000000000..6f8e9a68d --- /dev/null +++ b/man/get_EDMFit.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/edm.R +\name{get_EDMFit} +\alias{get_EDMFit} +\alias{get_method} +\alias{get_method,EDMFit-method} +\alias{get_predictions} +\alias{get_predictions,EDMFit-method} +\alias{get_parameters} +\alias{get_parameters,EDMFit-method} +\alias{get_embedding_name} +\alias{get_embedding_name,EDMFit-method} +\title{Get a slot from an EDMFit object} +\usage{ +get_method(x) + +\S4method{get_method}{EDMFit}(x) + +get_predictions(x) + +\S4method{get_predictions}{EDMFit}(x) + +get_parameters(x) + +\S4method{get_parameters}{EDMFit}(x) + +get_embedding_name(x) + +\S4method{get_embedding_name}{EDMFit}(x) +} +\arguments{ +\item{x}{An \linkS4class{EDMFit} object returned by \code{\link[=fit_edm]{fit_edm()}}.} +} +\value{ +\code{\link[=get_method]{get_method()}} returns a character string: one of \code{"simplex"}, +\code{"smap"}, or \code{"gp"}. + +\code{\link[=get_predictions]{get_predictions()}} returns a numeric vector of in-library one-step-ahead +predictions, one per library row of the delay embedding. + +\code{\link[=get_parameters]{get_parameters()}} returns a named list of method-specific +hyperparameters used during fitting. + +\code{\link[=get_embedding_name]{get_embedding_name()}} returns the character name of the delay +embedding used. +} +\description{ +Accessor functions for each slot of the \linkS4class{EDMFit} S4 class returned +by \code{\link[=fit_edm]{fit_edm()}}. These are the preferred way to access stored results. +} +\seealso{ +\code{\link[=fit_edm]{fit_edm()}}, \code{\link[=edm_forecast]{edm_forecast()}}, \linkS4class{EDMFit} +} +\keyword{fit_edm} diff --git a/man/is.EDMFit.Rd b/man/is.EDMFit.Rd new file mode 100644 index 000000000..9cf25d4a0 --- /dev/null +++ b/man/is.EDMFit.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/edm.R +\name{is.EDMFit} +\alias{is.EDMFit} +\title{Test whether an object is an EDMFit} +\usage{ +is.EDMFit(x) +} +\arguments{ +\item{x}{Any R object.} +} +\value{ +Logical. \code{TRUE} if \code{x} is an \linkS4class{EDMFit} object. +} +\description{ +Test whether an object is an EDMFit +} +\keyword{fit_edm} From 0e6077db79c89b453a367c1436cdb110618371c4 Mon Sep 17 00:00:00 2001 From: Aman Raj Date: Sat, 8 Aug 2026 00:23:44 +0530 Subject: [PATCH 3/3] feat(edm): implement fit_edm() for simplex, smap, and gp methods --- R/edm.R | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 127 insertions(+), 3 deletions(-) diff --git a/R/edm.R b/R/edm.R index 916a42b64..4459fbc3b 100644 --- a/R/edm.R +++ b/R/edm.R @@ -287,9 +287,133 @@ fit_edm <- function(data, forecast_horizon = 1L, ...) { method <- match.arg(method) - stopifnot(inherits(data, "FIMSFrame")) - # TODO: Implement method dispatch to C++ EDM interfaces (Commit 3) - stop("fit_edm() is not yet implemented. Coming in Phase 4 (GSoC 2026).") + + # --- Input validation --------------------------------------------------- + if (!methods::is(data, "FIMSFrame")) { + cli::cli_abort("{.arg data} must be a {.cls FIMSFrame} object.") + } + + # --- Resolve embedding -------------------------------------------------- + embeddings <- get_edm_embeddings(data) + if (length(embeddings) == 0L) { + cli::cli_abort(c( + "No delay embeddings found in {.arg data}.", + "i" = "Use {.fn create_edm_embedding} to build one first." + )) + } + + if (is.null(embedding_name)) { + embedding_name <- names(embeddings)[[1L]] + cli::cli_inform( + "Using first available embedding: {.val {embedding_name}}" + ) + } + + if (!embedding_name %in% names(embeddings)) { + cli::cli_abort(c( + "Embedding {.val {embedding_name}} not found in {.arg data}.", + "i" = "Available embeddings: {.val {names(embeddings)}}." + )) + } + + emb <- embeddings[[embedding_name]] + E_used <- emb$E + tau_used <- emb$tau + + # --- Reconstruct Rcpp DelayEmbedding from the stored series ------------- + # Re-extract the original series so the Rcpp object holds live pointers. + series_data <- dplyr::filter( + get_data(data), + .data[["type"]] == emb$series_type, + .data[["fleet"]] == emb$series_name + ) |> + dplyr::arrange(.data[["timing"]]) |> + dplyr::pull(.data[["value"]]) + + lib_de <- methods::new(DelayEmbedding) + if (isTRUE(emb$drop_missing)) { + lib_de$construct_drop_missing( + as.numeric(series_data), + as.integer(E_used), + as.integer(tau_used), + -999.0 + ) + } else { + lib_de$construct( + as.numeric(series_data), + as.integer(E_used), + as.integer(tau_used) + ) + } + + n_lib <- lib_de$n_rows + + if (n_lib < 2L) { + cli::cli_abort(c( + "Library has fewer than 2 rows after constructing the delay embedding.", + "i" = "Check that {.arg data} has enough observations for E={E_used}, tau={tau_used}." + )) + } + + # --- Dispatch to Rcpp predictor ----------------------------------------- + # In-library prediction: library == test (same DelayEmbedding id). + lib_id <- lib_de$get_id() + + result <- switch(method, + + simplex = { + k <- if (as.integer(n_neighbors) == 0L) { + as.integer(E_used + 1L) + } else { + as.integer(n_neighbors) + } + sp <- methods::new(SimplexProjection) + sp$embedding_dimension <- as.integer(E_used) + sp$n_neighbors <- k + preds <- sp$predict(lib_id, lib_id) + params <- list(n_neighbors = k) + list(predictions = preds, parameters = params) + }, + + smap = { + sm <- methods::new(SMapProjection) + sm$embedding_dimension <- as.integer(E_used) + sm$theta <- as.numeric(theta) + sm$kernel <- "exponential" + preds <- sm$predict(lib_id, lib_id) + params <- list(theta = as.numeric(theta), kernel = "exponential") + list(predictions = preds, parameters = params) + }, + + gp = { + gp <- methods::new(GPEdmProjection) + gp$embedding_dimension <- as.integer(E_used) + gp$phi <- rep(0.5, E_used) + gp$sigma2 <- 1.0 + gp$ve <- 0.1 + fitted <- gp$fit(lib_id) # optimises phi, sigma2, ve in-place + preds <- gp$predict(lib_id, lib_id) + params <- list( + phi = fitted$phi, + sigma2 = fitted$sigma2, + ve = fitted$ve + ) + list(predictions = preds, parameters = params) + } + ) + + # --- Construct and return EDMFit ---------------------------------------- + methods::new( + "EDMFit", + method = method, + predictions = as.numeric(result$predictions), + embedding_name = embedding_name, + embedding_dimension = as.integer(E_used), + time_lag = as.integer(tau_used), + n_library = as.integer(n_lib), + parameters = result$parameters, + version = utils::packageVersion("FIMS") + ) } # edm_forecast -----------------------------------------------------------